From 383e179e1a5299cc07ff74141b50bd55ff479bfd Mon Sep 17 00:00:00 2001 From: Arnaud Charlet Date: Mon, 1 Aug 2011 15:29:56 +0200 Subject: [PATCH] [multiple changes] 2011-08-01 Ed Schonberg * exp_ch5.adb (Expand_N_Iterator_Loop): handle properly an iterator over an arbitrary expression of an array or container type. * lib-xref.adb: clarify comment. 2011-08-01 Bob Duff * einfo.ads: Minor reformatting. * debug.adb: Minor comment improvement. 2011-08-01 Javier Miranda * sem_ch4.adb (Try_Object_Operation): For class-wide subprograms do not consider hidden subprograms as valid candidates. 2011-08-01 Arnaud Charlet * make.adb (Compile): Strip -mxxx switches in CodePeer mode. 2011-08-01 Vasiliy Fofanov * gnat_ugn.texi: Fix typo. From-SVN: r177031 --- gcc/ada/ChangeLog | 24 ++++++++++++++++++++++++ gcc/ada/debug.adb | 5 ++++- gcc/ada/einfo.ads | 14 +++++++------- gcc/ada/exp_ch5.adb | 19 ++++++++----------- gcc/ada/gnat_ugn.texi | 2 +- gcc/ada/lib-xref.adb | 4 +++- gcc/ada/make.adb | 27 +++++++++++++++++++++++---- gcc/ada/sem_ch4.adb | 6 ++++-- 8 files changed, 74 insertions(+), 27 deletions(-) diff --git a/gcc/ada/ChangeLog b/gcc/ada/ChangeLog index df098fcd1fc..3b9ede5f660 100644 --- a/gcc/ada/ChangeLog +++ b/gcc/ada/ChangeLog @@ -1,3 +1,27 @@ +2011-08-01 Ed Schonberg + + * exp_ch5.adb (Expand_N_Iterator_Loop): handle properly an iterator + over an arbitrary expression of an array or container type. + * lib-xref.adb: clarify comment. + +2011-08-01 Bob Duff + + * einfo.ads: Minor reformatting. + * debug.adb: Minor comment improvement. + +2011-08-01 Javier Miranda + + * sem_ch4.adb (Try_Object_Operation): For class-wide subprograms do not + consider hidden subprograms as valid candidates. + +2011-08-01 Arnaud Charlet + + * make.adb (Compile): Strip -mxxx switches in CodePeer mode. + +2011-08-01 Vasiliy Fofanov + + * gnat_ugn.texi: Fix typo. + 2011-08-01 Robert Dewar * i-cstrin.adb, sem_util.adb, exp_ch11.adb, sem_ch8.adb, diff --git a/gcc/ada/debug.adb b/gcc/ada/debug.adb index 5bfe7c42271..070994a3430 100644 --- a/gcc/ada/debug.adb +++ b/gcc/ada/debug.adb @@ -193,7 +193,7 @@ package body Debug is -- de -- df Only output file names, not path names, in log -- dg - -- dh + -- dh Generate listing showing loading of name table hash chains -- di -- dj -- dk @@ -698,6 +698,9 @@ package body Debug is -- df Only output file names, not path names, in log + -- dh Generate listing showing loading of name table hash chains, + -- same as for the compiler. + -- dm Issue a message indicating the maximum number of simultaneous -- compilations. diff --git a/gcc/ada/einfo.ads b/gcc/ada/einfo.ads index 577b208f436..1c1de932df4 100644 --- a/gcc/ada/einfo.ads +++ b/gcc/ada/einfo.ads @@ -1501,7 +1501,7 @@ package Einfo is -- Has_Homonym (Flag56) -- Present in all entities. Set if an entity has a homonym in the same -- scope. Used by Gigi to generate unique names for such entities. --- + -- Has_Initial_Value (Flag219) -- Present in entities for variables and out parameters. Set if there -- is an explicit initial value expression in the declaration of the @@ -1510,7 +1510,7 @@ package Einfo is -- of access types or controlled types. Always set to False for out -- parameters. Also present in entities for in and in-out parameters, -- but always false in these cases. --- + -- Has_Interrupt_Handler (synthesized) -- Applies to all protected type entities. Set if the protected type -- definition contains at least one procedure to which a pragma @@ -1766,13 +1766,13 @@ package Einfo is -- attribute definition clause. When such a clause occurs, a TSS is set -- on the underlying full view; the flags are used to track visibility of -- the attribute definition clause for partial or incomplete views. --- + -- Has_Static_Discriminants (Flag211) -- Present in record subtypes constrained by discriminant values. Set if -- all the discriminant values have static values, meaning that in the -- case of a variant record, the component list can be trimmed down to -- include only the components corresponding to these discriminants. --- + -- Has_Storage_Size_Clause (Flag23) [implementation base type only] -- Present in task types and access types. It is set if a Storage_Size -- clause is present for the type. Used to prevent multiple clauses for @@ -2315,7 +2315,7 @@ package Einfo is -- 4) Internal entities in the list of primitives of tagged types that -- are used to handle secondary dispatch tables. These entities have -- also the attribute Interface_Alias. --- + -- Is_Interrupt_Handler (Flag89) -- Present in procedures. Set if a pragma Interrupt_Handler applies -- to the procedure. The procedure must be parameterless, and on all @@ -2898,7 +2898,7 @@ package Einfo is -- the generated indexes entity. See unit Exp_Imgv for full details of -- the nature and use of this entity for implementing the Image and -- Value attributes for the enumeration type in question. --- + -- Lit_Strings (Node16) -- Present in enumeration types and subtypes. Non-empty only for the -- case of an enumeration root type, where it contains the entity for @@ -2983,7 +2983,7 @@ package Einfo is -- entities when the return type is an array type, and a call can be -- interpreted as an indexing of the result of the call. It is also -- used to resolve various cases of entry calls. --- + -- Never_Set_In_Source (Flag115) -- Present in all entities, but can be set only for variables and -- parameters. This flag is set if the object is never assigned a value diff --git a/gcc/ada/exp_ch5.adb b/gcc/ada/exp_ch5.adb index bdd5d3adce8..ef77ec938cb 100644 --- a/gcc/ada/exp_ch5.adb +++ b/gcc/ada/exp_ch5.adb @@ -2766,7 +2766,10 @@ package body Exp_Ch5 is Isc : constant Node_Id := Iteration_Scheme (N); I_Spec : constant Node_Id := Iterator_Specification (Isc); Id : constant Entity_Id := Defining_Identifier (I_Spec); - Container : constant Entity_Id := Entity (Name (I_Spec)); + + Container : constant Node_Id := Name (I_Spec); + -- An expression whose type is an array or a predefined container. + Typ : constant Entity_Id := Etype (Container); Cursor : Entity_Id; @@ -2788,8 +2791,7 @@ package body Exp_Ch5 is New_Occurrence_Of (Component_Type (Typ), Loc), Name => Make_Indexed_Component (Loc, - Prefix => - New_Occurrence_Of (Container, Loc), + Prefix => Relocate_Node (Container), Expressions => New_List (New_Occurrence_Of (Cursor, Loc)))); begin @@ -2805,8 +2807,7 @@ package body Exp_Ch5 is Defining_Identifier => Cursor, Discrete_Subtype_Definition => Make_Attribute_Reference (Loc, - Prefix => - New_Occurrence_Of (Container, Loc), + Prefix => Relocate_Node (Container), Attribute_Name => Name_Range), Reverse_Present => Reverse_Present (I_Spec))), Statements => Stats, @@ -2828,8 +2829,7 @@ package body Exp_Ch5 is Defining_Identifier => Cursor, Discrete_Subtype_Definition => Make_Attribute_Reference (Loc, - Prefix => - New_Occurrence_Of (Container, Loc), + Prefix => Relocate_Node (Container), Attribute_Name => Name_Range), Reverse_Present => Reverse_Present (I_Spec))), Statements => Statements (N), @@ -2895,7 +2895,7 @@ package body Exp_Ch5 is Selector_Name => Make_Identifier (Loc, Name_Cursor)), Expression => Make_Selected_Component (Loc, - Prefix => New_Occurrence_Of (Container, Loc), + Prefix => Relocate_Node (Container), Selector_Name => Make_Identifier (Loc, Name_Init))); Insert_Action (N, Cursor_Decl); @@ -2951,9 +2951,6 @@ package body Exp_Ch5 is end; end if; - -- Set_Analyzed (I_Spec); - -- Why is this commented out??? - Rewrite (N, New_Loop); Analyze (N); end Expand_Iterator_Loop; diff --git a/gcc/ada/gnat_ugn.texi b/gcc/ada/gnat_ugn.texi index 29923ee0d68..3ed62dd0d75 100644 --- a/gcc/ada/gnat_ugn.texi +++ b/gcc/ada/gnat_ugn.texi @@ -4148,7 +4148,7 @@ Specify a preprocessing data file @cindex @option{-gnateP} (@command{gcc}) Turn categorization dependency errors into warnings. Ada requires that units that WITH one another have compatible categories, for -example a Pure unit cannto WITH a Preelaborate unit. If this switch is used, +example a Pure unit cannot WITH a Preelaborate unit. If this switch is used, these errors become warnings (which can be ignored, or suppressed in the usual manner). This can be useful in some specialized circumstances such as the temporary use of special test software. diff --git a/gcc/ada/lib-xref.adb b/gcc/ada/lib-xref.adb index 4f440a84d22..4c4cef0f3a9 100644 --- a/gcc/ada/lib-xref.adb +++ b/gcc/ada/lib-xref.adb @@ -1440,7 +1440,9 @@ package body Lib.Xref is -- Finally, for two locations at the same address, we prefer -- the one that does NOT have the type 'r' so that a modification -- or extension takes preference, when there are more than one - -- reference at the same location. + -- reference at the same location. As a result, in the case of + -- entities that are in-out actuals, the read reference follows + -- the modify reference. else return T2.Typ = 'r'; diff --git a/gcc/ada/make.adb b/gcc/ada/make.adb index 98ae1eb4eb3..d4c1ae729f8 100644 --- a/gcc/ada/make.adb +++ b/gcc/ada/make.adb @@ -2934,11 +2934,30 @@ package body Make is -- Make a deep copy of the arguments, because Normalize_Arguments -- may deallocate some arguments. + -- Also strip target specific -mxxx switches in CodePeer mode. - for J in Comp_Next .. Comp_Last loop - Comp_Args (J) := new String'(Args (Arg_Index).all); - Arg_Index := Arg_Index + 1; - end loop; + declare + Index : Natural := Comp_Next; + Last : constant Natural := Comp_Last; + begin + for J in Comp_Next .. Last loop + declare + Str : String renames Args (Arg_Index).all; + begin + if Do_Codepeer_Globalize_Step + and then Str'Length > 2 + and then Str (Str'First .. Str'First + 1) = "-m" + then + Comp_Last := Comp_Last - 1; + else + Comp_Args (Index) := new String'(Str); + Index := Index + 1; + end if; + end; + + Arg_Index := Arg_Index + 1; + end loop; + end; -- Set -gnatpg for predefined files (for this purpose the renamings -- such as Text_IO do not count as predefined). Note that we strip diff --git a/gcc/ada/sem_ch4.adb b/gcc/ada/sem_ch4.adb index c94196ab042..086e3a68a35 100644 --- a/gcc/ada/sem_ch4.adb +++ b/gcc/ada/sem_ch4.adb @@ -6774,13 +6774,15 @@ package body Sem_Ch4 is Hom := Current_Entity (Subprog); - -- Find operation whose first parameter is of the class-wide - -- type, a subtype thereof, or an anonymous access to same. + -- Find a non-hidden operation whose first parameter is of the + -- class-wide type, a subtype thereof, or an anonymous access + -- to same. while Present (Hom) loop if (Ekind (Hom) = E_Procedure or else Ekind (Hom) = E_Function) + and then not Is_Hidden (Hom) and then Scope (Hom) = Scope (Anc_Type) and then Present (First_Formal (Hom)) and then -- 2.30.2