From 7ded77bbce506b12a4f2bbe751b304ebdcb9af27 Mon Sep 17 00:00:00 2001 From: Justin Squirek Date: Mon, 3 Jan 2022 08:26:44 +0000 Subject: [PATCH] [Ada] Improve error messages to include full package name This patch improves error messages in the compiler so that missing 'with' error messages show the complete package name instead of a limited number of selectors. gcc/ada/ * err_vars.ads: Add new error message names and nodes. * erroutc.adb (Set_Msg_Insertion_Name, Set_Msg_Insertion_Name_Literal): Likewise. * errout.adb (Set_Msg_Insertion_Node): Likewise. * errout.ads: Likewise. * exp_disp.adb (Check_Premature_Freezing): Modify setting of Error_Msg_Node_2 to occur directly before Error_Msg call where applicable. * sem_ch8.adb (Error_Missing_With_Of_Known_Unit): Added to handle the printing of full package names of known units. (Undefined, Find_Expanded_Name): Replace error printing with call to Error_Missing_With_Of_Known_Unit. --- gcc/ada/err_vars.ads | 12 ++++++ gcc/ada/errout.adb | 8 +++- gcc/ada/errout.ads | 7 ++++ gcc/ada/erroutc.adb | 18 ++++++--- gcc/ada/exp_disp.adb | 4 +- gcc/ada/sem_ch8.adb | 103 ++++++++++++++++++++++++++++++++++++++++----------- 6 files changed, 120 insertions(+), 32 deletions(-) diff --git a/gcc/ada/err_vars.ads b/gcc/ada/err_vars.ads index 105f467..05329dc 100644 --- a/gcc/ada/err_vars.ads +++ b/gcc/ada/err_vars.ads @@ -100,6 +100,11 @@ package Err_Vars is -- -- Some of these are initialized below, because they are read before being -- set by clients. + -- + -- Would it be desirable to use arrays (with element renamings) here + -- instead of individual variables, at least for the Error_Msg_Name_N and + -- Error_Msg_Node_N ??? This would allow simplifying existing code in some + -- cases (see errout.adb). Error_Msg_Col : Column_Number; -- Column for @ insertion character in message @@ -116,6 +121,9 @@ package Err_Vars is Error_Msg_Name_1 : Name_Id; Error_Msg_Name_2 : Name_Id := No_Name; Error_Msg_Name_3 : Name_Id := No_Name; + Error_Msg_Name_4 : Name_Id := No_Name; + Error_Msg_Name_5 : Name_Id := No_Name; + Error_Msg_Name_6 : Name_Id := No_Name; -- Name_Id values for % insertion characters in message Error_Msg_File_1 : File_Name_Type; @@ -129,6 +137,10 @@ package Err_Vars is Error_Msg_Node_1 : Node_Id; Error_Msg_Node_2 : Node_Id := Empty; + Error_Msg_Node_3 : Node_Id := Empty; + Error_Msg_Node_4 : Node_Id := Empty; + Error_Msg_Node_5 : Node_Id := Empty; + Error_Msg_Node_6 : Node_Id := Empty; -- Node_Id values for & insertion characters in message Error_Msg_Warn : Boolean; diff --git a/gcc/ada/errout.adb b/gcc/ada/errout.adb index b862637..f506bcc 100644 --- a/gcc/ada/errout.adb +++ b/gcc/ada/errout.adb @@ -3578,10 +3578,14 @@ package body Errout is end if; end if; - -- The following assignment ensures that a second ampersand insertion - -- character will correspond to the Error_Msg_Node_2 parameter. + -- The following assignment ensures that further ampersand insertion + -- characters will correspond to the Error_Msg_Node_# parameter. Error_Msg_Node_1 := Error_Msg_Node_2; + Error_Msg_Node_2 := Error_Msg_Node_3; + Error_Msg_Node_3 := Error_Msg_Node_4; + Error_Msg_Node_4 := Error_Msg_Node_5; + Error_Msg_Node_5 := Error_Msg_Node_6; end Set_Msg_Insertion_Node; -------------------------------------- diff --git a/gcc/ada/errout.ads b/gcc/ada/errout.ads index 950dd55..ff36344 100644 --- a/gcc/ada/errout.ads +++ b/gcc/ada/errout.ads @@ -468,6 +468,9 @@ package Errout is Error_Msg_Name_1 : Name_Id renames Err_Vars.Error_Msg_Name_1; Error_Msg_Name_2 : Name_Id renames Err_Vars.Error_Msg_Name_2; Error_Msg_Name_3 : Name_Id renames Err_Vars.Error_Msg_Name_3; + Error_Msg_Name_4 : Name_Id renames Err_Vars.Error_Msg_Name_4; + Error_Msg_Name_5 : Name_Id renames Err_Vars.Error_Msg_Name_5; + Error_Msg_Name_6 : Name_Id renames Err_Vars.Error_Msg_Name_6; -- Name_Id values for % insertion characters in message Error_Msg_File_1 : File_Name_Type renames Err_Vars.Error_Msg_File_1; @@ -481,6 +484,10 @@ package Errout is Error_Msg_Node_1 : Node_Id renames Err_Vars.Error_Msg_Node_1; Error_Msg_Node_2 : Node_Id renames Err_Vars.Error_Msg_Node_2; + Error_Msg_Node_3 : Node_Id renames Err_Vars.Error_Msg_Node_3; + Error_Msg_Node_4 : Node_Id renames Err_Vars.Error_Msg_Node_4; + Error_Msg_Node_5 : Node_Id renames Err_Vars.Error_Msg_Node_5; + Error_Msg_Node_6 : Node_Id renames Err_Vars.Error_Msg_Node_6; -- Node_Id values for & insertion characters in message Error_Msg_Qual_Level : Nat renames Err_Vars.Error_Msg_Qual_Level; diff --git a/gcc/ada/erroutc.adb b/gcc/ada/erroutc.adb index c18f418..d92ca33 100644 --- a/gcc/ada/erroutc.adb +++ b/gcc/ada/erroutc.adb @@ -1319,12 +1319,15 @@ package body Erroutc is end if; end if; - -- The following assignments ensure that the second and third percent - -- insertion characters will correspond to the Error_Msg_Name_2 and - -- Error_Msg_Name_3 as required. + -- The following assignments ensure that other percent insertion + -- characters will correspond to their appropriate Error_Msg_Name_# + -- values as required. Error_Msg_Name_1 := Error_Msg_Name_2; Error_Msg_Name_2 := Error_Msg_Name_3; + Error_Msg_Name_3 := Error_Msg_Name_4; + Error_Msg_Name_4 := Error_Msg_Name_5; + Error_Msg_Name_5 := Error_Msg_Name_6; end Set_Msg_Insertion_Name; ------------------------------------ @@ -1348,12 +1351,15 @@ package body Erroutc is Set_Msg_Quote; end if; - -- The following assignments ensure that the second and third % or %% - -- insertion characters will correspond to the Error_Msg_Name_2 and - -- Error_Msg_Name_3 values. + -- The following assignments ensure that other percent insertion + -- characters will correspond to their appropriate Error_Msg_Name_# + -- values as required. Error_Msg_Name_1 := Error_Msg_Name_2; Error_Msg_Name_2 := Error_Msg_Name_3; + Error_Msg_Name_3 := Error_Msg_Name_4; + Error_Msg_Name_4 := Error_Msg_Name_5; + Error_Msg_Name_5 := Error_Msg_Name_6; end Set_Msg_Insertion_Name_Literal; ------------------------------------- diff --git a/gcc/ada/exp_disp.adb b/gcc/ada/exp_disp.adb index f2d20af..e9967b4 100644 --- a/gcc/ada/exp_disp.adb +++ b/gcc/ada/exp_disp.adb @@ -3817,11 +3817,11 @@ package body Exp_Disp is and then not Is_Actual_For_Formal_Incomplete_Type (Comp) then Error_Msg_Sloc := Sloc (Subp); - Error_Msg_Node_2 := Subp; - Error_Msg_Name_1 := Chars (Tagged_Type); Error_Msg_NE ("declaration must appear after completion of type &", N, Comp); + Error_Msg_Node_2 := Subp; + Error_Msg_Name_1 := Chars (Tagged_Type); Error_Msg_NE ("\which is a component of untagged type& in the profile " & "of primitive & of type % that is frozen by the " diff --git a/gcc/ada/sem_ch8.adb b/gcc/ada/sem_ch8.adb index 77f8817..786df01 100644 --- a/gcc/ada/sem_ch8.adb +++ b/gcc/ada/sem_ch8.adb @@ -474,6 +474,10 @@ package body Sem_Ch8 is -- scope: the defining entity for U, unless U is a package instance, in -- which case we retrieve the entity of the instance spec. + procedure Error_Missing_With_Of_Known_Unit (Pkg : Node_Id); + -- Display an error message denoting a "with" is missing for a given known + -- package Pkg with its full path name. + procedure Find_Expanded_Name (N : Node_Id); -- The input is a selected component known to be an expanded name. Verify -- legality of selector given the scope denoted by prefix, and change node @@ -5334,6 +5338,81 @@ package body Sem_Ch8 is end if; end Entity_Of_Unit; + -------------------------------------- + -- Error_Missing_With_Of_Known_Unit -- + -------------------------------------- + + procedure Error_Missing_With_Of_Known_Unit (Pkg : Node_Id) is + Selectors : array (1 .. 6) of Node_Id; + -- Contains the chars of the full package name up to maximum number + -- allowed as per Errout.Error_Msg_Name_# variables. + + Count : Integer := Selectors'First; + -- Count of selector names forming the full package name + + Current_Pkg : Node_Id := Parent (Pkg); + + begin + Selectors (Count) := Pkg; + + -- Gather all the selectors we can display + + while Nkind (Current_Pkg) = N_Selected_Component + and then Is_Known_Unit (Current_Pkg) + and then Count < Selectors'Length + loop + Count := Count + 1; + Selectors (Count) := Selector_Name (Current_Pkg); + Current_Pkg := Parent (Current_Pkg); + end loop; + + -- Display the error message based on the number of selectors found + + case Count is + when 1 => + Error_Msg_Node_1 := Selectors (1); + Error_Msg_N -- CODEFIX + ("\\missing `WITH &;`", Pkg); + when 2 => + Error_Msg_Node_1 := Selectors (1); + Error_Msg_Node_2 := Selectors (2); + Error_Msg_N -- CODEFIX + ("\\missing `WITH &.&;`", Pkg); + when 3 => + Error_Msg_Node_1 := Selectors (1); + Error_Msg_Node_2 := Selectors (2); + Error_Msg_Node_3 := Selectors (3); + Error_Msg_N -- CODEFIX + ("\\missing `WITH &.&.&;`", Pkg); + when 4 => + Error_Msg_Node_1 := Selectors (1); + Error_Msg_Node_2 := Selectors (2); + Error_Msg_Node_3 := Selectors (3); + Error_Msg_Node_3 := Selectors (4); + Error_Msg_N -- CODEFIX + ("\\missing `WITH &.&.&.&;`", Pkg); + when 5 => + Error_Msg_Node_1 := Selectors (1); + Error_Msg_Node_2 := Selectors (2); + Error_Msg_Node_3 := Selectors (3); + Error_Msg_Node_3 := Selectors (4); + Error_Msg_Node_3 := Selectors (5); + Error_Msg_N -- CODEFIX + ("\\missing `WITH &.&.&.&.&;`", Pkg); + when 6 => + Error_Msg_Node_1 := Selectors (1); + Error_Msg_Node_2 := Selectors (2); + Error_Msg_Node_3 := Selectors (3); + Error_Msg_Node_4 := Selectors (4); + Error_Msg_Node_5 := Selectors (5); + Error_Msg_Node_6 := Selectors (6); + Error_Msg_N -- CODEFIX + ("\\missing `WITH &.&.&.&.&.&;`", Pkg); + when others => + raise Program_Error; + end case; + end Error_Missing_With_Of_Known_Unit; + ---------------------- -- Find_Direct_Name -- ---------------------- @@ -5877,25 +5956,7 @@ package body Sem_Ch8 is and then N = Prefix (Parent (N)) and then Is_Known_Unit (Parent (N)) then - declare - P : Node_Id := Parent (N); - begin - Error_Msg_Name_1 := Chars (N); - Error_Msg_Name_2 := Chars (Selector_Name (P)); - - if Nkind (Parent (P)) = N_Selected_Component - and then Is_Known_Unit (Parent (P)) - then - P := Parent (P); - Error_Msg_Name_3 := Chars (Selector_Name (P)); - Error_Msg_N -- CODEFIX - ("\\missing `WITH %.%.%;`", N); - - else - Error_Msg_N -- CODEFIX - ("\\missing `WITH %.%;`", N); - end if; - end; + Error_Missing_With_Of_Known_Unit (N); end if; -- Now check for possible misspellings @@ -6910,9 +6971,7 @@ package body Sem_Ch8 is Standard_Standard) then if not Error_Posted (N) then - Error_Msg_Node_2 := Selector; - Error_Msg_N -- CODEFIX - ("missing `WITH &.&;`", Prefix (N)); + Error_Missing_With_Of_Known_Unit (Prefix (N)); end if; -- If this is a selection from a dummy package, then suppress -- 2.7.4