vhdl: avoid crash on incorrect type mark in subtype indication.

3 files changed, 21 insertions, 10 deletions

diff --git a/src/vhdl/vhdl-parse.adb b/src/vhdl/vhdl-parse.adb
index f6d21731a..f909aac81 100644
--- a/src/vhdl/vhdl-parse.adb
+++ b/src/vhdl/vhdl-parse.adb
@@ -1459,17 +1459,18 @@ package body Vhdl.Parse is
    end Parse_Signature_Name;
 
    --  Emit an error message if MARK doesn't have the form of a type mark.
-   procedure Check_Type_Mark (Mark : Iir) is
+   function Check_Type_Mark (Mark : Iir) return Boolean is
    begin
       case Get_Kind (Mark) is
          when Iir_Kind_Simple_Name
            | Iir_Kind_Selected_Name =>
-            null;
+            return True;
          when Iir_Kind_Attribute_Name =>
             --  For O'Subtype.
-            null;
+            return True;
          when others =>
             Error_Msg_Parse (+Mark, "type mark must be a name of a type");
+            return False;
       end case;
    end Check_Type_Mark;
 
@@ -1487,10 +1488,13 @@ package body Vhdl.Parse is
    begin
       Res := Parse_Name (Allow_Indexes => False);
 
-      Check_Type_Mark (Res);
-      if Check_Paren and then Current_Token = Tok_Left_Paren then
-         Error_Msg_Parse ("index constraint not allowed here");
-         Old := Parse_Name_Suffix (Res, True);
+      if Check_Type_Mark (Res) then
+         if Check_Paren and then Current_Token = Tok_Left_Paren then
+            Error_Msg_Parse ("index constraint not allowed here");
+            Old := Parse_Name_Suffix (Res, True);
+         end if;
+      else
+         Res := Null_Iir;
       end if;
       return Res;
    end Parse_Type_Mark;
@@ -3283,8 +3287,12 @@ package body Vhdl.Parse is
 
       if Name /= Null_Iir then
          --  The type_mark was already parsed.
-         Type_Mark := Name;
-         Check_Type_Mark (Name);
+         if Check_Type_Mark (Name) then
+            Type_Mark := Name;
+         else
+            --  Not a type mark.  Ignore it.
+            Type_Mark := Null_Iir;
+         end if;
       else
          if Current_Token = Tok_Left_Paren then
             if Vhdl_Std < Vhdl_08 then
diff --git a/src/vhdl/vhdl-sem_assocs.adb b/src/vhdl/vhdl-sem_assocs.adb
index ee85fc0f9..d1e52b646 100644
--- a/src/vhdl/vhdl-sem_assocs.adb
+++ b/src/vhdl/vhdl-sem_assocs.adb
@@ -1539,7 +1539,7 @@ package body Vhdl.Sem_Assocs is
       --  LRM08 6.5.7.2 Generic map aspects
       --  b) If the formal generic package declaration includes an interface
       --     generic map aspect in the form that includes the box (<>) symbol,
-      --     then the instantiaed package denotes by the actual may be any
+      --     then the instantiated package denotes by the actual may be any
       --     instance of the uninstantiated package named in the formal
       --     generic package declaration.
       if Get_Generic_Map_Aspect_Chain (Inter) = Null_Iir then
diff --git a/src/vhdl/vhdl-sem_types.adb b/src/vhdl/vhdl-sem_types.adb
index 7ea08eab9..1d8bb3a33 100644
--- a/src/vhdl/vhdl-sem_types.adb
+++ b/src/vhdl/vhdl-sem_types.adb
@@ -2370,6 +2370,9 @@ package body Vhdl.Sem_Types is
 
       --  Analyze the type mark.
       Type_Mark_Name := Get_Subtype_Type_Mark (Def);
+      if Type_Mark_Name = Null_Iir then
+         return Create_Error_Type (Def);
+      end if;
       Type_Mark_Name := Sem_Type_Mark (Type_Mark_Name);
       Set_Subtype_Type_Mark (Def, Type_Mark_Name);
       if Is_Error (Type_Mark_Name) then