mirror/gcc
2
0
Fork 0
mirror of git://gcc.gnu.org/git/gcc.git synced 2025-02-04 12:40:02 +08:00
Code Issues Packages Projects Releases Wiki Activity

[multiple changes]

Browse Source 
2004-04-26  Thomas Quinot  <quinot@act-europe.fr>

	* sem_dist.adb, exp_dist.adb: When constructing a RAS value for a local
	subprogram for which no pragma All_Calls_Remote applies, store the
	address of the real subprogram in the underlying record type, so local
	dereferences do not go through the PCS.

2004-04-26  Robert Dewar  <dewar@gnat.com>

	* i-c.ads: Add some type qualifications to avoid ambiguities when
	compiling with s-auxdec.ads and a non-private address type.

2004-04-26  Arnaud Charlet  <charlet@act-europe.fr>

	* Makefile.rtl: Fix error in previous check-in:
	Add s-addope.o to non tasking object list (rather than tasking object
	list).

2004-04-26  Javier Miranda  <miranda@gnat.com>

	* sem_aggr.adb: Fix typo in comments
	(Resolve_Aggr_Expr): Propagate the type to the nested aggregate.
	Required to check the null-exclusion attribute.

	* sem_attr.adb (Resolve_Attribute): Check the accessibility level in
	case of anonymous access types in record and array components. For a
	component definition the level is the same of the enclosing composite
	type.

	* sem_ch3.adb (Analyze_Component_Declaration): In case of components
	that are anonymous access types the level of accessibility depends on
	the enclosing type declaration. In order to have this information, set
	the scope of the anonymous access type to the enclosing record type
	declaration.
	(Array_Type_Declaration): In case of components that are anonymous
	access types the level of accessibility depends on the enclosing type
	declaration. In order to have this information, set the scope of the
	anonymous access type to the enclosing array type declaration.

	* sem_ch3.adb (Array_Type_Declaration): Set the scope of the anonymous
	access type.

	* sem_ch8.adb (Analyze_Object_Renaming): Add check to verify that
	renaming of anonymous access-to-constant types allowed if and only if
	the renamed object is access-to-constant.

	* sem_util.adb (Type_Access_Level): In case of anonymous access types
	that are component_definition or discriminants of a nonlimited type,
	the level is the same as that of the enclosing component type.

2004-04-26  Sergey Rybin  <rybin@act-europe.fr>

	* sem_elim.adb: Some minor code reorganization from code reading. Fix
	misprint in the function name (File_Name_Match).

From-SVN: r81186
This commit is contained in:
Arnaud Charlet 2004-04-26 14:29:41 +02:00
parent e11283f1b4
commit 35b7fa6a40
11 changed files with 262 additions and 75 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

55
gcc/ada/ChangeLog
View File

@ -1,3 +1,58 @@
2004-04-26 Thomas Quinot <quinot@act-europe.fr>
* sem_dist.adb, exp_dist.adb: When constructing a RAS value for a local
subprogram for which no pragma All_Calls_Remote applies, store the
address of the real subprogram in the underlying record type, so local
dereferences do not go through the PCS.
2004-04-26 Robert Dewar <dewar@gnat.com>
* i-c.ads: Add some type qualifications to avoid ambiguities when
compiling with s-auxdec.ads and a non-private address type.
2004-04-26 Arnaud Charlet <charlet@act-europe.fr>
* Makefile.rtl: Fix error in previous check-in:
Add s-addope.o to non tasking object list (rather than tasking object
list).
2004-04-26 Javier Miranda <miranda@gnat.com>
* sem_aggr.adb: Fix typo in comments
(Resolve_Aggr_Expr): Propagate the type to the nested aggregate.
Required to check the null-exclusion attribute.
* sem_attr.adb (Resolve_Attribute): Check the accessibility level in
case of anonymous access types in record and array components. For a
component definition the level is the same of the enclosing composite
type.
* sem_ch3.adb (Analyze_Component_Declaration): In case of components
that are anonymous access types the level of accessibility depends on
the enclosing type declaration. In order to have this information, set
the scope of the anonymous access type to the enclosing record type
declaration.
(Array_Type_Declaration): In case of components that are anonymous
access types the level of accessibility depends on the enclosing type
declaration. In order to have this information, set the scope of the
anonymous access type to the enclosing array type declaration.
* sem_ch3.adb (Array_Type_Declaration): Set the scope of the anonymous
access type.
* sem_ch8.adb (Analyze_Object_Renaming): Add check to verify that
renaming of anonymous access-to-constant types allowed if and only if
the renamed object is access-to-constant.
* sem_util.adb (Type_Access_Level): In case of anonymous access types
that are component_definition or discriminants of a nonlimited type,
the level is the same as that of the enclosing component type.
2004-04-26 Sergey Rybin <rybin@act-europe.fr>
* sem_elim.adb: Some minor code reorganization from code reading. Fix
misprint in the function name (File_Name_Match).
2004-04-23 Laurent GUERBY <laurent@guerby.net>
* Makefile.in: Remove RANLIB_TEST, use -$(RANLIB) including after

2
gcc/ada/Makefile.rtl
View File

@ -40,7 +40,6 @@ GNATRTL_TASKING_OBJS= \
g-semaph$(objext) \
g-signal$(objext) \
g-thread$(objext) \
s-addope$(objext) \
s-asthan$(objext) \
s-inmaop$(objext) \
s-interr$(objext) \
@ -271,6 +270,7 @@ GNATRTL_NONTASKING_OBJS= \
ioexcept$(objext) \
machcode$(objext) \
s-addima$(objext) \
s-addope$(objext) \
s-arit64$(objext) \
s-assert$(objext) \
s-atacco$(objext) \

118
gcc/ada/exp_dist.adb
View File

@ -1193,15 +1193,14 @@ package body Exp_Dist is
Proc_Decls : constant List_Id := New_List;
Proc_Statements : constant List_Id := New_List;
Proc_Spec : Node_Id;
Proc : Node_Id;
Param : Node_Id;
Package_Name : Node_Id;
Subp_Id : Node_Id;
Asynch_P : Node_Id;
Return_Value : Node_Id;
Proc_Spec : Node_Id;
Proc : Node_Id;
Local_Addr : Entity_Id;
Package_Name : Entity_Id;
Subp_Id : Entity_Id;
Asynch_P : Entity_Id;
Origin : Entity_Id;
Return_Value : Entity_Id;
All_Calls_Remote : Entity_Id;
-- True if an All_Calls_Remote pragma applies to the RCI unit
@ -1210,65 +1209,106 @@ package body Exp_Dist is
Loc : constant Source_Ptr := Sloc (N);
procedure Set_Field (Field_Name : in Name_Id; Value : in Node_Id);
-- Set a field name for the return value
function Set_Field
(Field_Name : Name_Id;
Value : Node_Id) return Node_Id;
-- Construct an assignment that sets the named component in the
-- returned record
procedure Set_Field (Field_Name : in Name_Id; Value : in Node_Id)
---------------
-- Set_Field --
---------------
function Set_Field
(Field_Name : Name_Id;
Value : Node_Id) return Node_Id
is
begin
Append_To (Proc_Statements,
return
Make_Assignment_Statement (Loc,
Name =>
Make_Selected_Component (Loc,
Prefix => New_Occurrence_Of (Return_Value, Loc),
Selector_Name => Make_Identifier (Loc, Field_Name)),
Expression => Value));
Expression => Value);
end Set_Field;
-- Start of processing for Add_RAS_Access_Attribute
begin
Param := Make_Defining_Identifier (Loc, New_Internal_Name ('P'));
Package_Name := Make_Defining_Identifier (Loc, New_Internal_Name ('S'));
Subp_Id := Make_Defining_Identifier (Loc, New_Internal_Name ('N'));
Asynch_P := Make_Defining_Identifier (Loc, New_Internal_Name ('B'));
Return_Value := Make_Defining_Identifier (Loc, New_Internal_Name ('P'));
Local_Addr := Make_Defining_Identifier (Loc, New_Internal_Name ('L'));
Package_Name := Make_Defining_Identifier (Loc, New_Internal_Name ('P'));
Subp_Id := Make_Defining_Identifier (Loc, New_Internal_Name ('N'));
Asynch_P := Make_Defining_Identifier (Loc, New_Internal_Name ('B'));
Origin := Make_Defining_Identifier (Loc, New_Internal_Name ('P'));
Return_Value := Make_Defining_Identifier (Loc, New_Internal_Name ('R'));
All_Calls_Remote :=
Make_Defining_Identifier (Loc, New_Internal_Name ('A'));
-- Create the object which will be returned of type Fat_Type
Append_To (Proc_Decls,
Append_List_To (Proc_Decls, New_List (
Make_Object_Declaration (Loc,
Defining_Identifier => Origin,
Constant_Present => True,
Object_Definition =>
New_Occurrence_Of (RTE (RE_Partition_ID), Loc),
Expression =>
Make_Function_Call (Loc,
Name =>
New_Occurrence_Of (RTE (RE_Get_Active_Partition_Id), Loc),
Parameter_Associations => New_List (
New_Occurrence_Of (Package_Name, Loc)))),
Make_Object_Declaration (Loc,
Defining_Identifier => Return_Value,
Object_Definition =>
New_Occurrence_Of (Fat_Type, Loc)));
New_Occurrence_Of (Fat_Type, Loc))));
-- Initialize the fields of the record type with the appropriate data
Set_Field (Name_Ras,
OK_Convert_To (RTE (RE_Unsigned_64), New_Occurrence_Of (Param, Loc)));
Append_List_To (Proc_Statements, New_List (
Make_Implicit_If_Statement (N,
Condition =>
Make_And_Then (Loc,
Left_Opnd =>
Make_Op_Not (Loc,
New_Occurrence_Of (All_Calls_Remote, Loc)),
Right_Opnd =>
Make_Op_Eq (Loc,
Left_Opnd =>
New_Occurrence_Of (Origin, Loc),
Right_Opnd =>
Make_Function_Call (Loc,
New_Occurrence_Of (
RTE (RE_Get_Local_Partition_Id), Loc)))),
Set_Field (Name_Origin,
Unchecked_Convert_To (Standard_Integer,
Then_Statements => New_List (
Set_Field (Name_Ras,
OK_Convert_To (RTE (RE_Unsigned_64),
New_Occurrence_Of (Local_Addr, Loc)))),
Else_Statements => New_List (
Set_Field (Name_Ras,
Make_Integer_Literal (Loc, Uint_0)))),
Set_Field (Name_Origin,
Unchecked_Convert_To (Standard_Integer,
New_Occurrence_Of (Origin, Loc))),
Set_Field (Name_Receiver,
Make_Function_Call (Loc,
Name =>
New_Occurrence_Of (RTE (RE_Get_Active_Partition_Id), Loc),
New_Occurrence_Of (RTE (RE_Get_RCI_Package_Receiver), Loc),
Parameter_Associations => New_List (
New_Occurrence_Of (Package_Name, Loc)))));
New_Occurrence_Of (Package_Name, Loc)))),
Set_Field (Name_Receiver,
Make_Function_Call (Loc,
Name =>
New_Occurrence_Of (RTE (RE_Get_RCI_Package_Receiver), Loc),
Parameter_Associations => New_List (
New_Occurrence_Of (Package_Name, Loc))));
Set_Field (Name_Subp_Id,
New_Occurrence_Of (Subp_Id, Loc)),
Set_Field (Name_Subp_Id,
New_Occurrence_Of (Subp_Id, Loc));
Set_Field (Name_Async,
New_Occurrence_Of (Asynch_P, Loc));
Set_Field (Name_Async,
New_Occurrence_Of (Asynch_P, Loc))));
-- Return the newly created value
@ -1286,7 +1326,7 @@ package body Exp_Dist is
Defining_Unit_Name => Proc,
Parameter_Specifications => New_List (
Make_Parameter_Specification (Loc,
Defining_Identifier => Param,
Defining_Identifier => Local_Addr,
Parameter_Type =>
New_Occurrence_Of (RTE (RE_Address), Loc)),

18
gcc/ada/i-c.ads
View File

@ -6,7 +6,7 @@
-- --
-- S p e c --
-- --
-- Copyright (C) 1992-2003 Free Software Foundation, Inc. --
-- Copyright (C) 1992-2004 Free Software Foundation, Inc. --
-- --
-- This specification is derived from the Ada Reference Manual for use with --
-- GNAT. The copyright notice above, and the license provisions that follow --
@ -50,10 +50,14 @@ pragma Pure (C);
-- Signed and Unsigned Integers. Note that in GNAT, we have ensured that
-- the standard predefined Ada types correspond to the standard C types
-- Note: the Integer qualifications used in the declaration of type long
-- avoid ambiguities when compiling in the presence of s-auxdec.ads and
-- a non-private system.address type.
type int is new Integer;
type short is new Short_Integer;
type long is range -(2 ** (System.Parameters.long_bits - 1))
.. +(2 ** (System.Parameters.long_bits - 1)) - 1;
type long is range -(2 ** (System.Parameters.long_bits - Integer'(1)))
.. +(2 ** (System.Parameters.long_bits - Integer'(1))) - 1;
type signed_char is range SCHAR_MIN .. SCHAR_MAX;
for signed_char'Size use CHAR_BIT;
@ -67,9 +71,13 @@ pragma Pure (C);
subtype plain_char is unsigned_char; -- ??? should be parametrized
-- Note: the Integer qualifications used in the declaration of ptrdiff_t
-- avoid ambiguities when compiling in the presence of s-auxdec.ads and
-- a non-private system.address type.
type ptrdiff_t is
range -(2 ** (Standard'Address_Size - 1)) ..
+(2 ** (Standard'Address_Size - 1) - 1);
range -(2 ** (Standard'Address_Size - Integer'(1))) ..
+(2 ** (Standard'Address_Size - Integer'(1)) - 1);
type size_t is mod 2 ** Standard'Address_Size;

10
gcc/ada/sem_aggr.adb
View File

@ -960,7 +960,7 @@ package body Sem_Aggr is
Aggr_Typ : constant Entity_Id := Etype (Typ);
-- This is the unconstrained array type, which is the type
-- against which the aggregate is to be resoved. Typ itself
-- against which the aggregate is to be resolved. Typ itself
-- is the array type of the context which may not be the same
-- subtype as the subtype for the final aggregate.
@ -977,7 +977,7 @@ package body Sem_Aggr is
-- formal parameter. Consequently we also need to test for
-- N_Procedure_Call_Statement or N_Function_Call.
Set_Etype (N, Aggr_Typ); -- may be overridden later on.
Set_Etype (N, Aggr_Typ); -- may be overridden later on
-- Ada 0Y (AI-231): Propagate the null_exclusion attribute to the
-- components of the array aggregate
@ -1399,6 +1399,12 @@ package body Sem_Aggr is
end if;
end if;
-- Ada 0Y (AI-231): Propagate the type to the nested aggregate.
-- Required to check the null-exclusion attribute (if present).
-- This value may be overridden later on.
Set_Etype (Expr, Etype (N));
Resolution_OK := Resolve_Array_Aggregate
(Expr, Nxt_Ind, Nxt_Ind_Constr, Component_Typ, Others_Allowed);

31
gcc/ada/sem_attr.adb
View File

@ -6645,8 +6645,37 @@ package body Sem_Attr is
or else
Attr_Id = Attribute_Unchecked_Access)
and then (Ekind (Btyp) = E_General_Access_Type
or else Ekind (Btyp) = E_Anonymous_Access_Type)
or else Ekind (Btyp) = E_Anonymous_Access_Type)
then
-- Ada 0Y (AI-230): Check the accessibility of anonymous access
-- types in record and array components. For a component defini
-- tion the level is the same of the enclosing composite type.
if Extensions_Allowed
and then Ekind (Btyp) = E_Anonymous_Access_Type
and then (Is_Array_Type (Scope (Btyp))
or else Ekind (Scope (Btyp)) = E_Record_Type)
and then Object_Access_Level (P)
> Type_Access_Level (Btyp)
then
-- In an instance, this is a runtime check, but one we
-- know will fail, so generate an appropriate warning.
if In_Instance_Body then
Error_Msg_N
("?non-local pointer cannot point to local object", P);
Error_Msg_N
("?Program_Error will be raised at run time", P);
Rewrite (N,
Make_Raise_Program_Error (Loc,
Reason => PE_Accessibility_Check_Failed));
Set_Etype (N, Typ);
else
Error_Msg_N
("non-local pointer cannot point to local object", P);
end if;
end if;
if Is_Dependent_Component_Of_Mutable_Object (P) then
Error_Msg_N
("illegal attribute for discriminant-dependent component",

12
gcc/ada/sem_ch3.adb
View File

@ -993,6 +993,12 @@ package body Sem_Ch3 is
(Related_Nod => N,
N => Access_Definition (Component_Definition (N)));
-- Ada 0Y (AI-230): In case of components that are anonymous access
-- types the level of accessibility depends on the enclosing type
-- declaration
Set_Scope (T, Current_Scope); -- Ada 0Y (AI-230)
-- Ada 0Y (AI-254)
if Present (Access_To_Subprogram_Definition
@ -2993,6 +2999,12 @@ package body Sem_Ch3 is
(Related_Nod => Related_Id,
N => Access_Definition (Component_Def));
-- Ada 0Y (AI-230): In case of components that are anonymous access
-- types the level of accessibility depends on the enclosing type
-- declaration
Set_Scope (Element_Type, T); -- Ada 0Y (AI-230)
-- Ada 0Y (AI-254)
declare

20
gcc/ada/sem_ch8.adb
View File

@ -687,17 +687,25 @@ package body Sem_Ch8 is
elsif Present (Access_Definition (N)) then
if Null_Exclusion_Present (Access_Definition (N)) then
Error_Msg_N ("(Ada 0Y): null-excluding attribute ignored "
& "('R'M 8.5.1(6))?", N);
Set_Null_Exclusion_Present (Access_Definition (N), False);
end if;
T := Access_Definition
(Related_Nod => N,
N => Access_Definition (N));
Analyze_And_Resolve (Nam, T);
-- Ada 0Y (AI-230): Renaming of anonymous access-to-constant types
-- allowed if and only if the renamed object is access-to-constant
if Constant_Present (Access_Definition (N))
and then not Is_Access_Constant (Etype (Nam))
then
Error_Msg_N ("(Ada 0Y): the renamed object is not "
& "access-to-constant ('R'M 8.5.1(6))", N);
elsif Null_Exclusion_Present (Access_Definition (N)) then
Error_Msg_N ("(Ada 0Y): null-excluding attribute ignored "
& "('R'M 8.5.1(6))?", N);
end if;
else
pragma Assert (False);
null;

9
gcc/ada/sem_dist.adb
View File

@ -295,7 +295,7 @@ package body Sem_Dist is
Async_E : Entity_Id;
All_Calls_Remote_E : Entity_Id;
Attribute_Subp : Entity_Id;
Parameter : Node_Id;
Local_Addr : Node_Id;
begin
-- Check if we have to expand the access attribute
@ -346,14 +346,17 @@ package body Sem_Dist is
All_Calls_Remote_E := Standard_False;
end if;
Parameter := New_Occurrence_Of (RTE (RE_Null_Address), Loc);
Local_Addr :=
Make_Attribute_Reference (Loc,
Prefix => New_Occurrence_Of (Remote_Subp, Loc),
Attribute_Name => Name_Address);
Tick_Access_Conv_Call :=
Make_Function_Call (Loc,
Name => New_Occurrence_Of (Attribute_Subp, Loc),
Parameter_Associations =>
New_List (
Parameter,
Local_Addr,
Make_String_Literal (Loc, Full_Qualified_Name (RS_Pkg_E)),
Build_Subprogram_Id (Loc, Remote_Subp),
New_Occurrence_Of (Async_E, Loc),

53
gcc/ada/sem_elim.adb
View File

@ -376,7 +376,7 @@ package body Sem_Elim is
P : Source_Ptr;
Sindex : Source_File_Index;
function File_Mame_Match return Boolean;
function File_Name_Match return Boolean;
-- This function is supposed to be called when Idx points
-- to the beginning of the new file name, and Name_Buffer
-- is set to contain the name of the proper source file
@ -436,45 +436,64 @@ package body Sem_Elim is
end if;
end Different_Trace_Lengths;
function File_Mame_Match return Boolean is
Tmp_Idx : Positive := 1;
End_Idx : Positive := 1;
-- Initializations are to stop warnings
---------------------
-- File_Name_Match --
---------------------
-- But are warnings possibly valid ???
-- Why are loops below guaranteed to exit ???
function File_Name_Match return Boolean is
Tmp_Idx : Natural;
End_Idx : Natural;
begin
if Idx = 0 then
return False;
end if;
for J in Idx .. Last loop
if Sloc_Trace (J) = ':' then
Tmp_Idx := J - 1;
-- Find first colon. If no colon, then return False.
-- If there is a colon, Tmp_Idx is set to point just
-- before the colon.
Tmp_Idx := Idx - 1;
loop
if Tmp_Idx >= Last then
return False;
elsif Sloc_Trace (Tmp_Idx + 1) = ':' then
exit;
else
Tmp_Idx := Tmp_Idx + 1;
end if;
end loop;
for J in reverse Idx .. Tmp_Idx loop
if Sloc_Trace (J) /= ' ' then
End_Idx := J;
-- Find last non-space before this colon. If there
-- is no no space character before this colon, then
-- return False. Otherwise, End_Idx set to point to
-- this non-space character.
End_Idx := Tmp_Idx;
loop
if End_Idx < Idx then
return False;
elsif Sloc_Trace (End_Idx) /= ' ' then
exit;
else
End_Idx := End_Idx - 1;
end if;
end loop;
-- Now see if file name matches what is in Name_Buffer
-- and if so, step Idx past it and return True. If the
-- name does not match, return False.
if Sloc_Trace (Idx .. End_Idx) =
Name_Buffer (1 .. Name_Len)
then
Idx := Tmp_Idx + 2;
Idx := Skip_Spaces;
return True;
else
return False;
end if;
end File_Mame_Match;
end File_Name_Match;
--------------------
-- Line_Num_Match --
@ -548,7 +567,7 @@ package body Sem_Elim is
Idx := Skip_Spaces;
while Idx > 0 loop
if not File_Mame_Match then
if not File_Name_Match then
goto Continue;
elsif not Line_Num_Match then
goto Continue;

9
gcc/ada/sem_util.adb
View File

@ -6101,9 +6101,16 @@ package body Sem_Util is
-- declared at the library level to ensure that names such as
-- X.all'access don't fail static accessibility checks.
-- Ada 0Y (AI-230): In case of anonymous access types that are
-- component_definition or discriminants of a nonlimited type,
-- the level is the same as that of the enclosing component type.
Btyp := Base_Type (Typ);
if Ekind (Btyp) in Access_Kind then
if Ekind (Btyp) = E_Anonymous_Access_Type then
if Ekind (Btyp) = E_Anonymous_Access_Type
and then not Is_Array_Type (Scope (Btyp)) -- Ada 0Y (AI-230)
and then Ekind (Scope (Btyp)) /= E_Record_Type -- Ada 0Y (AI-230)
then
return Scope_Depth (Standard_Standard);
end if;