diff options
Diffstat (limited to 'gcc')
| -rw-r--r-- | gcc/ada/ChangeLog | 16 | ||||
| -rw-r--r-- | gcc/ada/a-except-2005.adb | 10 | ||||
| -rw-r--r-- | gcc/ada/adadecode.c | 11 | ||||
| -rw-r--r-- | gcc/ada/adadecode.h | 7 | ||||
| -rw-r--r-- | gcc/ada/sem_util.adb | 30 | ||||
| -rw-r--r-- | gcc/ada/sem_util.ads | 4 |
6 files changed, 60 insertions, 18 deletions
diff --git a/gcc/ada/ChangeLog b/gcc/ada/ChangeLog index c48e1f6..40e07ce 100644 --- a/gcc/ada/ChangeLog +++ b/gcc/ada/ChangeLog @@ -1,5 +1,21 @@ 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 elaboration circularities when polling is turned on. diff --git a/gcc/ada/a-except-2005.adb b/gcc/ada/a-except-2005.adb index 5f12346..92bec03 100644 --- a/gcc/ada/a-except-2005.adb +++ b/gcc/ada/a-except-2005.adb @@ -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); diff --git a/gcc/ada/adadecode.c b/gcc/ada/adadecode.c index d6935ca..8c9c7ab 100644 --- a/gcc/ada/adadecode.c +++ b/gcc/ada/adadecode.c @@ -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) { diff --git a/gcc/ada/adadecode.h b/gcc/ada/adadecode.h index 73dda23..03848e7 100644 --- a/gcc/ada/adadecode.h +++ b/gcc/ada/adadecode.h @@ -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 diff --git a/gcc/ada/sem_util.adb b/gcc/ada/sem_util.adb index 2915632..efdf326 100644 --- a/gcc/ada/sem_util.adb +++ b/gcc/ada/sem_util.adb @@ -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)); diff --git a/gcc/ada/sem_util.ads b/gcc/ada/sem_util.ads index 6955094..70ffa63 100644 --- a/gcc/ada/sem_util.ads +++ b/gcc/ada/sem_util.ads @@ -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 |