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.

git-svn-id: svn+ssh://gcc.gnu.org/svn/gcc/trunk@228886 138bc75d-0d04-0410-961f-82ee72b054a4

diff --git a/gcc/ada/ChangeLog b/gcc/ada/ChangeLog
index c48e1f6..40e07ce 100644 (file)
--- 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 (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 d6935ca..8c9c7ab 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 73dda23..03848e7 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 2915632..efdf326 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 6955094..70ffa63 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