+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 / gcc.git / commitdiff