Avoid a crash on error.

Fix bug041.

1 files changed, 21 insertions, 39 deletions

diff --git a/src/vhdl/sem_expr.adb b/src/vhdl/sem_expr.adb
index 415662a9f..050c17680 100644
--- a/src/vhdl/sem_expr.adb
+++ b/src/vhdl/sem_expr.adb
@@ -33,28 +33,6 @@ with Xrefs; use Xrefs;
 
 package body Sem_Expr is
 
-   procedure Not_Match (Expr: Iir; A_Type: Iir)
-   is
-      pragma Inline (Not_Match);
-   begin
-      Error_Not_Match (Expr, A_Type, Expr);
-   end Not_Match;
-
---    procedure Not_Match (Expr: Iir; Type1: Iir; Type2: Iir) is
---    begin
---       Error_Msg_Sem
---         ("can't match '" & Disp_Node (Expr) & "' with type '"
---          & Disp_Node (Type1) & "' or type '" & Disp_Node (Type2) & "'",
---          Expr);
---    end Not_Match;
-
---    procedure Overloaded (Expr: Iir) is
---    begin
---       Error_Msg_Sem
---         ("cant resolve overloaded identifier '" & Get_String (Expr) & "'",
---          Expr);
---    end Overloaded;
-
    -- Replace type of TARGET by A_TYPE.
    -- If TARGET has already a type, it must be an overload list, and in this
    -- case, this list is freed, or it must be A_TYPE.
@@ -760,7 +738,7 @@ package body Sem_Expr is
             if A_Type /= Null_Iir
               and then Get_Base_Type (Res_Type) /= Get_Base_Type (A_Type)
             then
-               Not_Match (Expr, A_Type);
+               Error_Not_Match (Expr, A_Type);
                return Null_Iir;
             end if;
 
@@ -1482,7 +1460,7 @@ package body Sem_Expr is
          end if;
       end if;
       if Res = Null_Iir then
-         Not_Match (Expr, A_Type);
+         Error_Not_Match (Expr, A_Type);
          return Null_Iir;
       end if;
 
@@ -2631,7 +2609,7 @@ package body Sem_Expr is
          Name1 : Iir;
       begin
          if Are_Types_Compatible (Range_Type, Sub_Type) = Not_Compatible then
-            Not_Match (Name, Sub_Type);
+            Error_Not_Match (Name, Sub_Type);
             return False;
          end if;
 
@@ -3741,7 +3719,7 @@ package body Sem_Expr is
                   Error_Msg_Sem ("expected type is not an access type", Expr);
                end if;
             else
-               Not_Match (Expr, A_Type);
+               Error_Not_Match (Expr, A_Type);
             end if;
             return Null_Iir;
          end if;
@@ -3762,7 +3740,7 @@ package body Sem_Expr is
       if A_Type /= Null_Iir
         and then Are_Types_Compatible (A_Type, N_Type) = Not_Compatible
       then
-         Not_Match (Expr, A_Type);
+         Error_Not_Match (Expr, A_Type);
          return Null_Iir;
       end if;
       Res := Sem_Expression (Get_Expression (Expr), N_Type);
@@ -4090,7 +4068,7 @@ package body Sem_Expr is
               and then Are_Basetypes_Compatible
               (A_Type, Get_Base_Type (Get_Type (Expr))) = Not_Compatible
             then
-               Not_Match (Expr, A_Type);
+               Error_Not_Match (Expr, A_Type);
                return Null_Iir;
             end if;
             return Expr;
@@ -4104,7 +4082,7 @@ package body Sem_Expr is
                Set_Type (Expr, A_Type);
                return Expr;
             else
-               Not_Match (Expr, A_Type);
+               Error_Not_Match (Expr, A_Type);
                return Null_Iir;
             end if;
 
@@ -4117,7 +4095,7 @@ package body Sem_Expr is
                Set_Type (Expr, A_Type);
                return Expr;
             else
-               Not_Match (Expr, A_Type);
+               Error_Not_Match (Expr, A_Type);
                return Null_Iir;
             end if;
 
@@ -4132,7 +4110,7 @@ package body Sem_Expr is
                   return Null_Iir;
                end if;
                if A_Type /= Null_Iir and then Get_Type (Res) /= A_Type then
-                  Not_Match (Res, A_Type);
+                  Error_Not_Match (Res, A_Type);
                   return Null_Iir;
                end if;
                return Res;
@@ -4148,7 +4126,7 @@ package body Sem_Expr is
             end if;
 
             if not Is_String_Literal_Type (A_Type, Expr) then
-               Not_Match (Expr, A_Type);
+               Error_Not_Match (Expr, A_Type);
                return Null_Iir;
             else
                Replace_Type (Expr, A_Type);
@@ -4209,6 +4187,10 @@ package body Sem_Expr is
               (Disp_Node (Expr) & " cannot be used as an expression", Expr);
             return Null_Iir;
 
+         when Iir_Kind_Error =>
+            -- Always ok.
+            return Expr;
+
          when others =>
             Error_Kind ("sem_expression_ov", Expr);
             return Null_Iir;
@@ -4383,7 +4365,7 @@ package body Sem_Expr is
          when Iir_Kind_String_Literal8 =>
             if Atype_Defined then
                if not Is_String_Literal_Type (Atype, Expr) then
-                  Not_Match (Expr, Atype);
+                  Error_Not_Match (Expr, Atype);
                   Set_Type (Expr, Error_Type);
                else
                   Set_Type (Expr, Atype);
@@ -4398,7 +4380,7 @@ package body Sem_Expr is
          when Iir_Kind_Null_Literal =>
             if Atype_Defined then
                if not Is_Null_Literal_Type (Atype) then
-                  Not_Match (Expr, Atype);
+                  Error_Not_Match (Expr, Atype);
                   Set_Type (Expr, Error_Type);
                else
                   Set_Type (Expr, Atype);
@@ -4414,7 +4396,7 @@ package body Sem_Expr is
            | Iir_Kind_Allocator_By_Subtype =>
             if Atype_Defined then
                if not Is_Null_Literal_Type (Atype) then
-                  Not_Match (Expr, Atype);
+                  Error_Not_Match (Expr, Atype);
                   Set_Type (Expr, Error_Type);
                else
                   return Sem_Allocator (Expr, Atype);
@@ -4462,7 +4444,7 @@ package body Sem_Expr is
                   if Atype in Iir_Wildcard_Types then
                      --  Analyze without known type.
                      Res := Sem_Expression_Ov (Expr, Null_Iir);
-                     if Res = Null_Iir then
+                     if Res = Null_Iir or else Is_Error (Res) then
                         Set_Type (Expr, Error_Type);
                         return Expr;
                      end if;
@@ -4474,7 +4456,7 @@ package body Sem_Expr is
 
                      if Res_Type = Null_Iir then
                         --  No matching type.  This is an error.
-                        Not_Match (Expr, Atype);
+                        Error_Not_Match (Expr, Atype);
                         Set_Type (Expr, Error_Type);
                      elsif Is_Defined_Type (Res_Type) then
                         --  Known and defined matching type.
@@ -4548,7 +4530,7 @@ package body Sem_Expr is
          if A_Type /= Null_Iir
            and then Are_Types_Compatible (Expr_Type, A_Type) = Not_Compatible
          then
-            Not_Match (Expr, A_Type);
+            Error_Not_Match (Expr, A_Type);
             return Null_Iir;
          end if;
          return Expr;
@@ -4569,7 +4551,7 @@ package body Sem_Expr is
                Res := Sem_Expression_Ov (Expr, Null_Iir);
             else
                if not Is_String_Literal_Type (A_Type, Expr) then
-                  Not_Match (Expr, A_Type);
+                  Error_Not_Match (Expr, A_Type);
                   return Null_Iir;
                end if;
                Set_Type (Expr, A_Type);