From 8cb1e16ceb5ee655fc214f1ef8a7abbe807ba4b3 Mon Sep 17 00:00:00 2001
From: Tristan Gingold <tgingold@free.fr>
Date: Sat, 26 Sep 2020 09:12:18 +0200
Subject: vhdl: evaluate operands of operators, check bounds.  For #1475

---
 src/vhdl/vhdl-evaluation.adb | 20 +++++++++++++++++---
 src/vhdl/vhdl-sem_expr.adb   | 24 +++++++++++++-----------
 2 files changed, 30 insertions(+), 14 deletions(-)

diff --git a/src/vhdl/vhdl-evaluation.adb b/src/vhdl/vhdl-evaluation.adb
index 9206db678..0784c706e 100644
--- a/src/vhdl/vhdl-evaluation.adb
+++ b/src/vhdl/vhdl-evaluation.adb
@@ -36,6 +36,8 @@ package body Vhdl.Evaluation is
    --  If FORCE is true, always return a literal.
    function Eval_Expr_Keep_Orig (Expr : Iir; Force : Boolean) return Iir;
 
+   function Eval_Check_Bound (Expr : Iir; Sub_Type : Iir) return Boolean;
+
    function Eval_Enum_To_String (Lit : Iir; Orig : Iir) return Iir;
    function Eval_Integer_Image (Val : Int64; Orig : Iir) return Iir;
    function Eval_Floating_Image (Val : Fp64; Orig : Iir) return Iir;
@@ -3417,8 +3419,9 @@ package body Vhdl.Evaluation is
            and then Get_Kind (Atype) in Iir_Kinds_Range_Type_Definition
          then
             --  Check bounds (as this can be done).
-            --  FIXME: create overflow_expr ?
-            Eval_Check_Bound (Res, Atype);
+            if not Eval_Check_Bound (Res, Atype) then
+               Res := Build_Overflow (Res, Atype);
+            end if;
          end if;
 
          return Res;
@@ -3657,15 +3660,26 @@ package body Vhdl.Evaluation is
       end case;
    end Eval_Is_In_Bound;
 
-   procedure Eval_Check_Bound (Expr : Iir; Sub_Type : Iir) is
+   function Eval_Check_Bound (Expr : Iir; Sub_Type : Iir) return Boolean is
    begin
       --  Note: use True not to repeat a message in case of overflow.
       if not Eval_Is_In_Bound (Expr, Sub_Type, True) then
          Warning_Msg_Sem (Warnid_Runtime_Error, +Expr,
                           "static expression violates bounds");
+         return False;
+      else
+         return True;
       end if;
    end Eval_Check_Bound;
 
+   procedure Eval_Check_Bound (Expr : Iir; Sub_Type : Iir)
+   is
+      Res : Boolean;
+   begin
+      Res := Eval_Check_Bound (Expr, Sub_Type);
+      pragma Unreferenced (Res);
+   end Eval_Check_Bound;
+
    function Eval_Is_Range_In_Bound
      (A_Range : Iir; Sub_Type : Iir; Any_Dir : Boolean)
      return Boolean
diff --git a/src/vhdl/vhdl-sem_expr.adb b/src/vhdl/vhdl-sem_expr.adb
index 0e6d17509..4d6b772b5 100644
--- a/src/vhdl/vhdl-sem_expr.adb
+++ b/src/vhdl/vhdl-sem_expr.adb
@@ -1727,36 +1727,38 @@ package body Vhdl.Sem_Expr is
       Is_Dyadic : constant Boolean :=
         Get_Kind (Expr) in Iir_Kinds_Dyadic_Operator;
       Interface_Chain : Iir;
-      Err : Boolean;
-      Left : Iir;
-      Right : Iir;
+      Err             : Boolean;
+      Left            : Iir;
+      Left_Type       : Iir;
+      Right           : Iir;
+      Right_Type      : Iir;
    begin
       Set_Type (Expr, Get_Return_Type (Decl));
       Interface_Chain := Get_Interface_Declaration_Chain (Decl);
       Err := False;
       Left := Get_Left (Expr);
+      Left_Type := Get_Type (Interface_Chain);
       if Is_Overloaded (Left) then
-         Left := Sem_Expression_Ov
-           (Left, Get_Base_Type (Get_Type (Interface_Chain)));
+         Left := Sem_Expression_Ov (Left, Get_Base_Type (Left_Type));
          if Left = Null_Iir then
             Err := True;
-         else
-            Set_Left (Expr, Left);
          end if;
       end if;
+      Left := Eval_Expr_Check_If_Static (Left, Left_Type);
       Check_Read (Left);
+      Set_Left (Expr, Left);
       if Is_Dyadic then
          Right := Get_Right (Expr);
+         Right_Type := Get_Type (Get_Chain (Interface_Chain));
          if Is_Overloaded (Right) then
-            Right := Sem_Expression_Ov
-              (Right, Get_Base_Type (Get_Type (Get_Chain (Interface_Chain))));
+            Right := Sem_Expression_Ov (Right, Get_Base_Type (Right_Type));
             if Right = Null_Iir then
                Err := True;
-            else
-               Set_Right (Expr, Right);
             end if;
          end if;
+         Right := Eval_Expr_Check_If_Static (Right, Right_Type);
          Check_Read (Right);
+         Set_Right (Expr, Right);
       end if;
       if not Err then
          Set_Implementation (Expr, Decl);
-- 
cgit v1.2.3