[multiple changes]

2014-08-04  Yannick Moy  <moy@adacore.com>

	* sem_ch3.adb (Analyze_Object_Declaration): In GNATprove mode,
	do not generate two Itypes with the same name for an array
	definition.
	* sinfo.ads: Expand doc on GNATprove mode.

2014-08-04  Hristian Kirtchev  <kirtchev@adacore.com>

	* exp_ch3.adb (Expand_Freeze_Record_Type): Set the finalization
	master and storage pool attributes on the root type of an
	anonymous access type.
	* exp_ch4.adb (Expand_N_Allocator): Set the finalization master
	and storage pool attributes on the root type of an anonymous
	access type.

2014-08-04  Arnaud Charlet  <charlet@adacore.com>

	* exp_ch3.adb: Minor reformatting.
	* tb-alvms.c, tb-alvxw.c, tb-ivms.c: Removed.
	* tracebak.c: Remove use of above files.
	* gcc-interface/Makefile.in: Update dependencies.

2014-08-04  Pierre-Marie Derodat  <derodat@adacore.com>

	* gcc-interface/utils.c (gnat_set_type_context): Also set the
	context for parallel types' TYPE_STUB_DECL.  Do not change
	anything if the context is already set for them.
	(gnat_pushdecl): Update the comment for calls to
	gnat_set_type_context to mention parallel types.
	(add_parallel_type): When adding a context-less parallel type to
	a type that has a context, propagate the context from the latter
	type to the former.
	(process_deferred_decl_context): Call gnat_set_type_context
	rather than manually setting the type context.
	(build_unc_object_type): Call gnat_set_type_context on the
	template type.

From-SVN: r213584

gcc/ada/ChangeLog

+2014-08-04  Yannick Moy  <moy@adacore.com>
+
+	* sem_ch3.adb (Analyze_Object_Declaration): In GNATprove mode,
+	do not generate two Itypes with the same name for an array
+	definition.
+	* sinfo.ads: Expand doc on GNATprove mode.
+
+2014-08-04  Hristian Kirtchev  <kirtchev@adacore.com>
+
+	* exp_ch3.adb (Expand_Freeze_Record_Type): Set the finalization
+	master and storage pool attributes on the root type of an
+	anonymous access type.
+	* exp_ch4.adb (Expand_N_Allocator): Set the finalization master
+	and storage pool attributes on the root type of an anonymous
+	access type.
+
+2014-08-04  Arnaud Charlet  <charlet@adacore.com>
+
+	* exp_ch3.adb: Minor reformatting.
+	* tb-alvms.c, tb-alvxw.c, tb-ivms.c: Removed.
+	* tracebak.c: Remove use of above files.
+	* gcc-interface/Makefile.in: Update dependencies.
+
+2014-08-04  Pierre-Marie Derodat  <derodat@adacore.com>
+
+	* gcc-interface/utils.c (gnat_set_type_context): Also set the
+	context for parallel types' TYPE_STUB_DECL.  Do not change
+	anything if the context is already set for them.
+	(gnat_pushdecl): Update the comment for calls to
+	gnat_set_type_context to mention parallel types.
+	(add_parallel_type): When adding a context-less parallel type to
+	a type that has a context, propagate the context from the latter
+	type to the former.
+	(process_deferred_decl_context): Call gnat_set_type_context
+	rather than manually setting the type context.
+	(build_unc_object_type): Call gnat_set_type_context on the
+	template type.
+
 2014-08-04  Ed Schonberg  <schonberg@adacore.com>
 
 	* exp_ch5.adb (Expand_N_Case_Statement): If a choice is a

gcc/ada/exp_ch4.adb

@@ -1124,10 +1124,11 @@ package body Exp_Ch4 is
                --  Inherit the allocation-related attributes from the original
                --  access type.
 
-               Set_Finalization_Master (Def_Id, Finalization_Master (PtrT));
+               Set_Finalization_Master
+                 (Def_Id, Finalization_Master (PtrT));
 
-               Set_Associated_Storage_Pool (Def_Id,
-                 Associated_Storage_Pool (PtrT));
+               Set_Associated_Storage_Pool
+                 (Def_Id, Associated_Storage_Pool (PtrT));
 
                --  Declare the object using the previous type declaration
 
@@ -4318,26 +4319,29 @@ package body Exp_Ch4 is
 
          --  Anonymous access-to-controlled types allocate on the global pool.
          --  Do not set this attribute on .NET/JVM since those targets do not
-         --  support pools.
+         --  support pools. Note that this is a "root type only" attribute.
 
          if No (Associated_Storage_Pool (PtrT)) and then VM_Target = No_VM then
             if Present (Rel_Typ) then
                Set_Associated_Storage_Pool
-                 (PtrT, Associated_Storage_Pool (Rel_Typ));
+                 (Root_Type (PtrT), Associated_Storage_Pool (Rel_Typ));
             else
                Set_Associated_Storage_Pool
-                 (PtrT, RTE (RE_Global_Pool_Object));
+                 (Root_Type (PtrT), RTE (RE_Global_Pool_Object));
             end if;
          end if;
 
          --  The finalization master must be inserted and analyzed as part of
          --  the current semantic unit. Note that the master is updated when
-         --  analysis changes current units.
+         --  analysis changes current units. Note that this is a "root type
+         --  only" attribute.
 
          if Present (Rel_Typ) then
-            Set_Finalization_Master (PtrT, Finalization_Master (Rel_Typ));
+            Set_Finalization_Master
+              (Root_Type (PtrT), Finalization_Master (Rel_Typ));
          else
-            Set_Finalization_Master (PtrT, Current_Anonymous_Master);
+            Set_Finalization_Master
+              (Root_Type (PtrT), Current_Anonymous_Master);
          end if;
       end if;
 

gcc/ada/gcc-interface/Makefile.in

@@ -515,7 +515,7 @@ ifeq ($(strip $(filter-out m68k% wrs vx%,$(target_cpu) $(target_vendor) $(target
 endif
 
 # PowerPC and e500v2 VxWorks
-ifeq ($(strip $(filter-out powerpc% wrs vxworks,$(target_cpu) $(target_vendor) $(target_os))),)
+ifeq ($(strip $(filter-out powerpc% wrs vxworks vxworks7,$(target_cpu) $(target_vendor) $(target_os))),)
 
   ifeq ($(strip $(filter-out e500%, $(target_alias))),)
      ARCH_STR=e500
@@ -3012,7 +3012,7 @@ a-tags.o  : a-tags.adb a-tags.ads
 
 # need to keep the frame pointer in this file to pop the stack properly on
 # some targets.
-tracebak.o  : tracebak.c tb-alvms.c tb-alvxw.c tb-gcc.c
+tracebak.o  : tracebak.c tb-gcc.c
 	$(COMPILER) -c $(ALL_COMPILERFLAGS) $(ADA_CFLAGS) $(ALL_CPPFLAGS) \
 	      $(INCLUDES) -fno-omit-frame-pointer $< $(OUTPUT_OPTION)
 

gcc/ada/gcc-interface/utils.c

@@ -575,7 +575,18 @@ gnat_set_type_context (tree type, tree context)
 
   while (decl && DECL_PARALLEL_TYPE (decl))
     {
-      TYPE_CONTEXT (DECL_PARALLEL_TYPE (decl)) = context;
+      tree parallel_type = DECL_PARALLEL_TYPE (decl);
+
+      /* Give a context to the parallel types and their stub decl, if any.
+	 Some parallel types seems to be present in multiple parallel type
+	 chains, so don't mess with their context if they already have one.  */
+      if (TYPE_CONTEXT (parallel_type) == NULL_TREE)
+	{
+	  if (TYPE_STUB_DECL (parallel_type) != NULL_TREE)
+	    DECL_CONTEXT (TYPE_STUB_DECL (parallel_type)) = context;
+	  TYPE_CONTEXT (parallel_type) = context;
+	}
+
       decl = TYPE_STUB_DECL (DECL_PARALLEL_TYPE (decl));
     }
 }
@@ -799,7 +810,9 @@ gnat_pushdecl (tree decl, Node_Id gnat_node)
 	t = NULL_TREE;
 
       /* Propagate the name to all the anonymous variants.  This is needed
-	 for the type qualifiers machinery to work properly.  */
+	 for the type qualifiers machinery to work properly.  Also propagate
+	 the context to them.  Note that the context will be propagated to all
+	 parallel types too thanks to gnat_set_type_context.  */
       if (t)
 	for (t = TYPE_MAIN_VARIANT (t); t; t = TYPE_NEXT_VARIANT (t))
 	  if (!(TYPE_NAME (t) && TREE_CODE (TYPE_NAME (t)) == TYPE_DECL))
@@ -1763,7 +1776,10 @@ finish_record_type (tree record_type, tree field_list, int rep_level,
     rest_of_record_type_compilation (record_type);
 }
 
-/* Append PARALLEL_TYPE on the chain of parallel types of TYPE.  */
+/* Append PARALLEL_TYPE on the chain of parallel types of TYPE.  If
+   PARRALEL_TYPE has no context and its computation is not deferred yet, also
+   propagate TYPE's context to PARALLEL_TYPE's or defer its propagation to the
+   moment TYPE will get a context.  */
 
 void
 add_parallel_type (tree type, tree parallel_type)
@@ -1774,6 +1790,19 @@ add_parallel_type (tree type, tree parallel_type)
     decl = TYPE_STUB_DECL (DECL_PARALLEL_TYPE (decl));
 
   SET_DECL_PARALLEL_TYPE (decl, parallel_type);
+
+  /* If PARALLEL_TYPE already has a context, we are done.  */
+  if (TYPE_CONTEXT (parallel_type) != NULL_TREE)
+    return;
+
+  /* Otherwise, try to get one from TYPE's context.  */
+  if (TYPE_CONTEXT (type) != NULL_TREE)
+    /* TYPE already has a context, so simply propagate it to PARALLEL_TYPE.  */
+    gnat_set_type_context (parallel_type, TYPE_CONTEXT (type));
+
+    /* ... otherwise TYPE has not context yet.  We know it will thanks to
+       gnat_pushdecl, and then its context will be propagated to PARALLEL_TYPE.
+       So we have nothing to do in this case.  */
 }
 
 /* Return true if TYPE has a parallel type.  */
@@ -2851,7 +2880,7 @@ process_deferred_decl_context (bool force)
 	     ..._TYPE nodes.  */
 	  FOR_EACH_VEC_ELT (node->types, i, t)
 	    {
-	      TYPE_CONTEXT (t) = context;
+	      gnat_set_type_context (t, context);
 	    }
 	  processed = true;
 	}
@@ -3629,6 +3658,7 @@ tree
 build_unc_object_type (tree template_type, tree object_type, tree name,
 		       bool debug_info_p)
 {
+  tree decl;
   tree type = make_node (RECORD_TYPE);
   tree template_field
     = create_field_decl (get_identifier ("BOUNDS"), template_type, type,
@@ -3644,7 +3674,12 @@ build_unc_object_type (tree template_type, tree object_type, tree name,
 
   /* Declare it now since it will never be declared otherwise.  This is
      necessary to ensure that its subtrees are properly marked.  */
-  create_type_decl (name, type, true, debug_info_p, Empty);
+  decl = create_type_decl (name, type, true, debug_info_p, Empty);
+
+  /* template_type will not be used elsewhere than here, so to keep the debug
+     info clean and in order to avoid scoping issues, make decl its
+     context.  */
+  gnat_set_type_context (template_type, decl);
 
   return type;
 }

gcc/ada/sem_ch3.adb

@@ -3769,6 +3769,14 @@ package body Sem_Ch3 is
             elsif Is_Interface (T) then
                null;
 
+            --  In GNATprove mode, Expand_Subtype_From_Expr does nothing. Thus,
+            --  we should prevent the generation of another Itype with the
+            --  same name as the one already generated, or we end up with
+            --  two identical types in GNATprove.
+
+            elsif GNATprove_Mode then
+               null;
+
             else
                Expand_Subtype_From_Expr (N, T, Object_Definition (N), E);
                Act_T := Find_Type_Of_Object (Object_Definition (N), N);

gcc/ada/sinfo.ads

@@ -577,6 +577,10 @@ package Sinfo is
    --       warning issued when generating code, to avoid formal verification
    --       of a partial unit.
 
+   --    4. Unconstrained types are not replaced by constrained types whose
+   --       bounds are generated from an expression: Expand_Subtype_From_Expr
+   --       should be noop.
+
    -----------------------
    -- Check Flag Fields --
    -----------------------

gcc/ada/tb-ivms.c

-/****************************************************************************
- *                                                                          *
- *                         GNAT RUN-TIME COMPONENTS                         *
- *                                                                          *
- *                 T R A C E B A C K - I t a n i u m  / V M S               *
- *                                                                          *
- *                          C Implementation File                           *
- *                                                                          *
- *                     Copyright (C) 2007-2011, AdaCore                     *
- *                                                                          *
- * 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- *
- * ware  Foundation;  either version 3,  or (at your option) any later ver- *
- * sion.  GNAT is distributed in the hope that it will be useful, but WITH- *
- * OUT ANY WARRANTY;  without even the  implied warranty of MERCHANTABILITY *
- * or FITNESS FOR A PARTICULAR PURPOSE.                                     *
- *                                                                          *
- * As a special exception under Section 7 of GPL version 3, you are granted *
- * additional permissions described in the GCC Runtime Library Exception,   *
- * version 3.1, as published by the Free Software Foundation.               *
- *                                                                          *
- * You should have received a copy of the GNU General Public License and    *
- * a copy of the GCC Runtime Library Exception along with this program;     *
- * see the files COPYING3 and COPYING.RUNTIME respectively.  If not, see    *
- * <http://www.gnu.org/licenses/>.                                          *
- *                                                                          *
- * GNAT was originally developed  by the GNAT team at  New York University. *
- * Extensive contributions were provided by Ada Core Technologies Inc.      *
- *                                                                          *
- ****************************************************************************/
-
-/* Itanium Open/VMS implementation of backtrace.  Use ICB (Invocation
-   Context Block) routines.  */
-#include <stdlib.h>
-#include <vms/libicb.h>
-
-/* Declare libicb routines.  */
-extern INVO_CONTEXT_BLK *LIB$I64_CREATE_INVO_CONTEXT (void *(*)(size_t),
-						      void (*)(void *),
-						      int);
-extern void LIB$I64_FREE_INVO_CONTEXT (INVO_CONTEXT_BLK *);
-extern int LIB$I64_GET_CURR_INVO_CONTEXT(INVO_CONTEXT_BLK *);
-extern int LIB$I64_GET_PREV_INVO_CONTEXT(INVO_CONTEXT_BLK *);
-
-/* Gcc internal headers poison malloc.  So use xmalloc() when building the
-   compiler.  */
-#ifdef IN_RTS
-#define BT_MALLOC malloc
-#else
-#define BT_MALLOC xmalloc
-#endif
-
-int
-__gnat_backtrace (void **array, int size,
-                  void *exclude_min, void *exclude_max, int skip_frames)
-{
-  INVO_CONTEXT_BLK *ctxt;
-  int res = 0;
-  int n = 0;
-
-  /* Create the context.  */
-  ctxt = LIB$I64_CREATE_INVO_CONTEXT (BT_MALLOC, free, 0);
-  if (ctxt == NULL)
-    return 0;
-
-  LIB$I64_GET_CURR_INVO_CONTEXT (ctxt);
-
-  while (1)
-    {
-      void *pc = (void *)ctxt->libicb$ih_pc;
-      if (pc == (void *)0)
-	break;
-      if (ctxt->libicb$v_bottom_of_stack)
-	break;
-      if (n >= skip_frames && (pc < exclude_min || pc > exclude_max))
-	{
-	  array[res++] = (void *)(ctxt->libicb$ih_pc);
-	  if (res == size)
-	    break;
-	}
-      n++;
-      LIB$I64_GET_PREV_INVO_CONTEXT (ctxt);
-    }
-
-  /* Free the context.  */
-  LIB$I64_FREE_INVO_CONTEXT (ctxt);
-  return res;
-}

gcc/ada/tracebak.c

@@ -6,7 +6,7 @@
  *                                                                          *
  *                          C Implementation File                           *
  *                                                                          *
- *            Copyright (C) 2000-2012, Free Software Foundation, Inc.       *
+ *            Copyright (C) 2000-2014, 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- *
@@ -95,19 +95,7 @@ extern void (*Unlock_Task) (void);
  *-- Target specific implementations --*
  *-------------------------------------*/
 
-#if defined (__alpha_vxworks)
-
-#include "tb-alvxw.c"
-
-#elif defined (__ALPHA) && defined (__VMS__)
-
-#include "tb-alvms.c"
-
-#elif defined (__ia64__) && defined (__VMS__)
-
-#include "tb-ivms.c"
-
-#elif defined (_WIN64) && defined (__SEH__)
+#if defined (_WIN64) && defined (__SEH__)
 
 #include <windows.h>