[Ada] Wrong compile time evaluation of Shift_Right
authorArnaud Charlet <charlet@adacore.com>
Thu, 5 Nov 2020 09:48:28 +0000 (04:48 -0500)
committerPierre-Marie de Rodat <derodat@adacore.com>
Fri, 27 Nov 2020 09:16:02 +0000 (04:16 -0500)
gcc/ada/

* sem_eval.adb (Fold_Shift): Fix evaluation of Shift_Right on
negative values.

gcc/ada/sem_eval.adb

index c54c49ac9a8919a29c74d0be03314ff98da3668c..198f72fe0854b39ea1d6cefdc0530424fa889da8 100644 (file)
@@ -4805,6 +4805,8 @@ package body Sem_Eval is
          end if;
       end Check_Elab_Call;
 
+      Modulus : Uint;
+
    begin
       if Compile_Time_Known_Value (Left)
         and then Compile_Time_Known_Value (Right)
@@ -4835,19 +4837,34 @@ package body Sem_Eval is
          elsif Op = N_Op_Shift_Right then
             Check_Elab_Call;
 
-            --  Fold Shift_Right (X, Y) by computing abs X / 2**Y
+            --  X >> 0 is a no-op
 
-            Fold_Uint
-              (N,
-               abs Expr_Value (Left) / (Uint_2 ** Expr_Value (Right)),
-               Static => Static);
+            if Expr_Value (Right) = Uint_0 then
+               Fold_Uint (N, Expr_Value (Left), Static => Static);
+            else
+               if Is_Modular_Integer_Type (Typ) then
+                  Modulus := Einfo.Modulus (Typ);
+               else
+                  Modulus := Uint_2 ** RM_Size (Typ);
+               end if;
+
+               --  Fold X >> Y by computing (X [+ Modulus]) / 2**Y
+               --  Note that after a Shift_Right operation (with Y > 0), the
+               --  result is always positive, even if the original operand was
+               --  negative.
 
+               Fold_Uint
+                 (N,
+                  (Expr_Value (Left) +
+                     (if Expr_Value (Left) >= Uint_0 then Uint_0 else Modulus))
+                  / (Uint_2 ** Expr_Value (Right)),
+                  Static => Static);
+            end if;
          elsif Op = N_Op_Shift_Right_Arithmetic then
             Check_Elab_Call;
 
             declare
                Two_Y   : constant Uint := Uint_2 ** Expr_Value (Right);
-               Modulus : Uint;
             begin
                if Is_Modular_Integer_Type (Typ) then
                   Modulus := Einfo.Modulus (Typ);