This patch corrects various problems with the generation of checks for type
invariants, when the type with an invariant is a discriminated type and the
invariant refers to an array component constrained by discriminants.
Tested on x86_64-pc-linux-gnu, committed on trunk
2014-10-17 Ed Schonberg <schonb...@adacore.com>
* exp_ch3.adb (Build_Component_Invariant_Call): Retrieve Invariant
subprogram from base type.
* sem_ch7.adb (Analyze_Package_Specification): Build invariant
subprogram for private type, not any of its subtypes.
* sem_ch13.adb (Build_Invariant_Procedure_Declaration): Set type
of procedure entity, because a call to it may be generated in
a client unit before the corresponding subprogram declaration
is analyzed.
Index: sem_ch7.adb
===================================================================
--- sem_ch7.adb (revision 216367)
+++ sem_ch7.adb (working copy)
@@ -1384,7 +1384,11 @@
end if;
if Has_Invariants (E) then
- Build_Invariant_Procedure (E, N);
+ if Ekind (E) = E_Private_Subtype then
+ null;
+ else
+ Build_Invariant_Procedure (E, N);
+ end if;
end if;
end if;
Index: sem_ch13.adb
===================================================================
--- sem_ch13.adb (revision 216377)
+++ sem_ch13.adb (working copy)
@@ -3903,6 +3903,7 @@
if Ctrl = Ent
or else Ctrl = Class_Wide_Type (Ent)
+
or else
(Ekind (Ctrl) = E_Anonymous_Access_Type
and then
@@ -7393,6 +7394,7 @@
Chars => New_External_Name (Chars (Typ), "Invariant"));
Set_Has_Invariants (Typ);
Set_Ekind (SId, E_Procedure);
+ Set_Etype (SId, Standard_Void_Type);
Set_Is_Invariant_Procedure (SId);
Set_Invariant_Procedure (Typ, SId);
Index: exp_ch3.adb
===================================================================
--- exp_ch3.adb (revision 216379)
+++ exp_ch3.adb (working copy)
@@ -3720,10 +3720,12 @@
end if;
end if;
+ -- The aspect is type-specific, so retrieve it from the base type.
+
Call :=
Make_Procedure_Call_Statement (Loc,
Name =>
- New_Occurrence_Of (Invariant_Procedure (Typ), Loc),
+ New_Occurrence_Of (Invariant_Procedure (Base_Type (Typ)), Loc),
Parameter_Associations => New_List (Sel_Comp));
if Is_Access_Type (Etype (Comp)) then
