OpenE2K
/
gcc
2
0
Fork 0
Code Issues Pull Requests Projects Releases Wiki Activity

[multiple changes] 

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).

From-SVN: r177237
This commit is contained in:
Arnaud Charlet 2011-08-03 10:08:31 +02:00
parent c0b1185020
commit 53f29d4f64
11 changed files with 150 additions and 57 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

41
gcc/ada/ChangeLog
View File

@ -1,3 +1,44 @@
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

11
gcc/ada/adaint.c
View File

@ -2145,8 +2145,15 @@ __gnat_is_executable_file_attr (char* name, struct file_attributes* attr)
__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

2
gcc/ada/exp_aggr.adb
View File

@ -5700,7 +5700,7 @@ package body Exp_Aggr is
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);

3
gcc/ada/exp_ch13.adb
View File

@ -311,7 +311,8 @@ package body Exp_Ch13 is
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;

39
gcc/ada/exp_ch4.adb
View File

@ -7594,6 +7594,18 @@ package body Exp_Ch4 is
-- 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 --
-----------------------
@ -7607,6 +7619,21 @@ package body Exp_Ch4 is
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
@ -7730,9 +7757,19 @@ package body Exp_Ch4 is
-- 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

23
gcc/ada/exp_ch5.adb
View File

@ -6,7 +6,7 @@
-- --
-- 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- --
@ -1934,24 +1934,19 @@ package body Exp_Ch5 is
-- 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

13
gcc/ada/exp_disp.adb
View File

@ -3808,12 +3808,12 @@ package body Exp_Disp is
-- 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 --
@ -3825,6 +3825,7 @@ package body Exp_Disp is
Typ : Entity_Id)
is
Comp : Entity_Id;
begin
if Present (N)
and then Is_Private_Type (Typ)

20
gcc/ada/sem_ch3.adb
View File

@ -3402,16 +3402,16 @@ package body Sem_Ch3 is
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;
@ -3419,9 +3419,9 @@ package body Sem_Ch3 is
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);
@ -3435,9 +3435,9 @@ package body Sem_Ch3 is
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)

18
gcc/ada/sem_prag.adb
View File

@ -4723,8 +4723,17 @@ package body Sem_Prag is
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
@ -13890,9 +13899,8 @@ package body Sem_Prag is
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);

33
gcc/ada/sem_res.adb
View File

@ -9881,21 +9881,24 @@ package body Sem_Res is
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;

4
gcc/ada/tree_io.ads
View File

@ -6,7 +6,7 @@
-- --
-- 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- --
@ -47,7 +47,7 @@ package Tree_IO is
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