diff options
| -rw-r--r-- | src/vhdl/disp_vhdl.adb | 16 | ||||
| -rw-r--r-- | src/vhdl/iirs_utils.adb | 2 | ||||
| -rw-r--r-- | src/vhdl/parse.adb | 3 | ||||
| -rw-r--r-- | src/vhdl/sem_types.adb | 12 |
4 files changed, 25 insertions, 8 deletions
diff --git a/src/vhdl/disp_vhdl.adb b/src/vhdl/disp_vhdl.adb index f3e8c8f37..603c41879 100644 --- a/src/vhdl/disp_vhdl.adb +++ b/src/vhdl/disp_vhdl.adb @@ -274,12 +274,16 @@ package body Disp_Vhdl is when Iir_Kind_Base_Attribute => Disp_Name (Get_Prefix (Name)); Put ("'base"); + when Iir_Kind_Subtype_Attribute => + Disp_Name (Get_Prefix (Name)); + Put ("'subtype"); when Iir_Kind_Type_Declaration | Iir_Kind_Subtype_Declaration | Iir_Kind_Enumeration_Literal | Iir_Kind_Unit_Declaration | Iir_Kinds_Interface_Object_Declaration | Iir_Kind_Variable_Declaration + | Iir_Kind_Constant_Declaration | Iir_Kind_Function_Declaration | Iir_Kind_Procedure_Declaration | Iir_Kind_Terminal_Declaration @@ -567,10 +571,14 @@ package body Disp_Vhdl is Base_Type : Iir; Decl : Iir; begin - if Get_Kind (Def) in Iir_Kinds_Denoting_Name then - Disp_Name (Def); - return; - end if; + case Get_Kind (Def) is + when Iir_Kinds_Denoting_Name + | Iir_Kind_Subtype_Attribute => + Disp_Name (Def); + return; + when others => + null; + end case; Decl := Get_Type_Declarator (Def); if not Full_Decl and then Decl /= Null_Iir then diff --git a/src/vhdl/iirs_utils.adb b/src/vhdl/iirs_utils.adb index 5aceb7a3a..5492d26f2 100644 --- a/src/vhdl/iirs_utils.adb +++ b/src/vhdl/iirs_utils.adb @@ -1028,6 +1028,8 @@ package body Iirs_Utils is return Get_Type (Ind); when Iir_Kinds_Subtype_Definition => return Ind; + when Iir_Kind_Subtype_Attribute => + return Get_Type (Ind); when others => Error_Kind ("get_type_of_subtype_indication", Ind); end case; diff --git a/src/vhdl/parse.adb b/src/vhdl/parse.adb index fbe5a9f95..ae5cd960e 100644 --- a/src/vhdl/parse.adb +++ b/src/vhdl/parse.adb @@ -1075,6 +1075,9 @@ package body Parse is when Iir_Kind_Simple_Name | Iir_Kind_Selected_Name => null; + when Iir_Kind_Attribute_Name => + -- For O'Subtype. + null; when others => Error_Msg_Parse (+Mark, "type mark must be a name of a type"); end case; diff --git a/src/vhdl/sem_types.adb b/src/vhdl/sem_types.adb index e6f242c1e..09806ad05 100644 --- a/src/vhdl/sem_types.adb +++ b/src/vhdl/sem_types.adb @@ -2219,10 +2219,14 @@ package body Sem_Types is -- -- If the subtype indication does not include a constraint, the subtype -- is the same as that denoted by the type mark. - if Get_Kind (Def) in Iir_Kinds_Denoting_Name then - Type_Mark := Sem_Type_Mark (Def, Incomplete); - return Type_Mark; - end if; + case Get_Kind (Def) is + when Iir_Kinds_Denoting_Name + | Iir_Kind_Attribute_Name => + Type_Mark := Sem_Type_Mark (Def, Incomplete); + return Type_Mark; + when others => + null; + end case; -- Analyze the type mark. Type_Mark_Name := Get_Subtype_Type_Mark (Def); |