[multiple changes]
2015-10-16 Bob Duff <duff@adacore.com> * adadecode.h, adadecode.c (ada_demangle): Remove ada_demangle, no longer used. * a-except-2005.adb: Bring System.Traceback.Symbolic into the closure. 2015-10-16 Ed Schonberg <schonberg@adacore.com> * sem_util.adb, sem_util.ads (Get_Reference_Discriminant): Utility to locate the access discriminant that supports implicit dereference on a record type. (Is_OK_Variable_For_Out_Parameter): Reject other illegal uses of Implicit_Dereference on an access_to_constant when actual parameter is a rewritten variable or function call. From-SVN: r228886
This commit is contained in:
parent
f9105bfacd
commit
65cddf367d
|
@ -1,3 +1,19 @@
|
|||
2015-10-16 Bob Duff <duff@adacore.com>
|
||||
|
||||
* adadecode.h, adadecode.c (ada_demangle): Remove
|
||||
ada_demangle, no longer used.
|
||||
* a-except-2005.adb: Bring System.Traceback.Symbolic into the
|
||||
closure.
|
||||
|
||||
2015-10-16 Ed Schonberg <schonberg@adacore.com>
|
||||
|
||||
* sem_util.adb, sem_util.ads (Get_Reference_Discriminant): Utility to
|
||||
locate the access discriminant that supports implicit dereference on a
|
||||
record type.
|
||||
(Is_OK_Variable_For_Out_Parameter): Reject other illegal uses
|
||||
of Implicit_Dereference on an access_to_constant when actual
|
||||
parameter is a rewritten variable or function call.
|
||||
|
||||
2015-10-16 Bob Duff <duff@adacore.com>
|
||||
|
||||
* a-tags.adb, s-trasym.adb, s-trasym.ads: Make sure we don't get
|
||||
|
|
|
@ -44,6 +44,16 @@ with System.Soft_Links; use System.Soft_Links;
|
|||
with System.WCh_Con; use System.WCh_Con;
|
||||
with System.WCh_StW; use System.WCh_StW;
|
||||
|
||||
pragma Warnings (Off);
|
||||
-- Suppress complaints about Symbolic not being referenced, and about it not
|
||||
-- having pragma Preelaborate.
|
||||
with System.Traceback.Symbolic;
|
||||
-- Bring Symbolic into the closure. If it is the s-trasym-dwarf.adb version,
|
||||
-- it will install symbolic tracebacks as the default decorator. Otherwise,
|
||||
-- symbolic tracebacks are not supported, and we fall back to hexadecimal
|
||||
-- addresses.
|
||||
pragma Warnings (On);
|
||||
|
||||
package body Ada.Exceptions is
|
||||
|
||||
pragma Suppress (All_Checks);
|
||||
|
|
|
@ -368,17 +368,6 @@ __gnat_decode (const char *coded_name, char *ada_name, int verbose)
|
|||
extern "C" {
|
||||
#endif
|
||||
|
||||
#ifdef IN_RTS
|
||||
char *
|
||||
ada_demangle (const char *coded_name)
|
||||
{
|
||||
char ada_name[2048];
|
||||
|
||||
__gnat_decode (coded_name, ada_name, 0);
|
||||
return xstrdup (ada_name);
|
||||
}
|
||||
#endif
|
||||
|
||||
void
|
||||
get_encoding (const char *coded_name, char *encoding)
|
||||
{
|
||||
|
|
|
@ -6,7 +6,7 @@
|
|||
* *
|
||||
* C Header File *
|
||||
* *
|
||||
* Copyright (C) 2001-2011, Free Software Foundation, Inc. *
|
||||
* Copyright (C) 2001-2015, 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- *
|
||||
|
@ -51,11 +51,6 @@ extern void __gnat_decode (const char *, char *, int);
|
|||
from the encoded form. The Ada encodings are described in exp_dbug.ads. */
|
||||
extern void get_encoding (const char *, char *);
|
||||
|
||||
/* ada_demangle is added for COMPATIBILITY ONLY. It has the name of the
|
||||
function used in the binutils and GDB. Always consider using __gnat_decode
|
||||
instead of ada_demangle. Caller must free the pointer returned. */
|
||||
extern char *ada_demangle (const char *);
|
||||
|
||||
#ifdef __cplusplus
|
||||
}
|
||||
#endif
|
||||
|
|
|
@ -7794,6 +7794,26 @@ package body Sem_Util is
|
|||
end if;
|
||||
end Get_Reason_String;
|
||||
|
||||
--------------------------------
|
||||
-- Get_Reference_Discriminant --
|
||||
--------------------------------
|
||||
|
||||
function Get_Reference_Discriminant (Typ : Entity_Id) return Entity_Id is
|
||||
D : Entity_Id;
|
||||
begin
|
||||
D := First_Discriminant (Typ);
|
||||
while Present (D) loop
|
||||
if Has_Implicit_Dereference (D) then
|
||||
return D;
|
||||
end if;
|
||||
Next_Discriminant (D);
|
||||
end loop;
|
||||
|
||||
-- Type must have a proper access discriminant.
|
||||
|
||||
pragma Assert (False);
|
||||
end Get_Reference_Discriminant;
|
||||
|
||||
---------------------------
|
||||
-- Get_Referenced_Object --
|
||||
---------------------------
|
||||
|
@ -12233,7 +12253,15 @@ package body Sem_Util is
|
|||
and then
|
||||
Has_Implicit_Dereference (Etype (Name (Original_Node (AV))))
|
||||
then
|
||||
return True;
|
||||
|
||||
-- Check that this is not a constant reference.
|
||||
|
||||
return not Is_Access_Constant (Etype (Prefix (AV)));
|
||||
|
||||
elsif Has_Implicit_Dereference (Etype (Original_Node (AV))) then
|
||||
return
|
||||
not Is_Access_Constant (Etype
|
||||
(Get_Reference_Discriminant (Etype (Original_Node (AV)))));
|
||||
|
||||
else
|
||||
return Is_OK_Variable_For_Out_Formal (Original_Node (AV));
|
||||
|
|
|
@ -909,6 +909,10 @@ package Sem_Util is
|
|||
-- literal or concatenation of string literals. An error is given for
|
||||
-- any other form.
|
||||
|
||||
function Get_Reference_Discriminant (Typ : Entity_Id) return Entity_Id;
|
||||
-- If Typ has Implicit_Dereference, return discriminant specified in
|
||||
-- the corresponding aspect.
|
||||
|
||||
function Get_Referenced_Object (N : Node_Id) return Node_Id;
|
||||
-- Given a node, return the renamed object if the node represents a renamed
|
||||
-- object, otherwise return the node unchanged. The node may represent an
|
||||
|
|
Loading…
Reference in New Issue