diff options
| -rw-r--r-- | src/vhdl/vhdl-sem_decls.adb | 2 | ||||
| -rw-r--r-- | src/vhdl/vhdl-sem_types.adb | 52 | ||||
| -rw-r--r-- | src/vhdl/vhdl-sem_types.ads | 3 |
3 files changed, 32 insertions, 25 deletions
diff --git a/src/vhdl/vhdl-sem_decls.adb b/src/vhdl/vhdl-sem_decls.adb index c081cba5d..8f44e0858 100644 --- a/src/vhdl/vhdl-sem_decls.adb +++ b/src/vhdl/vhdl-sem_decls.adb @@ -786,7 +786,7 @@ package body Vhdl.Sem_Decls is while Is_Valid (Ref) loop pragma Assert (Get_Kind (Ref) = Iir_Kind_Access_Type_Definition); - Set_Designated_Type (Ref, Def); + Check_Access_Type_Restrictions (Ref, Def); Ref := Get_Incomplete_Type_Ref_Chain (Ref); end loop; Set_Complete_Type_Definition (Old_Def, Def); diff --git a/src/vhdl/vhdl-sem_types.adb b/src/vhdl/vhdl-sem_types.adb index bb43d1d40..fe1777916 100644 --- a/src/vhdl/vhdl-sem_types.adb +++ b/src/vhdl/vhdl-sem_types.adb @@ -1116,6 +1116,33 @@ package body Vhdl.Sem_Types is return Def; end Sem_Constrained_Array_Type_Definition; + procedure Check_Access_Type_Restrictions (Def : Iir; D_Type : Iir) is + begin + case Get_Kind (D_Type) is + when Iir_Kind_Incomplete_Type_Definition => + -- Append on the chain of incomplete type ref + Set_Incomplete_Type_Ref_Chain + (Def, Get_Incomplete_Type_Ref_Chain (D_Type)); + Set_Incomplete_Type_Ref_Chain (D_Type, Def); + when Iir_Kind_File_Type_Definition => + if Vhdl_Std < Vhdl_19 then + -- LRM 3.3 + -- The designated type must not be a file type. + Error_Msg_Sem (+Def, "designated type must not be a file type"); + end if; + when Iir_Kind_Protected_Type_Declaration => + if Vhdl_Std < Vhdl_19 then + -- LRM02 3.3 + -- [..] or a protected type. + Error_Msg_Sem + (+Def, "designated type must not be a protected type"); + end if; + when others => + null; + end case; + Set_Designated_Type (Def, D_Type); + end Check_Access_Type_Restrictions; + function Sem_Access_Type_Definition (Def: Iir) return Iir is D_Type : Iir; @@ -1126,30 +1153,7 @@ package body Vhdl.Sem_Types is D_Type := Get_Type_Of_Subtype_Indication (D_Type); if D_Type /= Null_Iir then - case Get_Kind (D_Type) is - when Iir_Kind_Incomplete_Type_Definition => - -- Append on the chain of incomplete type ref - Set_Incomplete_Type_Ref_Chain - (Def, Get_Incomplete_Type_Ref_Chain (D_Type)); - Set_Incomplete_Type_Ref_Chain (D_Type, Def); - when Iir_Kind_File_Type_Definition => - if Vhdl_Std < Vhdl_19 then - -- LRM 3.3 - -- The designated type must not be a file type. - Error_Msg_Sem - (+Def, "designated type must not be a file type"); - end if; - when Iir_Kind_Protected_Type_Declaration => - if Vhdl_Std < Vhdl_19 then - -- LRM02 3.3 - -- [..] or a protected type. - Error_Msg_Sem - (+Def, "designated type must not be a protected type"); - end if; - when others => - null; - end case; - Set_Designated_Type (Def, D_Type); + Check_Access_Type_Restrictions (Def, D_Type); end if; Set_Type_Staticness (Def, None); Set_Resolved_Flag (Def, False); diff --git a/src/vhdl/vhdl-sem_types.ads b/src/vhdl/vhdl-sem_types.ads index 78068d6f6..67efccea2 100644 --- a/src/vhdl/vhdl-sem_types.ads +++ b/src/vhdl/vhdl-sem_types.ads @@ -29,6 +29,9 @@ package Vhdl.Sem_Types is function Sem_Type_Definition (Def: Iir; Decl: Iir) return Iir; + -- Check restrictions on access type DEF. + procedure Check_Access_Type_Restrictions (Def : Iir; D_Type : Iir); + -- If A_RANGE is a range (range expression or range attribute), convert it -- to a subtype definition. Otherwise return A_RANGE. -- The result is a subtype indication: either a type name or a subtype |