This patch adds a diagnostic to detect an illegal quantified expression which
is masquerading as an iterated component association.
------------
-- Source --
------------
-- proc.adb
with Ada.Containers;
with Ada.Containers.Hashed_Sets;
procedure Proc is
function Hash (X : Integer) return Ada.Containers.Hash_Type is
(Ada.Containers.Hash_Type (X));
package Int_Sets is new Ada.Containers.Hashed_Sets
(Element_Type => Integer,
Hash => Hash,
Equivalent_Elements => "=",
"=" => "=");
type T is record
S : Int_Sets.Set;
end record;
B : Boolean;
R : T;
begin
B := for E in R.S => E > 0;
end Proc;
----------------------------
-- Compilation and output --
----------------------------
$ gcc -c proc.adb
proc.adb:22:13: missing quantifier
Tested on x86_64-pc-linux-gnu, committed on trunk
2017-04-27 Hristian Kirtchev <kirtc...@adacore.com>
* sem.adb (Analyze): Diagnose an illegal iterated component
association.
* sem_util.ads, sem_util.adb
(Diagnose_Iterated_Component_Association): New routine.
Index: sem.adb
===================================================================
--- sem.adb (revision 247293)
+++ sem.adb (working copy)
@@ -654,6 +654,15 @@
=>
null;
+ -- A quantified expression with a missing "all" or "some" qualifier
+ -- looks identical to an iterated component association. By language
+ -- definition, the latter must be present within array aggregates. If
+ -- this is not the case, then the iterated component association is
+ -- really an illegal quantified expression. Diagnose this scenario.
+
+ when N_Iterated_Component_Association =>
+ Diagnose_Iterated_Component_Association (N);
+
-- For the remaining node types, we generate compiler abort, because
-- these nodes are always analyzed within the Sem_Chn routines and
-- there should never be a case of making a call to the main Analyze
@@ -704,7 +713,6 @@
| N_Function_Specification
| N_Generic_Association
| N_Index_Or_Discriminant_Constraint
- | N_Iterated_Component_Association
| N_Iteration_Scheme
| N_Mod_Clause
| N_Modular_Type_Definition
Index: sem_util.adb
===================================================================
--- sem_util.adb (revision 247296)
+++ sem_util.adb (working copy)
@@ -6023,12 +6023,52 @@
end if;
end Designate_Same_Unit;
- ------------------------------------------
- -- function Dynamic_Accessibility_Level --
- ------------------------------------------
+ ---------------------------------------------
+ -- Diagnose_Iterated_Component_Association --
+ ---------------------------------------------
+ procedure Diagnose_Iterated_Component_Association (N : Node_Id) is
+ Def_Id : constant Entity_Id := Defining_Identifier (N);
+ Aggr : Node_Id;
+
+ begin
+ -- Determine whether the iterated component association appears within
+ -- an aggregate. If this is the case, raise Program_Error because the
+ -- iterated component association cannot be left in the tree as is and
+ -- must always be processed by the related aggregate.
+
+ Aggr := N;
+ while Present (Aggr) loop
+ if Nkind (Aggr) = N_Aggregate then
+ raise Program_Error;
+
+ -- Prevent the search from going too far
+
+ elsif Is_Body_Or_Package_Declaration (Aggr) then
+ exit;
+ end if;
+
+ Aggr := Parent (Aggr);
+ end loop;
+
+ -- At this point it is known that the iterated component association is
+ -- not within an aggregate. This is really a quantified expression with
+ -- a missing "all" or "some" quantifier.
+
+ Error_Msg_N ("missing quantifier", Def_Id);
+
+ -- Rewrite the iterated component association as True to prevent any
+ -- cascaded errors.
+
+ Rewrite (N, New_Occurrence_Of (Standard_True, Sloc (N)));
+ Analyze (N);
+ end Diagnose_Iterated_Component_Association;
+
+ ---------------------------------
+ -- Dynamic_Accessibility_Level --
+ ---------------------------------
+
function Dynamic_Accessibility_Level (Expr : Node_Id) return Node_Id is
- E : Entity_Id;
Loc : constant Source_Ptr := Sloc (Expr);
function Make_Level_Literal (Level : Uint) return Node_Id;
@@ -6041,11 +6081,16 @@
function Make_Level_Literal (Level : Uint) return Node_Id is
Result : constant Node_Id := Make_Integer_Literal (Loc, Level);
+
begin
Set_Etype (Result, Standard_Natural);
return Result;
end Make_Level_Literal;
+ -- Local variables
+
+ E : Entity_Id;
+
-- Start of processing for Dynamic_Accessibility_Level
begin
Index: sem_util.ads
===================================================================
--- sem_util.ads (revision 247293)
+++ sem_util.ads (working copy)
@@ -545,6 +545,10 @@
-- these names is supposed to be a selected component name, an expanded
-- name, a defining program unit name or an identifier.
+ procedure Diagnose_Iterated_Component_Association (N : Node_Id);
+ -- Emit an error if iterated component association N is actually an illegal
+ -- quantified expression lacking a quantifier.
+
function Dynamic_Accessibility_Level (Expr : Node_Id) return Node_Id;
-- Expr should be an expression of an access type. Builds an integer
-- literal except in cases involving anonymous access types where
