From: Arnaud Charlet Date: Mon, 7 Nov 2011 16:25:32 +0000 (+0100) Subject: [multiple changes] X-Git-Tag: releases/gcc-4.7.0~2402 X-Git-Url: http://git.ipfire.org/cgi-bin/gitweb.cgi?a=commitdiff_plain;h=9ee76313c4ae8b4a9b9f887ae67747017096c89d;p=thirdparty%2Fgcc.git [multiple changes] 2011-11-07 Yannick Moy * sem_util.adb (Note_Possible_Modification): In Alfa mode, generate a reference for a modification even when the modification does not come from source. 2011-11-07 Ed Schonberg * exp_ch5.adb (Expand_Iterator_Loop): For the "of" iterator form, use the indexing attributes rather than the Element function, to obtain variable references. * sem_ch4.adb (Try_Container_Indexing): Code cleanup. Use Find_Aspect rather than iterating over representation items. Improve error message. * a-cohama.adb, a-cohama.ads Update to latest RM, with two versions of Reference functions. From-SVN: r181093 --- diff --git a/gcc/ada/ChangeLog b/gcc/ada/ChangeLog index f0f5bf953946..c24abece38a5 100644 --- a/gcc/ada/ChangeLog +++ b/gcc/ada/ChangeLog @@ -1,3 +1,20 @@ +2011-11-07 Yannick Moy + + * sem_util.adb (Note_Possible_Modification): In Alfa mode, + generate a reference for a modification even when the modification + does not come from source. + +2011-11-07 Ed Schonberg + + * exp_ch5.adb (Expand_Iterator_Loop): For the "of" iterator form, + use the indexing attributes rather than the Element function, + to obtain variable references. + * sem_ch4.adb (Try_Container_Indexing): Code cleanup. Use + Find_Aspect rather than iterating over representation + items. Improve error message. + * a-cohama.adb, a-cohama.ads Update to latest RM, with two versions + of Reference functions. + 2011-11-07 Yannick Moy * sem_util.adb (Unique_Entity): For a parameter on a subprogram diff --git a/gcc/ada/a-cohama.adb b/gcc/ada/a-cohama.adb index 20e10e8daf9e..bb7298892723 100644 --- a/gcc/ada/a-cohama.adb +++ b/gcc/ada/a-cohama.adb @@ -845,14 +845,36 @@ package body Ada.Containers.Hashed_Maps is -- Reference -- --------------- - function Constant_Reference (Container : Map; Key : Key_Type) - return Constant_Reference_Type is + function Constant_Reference + (Container : aliased Map; Position : Cursor) + return Constant_Reference_Type + is + pragma Unreferenced (Container); + begin + return (Element => Element (Position)'Unrestricted_Access); + end Constant_Reference; + + function Reference + (Container : aliased in out Map; Position : Cursor) + return Reference_Type + is + pragma Unreferenced (Container); + begin + return (Element => Element (Position)'Unrestricted_Access); + end Reference; + + function Constant_Reference + (Container : aliased Map; Key : Key_Type) + return Constant_Reference_Type + is begin return (Element => Container.Element (Key)'Unrestricted_Access); end Constant_Reference; - function Reference (Container : Map; Key : Key_Type) - return Reference_Type is + function Reference + (Container : aliased in out Map; Key : Key_Type) + return Reference_Type + is begin return (Element => Container.Element (Key)'Unrestricted_Access); end Reference; diff --git a/gcc/ada/a-cohama.ads b/gcc/ada/a-cohama.ads index 627738332465..a13d14c2cca0 100644 --- a/gcc/ada/a-cohama.ads +++ b/gcc/ada/a-cohama.ads @@ -311,10 +311,19 @@ package Ada.Containers.Hashed_Maps is for Reference_Type'Read use Read; function Constant_Reference - (Container : Map; Key : Key_Type) -- SHOULD BE ALIASED + (Container : aliased Map; Position : Cursor) return Constant_Reference_Type; - function Reference (Container : Map; Key : Key_Type) + function Reference + (Container : aliased in out Map; Position : Cursor) + return Reference_Type; + + function Constant_Reference + (Container : aliased Map; Key : Key_Type) + return Constant_Reference_Type; + + function Reference + (Container : aliased in out Map; Key : Key_Type) return Reference_Type; procedure Iterate diff --git a/gcc/ada/exp_ch5.adb b/gcc/ada/exp_ch5.adb index eb23bfd641cc..fd75b158449b 100644 --- a/gcc/ada/exp_ch5.adb +++ b/gcc/ada/exp_ch5.adb @@ -3120,32 +3120,32 @@ package body Exp_Ch5 is end loop; -- Generate: - -- Id : Element_Type renames Pack.Element (Cursor); + -- Id : Element_Type renames Container (Cursor); + -- This assumes that the container type has an indexing + -- operation with Cursor. The check that this operation + -- exists is performed in Check_Container_Indexing. Decl := Make_Object_Renaming_Declaration (Loc, Defining_Identifier => Id, - Subtype_Mark => + Subtype_Mark => New_Reference_To (Element_Type, Loc), - Name => + Name => Make_Indexed_Component (Loc, - Prefix => Make_Selected_Component (Loc, - Prefix => New_Reference_To (Pack, Loc), - Selector_Name => - Make_Identifier (Loc, Chars => Name_Element)), + Prefix => Relocate_Node (Container_Arg), Expressions => New_List (New_Occurrence_Of (Cursor, Loc)))); -- If the container holds controlled objects, wrap the loop -- statements and element renaming declaration with a block. - -- This ensures that the result of Element (Iterator) is + -- This ensures that the result of Element (Cusor) is -- cleaned up after each iteration of the loop. if Needs_Finalization (Element_Type) then -- Generate: -- declare - -- Id : Element_Type := Pack.Element (Iterator); + -- Id : Element_Type := Pack.Element (curosr); -- begin -- -- end; @@ -3279,9 +3279,11 @@ package body Exp_Ch5 is -- The Iterator is not modified in the source, but of course will -- be updated in the generated code. Indicate that it is actually - -- set to prevent spurious warnings. + -- set to prevent spurious warnings. Ditto for the Cursor, which + -- is modified indirectly in generated code. Set_Never_Set_In_Source (Iterator, False); + Set_Never_Set_In_Source (Cursor, False); -- If the range of iteration is given by a function call that -- returns a container, the finalization actions have been saved diff --git a/gcc/ada/sem_ch4.adb b/gcc/ada/sem_ch4.adb index 1a88e77ede8e..c9e81e989053 100644 --- a/gcc/ada/sem_ch4.adb +++ b/gcc/ada/sem_ch4.adb @@ -6427,38 +6427,20 @@ package body Sem_Ch4 is Func : Entity_Id; Func_Name : Node_Id; Indexing : Node_Id; - Is_Var : Boolean; - Ritem : Node_Id; begin -- Check whether type has a specified indexing aspect Func_Name := Empty; - Is_Var := False; - Ritem := First_Rep_Item (Etype (Prefix)); - while Present (Ritem) loop - if Nkind (Ritem) = N_Aspect_Specification then - - -- Prefer Variable_Indexing, but will settle for Constant - - if Get_Aspect_Id (Chars (Identifier (Ritem))) = - Aspect_Constant_Indexing - then - Func_Name := Expression (Ritem); - - elsif Get_Aspect_Id (Chars (Identifier (Ritem))) = - Aspect_Variable_Indexing - then - Func_Name := Expression (Ritem); - Is_Var := True; - exit; - end if; - end if; + if Is_Variable (Prefix) then + Func_Name := Find_Aspect (Etype (Prefix), Aspect_Variable_Indexing); + end if; - Next_Rep_Item (Ritem); - end loop; + if No (Func_Name) then + Func_Name := Find_Aspect (Etype (Prefix), Aspect_Constant_Indexing); + end if; -- If aspect does not exist the expression is illegal. Error is -- diagnosed in caller. @@ -6478,12 +6460,6 @@ package body Sem_Ch4 is end if; end if; - if Is_Var - and then not Is_Variable (Prefix) - then - Error_Msg_N ("Variable indexing cannot be applied to a constant", N); - end if; - if not Is_Overloaded (Func_Name) then Func := Entity (Func_Name); Indexing := Make_Function_Call (Loc, @@ -6526,6 +6502,7 @@ package body Sem_Ch4 is Analyze_One_Call (N, It.Nam, False, Success); if Success then Set_Etype (Name (N), It.Typ); + Set_Entity (Name (N), It.Nam); -- Add implicit dereference interpretation @@ -6540,12 +6517,20 @@ package body Sem_Ch4 is Next_Discriminant (Disc); end loop; + exit; end if; Get_Next_Interp (I, It); end loop; end; end if; + if Etype (N) = Any_Type then + Error_Msg_NE ("container cannot be indexed with&", N, Etype (Expr)); + Rewrite (N, New_Occurrence_Of (Any_Id, Loc)); + else + Analyze (N); + end if; + return True; end Try_Container_Indexing; diff --git a/gcc/ada/sem_util.adb b/gcc/ada/sem_util.adb index 6fbe39952669..1764da9db024 100644 --- a/gcc/ada/sem_util.adb +++ b/gcc/ada/sem_util.adb @@ -10837,7 +10837,9 @@ package body Sem_Util is -- source. This excludes, for example, calls to a dispatching -- assignment operation when the left-hand side is tagged. - if Modification_Comes_From_Source then + if Modification_Comes_From_Source + or else Alfa_Mode + then Generate_Reference (Ent, Exp, 'm'); -- If the target of the assignment is the bound variable