diff options
| -rw-r--r-- | src/vhdl/iirs_utils.adb | 16 | ||||
| -rw-r--r-- | src/vhdl/iirs_utils.ads | 6 | ||||
| -rw-r--r-- | src/vhdl/sem.adb | 9 | ||||
| -rw-r--r-- | src/vhdl/sem_names.adb | 13 | ||||
| -rw-r--r-- | src/vhdl/sem_names.ads | 3 | ||||
| -rw-r--r-- | src/vhdl/sem_scopes.adb | 24 |
6 files changed, 33 insertions, 38 deletions
diff --git a/src/vhdl/iirs_utils.adb b/src/vhdl/iirs_utils.adb index 32e52f77f..bc4b7b7e7 100644 --- a/src/vhdl/iirs_utils.adb +++ b/src/vhdl/iirs_utils.adb @@ -51,11 +51,6 @@ package body Iirs_Utils is return Get_Kind (N) = Iir_Kind_Error; end Is_Error; - function Is_Any_Error (N : Iir) return Boolean is - begin - return N = Null_Iir or else Get_Kind (N) = Iir_Kind_Error; - end Is_Any_Error; - function Is_Overflow_Literal (N : Iir) return Boolean is begin return Get_Kind (N) = Iir_Kind_Overflow_Literal; @@ -1601,6 +1596,17 @@ package body Iirs_Utils is return Res; end Create_Error_Type; + function Create_Error_Name (Orig : Iir) return Iir + is + Res : Iir; + begin + Res := Create_Iir (Iir_Kind_Error); + Set_Expr_Staticness (Res, None); + Set_Error_Origin (Res, Orig); + Location_Copy (Res, Orig); + return Res; + end Create_Error_Name; + -- Extract the entity from ASPECT. -- Note: if ASPECT is a component declaration, returns ASPECT. function Get_Entity_From_Entity_Aspect (Aspect : Iir) return Iir diff --git a/src/vhdl/iirs_utils.ads b/src/vhdl/iirs_utils.ads index f55cb5f08..d70096f09 100644 --- a/src/vhdl/iirs_utils.ads +++ b/src/vhdl/iirs_utils.ads @@ -31,9 +31,6 @@ package Iirs_Utils is function Is_Error (N : Iir) return Boolean; pragma Inline (Is_Error); - -- Return True iff N is not valid (Null_Iir or an error node). - function Is_Any_Error (N : Iir) return Boolean; - -- Return True iff N is an overflow_literal node. function Is_Overflow_Literal (N : Iir) return Boolean; pragma Inline (Is_Overflow_Literal); @@ -346,6 +343,9 @@ package Iirs_Utils is -- Create an error node for node ORIG, which is supposed to be a type. function Create_Error_Type (Orig : Iir) return Iir; + -- Create an error node for a name. + function Create_Error_Name (Orig : Iir) return Iir; + -- Extract the entity from ASPECT. -- Note: if ASPECT is a component declaration, returns ASPECT. -- if ASPECT is open, return Null_Iir; diff --git a/src/vhdl/sem.adb b/src/vhdl/sem.adb index 7698b63ad..9afb1f1d4 100644 --- a/src/vhdl/sem.adb +++ b/src/vhdl/sem.adb @@ -2911,6 +2911,7 @@ package body Sem is Name_Prefix := Get_Prefix (Name); when others => Error_Msg_Sem (+Name, "use clause allows only selected name"); + Set_Selected_Name (Clause, Create_Error_Name (Name)); return; end case; @@ -2922,6 +2923,7 @@ package body Sem is Error_Msg_Sem (+Name_Prefix, "use clause prefix must be a name or a selected name"); + Set_Selected_Name (Clause, Create_Error_Name (Name)); return; end case; @@ -2929,6 +2931,7 @@ package body Sem is Set_Prefix (Name, Name_Prefix); Prefix := Get_Named_Entity (Name_Prefix); if Is_Error (Prefix) then + Set_Selected_Name (Clause, Create_Error_Name (Name)); return; end if; @@ -2958,15 +2961,13 @@ package body Sem is Error_Msg_Sem (+Name_Prefix, "use of uninstantiated package is not allowed"); - -- FIXME: is it ok from ownership POV ? - Set_Named_Entity (Name_Prefix, Create_Error (Prefix)); + Set_Prefix (Name, Create_Error_Name (Name_Prefix)); return; end if; when others => Error_Msg_Sem (+Prefix, "prefix must designate a package or a library"); - -- FIXME: is it ok from ownership POV ? - Set_Named_Entity (Name_Prefix, Create_Error (Prefix)); + Set_Prefix (Name, Create_Error_Name (Name_Prefix)); return; end case; diff --git a/src/vhdl/sem_names.adb b/src/vhdl/sem_names.adb index 5cdcda825..f64e1209d 100644 --- a/src/vhdl/sem_names.adb +++ b/src/vhdl/sem_names.adb @@ -2082,7 +2082,7 @@ package body Sem_Names is Sem_Name (Prefix_Name); end if; Prefix := Get_Named_Entity (Prefix_Name); - if Prefix = Error_Mark then + if Is_Error (Prefix) then Set_Named_Entity (Name, Prefix); return; end if; @@ -4205,17 +4205,6 @@ package body Sem_Names is end case; end Name_To_Type_Definition; - function Create_Error_Name (Orig : Iir) return Iir - is - Res : Iir; - begin - Res := Create_Iir (Iir_Kind_Error); - Set_Expr_Staticness (Res, None); - Set_Error_Origin (Res, Orig); - Location_Copy (Res, Orig); - return Res; - end Create_Error_Name; - function Sem_Denoting_Name (Name: Iir) return Iir is Res: Iir; diff --git a/src/vhdl/sem_names.ads b/src/vhdl/sem_names.ads index 0e27a8c49..542ed4d07 100644 --- a/src/vhdl/sem_names.ads +++ b/src/vhdl/sem_names.ads @@ -156,7 +156,4 @@ package Sem_Names is -- Emit an error for NAME that doesn't match its class CLASS_NAME. procedure Error_Class_Match (Name : Iir; Class_Name : String); - - -- Create an error node for name ORIG; set its expr staticness to none. - function Create_Error_Name (Orig : Iir) return Iir; end Sem_Names; diff --git a/src/vhdl/sem_scopes.adb b/src/vhdl/sem_scopes.adb index 16be2a29d..f99273ef9 100644 --- a/src/vhdl/sem_scopes.adb +++ b/src/vhdl/sem_scopes.adb @@ -1445,10 +1445,6 @@ package body Sem_Scopes is -- name. procedure Use_Selected_Name (Name : Iir) is begin - if Is_Any_Error (Name) then - return; - end if; - case Get_Kind (Name) is when Iir_Kind_Overload_List => Add_Declarations_List (Get_Overload_List (Name), True); @@ -1475,10 +1471,6 @@ package body Sem_Scopes is -- library denotes by te prefix of the selected name. procedure Use_All_Names (Name: Iir) is begin - if Is_Any_Error (Name) then - return; - end if; - case Get_Kind (Name) is when Iir_Kind_Library_Declaration => Use_Library_All (Name); @@ -1509,10 +1501,20 @@ package body Sem_Scopes is Cl := Clause; loop Name := Get_Selected_Name (Cl); - if Get_Kind (Name) = Iir_Kind_Selected_By_All_Name then - Use_All_Names (Get_Named_Entity (Get_Prefix (Name))); + if Name = Null_Iir then + pragma Assert (Flags.Flag_Force_Analysis); + null; else - Use_Selected_Name (Get_Named_Entity (Name)); + if Get_Kind (Name) = Iir_Kind_Selected_By_All_Name then + Name := Get_Prefix (Name); + if not Is_Error (Name) then + Use_All_Names (Get_Named_Entity (Name)); + end if; + else + if not Is_Error (Name) then + Use_Selected_Name (Get_Named_Entity (Name)); + end if; + end if; end if; Cl := Get_Use_Clause_Chain (Cl); exit when Cl = Null_Iir; |