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.
Tested on x86_64-pc-linux-gnu, committed on trunk
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.diff --git a/gcc/ada/err_vars.ads b/gcc/ada/err_vars.ads
--- 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
--- 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
--- 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
--- 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
--- 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
--- 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
