public inbox for gcc-cvs@sourceware.org
help / color / mirror / Atom feed
* [gcc r13-249] [Ada] Incorrect ineffective use type clause warning
@ 2022-05-10 8:22 Pierre-Marie de Rodat
0 siblings, 0 replies; only message in thread
From: Pierre-Marie de Rodat @ 2022-05-10 8:22 UTC (permalink / raw)
To: gcc-cvs
https://gcc.gnu.org/g:a77ab90ed3a3077a1e9320ac43b32c850d7c525f
commit r13-249-ga77ab90ed3a3077a1e9320ac43b32c850d7c525f
Author: Justin Squirek <squirek@adacore.com>
Date: Fri Jan 21 17:09:29 2022 +0000
[Ada] Incorrect ineffective use type clause warning
This patch fixes an issue in the compiler whereby a use_type_clause
incorrectly gets flagged as ineffective when the use of it comes after a
generic package instantiation where the installation of private use
clauses are required and one such clause references the same type.
gcc/ada/
* sem_ch8.adb (Use_One_Type): Remove code in charge of setting
Current_Use_Clause when Id is known to be redundant, and modify
the printing of errors associated with redundant use type
clauses so that line number gets included in more cases.
Diff:
---
gcc/ada/sem_ch8.adb | 181 +++++++++++++++++++++-------------------------------
1 file changed, 72 insertions(+), 109 deletions(-)
diff --git a/gcc/ada/sem_ch8.adb b/gcc/ada/sem_ch8.adb
index 786df014486..18187789121 100644
--- a/gcc/ada/sem_ch8.adb
+++ b/gcc/ada/sem_ch8.adb
@@ -10571,20 +10571,6 @@ package body Sem_Ch8 is
-- even if it is redundant at the place of the instantiation.
elsif Redundant_Use (Id) then
-
- -- We must avoid incorrectly setting the Current_Use_Clause when we
- -- are working with a redundant clause that has already been linked
- -- in the Prev_Use_Clause chain, otherwise the chain will break.
-
- if Present (Current_Use_Clause (T))
- and then Present (Prev_Use_Clause (Current_Use_Clause (T)))
- and then Parent (Id) = Prev_Use_Clause (Current_Use_Clause (T))
- then
- null;
- else
- Set_Current_Use_Clause (T, Parent (Id));
- end if;
-
Set_Used_Operations (Parent (Id), New_Elmt_List);
-- If the subtype mark designates a subtype in a different package,
@@ -10689,121 +10675,98 @@ package body Sem_Ch8 is
-- Start of processing for Use_Clause_Known
begin
- -- If both current use_type_clause and the use_type_clause
- -- for the type are at the compilation unit level, one of
- -- the units must be an ancestor of the other, and the
- -- warning belongs on the descendant.
-
- if Nkind (Parent (Clause1)) = N_Compilation_Unit
- and then
- Nkind (Parent (Clause2)) = N_Compilation_Unit
- then
- -- If the unit is a subprogram body that acts as spec,
- -- the context clause is shared with the constructed
- -- subprogram spec. Clearly there is no redundancy.
-
- if Clause1 = Clause2 then
- return;
- end if;
+ -- If the unit is a subprogram body that acts as spec, the
+ -- context clause is shared with the constructed subprogram
+ -- spec. Clearly there is no redundancy.
- Unit1 := Unit (Parent (Clause1));
- Unit2 := Unit (Parent (Clause2));
+ if Clause1 = Clause2 then
+ return;
+ end if;
- -- If both clauses are on same unit, or one is the body
- -- of the other, or one of them is in a subunit, report
- -- redundancy on the later one.
+ Unit1 := Unit (Enclosing_Comp_Unit_Node (Clause1));
+ Unit2 := Unit (Enclosing_Comp_Unit_Node (Clause2));
- if Unit1 = Unit2 or else Nkind (Unit1) = N_Subunit then
- Error_Msg_Sloc := Sloc (Current_Use_Clause (T));
- Error_Msg_NE -- CODEFIX
- ("& is already use-visible through previous "
- & "use_type_clause #??", Clause1, T);
- return;
-
- elsif Nkind (Unit2) in N_Package_Body | N_Subprogram_Body
- and then Nkind (Unit1) /= Nkind (Unit2)
- and then Nkind (Unit1) /= N_Subunit
- then
- Error_Msg_Sloc := Sloc (Clause1);
- Error_Msg_NE -- CODEFIX
- ("& is already use-visible through previous "
- & "use_type_clause #??", Current_Use_Clause (T), T);
- return;
- end if;
+ -- If both clauses are on same unit, or one is the body of
+ -- the other, or one of them is in a subunit, report
+ -- redundancy on the later one.
- -- There is a redundant use_type_clause in a child unit.
- -- Determine which of the units is more deeply nested.
- -- If a unit is a package instance, retrieve the entity
- -- and its scope from the instance spec.
+ if Unit1 = Unit2
+ or else Nkind (Unit1) = N_Subunit
+ or else
+ (Nkind (Unit2) in N_Package_Body | N_Subprogram_Body
+ and then Nkind (Unit1) /= Nkind (Unit2)
+ and then Nkind (Unit1) /= N_Subunit)
+ then
+ Error_Msg_Sloc := Sloc (Clause1);
+ Error_Msg_NE -- CODEFIX
+ ("& is already use-visible through previous "
+ & "use_type_clause #??", Clause2, T);
+ return;
+ end if;
- Ent1 := Entity_Of_Unit (Unit1);
- Ent2 := Entity_Of_Unit (Unit2);
+ -- There is a redundant use_type_clause in a child unit.
+ -- Determine which of the units is more deeply nested. If a
+ -- unit is a package instance, retrieve the entity and its
+ -- scope from the instance spec.
- if Scope (Ent2) = Standard_Standard then
- Error_Msg_Sloc := Sloc (Current_Use_Clause (T));
- Err_No := Clause1;
+ Ent1 := Entity_Of_Unit (Unit1);
+ Ent2 := Entity_Of_Unit (Unit2);
- elsif Scope (Ent1) = Standard_Standard then
- Error_Msg_Sloc := Sloc (Id);
- Err_No := Clause2;
+ if Scope (Ent2) = Standard_Standard then
+ Error_Msg_Sloc := Sloc (Clause2);
+ Err_No := Clause1;
- -- If both units are child units, we determine which one
- -- is the descendant by the scope distance to the
- -- ultimate parent unit.
+ elsif Scope (Ent1) = Standard_Standard then
+ Error_Msg_Sloc := Sloc (Id);
+ Err_No := Clause2;
- else
- declare
- S1 : Entity_Id;
- S2 : Entity_Id;
-
- begin
- S1 := Scope (Ent1);
- S2 := Scope (Ent2);
- while Present (S1)
- and then Present (S2)
- and then S1 /= Standard_Standard
- and then S2 /= Standard_Standard
- loop
- S1 := Scope (S1);
- S2 := Scope (S2);
- end loop;
+ -- If both units are child units, we determine which one is
+ -- the descendant by the scope distance to the ultimate
+ -- parent unit.
- if S1 = Standard_Standard then
- Error_Msg_Sloc := Sloc (Id);
- Err_No := Clause2;
- else
- Error_Msg_Sloc := Sloc (Current_Use_Clause (T));
- Err_No := Clause1;
- end if;
- end;
- end if;
+ else
+ declare
+ S1 : Entity_Id;
+ S2 : Entity_Id;
- if Parent (Id) /= Err_No then
- if Most_Descendant_Use_Clause
- (Err_No, Parent (Id)) = Parent (Id)
- then
- Error_Msg_Sloc := Sloc (Err_No);
- Err_No := Parent (Id);
+ begin
+ S1 := Scope (Ent1);
+ S2 := Scope (Ent2);
+ while Present (S1)
+ and then Present (S2)
+ and then S1 /= Standard_Standard
+ and then S2 /= Standard_Standard
+ loop
+ S1 := Scope (S1);
+ S2 := Scope (S2);
+ end loop;
+
+ if S1 = Standard_Standard then
+ Error_Msg_Sloc := Sloc (Id);
+ Err_No := Clause2;
+ else
+ Error_Msg_Sloc := Sloc (Clause2);
+ Err_No := Clause1;
end if;
+ end;
+ end if;
- Error_Msg_NE -- CODEFIX
- ("& is already use-visible through previous "
- & "use_type_clause #??", Err_No, Id);
+ if Parent (Id) /= Err_No then
+ if Most_Descendant_Use_Clause
+ (Err_No, Parent (Id)) = Parent (Id)
+ then
+ Error_Msg_Sloc := Sloc (Err_No);
+ Err_No := Parent (Id);
end if;
- -- Case where current use_type_clause and use_type_clause
- -- for the type are not both at the compilation unit level.
- -- In this case we don't have location information.
-
- else
Error_Msg_NE -- CODEFIX
("& is already use-visible through previous "
- & "use_type_clause??", Id, T);
+ & "use_type_clause #??", Err_No, Id);
end if;
end Use_Clause_Known;
- -- Here if Current_Use_Clause is not set for T, another case where
- -- we do not have the location information available.
+ -- Here Current_Use_Clause is not set for T, so we do not have the
+ -- location information available.
else
Error_Msg_NE -- CODEFIX
^ permalink raw reply [flat|nested] only message in thread
only message in thread, other threads:[~2022-05-10 8:22 UTC | newest]
Thread overview: (only message) (download: mbox.gz / follow: Atom feed)
-- links below jump to the message on this page --
2022-05-10 8:22 [gcc r13-249] [Ada] Incorrect ineffective use type clause warning Pierre-Marie de Rodat
This is a public inbox, see mirroring instructions
for how to clone and mirror all data and code used for this inbox;
as well as URLs for read-only IMAP folder(s) and NNTP newsgroup(s).