procyberian/gcc
1
0
Fork 0
Code Issues Pull requests Projects Releases Packages Wiki Activity Actions

[Ada] Improve error messages to include full package name

Browse source 
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.
This commit is contained in:
Justin Squirek 2022-01-03 08:26:44 +00:00 • committed by Pierre-Marie de Rodat
parent 706940c2c8
commit 7ded77bbce
6 changed files with 120 additions and 32 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

12
gcc/ada/err_vars.ads
View file

@ -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;

8
gcc/ada/errout.adb
View file

@ -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;
--------------------------------------

7
gcc/ada/errout.ads
View file

@ -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;

18
gcc/ada/erroutc.adb
View file

@ -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;
-------------------------------------

4
gcc/ada/exp_disp.adb
View file

@ -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 "

103
gcc/ada/sem_ch8.adb
View file

@ -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