From af48935d43efb48e05ec5312eea34c1a875f6a66 Mon Sep 17 00:00:00 2001
From: Stephen Heumann <stephenheumann@gmail.com>
Date: Mon, 7 Nov 2016 18:57:40 -0600
Subject: [PATCH] Fix so the type of shift expressions depends only on the
 (promoted) type of their left operand.

This is as required by the C standards: the type of the right operand should not affect the result type.

The following program demonstrates problems with the old behavior:

#include <stdio.h>

int main(void)
{
    unsigned long ul;
    long l;
    unsigned u;
    int i;

    ul = 0x8000 << 1L; /* should be 0 */
    printf("%lx\n", ul);

    l = -1 >> 1U; /* should be -1 */
    printf("%ld\n", l);

    u = 0xFF10;
    l = 8;
    ul = u << l; /* should be 0x1000 */
    printf("%lx\n", ul);

    l = -4;
    ul = 1;
    l = l >> ul; /* should be -2 */
    printf("%ld\n", l);
}
---
 Expression.pas | 30 ++++++++++++++++++++++++++----
 1 file changed, 26 insertions(+), 4 deletions(-)

diff --git a/Expression.pas b/Expression.pas
index 984478f..86daef9 100644
--- a/Expression.pas
+++ b/Expression.pas
@@ -1061,11 +1061,17 @@ var
                                    op1 := ord(op1 >= op2);
                                 ekind := intconst;
                                 end;
-                  ltltop      : op1 := op1 << op2;                      {<<}
-                  gtgtop      : if unsigned1 then                       {>>}
+                  ltltop      : begin                                   {<<}
+                                op1 := op1 << op2;
+                                ekind := kindLeft;
+                                end;
+                  gtgtop      : begin                                   {>>}
+                                if unsigned1 then
                                    op1 := lshr(op1,op2)
                                 else
                                    op1 := op1 >> op2;
+                                ekind := kindLeft;
+                                end;
                   plusch      : op1 := op1 + op2;                       {+}
                   minusch     : op1 := op1 - op2;                       {-}
                   asteriskch  : if unsigned then          		{*}
@@ -3199,9 +3205,16 @@ case tree^.token.kind of
 
    ltltop: begin                        {<<}
       GenerateCode(tree^.left);
+      et := UsualUnaryConversions;
       lType := expressionType;
       GenerateCode(tree^.right);
-      case UsualBinaryConversions(lType) of
+      if (expressionType^.kind <> scalarType)
+         or not (expressionType^.baseType in
+         [cgByte,cgUByte,cgWord,cgUWord,cgLong,cgULong]) then
+         error(66);
+      if expressionType^.baseType <> et then
+         Gen2(pc_cnv, ord(expressionType^.baseType), ord(et));
+      case et of
          cgByte,cgUByte,cgWord,cgUWord:
             Gen0(pc_shl);
          cgLong,cgULong:
@@ -3209,13 +3222,21 @@ case tree^.token.kind of
          otherwise:
             error(66);
          end; {case}
+      expressionType := lType;
       end; {case ltltop}
 
    gtgtop: begin                        {>>}
       GenerateCode(tree^.left);
+      et := UsualUnaryConversions;
       lType := expressionType;
       GenerateCode(tree^.right);
-      case UsualBinaryConversions(lType) of
+      if (expressionType^.kind <> scalarType)
+         or not (expressionType^.baseType in
+         [cgByte,cgUByte,cgWord,cgUWord,cgLong,cgULong]) then
+         error(66);
+      if expressionType^.baseType <> et then
+         Gen2(pc_cnv, ord(expressionType^.baseType), ord(et));
+      case et of
          cgByte,cgWord:
             Gen0(pc_shr);
          cgUByte,cgUWord:
@@ -3227,6 +3248,7 @@ case tree^.token.kind of
          otherwise:
             error(66);
          end; {case}
+      expressionType := lType;
       end; {case gtgtop}
 
    plusch: begin                        {+}