[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

diff --git a/gcc/ada/ChangeLog b/gcc/ada/ChangeLog
index c48e1f65cda5d76907901a144dbfa12ac4202afc..40e07ce2d0f3ced30b447ef56933d368699f4285 100644 (file)
--- a/gcc/ada/ChangeLog
+++ b/gcc/ada/ChangeLog
@@ -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

diff --git a/gcc/ada/a-except-2005.adb b/gcc/ada/a-except-2005.adb
index 5f123460a072330246262b400fd9dd5019960654..92bec03f294b8cde0ed5a2c50d790ed723c84482 100644 (file)
--- 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 d6935ca206b62df2763a7f751728a249d31fe3f4..8c9c7ab7a88f78582af43f898e6b701bc7950662 100644 (file)
--- 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 73dda238a093ca08fda91a0940d0e6e7c852d63e..03848e74d8303756eefef7230041dd8629707584 100644 (file)
--- 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 2915632a84859eb5c5e36b85d393180a387e5fac..efdf3266a3e5f4c928edc31447be72cfb88f8a5d 100644 (file)
--- 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 6955094b7a2195e61fd4d8ec828843051249e278..70ffa636e9fddf776dd651fabf421357487de737 100644 (file)
--- 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