[Ada] Missing categorization check on generic subprogram body

[Pierre-Marie de Rodat]

This patch adds a categorization check on a generic subprogram body, so
that the compiler can reject a generic subprogram marked Pure if its body
depends on an impure unit.

Compiling gf.adb must yield:

   gf.adb:2:06: cannot depend on "Impure" (wrong categorization)
   gf.adb:2:06: pure unit cannot depend on non-pure unit

--
generic
function GF return String with Pure;
---
with Impure;
function GF return String is
begin
   return Impure.Think_Rotten_Thoughts;
end GF;
---
package Impure is
   function Think_Rotten_Thoughts return String;
end;
---
package body Impure is
   Count : Natural := 0;
   function Think_Rotten_Thoughts return String is
   begin
      Count := Count + 1;
      return "Rotten thought" & Natural'Image (Count);
   end;
end;

Tested on x86_64-pc-linux-gnu, committed on trunk

2017-11-08  Ed Schonberg  <schonberg@adacore.com>

	* sem_ch6.adb (Analyze_Generic_Subprobram_Body): Validate
	categorization dependency of the body, as is done for non-generic
	units.
	(New_Overloaded_Entity, Visible_Part_Type): Remove linear search
	through declarations (Simple optimization, no behavior change).

-------------- next part --------------
Index: sem_ch6.adb
===================================================================
--- sem_ch6.adb	(revision 254535)
+++ sem_ch6.adb	(working copy)
@@ -1510,6 +1510,7 @@
 
       Process_End_Label (Handled_Statement_Sequence (N), 't', Current_Scope);
       Update_Use_Clause_Chain;
+      Validate_Categorization_Dependency (N, Gen_Id);
       End_Scope;
       Check_Subprogram_Order (N);
 
@@ -10118,7 +10119,6 @@
 
          function Visible_Part_Type (T : Entity_Id) return Boolean is
             P : constant Node_Id := Unit_Declaration_Node (Scope (T));
-            N : Node_Id;
 
          begin
             --  If the entity is a private type, then it must be declared in a
@@ -10126,34 +10126,19 @@
 
             if Ekind (T) in Private_Kind then
                return True;
-            end if;
 
-            --  Otherwise, we traverse the visible part looking for its
-            --  corresponding declaration. We cannot use the declaration
-            --  node directly because in the private part the entity of a
-            --  private type is the one in the full view, which does not
-            --  indicate that it is the completion of something visible.
+            elsif Is_Type (T) and then Has_Private_Declaration (T) then
+               return True;
 
-            N := First (Visible_Declarations (Specification (P)));
-            while Present (N) loop
-               if Nkind (N) = N_Full_Type_Declaration
-                 and then Present (Defining_Identifier (N))
-                 and then T = Defining_Identifier (N)
-               then
-                  return True;
+            elsif Is_List_Member (Declaration_Node (T))
+              and then List_Containing (Declaration_Node (T)) =
+                         Visible_Declarations (Specification (P))
+            then
+               return True;
 
-               elsif Nkind_In (N, N_Private_Type_Declaration,
-                                  N_Private_Extension_Declaration)
-                 and then Present (Defining_Identifier (N))
-                 and then T = Full_View (Defining_Identifier (N))
-               then
-                  return True;
-               end if;
-
-               Next (N);
-            end loop;
-
-            return False;
+            else
+               return False;
+            end if;
          end Visible_Part_Type;
 
       --  Start of processing for Check_For_Primitive_Subprogram