[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
This commit is contained in:
parent
3b4598a761
commit
6fd0a72a53
|
@ -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>
|
2014-01-20 Bob Duff <duff@adacore.com>
|
||||||
|
|
||||||
* exp_intr.adb (Expand_Unc_Deallocation): Remove warning on abort
|
* exp_intr.adb (Expand_Unc_Deallocation): Remove warning on abort
|
||||||
|
|
|
@ -767,9 +767,11 @@ package body Checks is
|
||||||
and then not Warnings_Off (E)
|
and then not Warnings_Off (E)
|
||||||
and then Restriction_Active (No_Exception_Propagation)
|
and then Restriction_Active (No_Exception_Propagation)
|
||||||
then
|
then
|
||||||
Error_Msg_N ("address value may be incompatible with " &
|
Error_Msg_N
|
||||||
"alignment of object?", N);
|
("address value may be incompatible with alignment of object?",
|
||||||
|
N);
|
||||||
end if;
|
end if;
|
||||||
|
|
||||||
return;
|
return;
|
||||||
end if;
|
end if;
|
||||||
|
|
||||||
|
|
|
@ -70,9 +70,9 @@ package body Exp_Ch9 is
|
||||||
-- The following constant establishes the upper bound for the index of
|
-- The following constant establishes the upper bound for the index of
|
||||||
-- an entry family. It is used to limit the allocated size of protected
|
-- an entry family. It is used to limit the allocated size of protected
|
||||||
-- types with defaulted discriminant of an integer type, when the bound
|
-- types with defaulted discriminant of an integer type, when the bound
|
||||||
-- of some entry family depends on a discriminant. The limitation to
|
-- of some entry family depends on a discriminant. The limitation to entry
|
||||||
-- entry families of 128K should be reasonable in all cases, and is a
|
-- families of 128K should be reasonable in all cases, and is a documented
|
||||||
-- documented implementation restriction.
|
-- implementation restriction.
|
||||||
|
|
||||||
Entry_Family_Bound : constant Int := 2**16;
|
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
|
-- pre/postconditions. The body gathers the PPC's and expands them in the
|
||||||
-- usual way, and performs the entry call itself. This way preconditions
|
-- usual way, and performs the entry call itself. This way preconditions
|
||||||
-- are evaluated before the call is queued. E is the entry in question,
|
-- are evaluated before the call is queued. E is the entry in question,
|
||||||
-- and Decl is the enclosing synchronized type declaration at whose
|
-- and Decl is the enclosing synchronized type declaration at whose freeze
|
||||||
-- freeze point the generated body is analyzed.
|
-- point the generated body is analyzed.
|
||||||
|
|
||||||
function Build_Protected_Entry
|
function Build_Protected_Entry
|
||||||
(N : Node_Id;
|
(N : Node_Id;
|
||||||
|
@ -238,12 +238,12 @@ package body Exp_Ch9 is
|
||||||
Pid : Node_Id;
|
Pid : Node_Id;
|
||||||
N_Op_Spec : Node_Id) return Node_Id;
|
N_Op_Spec : Node_Id) return Node_Id;
|
||||||
-- This function is used to construct the protected version of a protected
|
-- This function is used to construct the protected version of a protected
|
||||||
-- subprogram. Its statement sequence first defers abort, then locks
|
-- subprogram. Its statement sequence first defers abort, then locks the
|
||||||
-- the associated protected object, and then enters a block that contains
|
-- associated protected object, and then enters a block that contains a
|
||||||
-- a call to the unprotected version of the subprogram (for details, see
|
-- call to the unprotected version of the subprogram (for details, see
|
||||||
-- Build_Unprotected_Subprogram_Body). This block statement requires
|
-- Build_Unprotected_Subprogram_Body). This block statement requires a
|
||||||
-- a cleanup handler that unlocks the object in all cases.
|
-- cleanup handler that unlocks the object in all cases. For details,
|
||||||
-- (see Exp_Ch7.Expand_Cleanup_Actions).
|
-- see Exp_Ch7.Expand_Cleanup_Actions.
|
||||||
|
|
||||||
function Build_Renamed_Formal_Declaration
|
function Build_Renamed_Formal_Declaration
|
||||||
(New_F : Entity_Id;
|
(New_F : Entity_Id;
|
||||||
|
@ -262,14 +262,13 @@ package body Exp_Ch9 is
|
||||||
(Prefix : Entity_Id;
|
(Prefix : Entity_Id;
|
||||||
Selector : Entity_Id;
|
Selector : Entity_Id;
|
||||||
Append_Char : Character := ' ') return Name_Id;
|
Append_Char : Character := ' ') return Name_Id;
|
||||||
-- Build a name in the form of Prefix__Selector, with an optional
|
-- Build a name in the form of Prefix__Selector, with an optional character
|
||||||
-- character appended. This is used for internal subprograms generated
|
-- appended. This is used for internal subprograms generated for operations
|
||||||
-- for operations of protected types, including barrier functions.
|
-- of protected types, including barrier functions. For the subprograms
|
||||||
-- For the subprograms generated for entry bodies and entry barriers,
|
-- generated for entry bodies and entry barriers, the generated name
|
||||||
-- the generated name includes a sequence number that makes names
|
-- includes a sequence number that makes names unique in the presence of
|
||||||
-- unique in the presence of entry overloading. This is necessary
|
-- entry overloading. This is necessary because entry body procedures and
|
||||||
-- because entry body procedures and barrier functions all have the
|
-- barrier functions all have the same signature.
|
||||||
-- same signature.
|
|
||||||
|
|
||||||
procedure Build_Simple_Entry_Call
|
procedure Build_Simple_Entry_Call
|
||||||
(N : Node_Id;
|
(N : Node_Id;
|
||||||
|
@ -350,14 +349,14 @@ package body Exp_Ch9 is
|
||||||
|
|
||||||
procedure Ensure_Statement_Present (Loc : Source_Ptr; Alt : Node_Id);
|
procedure Ensure_Statement_Present (Loc : Source_Ptr; Alt : Node_Id);
|
||||||
-- If control flow optimizations are suppressed, and Alt is an accept,
|
-- If control flow optimizations are suppressed, and Alt is an accept,
|
||||||
-- delay, or entry call alternative with no trailing statements, insert a
|
-- delay, or entry call alternative with no trailing statements, insert
|
||||||
-- null trailing statement with the given Loc (which is the sloc of the
|
-- a null trailing statement with the given Loc (which is the sloc of
|
||||||
-- accept, delay, or entry call statement). There might not be any
|
-- the accept, delay, or entry call statement). There might not be any
|
||||||
-- generated code for the accept, delay, or entry call itself (the
|
-- generated code for the accept, delay, or entry call itself (the effect
|
||||||
-- effect of these statements is part of the general processsing done
|
-- of these statements is part of the general processsing done for the
|
||||||
-- for the enclosing selective accept, timed entry call, or asynchronous
|
-- enclosing selective accept, timed entry call, or asynchronous select),
|
||||||
-- select), and the null statement is there to carry the sloc of that
|
-- and the null statement is there to carry the sloc of that statement to
|
||||||
-- statement to the back-end for trace-based coverage analysis purposes.
|
-- the back-end for trace-based coverage analysis purposes.
|
||||||
|
|
||||||
procedure Extract_Dispatching_Call
|
procedure Extract_Dispatching_Call
|
||||||
(N : Node_Id;
|
(N : Node_Id;
|
||||||
|
@ -376,8 +375,8 @@ package body Exp_Ch9 is
|
||||||
Concval : out Node_Id;
|
Concval : out Node_Id;
|
||||||
Ename : out Node_Id;
|
Ename : out Node_Id;
|
||||||
Index : out Node_Id);
|
Index : out Node_Id);
|
||||||
-- Given an entry call, returns the associated concurrent object,
|
-- Given an entry call, returns the associated concurrent object, the entry
|
||||||
-- the entry name, and the entry family index.
|
-- name, and the entry family index.
|
||||||
|
|
||||||
function Family_Offset
|
function Family_Offset
|
||||||
(Loc : Source_Ptr;
|
(Loc : Source_Ptr;
|
||||||
|
@ -385,11 +384,11 @@ package body Exp_Ch9 is
|
||||||
Lo : Node_Id;
|
Lo : Node_Id;
|
||||||
Ttyp : Entity_Id;
|
Ttyp : Entity_Id;
|
||||||
Cap : Boolean) return Node_Id;
|
Cap : Boolean) return Node_Id;
|
||||||
-- Compute (Hi - Lo) for two entry family indexes. Hi is the index in
|
-- Compute (Hi - Lo) for two entry family indexes. Hi is the index in an
|
||||||
-- an accept statement, or the upper bound in the discrete subtype of
|
-- accept statement, or the upper bound in the discrete subtype of an entry
|
||||||
-- an entry declaration. Lo is the corresponding lower bound. Ttyp is
|
-- declaration. Lo is the corresponding lower bound. Ttyp is the concurrent
|
||||||
-- the concurrent type of the entry. If Cap is true, the result is
|
-- type of the entry. If Cap is true, the result is capped according to
|
||||||
-- capped according to Entry_Family_Bound.
|
-- Entry_Family_Bound.
|
||||||
|
|
||||||
function Family_Size
|
function Family_Size
|
||||||
(Loc : Source_Ptr;
|
(Loc : Source_Ptr;
|
||||||
|
@ -397,11 +396,11 @@ package body Exp_Ch9 is
|
||||||
Lo : Node_Id;
|
Lo : Node_Id;
|
||||||
Ttyp : Entity_Id;
|
Ttyp : Entity_Id;
|
||||||
Cap : Boolean) return Node_Id;
|
Cap : Boolean) return Node_Id;
|
||||||
-- Compute (Hi - Lo) + 1 Max 0, to determine the number of entries in
|
-- Compute (Hi - Lo) + 1 Max 0, to determine the number of entries in a
|
||||||
-- a family, and handle properly the superflat case. This is equivalent
|
-- family, and handle properly the superflat case. This is equivalent to
|
||||||
-- to the use of 'Length on the index type, but must use Family_Offset
|
-- the use of 'Length on the index type, but must use Family_Offset to
|
||||||
-- to handle properly the case of bounds that depend on discriminants.
|
-- handle properly the case of bounds that depend on discriminants. If
|
||||||
-- If Cap is true, the result is capped according to Entry_Family_Bound.
|
-- Cap is true, the result is capped according to Entry_Family_Bound.
|
||||||
|
|
||||||
procedure Find_Enclosing_Context
|
procedure Find_Enclosing_Context
|
||||||
(N : Node_Id;
|
(N : Node_Id;
|
||||||
|
@ -417,8 +416,8 @@ package body Exp_Ch9 is
|
||||||
|
|
||||||
function Index_Object (Spec_Id : Entity_Id) return Entity_Id;
|
function Index_Object (Spec_Id : Entity_Id) return Entity_Id;
|
||||||
-- Given a subprogram identifier, return the entity which is associated
|
-- Given a subprogram identifier, return the entity which is associated
|
||||||
-- with the protection entry index in the Protected_Body_Subprogram or the
|
-- with the protection entry index in the Protected_Body_Subprogram or
|
||||||
-- Task_Body_Procedure of Spec_Id. The returned entity denotes formal
|
-- the Task_Body_Procedure of Spec_Id. The returned entity denotes formal
|
||||||
-- parameter _E.
|
-- parameter _E.
|
||||||
|
|
||||||
function Is_Exception_Safe (Subprogram : Node_Id) return Boolean;
|
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;
|
function Null_Statements (Stats : List_Id) return Boolean;
|
||||||
-- Used to check DO-END sequence. Checks for equivalent of DO NULL; END.
|
-- Used to check DO-END sequence. Checks for equivalent of DO NULL; END.
|
||||||
-- Allows labels, and pragma Warnings/Unreferenced in the sequence as
|
-- Allows labels, and pragma Warnings/Unreferenced in the sequence as well
|
||||||
-- well to still count as null. Returns True for a null sequence. The
|
-- to still count as null. Returns True for a null sequence. The argument
|
||||||
-- argument is the list of statements from the DO-END sequence.
|
-- is the list of statements from the DO-END sequence.
|
||||||
|
|
||||||
function Parameter_Block_Pack
|
function Parameter_Block_Pack
|
||||||
(Loc : Source_Ptr;
|
(Loc : Source_Ptr;
|
||||||
|
@ -447,8 +446,8 @@ package body Exp_Ch9 is
|
||||||
Formals : List_Id;
|
Formals : List_Id;
|
||||||
Decls : List_Id;
|
Decls : List_Id;
|
||||||
Stmts : List_Id) return Entity_Id;
|
Stmts : List_Id) return Entity_Id;
|
||||||
-- Set the components of the generated parameter block with the values of
|
-- Set the components of the generated parameter block with the values
|
||||||
-- the actual parameters. Generate aliased temporaries to capture the
|
-- of the actual parameters. Generate aliased temporaries to capture the
|
||||||
-- values for types that are passed by copy. Otherwise generate a reference
|
-- values for types that are passed by copy. Otherwise generate a reference
|
||||||
-- to the actual's value. Return the address of the aggregate block.
|
-- to the actual's value. Return the address of the aggregate block.
|
||||||
-- Generate:
|
-- Generate:
|
||||||
|
@ -605,8 +604,8 @@ package body Exp_Ch9 is
|
||||||
S :=
|
S :=
|
||||||
Etype (Discrete_Subtype_Definition (Declaration_Node (Prev)));
|
Etype (Discrete_Subtype_Definition (Declaration_Node (Prev)));
|
||||||
|
|
||||||
-- The need for the following full view retrieval stems from
|
-- The need for the following full view retrieval stems from this
|
||||||
-- this complex case of nested generics and tasking:
|
-- complex case of nested generics and tasking:
|
||||||
|
|
||||||
-- generic
|
-- generic
|
||||||
-- type Formal_Index is range <>;
|
-- type Formal_Index is range <>;
|
||||||
|
@ -638,6 +637,7 @@ package body Exp_Ch9 is
|
||||||
-- We are currently building the index expression for the entry
|
-- We are currently building the index expression for the entry
|
||||||
-- call "T.E" (1). Part of the expansion must mention the range
|
-- call "T.E" (1). Part of the expansion must mention the range
|
||||||
-- of the discrete type "Index" (2) of entry family "Fam".
|
-- of the discrete type "Index" (2) of entry family "Fam".
|
||||||
|
|
||||||
-- However only the private view of type "Index" is available to
|
-- However only the private view of type "Index" is available to
|
||||||
-- the inner generic (3) because there was no prior mention of
|
-- the inner generic (3) because there was no prior mention of
|
||||||
-- the type inside "Inner". This visibility requirement is
|
-- the type inside "Inner". This visibility requirement is
|
||||||
|
@ -708,9 +708,9 @@ package body Exp_Ch9 is
|
||||||
Set_Etype (New_F, Etype (Formal));
|
Set_Etype (New_F, Etype (Formal));
|
||||||
Set_Scope (New_F, Ent);
|
Set_Scope (New_F, Ent);
|
||||||
|
|
||||||
-- Now we set debug info needed on New_F even though it does not
|
-- Now we set debug info needed on New_F even though it does not come
|
||||||
-- come from source, so that the debugger will get the right
|
-- from source, so that the debugger will get the right information
|
||||||
-- information for these generated names.
|
-- for these generated names.
|
||||||
|
|
||||||
Set_Debug_Info_Needed (New_F);
|
Set_Debug_Info_Needed (New_F);
|
||||||
|
|
||||||
|
@ -843,8 +843,8 @@ package body Exp_Ch9 is
|
||||||
New_S := Stats;
|
New_S := Stats;
|
||||||
end if;
|
end if;
|
||||||
|
|
||||||
-- At this stage we know that the new statement sequence does not
|
-- At this stage we know that the new statement sequence does
|
||||||
-- have an exception handler part, so we supply one to call
|
-- not have an exception handler part, so we supply one to call
|
||||||
-- Exceptional_Complete_Rendezvous. This handler is
|
-- Exceptional_Complete_Rendezvous. This handler is
|
||||||
|
|
||||||
-- when all others =>
|
-- when all others =>
|
||||||
|
@ -974,8 +974,7 @@ package body Exp_Ch9 is
|
||||||
|
|
||||||
Prepend_To (Decls, Decl);
|
Prepend_To (Decls, Decl);
|
||||||
|
|
||||||
-- Ensure that the _chain appears in the proper scope of the
|
-- Ensure that _chain appears in the proper scope of the context
|
||||||
-- context.
|
|
||||||
|
|
||||||
if Context_Id /= Current_Scope then
|
if Context_Id /= Current_Scope then
|
||||||
Push_Scope (Context_Id);
|
Push_Scope (Context_Id);
|
||||||
|
@ -1189,9 +1188,9 @@ package body Exp_Ch9 is
|
||||||
while Nkind (Par) /= N_Compilation_Unit loop
|
while Nkind (Par) /= N_Compilation_Unit loop
|
||||||
Par := Parent (Par);
|
Par := Parent (Par);
|
||||||
|
|
||||||
-- If we fall off the top, we are at the outer level, and
|
-- If we fall off the top, we are at the outer level,
|
||||||
-- the environment task is our effective master, so
|
-- and the environment task is our effective master,
|
||||||
-- nothing to mark.
|
-- so nothing to mark.
|
||||||
|
|
||||||
if Nkind_In (Par, N_Block_Statement,
|
if Nkind_In (Par, N_Block_Statement,
|
||||||
N_Subprogram_Body,
|
N_Subprogram_Body,
|
||||||
|
|
|
@ -1018,11 +1018,12 @@ package body Exp_Intr is
|
||||||
-- For a task type, call Free_Task before freeing the ATCB
|
-- For a task type, call Free_Task before freeing the ATCB
|
||||||
|
|
||||||
if Is_Task_Type (Desig_T) then
|
if Is_Task_Type (Desig_T) then
|
||||||
|
|
||||||
-- We used to detect the case of Abort followed by a Free here,
|
-- 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
|
-- because the Free wouldn't actually free if it happens before
|
||||||
-- aborted task actually terminates. The warning is removed, because
|
-- the aborted task actually terminates. The warning was removed,
|
||||||
-- Free now works properly (the task will be freed once it
|
-- because Free now works properly (the task will be freed once
|
||||||
-- terminates).
|
-- it terminates).
|
||||||
|
|
||||||
Append_To
|
Append_To
|
||||||
(Stmts, Cleanup_Task (N, Duplicate_Subexpr_No_Checks (Arg)));
|
(Stmts, Cleanup_Task (N, Duplicate_Subexpr_No_Checks (Arg)));
|
||||||
|
|
|
@ -1239,8 +1239,9 @@ If the configuration pragma
|
||||||
@code{Allow_Integer_Address} is given, then integer expressions may
|
@code{Allow_Integer_Address} is given, then integer expressions may
|
||||||
be used anywhere a value of type @code{System.Address} is required.
|
be used anywhere a value of type @code{System.Address} is required.
|
||||||
The effect is to introduce an implicit unchecked conversion from the
|
The effect is to introduce an implicit unchecked conversion from the
|
||||||
integer value to type @code{System.Address}. The following example
|
integer value to type @code{System.Address}. The reverse case of using
|
||||||
compiles without errors:
|
an address where an integer type is required is handled analogously.
|
||||||
|
The following example compiles without errors:
|
||||||
|
|
||||||
@smallexample @c ada
|
@smallexample @c ada
|
||||||
pragma Allow_Integer_Address;
|
pragma Allow_Integer_Address;
|
||||||
|
@ -1253,6 +1254,8 @@ package AddrAsInt is
|
||||||
m : Address := 16#4000#;
|
m : Address := 16#4000#;
|
||||||
n : constant Address := 4000;
|
n : constant Address := 4000;
|
||||||
p : constant Address := Address (X + Y);
|
p : constant Address := Address (X + Y);
|
||||||
|
v : Integer := y'Address;
|
||||||
|
w : constant Integer := Integer (Y'Address);
|
||||||
type R is new integer;
|
type R is new integer;
|
||||||
RR : R := 1000;
|
RR : R := 1000;
|
||||||
Z : Integer;
|
Z : Integer;
|
||||||
|
|
|
@ -113,7 +113,12 @@ package body Ch8 is
|
||||||
Error_Msg_Ada_2012_Feature ("|`USE ALL TYPE`", Token_Ptr);
|
Error_Msg_Ada_2012_Feature ("|`USE ALL TYPE`", Token_Ptr);
|
||||||
All_Present := True;
|
All_Present := True;
|
||||||
Scan; -- past ALL
|
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;
|
All_Present := False;
|
||||||
end if;
|
end if;
|
||||||
|
|
||||||
|
|
|
@ -7,7 +7,7 @@
|
||||||
-- S p e c --
|
-- S p e c --
|
||||||
-- --
|
-- --
|
||||||
-- Copyright (C) 1991-1994, Florida State University --
|
-- 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 --
|
-- 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- --
|
-- terms of the GNU General Public License as published by the Free Soft- --
|
||||||
|
@ -589,7 +589,8 @@ private
|
||||||
for struct_sigaction use record
|
for struct_sigaction use record
|
||||||
sa_handler at Linux.sa_handler_pos range 0 .. Standard'Address_Size - 1;
|
sa_handler at Linux.sa_handler_pos range 0 .. Standard'Address_Size - 1;
|
||||||
sa_mask at Linux.sa_mask_pos range 0 .. 1023;
|
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;
|
end record;
|
||||||
-- We intentionally leave sa_restorer unspecified and let the compiler
|
-- We intentionally leave sa_restorer unspecified and let the compiler
|
||||||
-- append it after the last field, so disable corresponding warning.
|
-- append it after the last field, so disable corresponding warning.
|
||||||
|
|
|
@ -2612,30 +2612,36 @@ package body Sem_Res is
|
||||||
end;
|
end;
|
||||||
end if;
|
end if;
|
||||||
|
|
||||||
-- If an error message was issued already, Found got reset to
|
-- Looks like we have a type error, but check for special case
|
||||||
-- True, so if it is still False, issue standard Wrong_Type msg.
|
-- 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
|
if Allow_Integer_Address then
|
||||||
-- with the configuration pragma Allow_Integer_Address active.
|
if (Is_RTE (Typ, RE_Address)
|
||||||
|
and then Is_Integer_Type (Etype (N)))
|
||||||
if Allow_Integer_Address
|
or else
|
||||||
and then Is_RTE (Typ, RE_Address)
|
(Is_Integer_Type (Typ)
|
||||||
and then Is_Integer_Type (Etype (N))
|
and then Is_RTE (Etype (N), RE_Address))
|
||||||
then
|
then
|
||||||
Rewrite
|
Rewrite (N, Unchecked_Convert_To (Typ, Relocate_Node (N)));
|
||||||
(N, Unchecked_Convert_To (RTE (RE_Address),
|
Analyze_And_Resolve (N, Typ);
|
||||||
Relocate_Node (N)));
|
|
||||||
Analyze_And_Resolve (N, RTE (RE_Address));
|
|
||||||
return;
|
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 not Found then
|
||||||
if Is_Overloaded (N)
|
if Is_Overloaded (N) and then Nkind (N) = N_Function_Call then
|
||||||
and then Nkind (N) = N_Function_Call
|
|
||||||
then
|
|
||||||
declare
|
declare
|
||||||
Subp_Name : Node_Id;
|
Subp_Name : Node_Id;
|
||||||
|
|
||||||
begin
|
begin
|
||||||
if Is_Entity_Name (Name (N)) then
|
if Is_Entity_Name (Name (N)) then
|
||||||
Subp_Name := Name (N);
|
Subp_Name := Name (N);
|
||||||
|
@ -11085,6 +11091,23 @@ package body Sem_Res is
|
||||||
end;
|
end;
|
||||||
end if;
|
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
|
-- 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
|
-- expression has an ancestor in a parent unit, in which case it
|
||||||
-- belongs to its derivation class even if the ancestor is private.
|
-- belongs to its derivation class even if the ancestor is private.
|
||||||
|
@ -11637,18 +11660,6 @@ package body Sem_Res is
|
||||||
("add ALL to }!", N, Target_Type);
|
("add ALL to }!", N, Target_Type);
|
||||||
return False;
|
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
|
-- Here we have a real conversion error
|
||||||
|
|
||||||
else
|
else
|
||||||
|
|
Loading…
Reference in New Issue