[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:
Arnaud Charlet 2015-10-16 14:53:03 +02:00
parent f9105bfacd
commit 65cddf367d
6 changed files with 60 additions and 18 deletions

View File

@ -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

View File

@ -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);

View File

@ -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)
{

View File

@ -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

View File

@ -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));

View File

@ -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