mirror/gcc
2
0
Fork 0
mirror of git://gcc.gnu.org/git/gcc.git synced 2025-04-05 23:31:21 +08:00
Code Issues Packages Projects Releases Wiki Activity

[multiple changes]

Browse Source 
2014-01-20  Robert Dewar  <dewar@adacore.com>

	* exp_ch9.adb, checks.adb, exp_intr.adb: Minor reformatting.
	* sem_res.adb (Resolve): Fix error causing infinite loop for
	integer used as address. Allow addresses as integers.

2014-01-20  Arnaud Charlet  <charlet@adacore.com>

	* s-osinte-linux.ads (struct_sigaction): Fix rep clause.

2014-01-20  Bob Duff  <duff@adacore.com>

	* par-ch8.adb (P_Use_Type_Clause): Detect syntax
	error when "use all" is not followed by "type".

From-SVN: r206829
This commit is contained in:
Arnaud Charlet 2014-01-20 16:39:55 +01:00
parent 3b4598a761
commit 6fd0a72a53
8 changed files with 144 additions and 107 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

15
gcc/ada/ChangeLog
View File

@ -1,3 +1,18 @@
2014-01-20 Robert Dewar <dewar@adacore.com>
* exp_ch9.adb, checks.adb, exp_intr.adb: Minor reformatting.
* sem_res.adb (Resolve): Fix error causing infinite loop for
integer used as address. Allow addresses as integers.
2014-01-20 Arnaud Charlet <charlet@adacore.com>
* s-osinte-linux.ads (struct_sigaction): Fix rep clause.
2014-01-20 Bob Duff <duff@adacore.com>
* par-ch8.adb (P_Use_Type_Clause): Detect syntax
error when "use all" is not followed by "type".
2014-01-20 Bob Duff <duff@adacore.com>
* exp_intr.adb (Expand_Unc_Deallocation): Remove warning on abort

6
gcc/ada/checks.adb
View File

@ -767,9 +767,11 @@ package body Checks is
and then not Warnings_Off (E)
and then Restriction_Active (No_Exception_Propagation)
then
Error_Msg_N ("address value may be incompatible with " &
"alignment of object?", N);
Error_Msg_N
("address value may be incompatible with alignment of object?",
N);
end if;
return;
end if;

115
gcc/ada/exp_ch9.adb
View File

@ -70,9 +70,9 @@ package body Exp_Ch9 is
-- The following constant establishes the upper bound for the index of
-- an entry family. It is used to limit the allocated size of protected
-- types with defaulted discriminant of an integer type, when the bound
-- of some entry family depends on a discriminant. The limitation to
-- entry families of 128K should be reasonable in all cases, and is a
-- documented implementation restriction.
-- of some entry family depends on a discriminant. The limitation to entry
-- families of 128K should be reasonable in all cases, and is a documented
-- implementation restriction.
Entry_Family_Bound : constant Int := 2**16;
@ -202,8 +202,8 @@ package body Exp_Ch9 is
-- pre/postconditions. The body gathers the PPC's and expands them in the
-- usual way, and performs the entry call itself. This way preconditions
-- are evaluated before the call is queued. E is the entry in question,
-- and Decl is the enclosing synchronized type declaration at whose
-- freeze point the generated body is analyzed.
-- and Decl is the enclosing synchronized type declaration at whose freeze
-- point the generated body is analyzed.
function Build_Protected_Entry
(N : Node_Id;
@ -238,12 +238,12 @@ package body Exp_Ch9 is
Pid : Node_Id;
N_Op_Spec : Node_Id) return Node_Id;
-- This function is used to construct the protected version of a protected
-- subprogram. Its statement sequence first defers abort, then locks
-- the associated protected object, and then enters a block that contains
-- a call to the unprotected version of the subprogram (for details, see
-- Build_Unprotected_Subprogram_Body). This block statement requires
-- a cleanup handler that unlocks the object in all cases.
-- (see Exp_Ch7.Expand_Cleanup_Actions).
-- subprogram. Its statement sequence first defers abort, then locks the
-- associated protected object, and then enters a block that contains a
-- call to the unprotected version of the subprogram (for details, see
-- Build_Unprotected_Subprogram_Body). This block statement requires a
-- cleanup handler that unlocks the object in all cases. For details,
-- see Exp_Ch7.Expand_Cleanup_Actions.
function Build_Renamed_Formal_Declaration
(New_F : Entity_Id;
@ -262,14 +262,13 @@ package body Exp_Ch9 is
(Prefix : Entity_Id;
Selector : Entity_Id;
Append_Char : Character := ' ') return Name_Id;
-- Build a name in the form of Prefix__Selector, with an optional
-- character appended. This is used for internal subprograms generated
-- for operations of protected types, including barrier functions.
-- For the subprograms generated for entry bodies and entry barriers,
-- the generated name includes a sequence number that makes names
-- unique in the presence of entry overloading. This is necessary
-- because entry body procedures and barrier functions all have the
-- same signature.
-- Build a name in the form of Prefix__Selector, with an optional character
-- appended. This is used for internal subprograms generated for operations
-- of protected types, including barrier functions. For the subprograms
-- generated for entry bodies and entry barriers, the generated name
-- includes a sequence number that makes names unique in the presence of
-- entry overloading. This is necessary because entry body procedures and
-- barrier functions all have the same signature.
procedure Build_Simple_Entry_Call
(N : Node_Id;
@ -350,14 +349,14 @@ package body Exp_Ch9 is
procedure Ensure_Statement_Present (Loc : Source_Ptr; Alt : Node_Id);
-- If control flow optimizations are suppressed, and Alt is an accept,
-- delay, or entry call alternative with no trailing statements, insert a
-- null trailing statement with the given Loc (which is the sloc of the
-- accept, delay, or entry call statement). There might not be any
-- generated code for the accept, delay, or entry call itself (the
-- effect of these statements is part of the general processsing done
-- for the enclosing selective accept, timed entry call, or asynchronous
-- select), and the null statement is there to carry the sloc of that
-- statement to the back-end for trace-based coverage analysis purposes.
-- delay, or entry call alternative with no trailing statements, insert
-- a null trailing statement with the given Loc (which is the sloc of
-- the accept, delay, or entry call statement). There might not be any
-- generated code for the accept, delay, or entry call itself (the effect
-- of these statements is part of the general processsing done for the
-- enclosing selective accept, timed entry call, or asynchronous select),
-- and the null statement is there to carry the sloc of that statement to
-- the back-end for trace-based coverage analysis purposes.
procedure Extract_Dispatching_Call
(N : Node_Id;
@ -376,8 +375,8 @@ package body Exp_Ch9 is
Concval : out Node_Id;
Ename : out Node_Id;
Index : out Node_Id);
-- Given an entry call, returns the associated concurrent object,
-- the entry name, and the entry family index.
-- Given an entry call, returns the associated concurrent object, the entry
-- name, and the entry family index.
function Family_Offset
(Loc : Source_Ptr;
@ -385,11 +384,11 @@ package body Exp_Ch9 is
Lo : Node_Id;
Ttyp : Entity_Id;
Cap : Boolean) return Node_Id;
-- Compute (Hi - Lo) for two entry family indexes. Hi is the index in
-- an accept statement, or the upper bound in the discrete subtype of
-- an entry declaration. Lo is the corresponding lower bound. Ttyp is
-- the concurrent type of the entry. If Cap is true, the result is
-- capped according to Entry_Family_Bound.
-- Compute (Hi - Lo) for two entry family indexes. Hi is the index in an
-- accept statement, or the upper bound in the discrete subtype of an entry
-- declaration. Lo is the corresponding lower bound. Ttyp is the concurrent
-- type of the entry. If Cap is true, the result is capped according to
-- Entry_Family_Bound.
function Family_Size
(Loc : Source_Ptr;
@ -397,11 +396,11 @@ package body Exp_Ch9 is
Lo : Node_Id;
Ttyp : Entity_Id;
Cap : Boolean) return Node_Id;
-- Compute (Hi - Lo) + 1 Max 0, to determine the number of entries in
-- a family, and handle properly the superflat case. This is equivalent
-- to the use of 'Length on the index type, but must use Family_Offset
-- to handle properly the case of bounds that depend on discriminants.
-- If Cap is true, the result is capped according to Entry_Family_Bound.
-- Compute (Hi - Lo) + 1 Max 0, to determine the number of entries in a
-- family, and handle properly the superflat case. This is equivalent to
-- the use of 'Length on the index type, but must use Family_Offset to
-- handle properly the case of bounds that depend on discriminants. If
-- Cap is true, the result is capped according to Entry_Family_Bound.
procedure Find_Enclosing_Context
(N : Node_Id;
@ -417,8 +416,8 @@ package body Exp_Ch9 is
function Index_Object (Spec_Id : Entity_Id) return Entity_Id;
-- Given a subprogram identifier, return the entity which is associated
-- with the protection entry index in the Protected_Body_Subprogram or the
-- Task_Body_Procedure of Spec_Id. The returned entity denotes formal
-- with the protection entry index in the Protected_Body_Subprogram or
-- the Task_Body_Procedure of Spec_Id. The returned entity denotes formal
-- parameter _E.
function Is_Exception_Safe (Subprogram : Node_Id) return Boolean;
@ -436,9 +435,9 @@ package body Exp_Ch9 is
function Null_Statements (Stats : List_Id) return Boolean;
-- Used to check DO-END sequence. Checks for equivalent of DO NULL; END.
-- Allows labels, and pragma Warnings/Unreferenced in the sequence as
-- well to still count as null. Returns True for a null sequence. The
-- argument is the list of statements from the DO-END sequence.
-- Allows labels, and pragma Warnings/Unreferenced in the sequence as well
-- to still count as null. Returns True for a null sequence. The argument
-- is the list of statements from the DO-END sequence.
function Parameter_Block_Pack
(Loc : Source_Ptr;
@ -447,8 +446,8 @@ package body Exp_Ch9 is
Formals : List_Id;
Decls : List_Id;
Stmts : List_Id) return Entity_Id;
-- Set the components of the generated parameter block with the values of
-- the actual parameters. Generate aliased temporaries to capture the
-- Set the components of the generated parameter block with the values
-- of the actual parameters. Generate aliased temporaries to capture the
-- values for types that are passed by copy. Otherwise generate a reference
-- to the actual's value. Return the address of the aggregate block.
-- Generate:
@ -605,8 +604,8 @@ package body Exp_Ch9 is
S :=
Etype (Discrete_Subtype_Definition (Declaration_Node (Prev)));
-- The need for the following full view retrieval stems from
-- this complex case of nested generics and tasking:
-- The need for the following full view retrieval stems from this
-- complex case of nested generics and tasking:
-- generic
-- type Formal_Index is range <>;
@ -638,6 +637,7 @@ package body Exp_Ch9 is
-- We are currently building the index expression for the entry
-- call "T.E" (1). Part of the expansion must mention the range
-- of the discrete type "Index" (2) of entry family "Fam".
-- However only the private view of type "Index" is available to
-- the inner generic (3) because there was no prior mention of
-- the type inside "Inner". This visibility requirement is
@ -708,9 +708,9 @@ package body Exp_Ch9 is
Set_Etype (New_F, Etype (Formal));
Set_Scope (New_F, Ent);
-- Now we set debug info needed on New_F even though it does not
-- come from source, so that the debugger will get the right
-- information for these generated names.
-- Now we set debug info needed on New_F even though it does not come
-- from source, so that the debugger will get the right information
-- for these generated names.
Set_Debug_Info_Needed (New_F);
@ -843,8 +843,8 @@ package body Exp_Ch9 is
New_S := Stats;
end if;
-- At this stage we know that the new statement sequence does not
-- have an exception handler part, so we supply one to call
-- At this stage we know that the new statement sequence does
-- not have an exception handler part, so we supply one to call
-- Exceptional_Complete_Rendezvous. This handler is
-- when all others =>
@ -974,8 +974,7 @@ package body Exp_Ch9 is
Prepend_To (Decls, Decl);
-- Ensure that the _chain appears in the proper scope of the
-- context.
-- Ensure that _chain appears in the proper scope of the context
if Context_Id /= Current_Scope then
Push_Scope (Context_Id);
@ -1189,9 +1188,9 @@ package body Exp_Ch9 is
while Nkind (Par) /= N_Compilation_Unit loop
Par := Parent (Par);
-- If we fall off the top, we are at the outer level, and
-- the environment task is our effective master, so
-- nothing to mark.
-- If we fall off the top, we are at the outer level,
-- and the environment task is our effective master,
-- so nothing to mark.
if Nkind_In (Par, N_Block_Statement,
N_Subprogram_Body,

9
gcc/ada/exp_intr.adb
View File

@ -1018,11 +1018,12 @@ package body Exp_Intr is
-- For a task type, call Free_Task before freeing the ATCB
if Is_Task_Type (Desig_T) then
-- We used to detect the case of Abort followed by a Free here,
-- because the Free wouldn't actually free if it happens before the
-- aborted task actually terminates. The warning is removed, because
-- Free now works properly (the task will be freed once it
-- terminates).
-- because the Free wouldn't actually free if it happens before
-- the aborted task actually terminates. The warning was removed,
-- because Free now works properly (the task will be freed once
-- it terminates).
Append_To
(Stmts, Cleanup_Task (N, Duplicate_Subexpr_No_Checks (Arg)));

7
gcc/ada/gnat_rm.texi
View File

@ -1239,8 +1239,9 @@ If the configuration pragma
@code{Allow_Integer_Address} is given, then integer expressions may
be used anywhere a value of type @code{System.Address} is required.
The effect is to introduce an implicit unchecked conversion from the
integer value to type @code{System.Address}. The following example
compiles without errors:
integer value to type @code{System.Address}. The reverse case of using
an address where an integer type is required is handled analogously.
The following example compiles without errors:
@smallexample @c ada
pragma Allow_Integer_Address;
@ -1253,6 +1254,8 @@ package AddrAsInt is
m : Address := 16#4000#;
n : constant Address := 4000;
p : constant Address := Address (X + Y);
v : Integer := y'Address;
w : constant Integer := Integer (Y'Address);
type R is new integer;
RR : R := 1000;
Z : Integer;

7
gcc/ada/par-ch8.adb
View File

@ -113,7 +113,12 @@ package body Ch8 is
Error_Msg_Ada_2012_Feature ("|`USE ALL TYPE`", Token_Ptr);
All_Present := True;
Scan; -- past ALL
else
if Token /= Tok_Type then
Error_Msg_SC ("TYPE expected");
end if;
else pragma Assert (Token = Tok_Type);
All_Present := False;
end if;

5
gcc/ada/s-osinte-linux.ads
View File

@ -7,7 +7,7 @@
-- S p e c --
-- --
-- Copyright (C) 1991-1994, Florida State University --
-- Copyright (C) 1995-2012, Free Software Foundation, Inc. --
-- Copyright (C) 1995-2013, 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- --
@ -589,7 +589,8 @@ private
for struct_sigaction use record
sa_handler at Linux.sa_handler_pos range 0 .. Standard'Address_Size - 1;
sa_mask at Linux.sa_mask_pos range 0 .. 1023;
sa_flags at Linux.sa_flags_pos range 0 .. Standard'Address_Size - 1;
sa_flags at Linux.sa_flags_pos
range 0 .. Interfaces.C.unsigned_long'Size - 1;
end record;
-- We intentionally leave sa_restorer unspecified and let the compiler
-- append it after the last field, so disable corresponding warning.

87
gcc/ada/sem_res.adb
View File

@ -2612,30 +2612,36 @@ package body Sem_Res is
end;
end if;
-- If an error message was issued already, Found got reset to
-- True, so if it is still False, issue standard Wrong_Type msg.
-- Looks like we have a type error, but check for special case
-- of Address wanted, integer found, with the configuration pragma
-- Allow_Integer_Address active. If we have this case, introduce
-- an unchecked conversion to allow the integer expression to be
-- treated as an Address. The reverse case of integer wanted,
-- Address found, is treated in an analogous manner.
-- First check for special case of Address wanted, integer found
-- with the configuration pragma Allow_Integer_Address active.
if Allow_Integer_Address
and then Is_RTE (Typ, RE_Address)
and then Is_Integer_Type (Etype (N))
then
Rewrite
(N, Unchecked_Convert_To (RTE (RE_Address),
Relocate_Node (N)));
Analyze_And_Resolve (N, RTE (RE_Address));
return;
-- OK, not the special case go ahead and issue message
elsif not Found then
if Is_Overloaded (N)
and then Nkind (N) = N_Function_Call
if Allow_Integer_Address then
if (Is_RTE (Typ, RE_Address)
and then Is_Integer_Type (Etype (N)))
or else
(Is_Integer_Type (Typ)
and then Is_RTE (Etype (N), RE_Address))
then
Rewrite (N, Unchecked_Convert_To (Typ, Relocate_Node (N)));
Analyze_And_Resolve (N, Typ);
return;
end if;
end if;
-- That special Allow_Integer_Address check did not appply, so we
-- have a real type error. If an error message was issued already,
-- Found got reset to True, so if it's still False, issue standard
-- Wrong_Type message.
if not Found then
if Is_Overloaded (N) and then Nkind (N) = N_Function_Call then
declare
Subp_Name : Node_Id;
begin
if Is_Entity_Name (Name (N)) then
Subp_Name := Name (N);
@ -11085,6 +11091,23 @@ package body Sem_Res is
end;
end if;
-- Deal with conversion of integer type to address if the pragma
-- Allow_Integer_Address is in effect. We convert the conversion to
-- an unchecked conversion in this case and we are all done!
if Allow_Integer_Address
and then
((Is_RTE (Target_Type, RE_Address)
and then Is_Integer_Type (Opnd_Type))
or else
(Is_RTE (Opnd_Type, RE_Address)
and then Is_Integer_Type (Target_Type)))
then
Rewrite (N, Unchecked_Convert_To (Target_Type, Expression (N)));
Analyze_And_Resolve (N, Target_Type);
return True;
end if;
-- If we are within a child unit, check whether the type of the
-- expression has an ancestor in a parent unit, in which case it
-- belongs to its derivation class even if the ancestor is private.
@ -11094,7 +11117,7 @@ package body Sem_Res is
-- Numeric types
if Is_Numeric_Type (Target_Type) then
if Is_Numeric_Type (Target_Type) then
-- A universal fixed expression can be converted to any numeric type
@ -11120,11 +11143,11 @@ package body Sem_Res is
else
return Conversion_Check
(Is_Numeric_Type (Opnd_Type)
or else
(Present (Inc_Ancestor)
and then Is_Numeric_Type (Inc_Ancestor)),
"illegal operand for numeric conversion");
(Is_Numeric_Type (Opnd_Type)
or else
(Present (Inc_Ancestor)
and then Is_Numeric_Type (Inc_Ancestor)),
"illegal operand for numeric conversion");
end if;
-- Array types
@ -11637,18 +11660,6 @@ package body Sem_Res is
("add ALL to }!", N, Target_Type);
return False;
-- Deal with conversion of integer type to address if the pragma
-- Allow_Integer_Address is in effect.
elsif Allow_Integer_Address
and then Is_RTE (Etype (N), RE_Address)
and then Is_Integer_Type (Etype (Operand))
then
Rewrite (N,
Unchecked_Convert_To (RTE (RE_Address), Relocate_Node (N)));
Analyze_And_Resolve (N, RTE (RE_Address));
return True;
-- Here we have a real conversion error
else