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 <schonb...@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).
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
