Handle overflow during evaluation of type conversion. Forward on 'image.

3 files changed, 57 insertions, 31 deletions

diff --git a/src/vhdl/evaluation.adb b/src/vhdl/evaluation.adb
index bf0e7d3c6..c1cadf77c 100644
--- a/src/vhdl/evaluation.adb
+++ b/src/vhdl/evaluation.adb
@@ -164,18 +164,23 @@ package body Evaluation is
       return Res;
    end Build_Simple_Aggregate;
 
-   function Build_Overflow (Origin : Iir) return Iir
+   function Build_Overflow (Origin : Iir; Expr_Type : Iir) return Iir
    is
       Res : Iir;
    begin
       Res := Create_Iir (Iir_Kind_Overflow_Literal);
       Location_Copy (Res, Origin);
-      Set_Type (Res, Get_Type (Origin));
+      Set_Type (Res, Expr_Type);
       Set_Literal_Origin (Res, Origin);
       Set_Expr_Staticness (Res, Locally);
       return Res;
    end Build_Overflow;
 
+   function Build_Overflow (Origin : Iir) return Iir is
+   begin
+      return Build_Overflow (Origin, Get_Type (Origin));
+   end Build_Overflow;
+
    function Build_Constant (Val : Iir; Origin : Iir) return Iir
    is
       Res : Iir;
@@ -1749,37 +1754,48 @@ package body Evaluation is
       Val : Iir;
       Val_Type : Iir;
       Conv_Type : Iir;
+      Res : Iir;
    begin
       Val := Eval_Static_Expr (Get_Expression (Expr));
       Val_Type := Get_Base_Type (Get_Type (Val));
       Conv_Type := Get_Base_Type (Get_Type (Expr));
       if Conv_Type = Val_Type then
-         return Build_Constant (Val, Expr);
+         Res := Build_Constant (Val, Expr);
+      else
+         case Get_Kind (Conv_Type) is
+            when Iir_Kind_Integer_Type_Definition =>
+               case Get_Kind (Val_Type) is
+                  when Iir_Kind_Integer_Type_Definition =>
+                     Res := Build_Integer (Get_Value (Val), Expr);
+                  when Iir_Kind_Floating_Type_Definition =>
+                     Res := Build_Integer
+                       (Iir_Int64 (Get_Fp_Value (Val)), Expr);
+                  when others =>
+                     Error_Kind ("eval_type_conversion(1)", Val_Type);
+               end case;
+            when Iir_Kind_Floating_Type_Definition =>
+               case Get_Kind (Val_Type) is
+                  when Iir_Kind_Integer_Type_Definition =>
+                     Res := Build_Floating (Iir_Fp64 (Get_Value (Val)), Expr);
+                  when Iir_Kind_Floating_Type_Definition =>
+                     Res := Build_Floating (Get_Fp_Value (Val), Expr);
+                  when others =>
+                     Error_Kind ("eval_type_conversion(2)", Val_Type);
+               end case;
+            when Iir_Kind_Array_Type_Definition =>
+               --  Not a scalar, do not check bounds.
+               return Eval_Array_Type_Conversion (Expr, Val);
+            when others =>
+               Error_Kind ("eval_type_conversion(3)", Conv_Type);
+         end case;
       end if;
-      case Get_Kind (Conv_Type) is
-         when Iir_Kind_Integer_Type_Definition =>
-            case Get_Kind (Val_Type) is
-               when Iir_Kind_Integer_Type_Definition =>
-                  return Build_Integer (Get_Value (Val), Expr);
-               when Iir_Kind_Floating_Type_Definition =>
-                  return Build_Integer (Iir_Int64 (Get_Fp_Value (Val)), Expr);
-               when others =>
-                  Error_Kind ("eval_type_conversion(1)", Val_Type);
-            end case;
-         when Iir_Kind_Floating_Type_Definition =>
-            case Get_Kind (Val_Type) is
-               when Iir_Kind_Integer_Type_Definition =>
-                  return Build_Floating (Iir_Fp64 (Get_Value (Val)), Expr);
-               when Iir_Kind_Floating_Type_Definition =>
-                  return Build_Floating (Get_Fp_Value (Val), Expr);
-               when others =>
-                  Error_Kind ("eval_type_conversion(2)", Val_Type);
-            end case;
-         when Iir_Kind_Array_Type_Definition =>
-            return Eval_Array_Type_Conversion (Expr, Val);
-         when others =>
-            Error_Kind ("eval_type_conversion(3)", Conv_Type);
-      end case;
+      if not Eval_Is_In_Bound (Res, Get_Type (Expr)) then
+         if Get_Kind (Res) /= Iir_Kind_Overflow_Literal then
+            Warning_Msg_Sem ("result of conversion out of bounds", Expr);
+            Res := Build_Overflow (Res);
+         end if;
+      end if;
+      return Res;
    end Eval_Type_Conversion;
 
    function Eval_Physical_Literal (Expr : Iir) return Iir
@@ -1944,6 +1960,12 @@ package body Evaluation is
                Param := Get_Parameter (Expr);
                Param := Eval_Static_Expr (Param);
                Set_Parameter (Expr, Param);
+
+               --  Special case for overflow.
+               if Get_Kind (Param) = Iir_Kind_Overflow_Literal then
+                  return Build_Overflow (Expr);
+               end if;
+
                Param_Type := Get_Base_Type (Get_Type (Param));
                case Get_Kind (Param_Type) is
                   when Iir_Kind_Integer_Type_Definition =>
diff --git a/src/vhdl/translate/trans-chap4.adb b/src/vhdl/translate/trans-chap4.adb
index 7c71cc7e0..3cbfc0b74 100644
--- a/src/vhdl/translate/trans-chap4.adb
+++ b/src/vhdl/translate/trans-chap4.adb
@@ -543,7 +543,7 @@ package body Trans.Chap4 is
    --  Create code to elaborate OBJ.
    procedure Elab_Object (Obj : Iir)
    is
-      Value : Iir;
+      Value : constant Iir := Get_Default_Value (Obj);
       Obj1  : Iir;
    begin
       --  A locally static constant is pre-elaborated.
@@ -551,6 +551,9 @@ package body Trans.Chap4 is
       if Get_Expr_Staticness (Obj) = Locally
         and then Get_Deferred_Declaration (Obj) = Null_Iir
       then
+         if Get_Kind (Value) = Iir_Kind_Overflow_Literal then
+            Chap6.Gen_Bound_Error (Obj);
+         end if;
          return;
       end if;
 
@@ -575,7 +578,6 @@ package body Trans.Chap4 is
 
       --  Still use the default value of the not deferred constant.
       --  FIXME: what about composite types.
-      Value := Get_Default_Value (Obj);
       Elab_Object_Value (Obj1, Value);
    end Elab_Object;
 
diff --git a/src/vhdl/translate/trans-chap7.adb b/src/vhdl/translate/trans-chap7.adb
index 9e721a932..6497f428f 100644
--- a/src/vhdl/translate/trans-chap7.adb
+++ b/src/vhdl/translate/trans-chap7.adb
@@ -3894,9 +3894,11 @@ package body Trans.Chap7 is
                --  Generate the error message
                Chap6.Gen_Bound_Error (Expr);
 
-               --  Create a dummy value
+               --  Create a dummy value, for type checking.  But never
+               --  executed.
                L := Create_Temp (Otype);
-               if Tinfo.Type_Mode = Type_Mode_Fat_Acc then
+               if Tinfo.Type_Mode in Type_Mode_Fat then
+                  --  For fat pointers or arrays.
                   return New_Address (New_Obj (L),
                                       Tinfo.Ortho_Ptr_Type (Mode_Value));
                else