diff mbox series

[Ada] Spurious ineffective use_clause warning on class-wide type

Message ID 20171108160621.GA6967@adacore.com
State New
Headers show
Series [Ada] Spurious ineffective use_clause warning on class-wide type | expand

Commit Message

Pierre-Marie de Rodat Nov. 8, 2017, 4:06 p.m. UTC 
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  <squirek@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).
diff mbox series

Patch

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;