* sem_ch3.adb, sem_res.adb, exp_ch13.adb, exp_disp.adb,
exp_aggr.adb: Minor reformatting.
2011-08-03 Thomas Quinot <quinot@adacore.com>
* exp_ch5.adb (Expand_N_Assignment_Statement): Do not force inlining of
tagged assignment when discriminant checks are suppressed. This is
useless and extremely costly in terms of static stack usage.
2011-08-03 Bob Duff <duff@adacore.com>
* sem_prag.adb (Get_Base_Subprogram): Do not follow Alias for instances
of generics, because this leads to the wrong entity in the wrong scope,
causing (e.g.) pragma Export_Procedure to get an error if the entity is
an instance.
(Process_Interface_Name): Follow Alias for instances of generics, to
correct for the above change.
2011-08-03 Ed Schonberg <schonberg@adacore.com>
* exp_ch4.adb (Expand_N_Selected_Component): If the discriminant value
is an integer literal it is always safe to replace the reference. In
addition, if the reference appears in the generated code for an object
declaration it is necessary to copy because otherwise the reference
might be to the uninitilized value of the discriminant of the object
itself.
2011-08-03 Pascal Obry <obry@adacore.com>
* adaint.c (__gnat_is_executable_file_attr): Fix Win32 circuitry when no
ACL used, in this case we want to check for ending .exe, not .exe
anywhere in the path.
2011-08-03 Sergey Rybin <rybin@adacore.com>
* tree_io.ads (ASIS_Version_Number): Update because of the changes in
the tree structure (semantic decoration of references to record
discriminants).
git-svn-id: svn+ssh://gcc.gnu.org/svn/gcc/trunk@177237
138bc75d-0d04-0410-961f-
82ee72b054a4
+2011-08-03 Robert Dewar <dewar@adacore.com>
+
+ * sem_ch3.adb, sem_res.adb, exp_ch13.adb, exp_disp.adb,
+ exp_aggr.adb: Minor reformatting.
+
+2011-08-03 Thomas Quinot <quinot@adacore.com>
+
+ * exp_ch5.adb (Expand_N_Assignment_Statement): Do not force inlining of
+ tagged assignment when discriminant checks are suppressed. This is
+ useless and extremely costly in terms of static stack usage.
+
+2011-08-03 Bob Duff <duff@adacore.com>
+
+ * sem_prag.adb (Get_Base_Subprogram): Do not follow Alias for instances
+ of generics, because this leads to the wrong entity in the wrong scope,
+ causing (e.g.) pragma Export_Procedure to get an error if the entity is
+ an instance.
+ (Process_Interface_Name): Follow Alias for instances of generics, to
+ correct for the above change.
+
+2011-08-03 Ed Schonberg <schonberg@adacore.com>
+
+ * exp_ch4.adb (Expand_N_Selected_Component): If the discriminant value
+ is an integer literal it is always safe to replace the reference. In
+ addition, if the reference appears in the generated code for an object
+ declaration it is necessary to copy because otherwise the reference
+ might be to the uninitilized value of the discriminant of the object
+ itself.
+
+2011-08-03 Pascal Obry <obry@adacore.com>
+
+ * adaint.c (__gnat_is_executable_file_attr): Fix Win32 circuitry when no
+ ACL used, in this case we want to check for ending .exe, not .exe
+ anywhere in the path.
+
+2011-08-03 Sergey Rybin <rybin@adacore.com>
+
+ * tree_io.ads (ASIS_Version_Number): Update because of the changes in
+ the tree structure (semantic decoration of references to record
+ discriminants).
+
2011-08-03 Gary Dismukes <dismukes@adacore.com>
* sem_aggr.adb (Analyze_Array_Aggregate): When checking the discrete
__gnat_check_OWNER_ACL (wname, FILE_EXECUTE, GenericMapping);
}
else
- attr->executable = GetFileAttributes (wname) != INVALID_FILE_ATTRIBUTES
- && _tcsstr (wname, _T(".exe")) - wname == (int) (_tcslen (wname) - 4);
+ {
+ TCHAR *l, *last = _tcsstr(wname, _T(".exe"));
+
+ /* look for last .exe */
+ while (l = _tcsstr(last+1, _T(".exe"))) last = l;
+
+ attr->executable = GetFileAttributes (wname) != INVALID_FILE_ATTRIBUTES
+ && last - wname == (int) (_tcslen (wname) - 4);
+ }
#else
__gnat_stat_to_attr (-1, name, attr);
#endif
elsif Has_Mutable_Components (Typ)
and then
(Nkind (Parent (N)) /= N_Object_Declaration
- or else not Constant_Present (Parent (N)))
+ or else not Constant_Present (Parent (N)))
then
Convert_To_Assignments (N, Typ);
In_Other_Scope := False;
In_Outer_Scope := E_Scope /= Current_Scope;
- -- Otherwise it is a local package or a different compilation unit.
+ -- Otherwise it is a local package or a different compilation unit
+
else
In_Other_Scope := True;
In_Outer_Scope := False;
-- unless the context of an assignment can provide size information.
-- Don't we have a general routine that does this???
+ function Is_Subtype_Declaration return Boolean;
+ -- The replacement of a discriminant reference by its value is required
+ -- if this is part of the initialization of an temporary generated by
+ -- a change of representation. This shows up as the construction of a
+ -- discriminant constraint for a subtype declared at the same point as
+ -- the entity in the prefix of the selected component.
+ -- We recognize this case when the context of the reference is:
+ --
+ -- subtype ST is T(Obj.D);
+ --
+ -- The entity for Obj comes from source, and ST has the same sloc.
+
-----------------------
-- In_Left_Hand_Side --
-----------------------
and then In_Left_Hand_Side (Parent (Comp)));
end In_Left_Hand_Side;
+ -----------------------------
+ -- Is_Subtype_Declaration --
+ -----------------------------
+
+ function Is_Subtype_Declaration return Boolean is
+ Par : constant Node_Id := Parent (N);
+
+ begin
+ return
+ Nkind (Par) = N_Index_Or_Discriminant_Constraint
+ and then Nkind (Parent (Parent (Par))) = N_Subtype_Declaration
+ and then Comes_From_Source (Entity (Prefix (N)))
+ and then Sloc (Par) = Sloc (Entity (Prefix (N)));
+ end Is_Subtype_Declaration;
+
-- Start of processing for Expand_N_Selected_Component
begin
-- AND THEN was copied, causing problems for coverage
-- analysis tools).
+ -- However, if the reference is part of the initialization
+ -- code generated for an object declaration, we must use
+ -- the discriminant value from the subtype constraint,
+ -- because the selected component may be a reference to the
+ -- object being initialized, whose discriminant is not yet
+ -- set. This only happens in complex cases involving changes
+ -- or representation.
+
if Disc = Entity (Selector_Name (N))
and then (Is_Entity_Name (Dval)
- or else Is_Static_Expression (Dval))
+ or else Nkind (Dval) = N_Integer_Literal
+ or else Is_Subtype_Declaration
+ or else Is_Static_Expression (Dval))
then
-- Here we have the matching discriminant. Check for
-- the case of a discriminant of a component that is
-- --
-- B o d y --
-- --
--- Copyright (C) 1992-2010, Free Software Foundation, Inc. --
+-- Copyright (C) 1992-2011, Free Software Foundation, Inc. --
-- --
-- GNAT is free software; you can redistribute it and/or modify it under --
-- terms of the GNU General Public License as published by the Free Soft- --
-- If the type is tagged, we may as well use the predefined
-- primitive assignment. This avoids inlining a lot of code
- -- and in the class-wide case, the assignment is replaced by
- -- dispatch call to _assign. Note that this cannot be done when
- -- discriminant checks are locally suppressed (as in extension
- -- aggregate expansions) because otherwise the discriminant
- -- check will be performed within the _assign call. It is also
- -- suppressed for assignments created by the expander that
- -- correspond to initializations, where we do want to copy the
- -- tag (No_Ctrl_Actions flag set True) by the expander and we
- -- do not need to mess with tags ever (Expand_Ctrl_Actions flag
- -- is set True in this case). Finally, it is suppressed if the
- -- restriction No_Dispatching_Calls is in force because in that
- -- case predefined primitives are not generated.
+ -- and in the class-wide case, the assignment is replaced by a
+ -- dispatching call to _assign. It is suppressed in the case of
+ -- assignments created by the expander that correspond to
+ -- initializations, where we do want to copy the tag
+ -- (Expand_Ctrl_Actions flag is set True in this case).
+ -- It is also suppressed if restriction No_Dispatching_Calls is
+ -- in force because in that case predefined primitives are not
+ -- generated.
or else (Is_Tagged_Type (Typ)
and then not Is_Value_Type (Etype (Lhs))
and then Chars (Current_Scope) /= Name_uAssign
and then Expand_Ctrl_Actions
- and then not Discriminant_Checks_Suppressed (Empty)
and then
not Restriction_Active (No_Dispatching_Calls))
then
-- calls through interface types; the latter secondary table is
-- generated when Build_Thunks is False, and provides support for
-- Generic Dispatching Constructors that dispatch calls through
- -- interface types. When constructing this latter table the value
- -- of Suffix_Index is -1 to indicate that there is no need to export
- -- such table when building statically allocated dispatch tables; a
- -- positive value of Suffix_Index must match the Suffix_Index value
- -- assigned to this secondary dispatch table by Make_Tags when its
- -- unique external name was generated.
+ -- interface types. When constructing this latter table the value of
+ -- Suffix_Index is -1 to indicate that there is no need to export such
+ -- table when building statically allocated dispatch tables; a positive
+ -- value of Suffix_Index must match the Suffix_Index value assigned to
+ -- this secondary dispatch table by Make_Tags when its unique external
+ -- name was generated.
------------------------------
-- Check_Premature_Freezing --
Typ : Entity_Id)
is
Comp : Entity_Id;
+
begin
if Present (N)
and then Is_Private_Type (Typ)
Remove_Side_Effects (E);
+ -- If this is a constant declaration of an unconstrained type and
+ -- the initialization is an aggregate, we can use the subtype of the
+ -- aggregate for the declared entity because it is immutable.
+
elsif not Is_Constrained (T)
and then Has_Discriminants (T)
and then Constant_Present (N)
and then not Has_Unchecked_Union (T)
and then Nkind (E) = N_Aggregate
then
- -- If this is a constant declaration of an unconstrained type and
- -- the initialization is an aggregate, we can use the subtype of the
- -- aggregate for the declared entity because it is immutable.
-
Act_T := Etype (E);
end if;
Check_Wide_Character_Restriction (T, Object_Definition (N));
- -- Indicate this is not set in source. Certainly true for constants,
- -- and true for variables so far (will be reset for a variable if and
- -- when we encounter a modification in the source).
+ -- Indicate this is not set in source. Certainly true for constants, and
+ -- true for variables so far (will be reset for a variable if and when
+ -- we encounter a modification in the source).
Set_Never_Set_In_Source (Id, True);
Set_Ekind (Id, E_Variable);
-- A variable is set as shared passive if it appears in a shared
- -- passive package, and is at the outer level. This is not done
- -- for entities generated during expansion, because those are
- -- always manipulated locally.
+ -- passive package, and is at the outer level. This is not done for
+ -- entities generated during expansion, because those are always
+ -- manipulated locally.
if Is_Shared_Passive (Current_Scope)
and then Is_Library_Level_Entity (Id)
Strval => End_String);
end if;
- Set_Encoded_Interface_Name
- (Get_Base_Subprogram (Subprogram_Def), Link_Nam);
+ -- Set the interface name. If the entity is a generic instance, use
+ -- its alias, which is the callable entity.
+
+ if Is_Generic_Instance (Subprogram_Def) then
+ Set_Encoded_Interface_Name
+ (Alias (Get_Base_Subprogram (Subprogram_Def)), Link_Nam);
+
+ else
+ Set_Encoded_Interface_Name
+ (Get_Base_Subprogram (Subprogram_Def), Link_Nam);
+ end if;
-- We allow duplicated export names in CIL, as they are always
-- enclosed in a namespace that differentiates them, and overloaded
Result := Def_Id;
while Is_Subprogram (Result)
and then
- (Is_Generic_Instance (Result)
- or else Nkind (Parent (Declaration_Node (Result))) =
- N_Subprogram_Renaming_Declaration)
+ Nkind (Parent (Declaration_Node (Result))) =
+ N_Subprogram_Renaming_Declaration
and then Present (Alias (Result))
loop
Result := Alias (Result);
declare
Index_List : constant List_Id := New_List;
Index_Type : constant Entity_Id := Etype (First_Index (Typ));
- High_Bound : constant Node_Id :=
- Make_Attribute_Reference (Loc,
- Attribute_Name => Name_Val,
- Prefix => New_Occurrence_Of (Index_Type, Loc),
- Expressions =>
- New_List (
- Make_Op_Add (Loc,
- Left_Opnd =>
- Make_Attribute_Reference (Loc,
- Attribute_Name => Name_Pos,
- Prefix => New_Occurrence_Of (Index_Type, Loc),
- Expressions => New_List (New_Copy_Tree (Low_Bound))),
- Right_Opnd =>
- Make_Integer_Literal (Loc,
- String_Length (Strval (N)) - 1))));
+
+ High_Bound : constant Node_Id :=
+ Make_Attribute_Reference (Loc,
+ Attribute_Name => Name_Val,
+ Prefix =>
+ New_Occurrence_Of (Index_Type, Loc),
+ Expressions => New_List (
+ Make_Op_Add (Loc,
+ Left_Opnd =>
+ Make_Attribute_Reference (Loc,
+ Attribute_Name => Name_Pos,
+ Prefix =>
+ New_Occurrence_Of (Index_Type, Loc),
+ Expressions =>
+ New_List (New_Copy_Tree (Low_Bound))),
+ Right_Opnd =>
+ Make_Integer_Literal (Loc,
+ String_Length (Strval (N)) - 1))));
Array_Subtype : Entity_Id;
Index_Subtype : Entity_Id;
-- --
-- S p e c --
-- --
--- Copyright (C) 1992-2010, Free Software Foundation, Inc. --
+-- Copyright (C) 1992-2011, Free Software Foundation, Inc. --
-- --
-- GNAT is free software; you can redistribute it and/or modify it under --
-- terms of the GNU General Public License as published by the Free Soft- --
Tree_Format_Error : exception;
-- Raised if a format error is detected in the input file
- ASIS_Version_Number : constant := 23;
+ ASIS_Version_Number : constant := 24;
-- ASIS Version. This is used to check for consistency between the compiler
-- used to generate trees and an ASIS application that is reading the
-- trees. It must be incremented whenever a change is made to the tree
projects / platform / upstream / linaro-gcc.git / commitdiff