diff options
| author | Tristan Gingold <tgingold@free.fr> | 2018-12-15 20:46:07 +0100 |
|---|---|---|
| committer | Tristan Gingold <tgingold@free.fr> | 2018-12-16 07:05:32 +0100 |
| commit | f254753526582ff65787767a8e00885b5227b356 (patch) | |
| tree | c78685394f86586c06a64c037e2b4ccfe38c62ad /src/vhdl | |
| parent | 814d63034a45f14c6eb1d00d7446537777ed855f (diff) | |
| download | ghdl-f254753526582ff65787767a8e00885b5227b356.tar.gz ghdl-f254753526582ff65787767a8e00885b5227b356.tar.bz2 ghdl-f254753526582ff65787767a8e00885b5227b356.zip | |
Improve error recovery on use clauses.
Diffstat (limited to 'src/vhdl')
| -rw-r--r-- | src/vhdl/iirs_utils.adb | 5 | ||||
| -rw-r--r-- | src/vhdl/iirs_utils.ads | 3 | ||||
| -rw-r--r-- | src/vhdl/sem.adb | 171 | ||||
| -rw-r--r-- | src/vhdl/sem_scopes.adb | 8 |
4 files changed, 112 insertions, 75 deletions
diff --git a/src/vhdl/iirs_utils.adb b/src/vhdl/iirs_utils.adb index 6f655569f..536238bef 100644 --- a/src/vhdl/iirs_utils.adb +++ b/src/vhdl/iirs_utils.adb @@ -51,6 +51,11 @@ 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; diff --git a/src/vhdl/iirs_utils.ads b/src/vhdl/iirs_utils.ads index cade6b332..f55cb5f08 100644 --- a/src/vhdl/iirs_utils.ads +++ b/src/vhdl/iirs_utils.ads @@ -31,6 +31,9 @@ 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); diff --git a/src/vhdl/sem.adb b/src/vhdl/sem.adb index 98ae4ec6c..7698b63ad 100644 --- a/src/vhdl/sem.adb +++ b/src/vhdl/sem.adb @@ -2892,92 +2892,113 @@ package body Sem is end Sem_Package_Instantiation_Declaration; -- LRM 10.4 Use Clauses. - procedure Sem_Use_Clause (Clauses: Iir_Use_Clause) + procedure Sem_Use_Clause_Name (Clause : Iir) is - Clause : Iir_Use_Clause; Name: Iir; Prefix: Iir; Name_Prefix : Iir; begin - Clause := Clauses; - loop - -- LRM93 10.4 - -- A use clause achieves direct visibility of declarations that are - -- visible by selection. - -- Each selected name is a use clause identifies one or more - -- declarations that will potentialy become directly visible. - - Name := Get_Selected_Name (Clause); - case Get_Kind (Name) is - when Iir_Kind_Selected_By_All_Name - | Iir_Kind_Selected_Name => - Name_Prefix := Get_Prefix (Name); - when others => - Error_Msg_Sem (+Name, "use clause allows only selected name"); - return; - end case; + -- LRM93 10.4 + -- A use clause achieves direct visibility of declarations that are + -- visible by selection. + -- Each selected name is a use clause identifies one or more + -- declarations that will potentialy become directly visible. + + Name := Get_Selected_Name (Clause); + case Get_Kind (Name) is + when Iir_Kind_Selected_By_All_Name + | Iir_Kind_Selected_Name => + Name_Prefix := Get_Prefix (Name); + when others => + Error_Msg_Sem (+Name, "use clause allows only selected name"); + return; + end case; - Name_Prefix := Sem_Denoting_Name (Name_Prefix); - Set_Prefix (Name, Name_Prefix); - Prefix := Get_Named_Entity (Name_Prefix); - if Is_Error (Prefix) then - -- FIXME: continue with the clauses + case Get_Kind (Name_Prefix) is + when Iir_Kind_Simple_Name + | Iir_Kind_Selected_Name => + null; + when others => + Error_Msg_Sem + (+Name_Prefix, + "use clause prefix must be a name or a selected name"); return; - end if; + end case; - -- LRM 10.4 Use Clauses - -- - -- If the suffix of the selected name is [...], then the - -- selected name identifies only the declaration(s) of that - -- [...] contained within the package or library denoted by - -- the prefix of the selected name. - -- - -- If the suffix is the reserved word ALL, then the selected name - -- identifies all declarations that are contained within the package - -- or library denoted by the prefix of the selected name. - -- - -- GHDL: therefore, the suffix must be either a package or a library. - case Get_Kind (Prefix) is - when Iir_Kind_Library_Declaration => - null; - when Iir_Kind_Package_Instantiation_Declaration - | Iir_Kind_Interface_Package_Declaration => - null; - when Iir_Kind_Package_Declaration => - -- LRM08 12.4 Use clauses - -- It is an error if the prefix of a selected name in a use - -- clause denotes an uninstantiated package. - if Is_Uninstantiated_Package (Prefix) then - Error_Msg_Sem - (+Name_Prefix, - "use of uninstantiated package is not allowed"); - return; - end if; - when others => + Name_Prefix := Sem_Denoting_Name (Name_Prefix); + Set_Prefix (Name, Name_Prefix); + Prefix := Get_Named_Entity (Name_Prefix); + if Is_Error (Prefix) then + return; + end if; + + -- LRM 10.4 Use Clauses + -- + -- If the suffix of the selected name is [...], then the + -- selected name identifies only the declaration(s) of that + -- [...] contained within the package or library denoted by + -- the prefix of the selected name. + -- + -- If the suffix is the reserved word ALL, then the selected name + -- identifies all declarations that are contained within the package + -- or library denoted by the prefix of the selected name. + -- + -- GHDL: therefore, the suffix must be either a package or a library. + case Get_Kind (Prefix) is + when Iir_Kind_Library_Declaration => + null; + when Iir_Kind_Package_Instantiation_Declaration + | Iir_Kind_Interface_Package_Declaration => + null; + when Iir_Kind_Package_Declaration => + -- LRM08 12.4 Use clauses + -- It is an error if the prefix of a selected name in a use + -- clause denotes an uninstantiated package. + if Is_Uninstantiated_Package (Prefix) then Error_Msg_Sem - (+Prefix, "prefix must designate a package or a library"); + (+Name_Prefix, + "use of uninstantiated package is not allowed"); + -- FIXME: is it ok from ownership POV ? + Set_Named_Entity (Name_Prefix, Create_Error (Prefix)); return; - end case; + 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)); + return; + end case; - case Get_Kind (Name) is - when Iir_Kind_Selected_Name => - Sem_Name (Name, True); - case Get_Kind (Get_Named_Entity (Name)) is - when Iir_Kind_Error => - -- Continue in case of error. - null; - when Iir_Kind_Overload_List => - -- Analyze is correct as is. - null; - when others => - Name := Finish_Sem_Name (Name); - Set_Selected_Name (Clause, Name); - end case; - when Iir_Kind_Selected_By_All_Name => - null; - when others => - raise Internal_Error; - end case; + case Get_Kind (Name) is + when Iir_Kind_Selected_Name => + Sem_Name (Name, True); + case Get_Kind (Get_Named_Entity (Name)) is + when Iir_Kind_Error => + -- Continue in case of error. + null; + when Iir_Kind_Overload_List => + -- Analyze is correct as is. + null; + when others => + Name := Finish_Sem_Name (Name); + Set_Selected_Name (Clause, Name); + end case; + when Iir_Kind_Selected_By_All_Name => + null; + when others => + raise Internal_Error; + end case; + end Sem_Use_Clause_Name; + + -- LRM 10.4 Use Clauses. + procedure Sem_Use_Clause (Clauses: Iir_Use_Clause) + is + Clause : Iir_Use_Clause; + begin + Clause := Clauses; + loop + Sem_Use_Clause_Name (Clause); Clause := Get_Use_Clause_Chain (Clause); exit when Clause = Null_Iir; diff --git a/src/vhdl/sem_scopes.adb b/src/vhdl/sem_scopes.adb index aeecbc8a7..2f70832e0 100644 --- a/src/vhdl/sem_scopes.adb +++ b/src/vhdl/sem_scopes.adb @@ -1438,6 +1438,10 @@ 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); @@ -1464,6 +1468,10 @@ 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); |