From 4f2cae4a92d1135ededcecdffd84e1c4c394b083 Mon Sep 17 00:00:00 2001 From: Ed Schonberg Date: Thu, 21 May 2015 10:47:34 +0000 Subject: [PATCH] sem_ch13.adb (Check_Iterator_Functions): Emit error on Iterator aspect as well when indexing function is illegal. 2015-05-21 Ed Schonberg * sem_ch13.adb (Check_Iterator_Functions): Emit error on Iterator aspect as well when indexing function is illegal. (Valid_Default_Iterator): Handle properly somme illegal cases to prevent compilation abandoned messages. (Check_Primitive_Function): Verify that type and indexing function are in the same scope. * freeze.adb (Freeze_Record): Extend patch on the presence of indexing aspects to aspect Default_Iterator. From-SVN: r223475 --- gcc/ada/ChangeLog | 11 +++++++++++ gcc/ada/freeze.adb | 37 +++++++++++++++++++++++++------------ gcc/ada/sem_ch13.adb | 21 +++++++++++++++++---- 3 files changed, 53 insertions(+), 16 deletions(-) diff --git a/gcc/ada/ChangeLog b/gcc/ada/ChangeLog index 004901ef170..230a62b905b 100644 --- a/gcc/ada/ChangeLog +++ b/gcc/ada/ChangeLog @@ -1,3 +1,14 @@ +2015-05-21 Ed Schonberg + + * sem_ch13.adb (Check_Iterator_Functions): Emit error on Iterator + aspect as well when indexing function is illegal. + (Valid_Default_Iterator): Handle properly somme illegal cases + to prevent compilation abandoned messages. + (Check_Primitive_Function): Verify that type and indexing function + are in the same scope. + * freeze.adb (Freeze_Record): Extend patch on the presence of + indexing aspects to aspect Default_Iterator. + 2015-05-19 David Malcolm * gcc-interface/trans.c (Sloc_to_locus1): Strenghthen local "map" diff --git a/gcc/ada/freeze.adb b/gcc/ada/freeze.adb index 2377c39c3d2..14c2aa3336f 100644 --- a/gcc/ada/freeze.adb +++ b/gcc/ada/freeze.adb @@ -3048,7 +3048,9 @@ package body Freeze is Set_Etype (Formal, F_Type); end if; - Freeze_And_Append (F_Type, N, Result); + if not From_Limited_With (F_Type) then + Freeze_And_Append (F_Type, N, Result); + end if; if Is_Private_Type (F_Type) and then Is_Private_Type (Base_Type (F_Type)) @@ -4288,21 +4290,32 @@ package body Freeze is end if; end if; - -- Make sure that if we have aspect Iterator_Element, then we have + -- Make sure that if we have terator aspect, then we have -- either Constant_Indexing or Variable_Indexing. - if Has_Aspect (Rec, Aspect_Iterator_Element) then - if Has_Aspect (Rec, Aspect_Constant_Indexing) + declare + Iterator_Aspect : Node_Id; + + begin + Iterator_Aspect := Find_Aspect (Rec, Aspect_Iterator_Element); + + if No (Iterator_Aspect) then + Iterator_Aspect := Find_Aspect (Rec, Aspect_Default_Iterator); + end if; + + if Present (Iterator_Aspect) 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)); + Has_Aspect (Rec, Aspect_Variable_Indexing) + then + null; + else + Error_Msg_N + ("Iterator_Element requires indexing aspect", + Iterator_Aspect); + end if; end if; - end if; + end; -- All done if not a full record definition diff --git a/gcc/ada/sem_ch13.adb b/gcc/ada/sem_ch13.adb index 30437ba5eea..1de87d9fc57 100644 --- a/gcc/ada/sem_ch13.adb +++ b/gcc/ada/sem_ch13.adb @@ -4124,8 +4124,10 @@ package body Sem_Ch13 is Entity (Expr), Ent); end if; + -- Flag the default_iterator as well as the denoted function. + if not Valid_Default_Iterator (Entity (Expr)) then - Error_Msg_N ("improper function for default iterator", Expr); + Error_Msg_N ("improper function for default iterator!", Expr); end if; else @@ -4178,6 +4180,12 @@ package body Sem_Ch13 is Ctrl := Etype (First_Formal (Subp)); end if; + -- To be a primitive operation subprogram has to be in same scope. + + if Scope (Ctrl) /= Scope (Subp) then + return False; + end if; + -- Type of formal may be the class-wide type, an access to such, -- or an incomplete view. @@ -4972,9 +4980,12 @@ package body Sem_Ch13 is Typ : Entity_Id; begin + -- If target type is untagged, further checks are irrelevant + if not Is_Tagged_Type (U_Ent) then Error_Msg_N - ("aspect Default_Iterator applies to tagged type", Nam); + ("aspect Default_Iterator applies to tagged type", Nam); + return; end if; Check_Iterator_Functions; @@ -4985,15 +4996,17 @@ package body Sem_Ch13 is or else Ekind (Entity (Expr)) /= E_Function then Error_Msg_N ("aspect Iterator must be a function", Expr); + return; else Func := Entity (Expr); end if; -- The type of the first parameter must be T, T'class, or a - -- corresponding access type (5.5.1 (8/3) + -- corresponding access type (5.5.1 (8/3). If function is + -- parameterless label type accordingly. if No (First_Formal (Func)) then - Typ := Empty; + Typ := Any_Type; else Typ := Etype (First_Formal (Func)); end if; -- 2.30.2