From 7166d53559b1d2fc49d7f55166364b3ca345a00a Mon Sep 17 00:00:00 2001 From: Arnaud Charlet Date: Tue, 12 May 2015 17:13:06 +0200 Subject: [PATCH] [multiple changes] 2015-05-12 Ed Schonberg * sem_ch5.adb (Analyze_Iterator_Specifications): Additional legality checks for array and container iterators: a) The domain of iteration cannot be a component that depends on discriminants of a mutable object. The check was recently added for element iterators. b) The cursor type cannot be a limited type at the point of the iteration, because the cursor will be assigned to in the body of the loop. 2015-05-12 Robert Dewar * freeze.adb (Freeze_Record_Type): Make sure that if we have aspect Iterator_Element, then we have either Constant_Indexing or Variable_Indexing. From-SVN: r223077 --- gcc/ada/ChangeLog | 17 +++++++++++++++++ gcc/ada/freeze.adb | 16 ++++++++++++++++ gcc/ada/sem_ch5.adb | 38 +++++++++++++++++++++++++++++++++++++- 3 files changed, 70 insertions(+), 1 deletion(-) diff --git a/gcc/ada/ChangeLog b/gcc/ada/ChangeLog index e12294194c1..045992b6696 100644 --- a/gcc/ada/ChangeLog +++ b/gcc/ada/ChangeLog @@ -1,3 +1,20 @@ +2015-05-12 Ed Schonberg + + * sem_ch5.adb (Analyze_Iterator_Specifications): Additional + legality checks for array and container iterators: + a) The domain of iteration cannot be a component that depends + on discriminants of a mutable object. The check was recently + added for element iterators. + b) The cursor type cannot be a limited type at the point of the + iteration, because the cursor will be assigned to in the body + of the loop. + +2015-05-12 Robert Dewar + + * freeze.adb (Freeze_Record_Type): Make sure that if we have + aspect Iterator_Element, then we have either Constant_Indexing + or Variable_Indexing. + 2015-05-12 Ed Schonberg * a-coormu.ads, a-coormu.adb: Add Indexing aspect, Reference_Type, diff --git a/gcc/ada/freeze.adb b/gcc/ada/freeze.adb index 7612c189b5c..2377c39c3d2 100644 --- a/gcc/ada/freeze.adb +++ b/gcc/ada/freeze.adb @@ -4288,6 +4288,22 @@ package body Freeze is end if; end if; + -- Make sure that if we have aspect Iterator_Element, then we have + -- either Constant_Indexing or Variable_Indexing. + + if Has_Aspect (Rec, Aspect_Iterator_Element) then + if Has_Aspect (Rec, Aspect_Constant_Indexing) + or else + Has_Aspect (Rec, Aspect_Variable_Indexing) + then + null; + else + Error_Msg_N + ("Iterator_Element requires indexing aspect", + Find_Aspect (Rec, Aspect_Iterator_Element)); + end if; + end if; + -- All done if not a full record definition if Ekind (Rec) /= E_Record_Type then diff --git a/gcc/ada/sem_ch5.adb b/gcc/ada/sem_ch5.adb index dea8acffe8e..34cc18eff4e 100644 --- a/gcc/ada/sem_ch5.adb +++ b/gcc/ada/sem_ch5.adb @@ -2088,7 +2088,7 @@ package body Sem_Ch5 is end; end if; - -- OF not present + -- IN iterator, domain is a range, or a call to Iterate function else -- For an iteration of the form IN, the name must denote an @@ -2125,6 +2125,35 @@ package body Sem_Ch5 is end if; end if; + -- If the name is a call (typically prefixed) to some Iterate + -- function, it has been rewritten as an object declaration. + -- If that object is a selected component, verify that it is not + -- a component of an unconstrained mutable object. + + if Nkind (Iter_Name) = N_Identifier then + declare + Iter_Kind : constant Node_Kind := + Nkind (Original_Node (Iter_Name)); + Obj : Node_Id; + + begin + if Iter_Kind = N_Selected_Component then + Obj := Prefix (Original_Node (Iter_Name)); + + elsif Iter_Kind = N_Function_Call then + Obj := First_Actual (Original_Node (Iter_Name)); + end if; + + if Nkind (Obj) = N_Selected_Component + and then Is_Dependent_Component_Of_Mutable_Object (Obj) + then + Error_Msg_N + ("container cannot be a discriminant-dependent " & + "component of a mutable object", N); + end if; + end; + end if; + -- The result type of Iterate function is the classwide type of -- the interface parent. We need the specific Cursor type defined -- in the container package. We obtain it by name for a predefined @@ -2148,6 +2177,13 @@ package body Sem_Ch5 is Next_Entity (Ent); end loop; end if; + + -- The cursor is the target of generated assignments in the + -- loop, and cannot have a limited type. + + if Is_Limited_Type (Etype (Def_Id)) then + Error_Msg_N ("cursor type cannot be limited", N); + end if; end if; end if; -- 2.30.2