eval_is_in_bound: make it more tolerant.

Replaces check_implicit_conversion.

Fix #258

6 files changed, 60 insertions, 75 deletions

diff --git a/src/vhdl/evaluation.adb b/src/vhdl/evaluation.adb
index f41a6a50d..cc64c9924 100644
--- a/src/vhdl/evaluation.adb
+++ b/src/vhdl/evaluation.adb
@@ -3098,40 +3098,48 @@ package body Evaluation is
       Val : Iir;
    begin
       case Get_Kind (Expr) is
+         when Iir_Kind_Simple_Name
+           | Iir_Kind_Character_Literal
+           | Iir_Kind_Selected_Name
+           | Iir_Kind_Parenthesis_Name =>
+            Val := Get_Named_Entity (Expr);
+         when others =>
+            Val := Expr;
+      end case;
+
+      case Get_Kind (Val) is
          when Iir_Kind_Error =>
             --  Ignore errors.
             return True;
          when Iir_Kind_Overflow_Literal =>
             --  Never within bounds
             return False;
-         when Iir_Kind_Simple_Name
-           | Iir_Kind_Character_Literal
-           | Iir_Kind_Selected_Name =>
-            Val := Get_Named_Entity (Expr);
          when others =>
-            Val := Expr;
+            null;
       end case;
 
       case Get_Kind (Sub_Type) is
          when Iir_Kind_Integer_Subtype_Definition =>
-            if Get_Expr_Staticness (Expr) /= Locally
+            if Get_Expr_Staticness (Val) /= Locally
               or else Get_Type_Staticness (Sub_Type) /= Locally
             then
                return True;
             end if;
             Type_Range := Get_Range_Constraint (Sub_Type);
             return Eval_Int_In_Range (Get_Value (Val), Type_Range);
+
          when Iir_Kind_Floating_Subtype_Definition =>
-            if Get_Expr_Staticness (Expr) /= Locally
+            if Get_Expr_Staticness (Val) /= Locally
               or else Get_Type_Staticness (Sub_Type) /= Locally
             then
                return True;
             end if;
             Type_Range := Get_Range_Constraint (Sub_Type);
             return Eval_Fp_In_Range (Get_Fp_Value (Val), Type_Range);
+
          when Iir_Kind_Enumeration_Subtype_Definition
            | Iir_Kind_Enumeration_Type_Definition =>
-            if Get_Expr_Staticness (Expr) /= Locally
+            if Get_Expr_Staticness (Val) /= Locally
               or else Get_Type_Staticness (Sub_Type) /= Locally
             then
                return True;
@@ -3141,8 +3149,9 @@ package body Evaluation is
             Type_Range := Get_Range_Constraint (Sub_Type);
             return Eval_Int_In_Range
               (Iir_Int64 (Get_Enum_Pos (Val)), Type_Range);
+
          when Iir_Kind_Physical_Subtype_Definition =>
-            if Get_Expr_Staticness (Expr) /= Locally
+            if Get_Expr_Staticness (Val) /= Locally
               or else Get_Type_Staticness (Sub_Type) /= Locally
             then
                return True;
@@ -3151,7 +3160,7 @@ package body Evaluation is
             return Eval_Phys_In_Range (Get_Physical_Value (Val), Type_Range);
 
          when Iir_Kind_Base_Attribute =>
-            if Get_Expr_Staticness (Expr) /= Locally
+            if Get_Expr_Staticness (Val) /= Locally
               or else Get_Type_Staticness (Sub_Type) /= Locally
             then
                return True;
@@ -3162,6 +3171,11 @@ package body Evaluation is
             declare
                Val_Type : constant Iir := Get_Type (Val);
             begin
+               if Is_Null (Val_Type) then
+                  --  Punt on errors.
+                  return True;
+               end if;
+
                if Get_Constraint_State (Sub_Type) /= Fully_Constrained
                  or else
                  Get_Kind (Val_Type) /= Iir_Kind_Array_Subtype_Definition
@@ -3206,6 +3220,21 @@ package body Evaluation is
             --  FIXME: do it.
             return True;
 
+         when Iir_Kind_File_Type_Definition =>
+            return True;
+
+         when Iir_Kind_Integer_Type_Definition
+           | Iir_Kind_Physical_Type_Definition
+           | Iir_Kind_Floating_Type_Definition =>
+            return True;
+
+         when Iir_Kind_Interface_Type_Definition
+           | Iir_Kind_Protected_Type_Declaration =>
+            return True;
+
+         when Iir_Kind_Error =>
+            return True;
+
          when others =>
             Error_Kind ("eval_is_in_bound", Sub_Type);
       end case;
diff --git a/src/vhdl/sem_assocs.adb b/src/vhdl/sem_assocs.adb
index 1eef39292..d760101e7 100644
--- a/src/vhdl/sem_assocs.adb
+++ b/src/vhdl/sem_assocs.adb
@@ -2222,9 +2222,9 @@ package body Sem_Assocs is
          Expr := Eval_Expr_Check_If_Static (Expr, Res_Type);
          Set_Actual (Assoc, Expr);
          if In_Conv = Null_Iir and then Out_Conv = Null_Iir then
-            if not Check_Implicit_Conversion (Formal_Type, Expr) then
+            if not Eval_Is_In_Bound (Expr, Formal_Type) then
                Error_Msg_Sem
-                 (+Assoc, "actual length does not match formal length");
+                 (+Assoc, "actual constraints don't match formal ones");
             end if;
          end if;
       end if;
diff --git a/src/vhdl/sem_decls.adb b/src/vhdl/sem_decls.adb
index 53daeb6fa..0802e6128 100644
--- a/src/vhdl/sem_decls.adb
+++ b/src/vhdl/sem_decls.adb
@@ -1856,9 +1856,15 @@ package body Sem_Decls is
             end if;
       end case;
 
-      if not Check_Implicit_Conversion (Atype, Default_Value) then
-         Error_Msg_Sem
-           (+Decl, "default value length does not match object type length");
+      if Is_Valid (Default_Value)
+        and then not Eval_Is_In_Bound (Default_Value, Atype)
+        and then Get_Kind (Default_Value) /= Iir_Kind_Overflow_Literal
+      then
+         Warning_Msg_Sem
+           (Warnid_Runtime_Error, +Decl,
+            "default value constraints don't match object type ones");
+         Default_Value := Build_Overflow (Default_Value, Atype);
+         Set_Default_Value (Decl, Default_Value);
       end if;
 
       case Get_Kind (Decl) is
diff --git a/src/vhdl/sem_expr.adb b/src/vhdl/sem_expr.adb
index 084aa377f..20ff0da71 100644
--- a/src/vhdl/sem_expr.adb
+++ b/src/vhdl/sem_expr.adb
@@ -425,54 +425,6 @@ package body Sem_Expr is
       end case;
    end Check_Is_Expression;
 
-   function Check_Implicit_Conversion (Targ_Type : Iir; Expr : Iir)
-                                      return Boolean
-   is
-      Expr_Type : Iir;
-      Targ_Indexes : Iir_List;
-      Expr_Indexes : Iir_List;
-      Targ_Index : Iir;
-      Expr_Index : Iir;
-   begin
-      --  Handle errors.
-      if Targ_Type = Null_Iir or else Expr = Null_Iir then
-         return True;
-      end if;
-      if Get_Kind (Targ_Type) /= Iir_Kind_Array_Subtype_Definition
-        or else Get_Constraint_State (Targ_Type) /= Fully_Constrained
-      then
-         return True;
-      end if;
-      Expr_Type := Get_Type (Expr);
-      if Expr_Type = Null_Iir
-        or else Get_Kind (Expr_Type) /= Iir_Kind_Array_Subtype_Definition
-        or else Get_Constraint_State (Expr_Type) /= Fully_Constrained
-      then
-         return True;
-      end if;
-      Targ_Indexes := Get_Index_Subtype_List (Targ_Type);
-      Expr_Indexes := Get_Index_Subtype_List (Expr_Type);
-      for I in Natural loop
-         Targ_Index := Get_Index_Type (Targ_Indexes, I);
-         Expr_Index := Get_Index_Type (Expr_Indexes, I);
-         exit when Targ_Index = Null_Iir and Expr_Index = Null_Iir;
-         if Targ_Index = Null_Iir or Expr_Index = Null_Iir then
-            --  Types does not match.
-            raise Internal_Error;
-         end if;
-         if Get_Type_Staticness (Targ_Index) = Locally
-           and then Get_Type_Staticness (Expr_Index) = Locally
-         then
-            if Eval_Discrete_Type_Length (Targ_Index)
-              /= Eval_Discrete_Type_Length (Expr_Index)
-            then
-               return False;
-            end if;
-         end if;
-      end loop;
-      return True;
-   end Check_Implicit_Conversion;
-
    -- Find a type compatible with A_TYPE in TYPE_LIST (which can be an
    -- overload list or a simple type) and return it.
    -- In case of failure, return null.
diff --git a/src/vhdl/sem_expr.ads b/src/vhdl/sem_expr.ads
index 1576bc8ad..4f1a9d70e 100644
--- a/src/vhdl/sem_expr.ads
+++ b/src/vhdl/sem_expr.ads
@@ -93,13 +93,6 @@ package Sem_Expr is
    --  Check EXPR can be updated.
    procedure Check_Update (Expr : Iir);
 
-   --  Check the type of EXPR can be implicitly converted to TARG_TYPE, ie
-   --  if TARG_TYPE is a constrained array subtype, number of elements matches.
-   --  Return FALSE in case of error.
-   --  If TARG_TYPE or EXPR is NULL_IIR, silently returns TRUE.
-   function Check_Implicit_Conversion (Targ_Type : Iir; Expr : Iir)
-                                      return Boolean;
-
    -- For a procedure call, A_TYPE must be null.
    function Sem_Subprogram_Call (Expr: Iir; A_Type: Iir) return Iir;
 
diff --git a/src/vhdl/sem_stmts.adb b/src/vhdl/sem_stmts.adb
index f68040959..a2c864849 100644
--- a/src/vhdl/sem_stmts.adb
+++ b/src/vhdl/sem_stmts.adb
@@ -605,9 +605,13 @@ package body Sem_Stmts is
                   "null transactions can be assigned only to guarded signals");
             end if;
          else
-            if not Check_Implicit_Conversion (Targ_Type, Expr) then
-               Error_Msg_Sem
-                 (+We, "length of value does not match length of target");
+            if not Eval_Is_In_Bound (Expr, Targ_Type)
+              and then Get_Kind (Expr) /= Iir_Kind_Overflow_Literal
+            then
+               Warning_Msg_Sem
+                 (Warnid_Runtime_Error, +We,
+                  "value constraints don't match target ones");
+               Set_We_Value (We, Build_Overflow (Expr, Targ_Type));
             end if;
          end if;
          We := Get_Chain (We);
@@ -836,11 +840,12 @@ package body Sem_Stmts is
                   Set_Expression (Stmt, Expr);
                   Merge_Wildcard_Type (Expr, Stmt_Type);
                   if Done
-                    and then not Check_Implicit_Conversion (Target_Type, Expr)
+                    and then not Eval_Is_In_Bound (Expr, Target_Type)
+                    and then Get_Kind (Expr) /= Iir_Kind_Overflow_Literal
                   then
                      Warning_Msg_Sem
                        (Warnid_Runtime_Error, +Stmt,
-                        "expression length does not match target length");
+                        "expression constraints don't match target ones");
                      Set_Expression (Stmt, Build_Overflow (Expr, Target_Type));
                   end if;
                end if;