Commit 383e179e by Arnaud Charlet

[multiple changes]

2011-08-01  Ed Schonberg  <schonberg@adacore.com>

	* 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  <duff@adacore.com>

	* einfo.ads: Minor reformatting.
	* debug.adb: Minor comment improvement.

2011-08-01  Javier Miranda  <miranda@adacore.com>

	* sem_ch4.adb (Try_Object_Operation): For class-wide subprograms do not
	consider hidden subprograms as valid candidates.

2011-08-01  Arnaud Charlet  <charlet@adacore.com>

	* make.adb (Compile): Strip -mxxx switches in CodePeer mode.

2011-08-01  Vasiliy Fofanov  <fofanov@adacore.com>

	* gnat_ugn.texi: Fix typo.

From-SVN: r177031
parent 61c161b2
2011-08-01 Ed Schonberg <schonberg@adacore.com>
* 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 <duff@adacore.com>
* einfo.ads: Minor reformatting.
* debug.adb: Minor comment improvement.
2011-08-01 Javier Miranda <miranda@adacore.com>
* sem_ch4.adb (Try_Object_Operation): For class-wide subprograms do not
consider hidden subprograms as valid candidates.
2011-08-01 Arnaud Charlet <charlet@adacore.com>
* make.adb (Compile): Strip -mxxx switches in CodePeer mode.
2011-08-01 Vasiliy Fofanov <fofanov@adacore.com>
* gnat_ugn.texi: Fix typo.
2011-08-01 Robert Dewar <dewar@adacore.com> 2011-08-01 Robert Dewar <dewar@adacore.com>
* i-cstrin.adb, sem_util.adb, exp_ch11.adb, sem_ch8.adb, * i-cstrin.adb, sem_util.adb, exp_ch11.adb, sem_ch8.adb,
......
...@@ -193,7 +193,7 @@ package body Debug is ...@@ -193,7 +193,7 @@ package body Debug is
-- de -- de
-- df Only output file names, not path names, in log -- df Only output file names, not path names, in log
-- dg -- dg
-- dh -- dh Generate listing showing loading of name table hash chains
-- di -- di
-- dj -- dj
-- dk -- dk
...@@ -698,6 +698,9 @@ package body Debug is ...@@ -698,6 +698,9 @@ package body Debug is
-- df Only output file names, not path names, in log -- 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 -- dm Issue a message indicating the maximum number of simultaneous
-- compilations. -- compilations.
......
...@@ -1501,7 +1501,7 @@ package Einfo is ...@@ -1501,7 +1501,7 @@ package Einfo is
-- Has_Homonym (Flag56) -- Has_Homonym (Flag56)
-- Present in all entities. Set if an entity has a homonym in the same -- 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. -- scope. Used by Gigi to generate unique names for such entities.
--
-- Has_Initial_Value (Flag219) -- Has_Initial_Value (Flag219)
-- Present in entities for variables and out parameters. Set if there -- Present in entities for variables and out parameters. Set if there
-- is an explicit initial value expression in the declaration of the -- is an explicit initial value expression in the declaration of the
...@@ -1510,7 +1510,7 @@ package Einfo is ...@@ -1510,7 +1510,7 @@ package Einfo is
-- of access types or controlled types. Always set to False for out -- of access types or controlled types. Always set to False for out
-- parameters. Also present in entities for in and in-out parameters, -- parameters. Also present in entities for in and in-out parameters,
-- but always false in these cases. -- but always false in these cases.
--
-- Has_Interrupt_Handler (synthesized) -- Has_Interrupt_Handler (synthesized)
-- Applies to all protected type entities. Set if the protected type -- Applies to all protected type entities. Set if the protected type
-- definition contains at least one procedure to which a pragma -- definition contains at least one procedure to which a pragma
...@@ -1766,13 +1766,13 @@ package Einfo is ...@@ -1766,13 +1766,13 @@ package Einfo is
-- attribute definition clause. When such a clause occurs, a TSS is set -- 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 -- on the underlying full view; the flags are used to track visibility of
-- the attribute definition clause for partial or incomplete views. -- the attribute definition clause for partial or incomplete views.
--
-- Has_Static_Discriminants (Flag211) -- Has_Static_Discriminants (Flag211)
-- Present in record subtypes constrained by discriminant values. Set if -- Present in record subtypes constrained by discriminant values. Set if
-- all the discriminant values have static values, meaning that in the -- all the discriminant values have static values, meaning that in the
-- case of a variant record, the component list can be trimmed down to -- case of a variant record, the component list can be trimmed down to
-- include only the components corresponding to these discriminants. -- include only the components corresponding to these discriminants.
--
-- Has_Storage_Size_Clause (Flag23) [implementation base type only] -- Has_Storage_Size_Clause (Flag23) [implementation base type only]
-- Present in task types and access types. It is set if a Storage_Size -- 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 -- clause is present for the type. Used to prevent multiple clauses for
...@@ -2315,7 +2315,7 @@ package Einfo is ...@@ -2315,7 +2315,7 @@ package Einfo is
-- 4) Internal entities in the list of primitives of tagged types that -- 4) Internal entities in the list of primitives of tagged types that
-- are used to handle secondary dispatch tables. These entities have -- are used to handle secondary dispatch tables. These entities have
-- also the attribute Interface_Alias. -- also the attribute Interface_Alias.
--
-- Is_Interrupt_Handler (Flag89) -- Is_Interrupt_Handler (Flag89)
-- Present in procedures. Set if a pragma Interrupt_Handler applies -- Present in procedures. Set if a pragma Interrupt_Handler applies
-- to the procedure. The procedure must be parameterless, and on all -- to the procedure. The procedure must be parameterless, and on all
...@@ -2898,7 +2898,7 @@ package Einfo is ...@@ -2898,7 +2898,7 @@ package Einfo is
-- the generated indexes entity. See unit Exp_Imgv for full details of -- the generated indexes entity. See unit Exp_Imgv for full details of
-- the nature and use of this entity for implementing the Image and -- the nature and use of this entity for implementing the Image and
-- Value attributes for the enumeration type in question. -- Value attributes for the enumeration type in question.
--
-- Lit_Strings (Node16) -- Lit_Strings (Node16)
-- Present in enumeration types and subtypes. Non-empty only for the -- Present in enumeration types and subtypes. Non-empty only for the
-- case of an enumeration root type, where it contains the entity for -- case of an enumeration root type, where it contains the entity for
...@@ -2983,7 +2983,7 @@ package Einfo is ...@@ -2983,7 +2983,7 @@ package Einfo is
-- entities when the return type is an array type, and a call can be -- 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 -- interpreted as an indexing of the result of the call. It is also
-- used to resolve various cases of entry calls. -- used to resolve various cases of entry calls.
--
-- Never_Set_In_Source (Flag115) -- Never_Set_In_Source (Flag115)
-- Present in all entities, but can be set only for variables and -- 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 -- parameters. This flag is set if the object is never assigned a value
......
...@@ -2766,7 +2766,10 @@ package body Exp_Ch5 is ...@@ -2766,7 +2766,10 @@ package body Exp_Ch5 is
Isc : constant Node_Id := Iteration_Scheme (N); Isc : constant Node_Id := Iteration_Scheme (N);
I_Spec : constant Node_Id := Iterator_Specification (Isc); I_Spec : constant Node_Id := Iterator_Specification (Isc);
Id : constant Entity_Id := Defining_Identifier (I_Spec); 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); Typ : constant Entity_Id := Etype (Container);
Cursor : Entity_Id; Cursor : Entity_Id;
...@@ -2788,8 +2791,7 @@ package body Exp_Ch5 is ...@@ -2788,8 +2791,7 @@ package body Exp_Ch5 is
New_Occurrence_Of (Component_Type (Typ), Loc), New_Occurrence_Of (Component_Type (Typ), Loc),
Name => Name =>
Make_Indexed_Component (Loc, Make_Indexed_Component (Loc,
Prefix => Prefix => Relocate_Node (Container),
New_Occurrence_Of (Container, Loc),
Expressions => Expressions =>
New_List (New_Occurrence_Of (Cursor, Loc)))); New_List (New_Occurrence_Of (Cursor, Loc))));
begin begin
...@@ -2805,8 +2807,7 @@ package body Exp_Ch5 is ...@@ -2805,8 +2807,7 @@ package body Exp_Ch5 is
Defining_Identifier => Cursor, Defining_Identifier => Cursor,
Discrete_Subtype_Definition => Discrete_Subtype_Definition =>
Make_Attribute_Reference (Loc, Make_Attribute_Reference (Loc,
Prefix => Prefix => Relocate_Node (Container),
New_Occurrence_Of (Container, Loc),
Attribute_Name => Name_Range), Attribute_Name => Name_Range),
Reverse_Present => Reverse_Present (I_Spec))), Reverse_Present => Reverse_Present (I_Spec))),
Statements => Stats, Statements => Stats,
...@@ -2828,8 +2829,7 @@ package body Exp_Ch5 is ...@@ -2828,8 +2829,7 @@ package body Exp_Ch5 is
Defining_Identifier => Cursor, Defining_Identifier => Cursor,
Discrete_Subtype_Definition => Discrete_Subtype_Definition =>
Make_Attribute_Reference (Loc, Make_Attribute_Reference (Loc,
Prefix => Prefix => Relocate_Node (Container),
New_Occurrence_Of (Container, Loc),
Attribute_Name => Name_Range), Attribute_Name => Name_Range),
Reverse_Present => Reverse_Present (I_Spec))), Reverse_Present => Reverse_Present (I_Spec))),
Statements => Statements (N), Statements => Statements (N),
...@@ -2895,7 +2895,7 @@ package body Exp_Ch5 is ...@@ -2895,7 +2895,7 @@ package body Exp_Ch5 is
Selector_Name => Make_Identifier (Loc, Name_Cursor)), Selector_Name => Make_Identifier (Loc, Name_Cursor)),
Expression => Expression =>
Make_Selected_Component (Loc, Make_Selected_Component (Loc,
Prefix => New_Occurrence_Of (Container, Loc), Prefix => Relocate_Node (Container),
Selector_Name => Make_Identifier (Loc, Name_Init))); Selector_Name => Make_Identifier (Loc, Name_Init)));
Insert_Action (N, Cursor_Decl); Insert_Action (N, Cursor_Decl);
...@@ -2951,9 +2951,6 @@ package body Exp_Ch5 is ...@@ -2951,9 +2951,6 @@ package body Exp_Ch5 is
end; end;
end if; end if;
-- Set_Analyzed (I_Spec);
-- Why is this commented out???
Rewrite (N, New_Loop); Rewrite (N, New_Loop);
Analyze (N); Analyze (N);
end Expand_Iterator_Loop; end Expand_Iterator_Loop;
......
...@@ -4148,7 +4148,7 @@ Specify a preprocessing data file ...@@ -4148,7 +4148,7 @@ Specify a preprocessing data file
@cindex @option{-gnateP} (@command{gcc}) @cindex @option{-gnateP} (@command{gcc})
Turn categorization dependency errors into warnings. Turn categorization dependency errors into warnings.
Ada requires that units that WITH one another have compatible categories, for 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 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 manner). This can be useful in some specialized circumstances such as the
temporary use of special test software. temporary use of special test software.
......
...@@ -1440,7 +1440,9 @@ package body Lib.Xref is ...@@ -1440,7 +1440,9 @@ package body Lib.Xref is
-- Finally, for two locations at the same address, we prefer -- Finally, for two locations at the same address, we prefer
-- the one that does NOT have the type 'r' so that a modification -- the one that does NOT have the type 'r' so that a modification
-- or extension takes preference, when there are more than one -- 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 else
return T2.Typ = 'r'; return T2.Typ = 'r';
......
...@@ -2934,11 +2934,30 @@ package body Make is ...@@ -2934,11 +2934,30 @@ package body Make is
-- Make a deep copy of the arguments, because Normalize_Arguments -- Make a deep copy of the arguments, because Normalize_Arguments
-- may deallocate some arguments. -- may deallocate some arguments.
-- Also strip target specific -mxxx switches in CodePeer mode.
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;
for J in Comp_Next .. Comp_Last loop
Comp_Args (J) := new String'(Args (Arg_Index).all);
Arg_Index := Arg_Index + 1; Arg_Index := Arg_Index + 1;
end loop; end loop;
end;
-- Set -gnatpg for predefined files (for this purpose the renamings -- Set -gnatpg for predefined files (for this purpose the renamings
-- such as Text_IO do not count as predefined). Note that we strip -- such as Text_IO do not count as predefined). Note that we strip
......
...@@ -6774,13 +6774,15 @@ package body Sem_Ch4 is ...@@ -6774,13 +6774,15 @@ package body Sem_Ch4 is
Hom := Current_Entity (Subprog); Hom := Current_Entity (Subprog);
-- Find operation whose first parameter is of the class-wide -- Find a non-hidden operation whose first parameter is of the
-- type, a subtype thereof, or an anonymous access to same. -- class-wide type, a subtype thereof, or an anonymous access
-- to same.
while Present (Hom) loop while Present (Hom) loop
if (Ekind (Hom) = E_Procedure if (Ekind (Hom) = E_Procedure
or else or else
Ekind (Hom) = E_Function) Ekind (Hom) = E_Function)
and then not Is_Hidden (Hom)
and then Scope (Hom) = Scope (Anc_Type) and then Scope (Hom) = Scope (Anc_Type)
and then Present (First_Formal (Hom)) and then Present (First_Formal (Hom))
and then and then
......
Markdown is supported
0% or
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment