This patch corrects an issue whereby the use of a class-wide type's primitive
did not lead to its base type being recognized as effective - causing to
spurious use_clause warnings. Additionally, class-wide types used as generic
actuals were not checked in certain cases due to not being flagged as
potentially visible.
------------
-- Source --
------------
-- pck.ads
package Pck is
type R (V : Positive) is abstract tagged private;
private
type R (V : Positive) is abstract tagged null record;
end Pck;
-- proc.adb
with Ada.Containers.Indefinite_Vectors;
with Pck;
procedure Proc is
use type Pck.R;
package V is new Ada.Containers.Indefinite_Vectors (Positive, Pck.R'Class);
begin
null;
end Proc;
----------------------------
-- Compilation and output --
----------------------------
& gcc -c -gnatwu proc.adb
Tested on x86_64-pc-linux-gnu, committed on trunk
2017-11-08 Justin Squirek <squi...@adacore.com>
* sem_ch8.adb (Mark_Use_Clauses): Add condition to always mark the
primitives of generic actuals.
(Mark_Use_Type): Add recursive call to properly mark class-wide type's
base type clauses as per ARM 8.4 (8.2/3).
Index: sem_ch8.adb
===================================================================
--- sem_ch8.adb (revision 254535)
+++ sem_ch8.adb (working copy)
@@ -8320,6 +8320,7 @@
procedure Mark_Use_Type (E : Entity_Id) is
Curr : Node_Id;
+ Base : Entity_Id;
begin
-- Ignore void types and unresolved string literals and primitives
@@ -8331,12 +8332,22 @@
return;
end if;
+ -- Primitives with class-wide operands might additionally render
+ -- their base type's use_clauses effective - so do a recursive check
+ -- here.
+
+ Base := Base_Type (Etype (E));
+
+ if Ekind (Base) = E_Class_Wide_Type then
+ Mark_Use_Type (Base);
+ end if;
+
-- The package containing the type or operator function being used
-- may be in use as well, so mark any use_package_clauses for it as
-- effective. There are also additional sanity checks performed here
-- for ignoring previous errors.
- Mark_Use_Package (Scope (Base_Type (Etype (E))));
+ Mark_Use_Package (Scope (Base));
if Nkind (E) in N_Op
and then Present (Entity (E))
@@ -8345,7 +8356,7 @@
Mark_Use_Package (Scope (Entity (E)));
end if;
- Curr := Current_Use_Clause (Base_Type (Etype (E)));
+ Curr := Current_Use_Clause (Base);
while Present (Curr)
and then not Is_Effective_Use_Clause (Curr)
loop
@@ -8397,7 +8408,9 @@
or else Ekind_In (Id, E_Generic_Function,
E_Generic_Procedure))
and then (Is_Potentially_Use_Visible (Id)
- or else Is_Intrinsic_Subprogram (Id))
+ or else Is_Intrinsic_Subprogram (Id)
+ or else (Ekind_In (Id, E_Function, E_Procedure)
+ and then Is_Generic_Actual_Subprogram (Id)))
then
Mark_Parameters (Id);
end if;
