Skip to content

R
riscv-gcc-1
Commit 6fd0a72a by Arnaud Charlet
Options

[multiple changes] 

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
parent 3b4598a7
Showing with 87 additions and 49 deletions
gcc/ada/ChangeLog
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
......
gcc/ada/checks.adb
......@@ -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;
......
gcc/ada/exp_intr.adb
......@@ -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)));
......
gcc/ada/gnat_rm.texi
......@@ -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;
......
gcc/ada/par-ch8.adb
......@@ -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;
......
gcc/ada/s-osinte-linux.ads
......@@ -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.
......
gcc/ada/sem_res.adb
......@@ -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.
-- 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;
-- 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.
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;
-- OK, not the special case go ahead and issue message
-- 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.
elsif not Found then
if Is_Overloaded (N)
and then Nkind (N) = N_Function_Call
then
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
......
Markdown is supported
0% or
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment