[Ada] Use actual types instead of formal types consistently in debug info

[Pierre-Marie de Rodat via Gcc-patches]

This makes sure that the objects present in instantiations always have the
actual type instead of a local variant of the formal type in the debugging
information generated by the compiler (this was already the case when the
actual type is a record, a protected or a task type).

Tested on x86_64-pc-linux-gnu, committed on trunk

gcc/ada/

* gcc-interface/decl.cc (Gigi_Cloned_Subtype): New function.
(gnat_to_gnu_entity) : Call it to get the
cloned subtype, if any.
: Likewise.
: Likewise.
: Likewise.
: Likewise.
Deal with all cloned subtypes on the main path.diff --git a/gcc/ada/gcc-interface/decl.cc b/gcc/ada/gcc-interface/decl.cc
--- a/gcc/ada/gcc-interface/decl.cc
+++ b/gcc/ada/gcc-interface/decl.cc
@@ -212,6 +212,7 @@ static tree gnat_to_gnu_subprog_type (Entity_Id, bool, bool, tree *);
 static int adjust_packed (tree, tree, int);
 static tree gnat_to_gnu_field (Entity_Id, tree, int, bool, bool);
 static enum inline_status_t inline_status_for_subprog (Entity_Id);
+static Entity_Id Gigi_Cloned_Subtype (Entity_Id);
 static tree gnu_ext_name_for_subprog (Entity_Id, tree);
 static void set_nonaliased_component_on_array_type (tree);
 static void set_reverse_storage_order_on_array_type (tree);
@@ -301,8 +302,8 @@ gnat_to_gnu_entity (Entity_Id gnat_entity, tree gnu_expr, bool definition)
   const bool foreign = Has_Foreign_Convention (gnat_entity);
   /* For a type, contains the equivalent GNAT node to be used in gigi.  */
   Entity_Id gnat_equiv_type = Empty;
-  /* For a type, contains the GNAT node to be used for back-annotation.  */
-  Entity_Id gnat_annotate_type = Empty;
+  /* For a subtype, contains the GNAT node to be used  as cloned subtype.  */
+  Entity_Id gnat_cloned_subtype = Empty;
   /* Temporary used to walk the GNAT tree.  */
   Entity_Id gnat_temp;
   /* Contains the GCC DECL node which is equivalent to the input GNAT node.
@@ -1807,6 +1808,9 @@ gnat_to_gnu_entity (Entity_Id gnat_entity, tree gnu_expr, bool definition)
 case E_Modular_Integer_Subtype:
 case E_Ordinary_Fixed_Point_Subtype:
 case E_Decimal_Fixed_Point_Subtype:
+  gnat_cloned_subtype = Gigi_Cloned_Subtype (gnat_entity);
+  if (Present (gnat_cloned_subtype))
+	break;
 
   /* For integral subtypes, we make a new INTEGER_TYPE.  Note that we do
 	 not want to call create_range_type since we would like each subtype
@@ -2035,6 +2039,10 @@ gnat_to_gnu_entity (Entity_Id gnat_entity, tree gnu_expr, bool definition)
   break;
 
 case E_Floating_Point_Subtype:
+  gnat_cloned_subtype = Gigi_Cloned_Subtype (gnat_entity);
+  if (Present (gnat_cloned_subtype))
+	break;
+
   /* See the E_Signed_Integer_Subtype case for the rationale.  */
   if (!definition
 	  && Present (Ancestor_Subtype (gnat_entity))
@@ -2446,6 +2454,9 @@ gnat_to_gnu_entity (Entity_Id gnat_entity, tree gnu_expr, bool definition)
   break;
 
 case E_Array_Subtype:
+  gnat_cloned_subtype = Gigi_Cloned_Subtype (gnat_entity);
+  if (Present (gnat_cloned_subtype))
+	break;
 
   /* This is the actual data type for array variables.  Multidimensional
 	 arrays are implemented as arrays of arrays.  Note that arrays which
@@ -3443,18 +3454,9 @@ gnat_to_gnu_entity (Entity_Id gnat_entity, tree gnu_expr, bool definition)
   /* ... fall through ... */
 
 case E_Record_Subtype:
-  /* If Cloned_Subtype is Present it means this record subtype has
-	 identical layout to that type or subtype and we should use
-	 that GCC type for this one.  The front-end guarantees that
-	 the component list is shared.  */
-  if (Present (Cloned_Subtype (gnat_entity)))
-	{
-	  gnu_decl = gnat_to_gnu_entity (Cloned_Subtype (gnat_entity),
-	 NULL_TREE, false);
-	  gnat_annotate_type = Cloned_Subtype (gnat_entity);
-	  maybe_present = true;
-	  break;
-	}
+  gnat_cloned_subtype = Gigi_Cloned_Subtype (gnat_entity);
+  if (Present (gnat_cloned_subtype))
+	break;
 
   /* Otherwise, first ensure the base type is elaborated.  Then, if we are
 	 changing the type, make a new type with each field having the type of
@@ -3865,6 +3867,10 @@ gnat_to_gnu_entity (Entity_Id gnat_entity, tree gnu_expr, bool definition)
   break;
 
 case E_Access_Subtype:
+  gnat_cloned_subtype = Gigi_Cloned_Subtype (gnat_entity);
+  if (Present (gnat_cloned_subtype))
+	break;
+
   /* We treat this as identical to its base type; any constraint is
 	 meaningful only to the front-end.  */
   gnu_type = gnat_to_gnu_type (gnat_equiv_type);
@@ -4277,6 +4283,27 @@ gnat_to_gnu_entity (Entity_Id gnat_entity, tree gnu_expr, bool definition)
   gcc_unreachable ();
 }
 
+  /* If this is the clone of a subtype, just reuse the cloned subtype; another
+ approach would be to set the cloned subtype as the DECL_ORIGINAL_TYPE of
+ the entity, which would generate a DW_TAG_typedef in the debug info, but
+ at the cost of the duplication of the GCC type and, more a

[Ada] Fix internal error on instance of Ada.Task_Attributes at -O

[Pierre-Marie de Rodat via Gcc-patches]

This happens when there is a size mismatch, but this must be accepted.

Tested on x86_64-pc-linux-gnu, committed on trunk

gcc/ada/

* gcc-interface/utils.cc (unchecked_convert): Also pad in most cases
if the source is not a scalar type but the destination is.diff --git a/gcc/ada/gcc-interface/utils.cc b/gcc/ada/gcc-interface/utils.cc
--- a/gcc/ada/gcc-interface/utils.cc
+++ b/gcc/ada/gcc-interface/utils.cc
@@ -5503,8 +5503,8 @@ unchecked_convert (tree type, tree expr, bool notrunc_p)
   expr = unchecked_convert (type, expr, notrunc_p);
 }
 
-  /* If we are converting from a scalar type to a type with a different size,
- we need to pad to have the same size on both sides.
+  /* If we are converting between fixed-size types with different sizes, we
+ need to pad to have the same size on both sides.
 
  ??? We cannot do it unconditionally because unchecked conversions are
  used liberally by the front-end to implement interface thunks:
@@ -5515,8 +5515,10 @@ unchecked_convert (tree type, tree expr, bool notrunc_p)
 
  so we need to skip dereferences.  */
   else if (!INDIRECT_REF_P (expr)
-	   && !AGGREGATE_TYPE_P (etype)
+	   && TREE_CODE (expr) != STRING_CST
+	   && !(AGGREGATE_TYPE_P (etype) && AGGREGATE_TYPE_P (type))
 	   && ecode != UNCONSTRAINED_ARRAY_TYPE
+	   && TREE_CONSTANT (TYPE_SIZE (etype))
 	   && TREE_CONSTANT (TYPE_SIZE (type))
 	   && (c = tree_int_cst_compare (TYPE_SIZE (etype), TYPE_SIZE (type
 {
@@ -5532,15 +5534,18 @@ unchecked_convert (tree type, tree expr, bool notrunc_p)
 	  tree rec_type = maybe_pad_type (type, TYPE_SIZE (etype), 0, Empty,
 	  false, false, true);
 	  expr = unchecked_convert (rec_type, expr, notrunc_p);
-	  expr = build_component_ref (expr, TYPE_FIELDS (rec_type), false);
+	  expr = build3 (COMPONENT_REF, type, expr, TYPE_FIELDS (rec_type),
+			 NULL_TREE);
 	}
 }
 
-  /* Likewise if we are converting from a scalar type to a type with self-
+  /* Likewise if we are converting from a fixed-szie type to a type with self-
  referential size.  We use the max size to do the padding in this case.  */
   else if (!INDIRECT_REF_P (expr)
-	   && !AGGREGATE_TYPE_P (etype)
+	   && TREE_CODE (expr) != STRING_CST
+	   && !(AGGREGATE_TYPE_P (etype) && AGGREGATE_TYPE_P (type))
 	   && ecode != UNCONSTRAINED_ARRAY_TYPE
+	   && TREE_CONSTANT (TYPE_SIZE (etype))
 	   && CONTAINS_PLACEHOLDER_P (TYPE_SIZE (type)))
 {
   tree new_size = max_size (TYPE_SIZE (type), true);
@@ -5557,7 +5562,8 @@ unchecked_convert (tree type, tree expr, bool notrunc_p)
 	  tree rec_type = maybe_pad_type (type, TYPE_SIZE (etype), 0, Empty,
 	  false, false, true);
 	  expr = unchecked_convert (rec_type, expr, notrunc_p);
-	  expr = build_component_ref (expr, TYPE_FIELDS (rec_type), false);
+	  expr = build3 (COMPONENT_REF, type, expr, TYPE_FIELDS (rec_type),
+			 NULL_TREE);
 	}
 }
 

[Ada] Handle bodies-to-inline just like generic templates

[Pierre-Marie de Rodat via Gcc-patches]

Originally bodies-to-inline created for the frontend inlining were
analyzed with expansion disabled. Then, to facilitate inlining in
GNATprove mode, the analysis was changed to preanalysis.

However, preanalysis in this context works badly for calls in prefix
notation, because preanalysis assigns entities and types to nodes but
doesn't convert calls from prefix to ordinary notation. When the
body-to-inline is actually inlined, the (re)analysis of calls in prefix
notation fails.

The proper solution is rather to handle bodies-to-inline just like
generic templates.

>From the user point of view, this patch fixes spurious errors both in
GNATprove (which uses frontend inlining by default) and in GNAT (where
frontend inlining is typically explicitly requested with -gnatN and
pragma Inline_Always).

Tested on x86_64-pc-linux-gnu, committed on trunk

gcc/ada/

* inline.adb (Build_Body_To_Inline): Instead of manipulating the
Full_Analysis flag, use the Inside_A_Generic flag (which is
conveniently manipulated by Start_Generic/End_Generic, together
with Expander_Active).
* sem_attr.adb (Analyze_Attribute_Old_Result): Adapt comment and
assertion to different flag that is set while building
body-to-inline.diff --git a/gcc/ada/inline.adb b/gcc/ada/inline.adb
--- a/gcc/ada/inline.adb
+++ b/gcc/ada/inline.adb
@@ -32,7 +32,6 @@ with Einfo.Entities; use Einfo.Entities;
 with Einfo.Utils;use Einfo.Utils;
 with Elists; use Elists;
 with Errout; use Errout;
-with Expander;   use Expander;
 with Exp_Ch6;use Exp_Ch6;
 with Exp_Ch7;use Exp_Ch7;
 with Exp_Tss;use Exp_Tss;
@@ -1107,7 +1106,6 @@ package body Inline is
 
procedure Build_Body_To_Inline (N : Node_Id; Spec_Id : Entity_Id) is
   Decl: constant Node_Id := Unit_Declaration_Node (Spec_Id);
-  Analysis_Status : constant Boolean := Full_Analysis;
   Original_Body   : Node_Id;
   Body_To_Analyze : Node_Id;
   Max_Size: constant := 10;
@@ -1419,12 +1417,7 @@ package body Inline is
  Append (Body_To_Analyze, Declarations (N));
   end if;
 
-  --  The body to inline is preanalyzed. In GNATprove mode we must disable
-  --  full analysis as well so that light expansion does not take place
-  --  either, and name resolution is unaffected.
-
-  Expander_Mode_Save_And_Set (False);
-  Full_Analysis := False;
+  Start_Generic;
 
   Analyze (Body_To_Analyze);
   Push_Scope (Defining_Entity (Body_To_Analyze));
@@ -1432,8 +1425,7 @@ package body Inline is
   End_Scope;
   Remove (Body_To_Analyze);
 
-  Expander_Mode_Restore;
-  Full_Analysis := Analysis_Status;
+  End_Generic;
 
   --  Restore environment if previously saved
 


diff --git a/gcc/ada/sem_attr.adb b/gcc/ada/sem_attr.adb
--- a/gcc/ada/sem_attr.adb
+++ b/gcc/ada/sem_attr.adb
@@ -1508,9 +1508,9 @@ package body Sem_Attr is
and then Chars (Spec_Id) = Name_uParent
and then Chars (Scope (Spec_Id)) = Name_uPostconditions
  then
---  This situation occurs only when preanalyzing the inlined body
+--  This situation occurs only when analyzing the body-to-inline
 
-pragma Assert (not Full_Analysis);
+pragma Assert (Inside_A_Generic);
 
 Spec_Id := Scope (Spec_Id);
 pragma Assert (Is_Inlined (Spec_Id));

[Ada] Extend No_Dependence restriction to code generation

[Pierre-Marie de Rodat via Gcc-patches]

This reports violations for 4 units from gigi.

Tested on x86_64-pc-linux-gnu, committed on trunk

gcc/ada/

* gcc-interface/trans.cc (gigi): Report a violation of No_Dependence
on System.Stack_Checking if Stack_Check_Probes_On_Target is not set
and -fstack-check is specified.
(build_binary_op_trapv): Report violatiosn of No_Dependence on both
System.Arith_64 and System.Arith_128.
(add_decl_expr): If an initialized variable, report a violation of
No_Dependence on System.Memory_Copy for large aggregate types.
(gnat_to_gnu) : Report a violation
of No_Dependence on System.Memory_Compare for large aggregate types.
! Report a violation of No_Dependence on
System.Memory_Set, System.Memory_Move or else System.Memory_Copy for
large aggregate types.
* gcc-interface/utils2.cc (maybe_wrap_malloc): Report a violation of
No_Dependence on System.Memory.
(maybe_wrap_free): Add GNAT_NODE parameter and report a violation of
No_Dependence on System.Memory.
(build_call_alloc_dealloc): Adjust call to maybe_wrap_free.diff --git a/gcc/ada/gcc-interface/trans.cc b/gcc/ada/gcc-interface/trans.cc
--- a/gcc/ada/gcc-interface/trans.cc
+++ b/gcc/ada/gcc-interface/trans.cc
@@ -364,7 +364,12 @@ gigi (Node_Id gnat_root,
 
   /* Enable GNAT stack checking method if needed */
   if (!Stack_Check_Probes_On_Target)
-set_stack_check_libfunc ("__gnat_stack_check");
+{
+  set_stack_check_libfunc ("__gnat_stack_check");
+  if (flag_stack_check != NO_STACK_CHECK)
+	Check_Restriction_No_Dependence_On_System (Name_Stack_Checking,
+		   gnat_root);
+}
 
   /* Retrieve alignment settings.  */
   double_float_alignment = get_target_double_float_alignment ();
@@ -6933,9 +6938,18 @@ gnat_to_gnu (Node_Id gnat_node)
 	  = convert (TREE_TYPE (gnu_rhs), TYPE_SIZE (gnu_type));
 	  }
 
+	/* If this is a comparison between (potentially) large aggregates, then
+	   declare the dependence on the memcmp routine.  */
+	else if ((kind == N_Op_Eq || kind == N_Op_Ne)
+		 && AGGREGATE_TYPE_P (TREE_TYPE (gnu_lhs))
+		 && (!TREE_CONSTANT (TYPE_SIZE (TREE_TYPE (gnu_lhs)))
+		 || compare_tree_int (TYPE_SIZE (TREE_TYPE (gnu_lhs)),
+	  2 * BITS_PER_WORD) > 0))
+	  Check_Restriction_No_Dependence_On_System (Name_Memory_Compare,
+		 gnat_node);
+
 	/* Pending generic support for efficient vector logical operations in
-	   GCC, convert vectors to their representative array type view and
-	   fallthrough.  */
+	   GCC, convert vectors to their representative array type view.  */
 	gnu_lhs = maybe_vector_array (gnu_lhs);
 	gnu_rhs = maybe_vector_array (gnu_rhs);
 
@@ -7254,6 +7268,8 @@ gnat_to_gnu (Node_Id gnat_node)
 		  value = int_const_binop (BIT_AND_EXPR, value, mask);
 		}
 	  gnu_result = build_call_expr (t, 3, dest, value, size);
+	  Check_Restriction_No_Dependence_On_System (Name_Memory_Set,
+			 gnat_node);
 	}
 
 	  /* Otherwise build a regular assignment.  */
@@ -7278,7 +7294,18 @@ gnat_to_gnu (Node_Id gnat_node)
 	  tree from_ptr = build_fold_addr_expr (from);
 	  tree t = builtin_decl_explicit (BUILT_IN_MEMMOVE);
 	  gnu_result = build_call_expr (t, 3, to_ptr, from_ptr, size);
+	  Check_Restriction_No_Dependence_On_System (Name_Memory_Move,
+			 gnat_node);
 	   }
+
+	  /* If this is an assignment between (potentially) large aggregates,
+	 then declare the dependence on the memcpy routine.  */
+	  else if (AGGREGATE_TYPE_P (TREE_TYPE (gnu_lhs))
+		   && (!TREE_CONSTANT (TYPE_SIZE (TREE_TYPE (gnu_lhs)))
+		   || compare_tree_int (TYPE_SIZE (TREE_TYPE (gnu_lhs)),
+	2 * BITS_PER_WORD) > 0))
+	Check_Restriction_No_Dependence_On_System (Name_Memory_Copy,
+		   gnat_node);
 	}
   break;
 
@@ -8437,27 +8464,37 @@ add_decl_expr (tree gnu_decl, Node_Id gnat_node)
   && !TYPE_FAT_POINTER_P (type))
 MARK_VISITED (TYPE_ADA_SIZE (type));
 
-  /* If this is a variable and an initializer is attached to it, it must be
- valid for the context.  Similar to init_const in create_var_decl.  */
-  if (TREE_CODE (gnu_decl) == VAR_DECL
-  && (gnu_init = DECL_INITIAL (gnu_decl))
-  && (!gnat_types_compatible_p (type, TREE_TYPE (gnu_init))
+  if (TREE_CODE (gnu_decl) == VAR_DECL && (gnu_init = DECL_INITIAL (gnu_decl)))
+{
+  /* If this is a variable and an initializer is attached to it, it must be
+	 valid for the context.  Similar to init_const in create_var_decl.  */
+  if (!gnat_types_compatible_p (type, TREE_TYPE (gnu_init))
 	  || (TREE_STATIC (gnu_decl)
 	  && !initializer_constant_valid_p (gnu_init,
-		TREE_TYPE (gnu_init)
-{
-  DECL_INITIAL (gnu_decl) = NULL_TREE;
-  if (TREE_READONLY (gnu_decl))
+		TREE_TYPE (gnu_init
 	{
-	  TREE_READONLY (gnu_decl) = 0;
-	  DECL_READONLY_ONCE_ELAB (gnu_decl) = 1;
-	}
+	  DECL_INITIAL (gnu_decl) = NULL_TREE;
+	  if (TREE_READONLY (gnu_decl)

[Ada] Fix internal error on comparison with access function parameter

[Pierre-Marie de Rodat via Gcc-patches]

It comes from an overzealous assertion.

Tested on x86_64-pc-linux-gnu, committed on trunk

gcc/ada/

* gcc-interface/utils2.cc (build_binary_op) : Also accept
pointer-to-function types that are not variant of each other.diff --git a/gcc/ada/gcc-interface/utils2.cc b/gcc/ada/gcc-interface/utils2.cc
--- a/gcc/ada/gcc-interface/utils2.cc
+++ b/gcc/ada/gcc-interface/utils2.cc
@@ -1134,12 +1134,17 @@ build_binary_op (enum tree_code op_code, tree result_type,
 	  else if (POINTER_TYPE_P (left_base_type)
 		   && POINTER_TYPE_P (right_base_type))
 	{
+	  tree left_ref_type = TREE_TYPE (left_base_type);
+	  tree right_ref_type = TREE_TYPE (right_base_type);
+
 	  /* Anonymous access types in Ada 2005 can point to different
-		 members of a tagged type hierarchy.  */
-	  gcc_assert (TYPE_MAIN_VARIANT (TREE_TYPE (left_base_type))
-			  == TYPE_MAIN_VARIANT (TREE_TYPE (right_base_type))
-			  || (TYPE_ALIGN_OK (TREE_TYPE (left_base_type))
-			  && TYPE_ALIGN_OK (TREE_TYPE (right_base_type;
+		 members of a tagged hierarchy or different function types.  */
+	  gcc_assert (TYPE_MAIN_VARIANT (left_ref_type)
+			  == TYPE_MAIN_VARIANT (right_ref_type)
+			  || (TYPE_ALIGN_OK (left_ref_type)
+			  && TYPE_ALIGN_OK (right_ref_type))
+			  || (TREE_CODE (left_ref_type) == FUNCTION_TYPE
+			  && TREE_CODE (right_ref_type) == FUNCTION_TYPE));
 	  best_type = left_base_type;
 	}
 

[Ada] Fix wrong access check with access-to-unconstrained-array

[Pierre-Marie de Rodat via Gcc-patches]

The current implementation may create dangling references from a superset
of the alias set of the dummy pointer-to-array type when it exists.

Tested on x86_64-pc-linux-gnu, committed on trunk

gcc/ada/

* gcc-interface/decl.cc (gnat_to_gnu_entity) : Save
and restore the alias set of the dummy pointer-to-array type.diff --git a/gcc/ada/gcc-interface/decl.cc b/gcc/ada/gcc-interface/decl.cc
--- a/gcc/ada/gcc-interface/decl.cc
+++ b/gcc/ada/gcc-interface/decl.cc
@@ -2102,15 +2102,15 @@ gnat_to_gnu_entity (Entity_Id gnat_entity, tree gnu_expr, bool definition)
 	const bool convention_fortran_p
 	  = (Convention (gnat_entity) == Convention_Fortran);
 	const int ndim = Number_Dimensions (gnat_entity);
-	tree gnu_template_type;
-	tree gnu_ptr_template;
-	tree gnu_template_reference, gnu_template_fields, gnu_fat_type;
+	tree gnu_fat_type, gnu_template_type, gnu_ptr_template;
+	tree gnu_template_reference, gnu_template_fields;
 	tree *gnu_index_types = XALLOCAVEC (tree, ndim);
 	tree *gnu_temp_fields = XALLOCAVEC (tree, ndim);
-	tree gnu_max_size = size_one_node, tem, obj;
+	tree gnu_max_size = size_one_node;
+	tree comp_type, tem, obj;
 	Entity_Id gnat_index;
+	alias_set_type ptr_set = -1;
 	int index;
-	tree comp_type;
 
 	/* Create the type for the component now, as it simplifies breaking
 	   type reference loops.  */
@@ -2181,6 +2181,8 @@ gnat_to_gnu_entity (Entity_Id gnat_entity, tree gnu_expr, bool definition)
 	if (COMPLETE_TYPE_P (gnu_fat_type))
 	  {
 	tem = TYPE_FIELDS (gnu_fat_type);
+	if (TYPE_ALIAS_SET_KNOWN_P (TREE_TYPE (tem)))
+	  ptr_set = TYPE_ALIAS_SET (TREE_TYPE (tem));
 	TREE_TYPE (tem) = ptr_type_node;
 	TREE_TYPE (DECL_CHAIN (tem)) = gnu_ptr_template;
 	TYPE_DECL_SUPPRESS_DEBUG (TYPE_STUB_DECL (gnu_fat_type)) = 0;
@@ -2389,7 +2391,10 @@ gnat_to_gnu_entity (Entity_Id gnat_entity, tree gnu_expr, bool definition)
 	  tem = change_qualified_type (tem, TYPE_QUAL_VOLATILE);
 
 	/* Adjust the type of the pointer-to-array field of the fat pointer
-	   and record the aliasing relationships if necessary.  If this is
+	   and preserve its existing alias set, if any.  Note that calling
+	   again record_component_aliases on the fat pointer is not enough
+	   because this may leave dangling references to the existing alias
+	   set from types containing a fat pointer component.  If this is
 	   a packed type implemented specially, then use a ref-all pointer
 	   type since the implementation type may vary between constrained
 	   subtypes and unconstrained base type.  */
@@ -2398,8 +2403,8 @@ gnat_to_gnu_entity (Entity_Id gnat_entity, tree gnu_expr, bool definition)
 	= build_pointer_type_for_mode (tem, ptr_mode, true);
 	else
 	  TREE_TYPE (TYPE_FIELDS (gnu_fat_type)) = build_pointer_type (tem);
-	if (TYPE_ALIAS_SET_KNOWN_P (gnu_fat_type))
-	  record_component_aliases (gnu_fat_type);
+	if (ptr_set != -1)
+	  TYPE_ALIAS_SET (TREE_TYPE (TYPE_FIELDS (gnu_fat_type))) = ptr_set;
 
 	/* If the maximum size doesn't overflow, use it.  */
 	if (gnu_max_size

[Ada] Generate debug info entry for user-defined access subtype

[Pierre-Marie de Rodat via Gcc-patches]

This is consistent with the other kinds of subtypes.

Tested on x86_64-pc-linux-gnu, committed on trunk

gcc/ada/

* gcc-interface/decl.cc (gnat_to_gnu_entity) : Do
not reuse the TYPE_DECL of the base type.diff --git a/gcc/ada/gcc-interface/decl.cc b/gcc/ada/gcc-interface/decl.cc
--- a/gcc/ada/gcc-interface/decl.cc
+++ b/gcc/ada/gcc-interface/decl.cc
@@ -3867,7 +3867,7 @@ gnat_to_gnu_entity (Entity_Id gnat_entity, tree gnu_expr, bool definition)
 case E_Access_Subtype:
   /* We treat this as identical to its base type; any constraint is
 	 meaningful only to the front-end.  */
-  gnu_decl = gnat_to_gnu_entity (gnat_equiv_type, NULL_TREE, false);
+  gnu_type = gnat_to_gnu_type (gnat_equiv_type);
   maybe_present = true;
 
   /* The designated subtype must be elaborated as well, if it does
@@ -3877,11 +3877,10 @@ gnat_to_gnu_entity (Entity_Id gnat_entity, tree gnu_expr, bool definition)
 	  && Is_Frozen (Directly_Designated_Type (gnat_entity))
 	  && No (Freeze_Node (Directly_Designated_Type (gnat_entity
 	{
-	  tree gnu_base_type = TREE_TYPE (gnu_decl);
-	  tree gnu_desig_base_type
-	= TYPE_IS_FAT_POINTER_P (gnu_base_type)
-	  ? TREE_TYPE (TREE_TYPE (TYPE_FIELDS (gnu_base_type)))
-	  : TREE_TYPE (gnu_base_type);
+	  tree gnu_desig_type
+	= TYPE_IS_FAT_POINTER_P (gnu_type)
+	  ? TREE_TYPE (TREE_TYPE (TYPE_FIELDS (gnu_type)))
+	  : TREE_TYPE (gnu_type);
 
 	  /* If we are to defer elaborating incomplete types, make a dummy
 	 type node and elaborate it later.  */
@@ -3898,7 +3897,7 @@ gnat_to_gnu_entity (Entity_Id gnat_entity, tree gnu_expr, bool definition)
 
 	  /* Otherwise elaborate the designated subtype only if its base type
 	 has already been elaborated.  */
-	  else if (!TYPE_IS_DUMMY_P (gnu_desig_base_type))
+	  else if (!TYPE_IS_DUMMY_P (gnu_desig_type))
 	gnat_to_gnu_entity (Directly_Designated_Type (gnat_entity),
 NULL_TREE, false);
 	}

[Ada] Revert recent change in debug info for vector array types

[Pierre-Marie de Rodat via Gcc-patches]

It lost too much useful information.

Tested on x86_64-pc-linux-gnu, committed on trunk

gcc/ada/

* gcc-interface/decl.cc (gnat_to_gnu_entity): Do not set the debug
type for vector types.diff --git a/gcc/ada/gcc-interface/decl.cc b/gcc/ada/gcc-interface/decl.cc
--- a/gcc/ada/gcc-interface/decl.cc
+++ b/gcc/ada/gcc-interface/decl.cc
@@ -4785,14 +4785,6 @@ gnat_to_gnu_entity (Entity_Id gnat_entity, tree gnu_expr, bool definition)
   else
 	gnu_decl = create_type_decl (gnu_entity_name, gnu_type, artificial_p,
  debug_info_p, gnat_entity);
-
-  /* For vector types, make the representative array the debug type.  */
-  if (VECTOR_TYPE_P (gnu_type))
-	{
-	  tree rep = TYPE_REPRESENTATIVE_ARRAY (gnu_type);
-	  TYPE_NAME (rep) = DECL_NAME (gnu_decl);
-	  SET_TYPE_DEBUG_TYPE (gnu_type, rep);
-	}
 }
 
   /* If we haven't already, associate the ..._DECL node that we just made with

[Ada] Fix for visibility of aspect expressions inside generic units

[Pierre-Marie de Rodat via Gcc-patches]

When a generic unit contains references to global entities (i.e.
entities declared outside of this generic unit), those references are
saved: from the analyzed copy of a generic unit (which is then
discarded) into a generic template (which is then instantiated, possibly
many times). To save those references we maintain an association from
nodes in the generic template to nodes in the analyzed copy. However,
this association breaks when analysis of the generic copy calls
Relocate_Node, which conceptually only moves the node, while in fact it
creates a copy with a new Node_Id.

In particular, this association was broken by calls to Relocate_Node
that happen when transforming various aspects into corresponding pragmas
or attribute definition clases. For the most common Pre and Post aspects
this was fixed years ago by not using Relocate_Node and simply sharing
the tree.  This patch extends this fix to other aspects, in particular
those that allow non-static expressions.

Tested on x86_64-pc-linux-gnu, committed on trunk

gcc/ada/

* sem_ch13.adb (Relocate_Expression): New routine with code that
previously was only applied to Pre and Post aspects.
(Analyze_Aspect_Specifications): Apply the above routine to
other aspects, in particular to aspects Address, Attach_Handler,
Predicate and Interrupt_Priority.diff --git a/gcc/ada/sem_ch13.adb b/gcc/ada/sem_ch13.adb
--- a/gcc/ada/sem_ch13.adb
+++ b/gcc/ada/sem_ch13.adb
@@ -1650,6 +1650,18 @@ package body Sem_Ch13 is
   --  pragma of the same kind. Flag Is_Generic should be set when the
   --  context denotes a generic instance.
 
+  function Relocate_Expression (Source : Node_Id) return Node_Id;
+  --  Outside of a generic this function is equivalent to Relocate_Node.
+  --  Inside a generic it is an identity function, because Relocate_Node
+  --  would create a new node that is not associated with the generic
+  --  template. This association is needed to save references to entities
+  --  that are global to the generic (and might be not visible from where
+  --  the generic is instantiated).
+  --
+  --  Inside a generic the original tree is shared between aspect and
+  --  a corresponding pragma (or an attribute definition clause). This
+  --  parallels what is done in sem_prag.adb (see Get_Argument).
+
   --
   -- Decorate --
   --
@@ -1835,6 +1847,19 @@ package body Sem_Ch13 is
  end if;
   end Insert_Pragma;
 
+  -
+  -- Relocate_Expression --
+  -
+
+  function Relocate_Expression (Source : Node_Id) return Node_Id is
+  begin
+ if Inside_A_Generic then
+return Source;
+ else
+return Atree.Relocate_Node (Source);
+ end if;
+  end Relocate_Expression;
+
   --  Local variables
 
   Aspect : Node_Id;
@@ -3229,7 +3254,7 @@ package body Sem_Ch13 is
 Make_Attribute_Definition_Clause (Loc,
   Name   => Ent,
   Chars  => Nam,
-  Expression => Relocate_Node (Expr));
+  Expression => Relocate_Expression (Expr));
 
   --  If the address is specified, then we treat the entity as
   --  referenced, to avoid spurious warnings. This is analogous
@@ -3293,7 +3318,7 @@ package body Sem_Ch13 is
Make_Pragma_Argument_Association (Sloc (Ent),
  Expression => Ent),
Make_Pragma_Argument_Association (Sloc (Expr),
- Expression => Relocate_Node (Expr))),
+ Expression => Relocate_Expression (Expr))),
  Pragma_Name  => Name_Attach_Handler);
 
   --  We need to insert this pragma into the tree to get proper
@@ -3335,7 +3360,7 @@ package body Sem_Ch13 is
Make_Pragma_Argument_Association (Sloc (Ent),
  Expression => Ent),
Make_Pragma_Argument_Association (Sloc (Expr),
- Expression => Relocate_Node (Expr))),
+ Expression => Relocate_Expression (Expr))),
  Pragma_Name => Name_Predicate);
 
   --  Mark type has predicates, and remember what kind of
@@ -3580,7 +3605,7 @@ package body Sem_Ch13 is
Make_Attribute_Definition_Clause (Loc,
  Name   => Ent,
  Chars  => Nam,
- Expression => Relocate_Node (Expr));
+ Expression => Relocate_Expression (Expr));
   end if;
 
--  Suppress/Unsuppress
@@ -4599,32 +4624,12 @@ package body Sem_Ch13 is
 
   --  Build the precondition/postcondition pragma
 
-  

[Ada] Fix incorrect handling of Ghost aspect

[Pierre-Marie de Rodat via Gcc-patches]

When a formal generic type is marked as Ghost, the instantiation of that
generic will contain a generic subtype for the actual with the Ghost
pragma. Recognize this case.

Tested on x86_64-pc-linux-gnu, committed on trunk

gcc/ada/

* sem_prag.adb (Analyze_Pragma): Recognize a generated subtype
with Ghost pragma for generic instantiations.diff --git a/gcc/ada/sem_prag.adb b/gcc/ada/sem_prag.adb
--- a/gcc/ada/sem_prag.adb
+++ b/gcc/ada/sem_prag.adb
@@ -16999,6 +16999,16 @@ package body Sem_Prag is
   then
  Id := Defining_Entity (Stmt);
  exit;
+
+  --  When pragma Ghost applies to a generic formal type, the
+  --  type declaration in the instantiation is a generated
+  --  subtype declaration.
+
+  elsif Nkind (Stmt) = N_Subtype_Declaration
+and then Present (Generic_Parent_Type (Stmt))
+  then
+ Id := Defining_Entity (Stmt);
+ exit;
   end if;
 
--  The pragma applies to a legal construct, stop the traversal

[Ada] Add support for defaulted Storage_Model_Type aspect and subaspects

[Pierre-Marie de Rodat via Gcc-patches]

The compiler currently rejects a Storage_Model_Type aspect that is not
specified with an aggregate, or that has an aggregate that does not
specify all defined "subaspects" (Address_Type, Null_Address, Allocate,
etc.). The RFC for this feature defines the aspect to fully default to
the native memory model when no aggregate is given, and also allows any
subaspects to be specified and others to default in the case where the
address type is the native address type (System.Address), whether that
address type is explicitly specified or defaulted. This set of changes
now supports that defaulting semantics. Note that the subaspect
retrieval functions in Sem_Util.Storage_Model_Support (which are called
by the compiler back ends) will now return Empty for any subprogram
subaspects (Allocate, Deallocate, etc.) that are defaulted in the aspect
(that is, in the native model case where the address type is
System.Address).  Also in the native case, retrieval of defaulted
subaspects Address_Type and Null_Address will return the entities for
System.Address and System.Null_Address, respectively. Additionally,
error checks for multiple associations given for the same subaspect are
now done.

Tested on x86_64-pc-linux-gnu, committed on trunk

gcc/ada/

* aspects.ads (Aspect_Argument): Change the association for
Aspect_Storage_Model_Type from Expression to
Optional_Expression.
* exp_util.ads (Find_Storage_Op): Update comment to indicate
that Empty can be returned in the case where a storage-model
operation is defaulted.
* exp_util.adb (Find_Storage_Op): Allow the function to return
Empty in Storage_Model_Type case rather than raising
Program_Error, so that Procedure_To_Call fields in N_Allocator
and N_Free_Statement nodes will be set to Empty in the defaulted
native storage-model case.
* sem_ch13.adb: Add with and use of System.Case_Util (and
reformat context_clause).
(Check_Aspect_At_Freeze_Point): Return with no action for a
Storage_Model_Type aspect with no expression (fully-defaulted
native memory-model case).
(Resolve_Storage_Model_Type_Argument): If an Address_Type has
not been explicitly specified, then set Addr_Type to denote type
System.Address.
(Validate_Storage_Model_Type_Aspect): Return immediately in the
case where the aspect has no Expression (fully-defaulted native
memory-model case).  No longer issue an error when Address_Type
isn't specified, and instead use type System.Address as the
default address type. When the address type is
System.Address (whether specified or defaulted), no longer issue
errors for any other "subaspects" that aren't specified, since
in that case those are allowed to default as well. Remove ???
comment about needing to check for duplicates, which is now
addressed.
(Check_And_Resolve_Storage_Model_Type_Argument): New procedure
to check that an association for a storage-model subaspect in
the aggregate has not been specified earlier in the aggregate,
and to then resolve the expression of the association and save
the resolved entity. Called by
Validate_Storage_Model_Type_Aspect.
* sem_util.ads (Storage_Model_Support): Update comments on specs
of the functions Get_Storage_Model_Type_Entity,
Storage_Model_Address_Type, and Storage_Model_Null_Address to
indicate the behavior when the address type is System.Address
(the native memory-model case).
* sem_util.adb
(Storage_Model_Support.Get_Storage_Model_Type_Entity): Suppress
the search for the given subaspect name (Nam) when the
Storage_Model_Type aspect is fully defaulted (i.e., no
Expression is present) and simply return. In cases where the
search is done, but no association that matches Nam is found,
return System.Address for the Name_Address_Type case, return
System.Null_Address for the Name_Null_Address case, and return
Empty for all other cases.diff --git a/gcc/ada/aspects.ads b/gcc/ada/aspects.ads
--- a/gcc/ada/aspects.ads
+++ b/gcc/ada/aspects.ads
@@ -441,7 +441,7 @@ package Aspects is
   Aspect_SPARK_Mode => Optional_Name,
   Aspect_Stable_Properties  => Expression,
   Aspect_Static_Predicate   => Expression,
-  Aspect_Storage_Model_Type => Expression,
+  Aspect_Storage_Model_Type => Optional_Expression,
   Aspect_Storage_Pool   => Name,
   Aspect_Storage_Size   => Expression,
   Aspect_Stream_Size=> Expression,


diff --git a/gcc/ada/exp_util.adb b/gcc/ada/exp_util.adb
--- a/gcc/ada/exp_util.adb
+++ b/gcc/ada/exp_util.adb
@@ -6406,16 +6406,7 @@ package body Exp_Util is
 
begin
   if Has_Storage_Model_Type_Aspect (Typ) then
- 

[Ada] Do not generate DW_TAG_typedef for constrained array types

[Pierre-Marie de Rodat via Gcc-patches]

It no longer serves any useful purpose at this point.

Tested on x86_64-pc-linux-gnu, committed on trunk

gcc/ada/

* gcc-interface/utils.cc (gnat_pushdecl): Build DECL_ORIGINAL_TYPE
only for pointer types.diff --git a/gcc/ada/gcc-interface/utils.cc b/gcc/ada/gcc-interface/utils.cc
--- a/gcc/ada/gcc-interface/utils.cc
+++ b/gcc/ada/gcc-interface/utils.cc
@@ -877,21 +877,18 @@ gnat_pushdecl (tree decl, Node_Id gnat_node)
 {
   tree t = TREE_TYPE (decl);
 
-  /* Array and pointer types aren't tagged types in the C sense so we need
-	 to generate a typedef in DWARF for them and make sure it is preserved,
-	 unless the type is artificial.  */
+  /* Pointer types aren't named types in the C sense so we need to generate
+ a typedef in DWARF for them and make sure it is preserved, unless the
+ type is artificial.  */
   if (!(TYPE_NAME (t) && TREE_CODE (TYPE_NAME (t)) == TYPE_DECL)
-	  && ((TREE_CODE (t) != ARRAY_TYPE && TREE_CODE (t) != POINTER_TYPE)
-	  || DECL_ARTIFICIAL (decl)))
+	  && (TREE_CODE (t) != POINTER_TYPE || DECL_ARTIFICIAL (decl)))
 	;
-  /* For array and pointer types, create the DECL_ORIGINAL_TYPE that will
-	 generate the typedef in DWARF.  Also do that for fat pointer types
-	 because, even though they are tagged types in the C sense, they are
-	 still XUP types attached to the base array type at this point.  */
+  /* For pointer types, create the DECL_ORIGINAL_TYPE that will generate
+	 the typedef in DWARF.  Also do that for fat pointer types because,
+	 even though they are named types in the C sense, they are still the
+	 XUP types created for the base array type at this point.  */
   else if (!DECL_ARTIFICIAL (decl)
-	   && (TREE_CODE (t) == ARRAY_TYPE
-		   || TREE_CODE (t) == POINTER_TYPE
-		   || TYPE_IS_FAT_POINTER_P (t)))
+	   && (TREE_CODE (t) == POINTER_TYPE || TYPE_IS_FAT_POINTER_P (t)))
 	{
 	  tree tt = build_variant_type_copy (t);
 	  TYPE_NAME (tt) = decl;
@@ -905,10 +902,6 @@ gnat_pushdecl (tree decl, Node_Id gnat_node)
 	DECL_ORIGINAL_TYPE (decl) = DECL_ORIGINAL_TYPE (TYPE_NAME (t));
 	  else
 	DECL_ORIGINAL_TYPE (decl) = t;
-	  /* Array types need to have a name so that they can be related to
-	 their GNAT encodings.  */
-	  if (TREE_CODE (t) == ARRAY_TYPE && !TYPE_NAME (t))
-	TYPE_NAME (t) = DECL_NAME (decl);
 	  /* Remark the canonical fat pointer type as artificial.  */
 	  if (TYPE_IS_FAT_POINTER_P (t))
 	TYPE_ARTIFICIAL (t) = 1;

[Ada] Plug legality loophole for equality operator of untagged record types

[Pierre-Marie de Rodat via Gcc-patches]

In Ada 2012, the RM 4.5.2(9.8) clause prevents an equality operator for an
untagged record type from being declared after the type is frozen.  While
the clause is implemented in GNAT, the implementation has a loophole which
lets subprogram bodies that are not the completion of a declaration pass
the check without being flagged.

Tested on x86_64-pc-linux-gnu, committed on trunk

gcc/ada/

* sem_ch6.adb (Analyze_Subprogram_Body_Helper): Set Acts_As_Spec
earlier if the body is not the completion of a declaration.
(Check_Untagged_Equality): Deal with subprogram bodies that are
not the completion of a declaration and make sure that they are
not flagged when they cause the freezing of the type themselves.
Give a warning on the freezing point of the type in more cases.
* sem_res.adb (Resolve_Equality_Op): Revert latest change.diff --git a/gcc/ada/sem_ch6.adb b/gcc/ada/sem_ch6.adb
--- a/gcc/ada/sem_ch6.adb
+++ b/gcc/ada/sem_ch6.adb
@@ -4743,6 +4743,12 @@ package body Sem_Ch6 is
 Style.Body_With_No_Spec (N);
  end if;
 
+ --  First set Acts_As_Spec if appropriate
+
+ if Nkind (N) /= N_Subprogram_Body_Stub then
+Set_Acts_As_Spec (N);
+ end if;
+
  New_Overloaded_Entity (Body_Id);
 
  --  A subprogram body should cause freezing of its own declaration,
@@ -4767,7 +4773,6 @@ package body Sem_Ch6 is
  end if;
 
  if Nkind (N) /= N_Subprogram_Body_Stub then
-Set_Acts_As_Spec (N);
 Generate_Definition (Body_Id);
 Generate_Reference
   (Body_Id, Body_Id, 'b', Set_Ref => False, Force => True);
@@ -9525,15 +9530,85 @@ package body Sem_Ch6 is
-
 
procedure Check_Untagged_Equality (Eq_Op : Entity_Id) is
-  Typ  : constant Entity_Id := Etype (First_Formal (Eq_Op));
-  Decl : constant Node_Id   := Unit_Declaration_Node (Eq_Op);
-  Obj_Decl : Node_Id;
+  Eq_Decl : constant Node_Id   := Unit_Declaration_Node (Eq_Op);
+  Typ : constant Entity_Id := Etype (First_Formal (Eq_Op));
+
+  procedure Freezing_Point_Warning (N : Node_Id; S : String);
+  --  Output a warning about the freezing point N of Typ
+
+  function Is_Actual_Of_Instantiation
+(E: Entity_Id;
+ Inst : Node_Id) return Boolean;
+  --  Return True if E is an actual parameter of instantiation Inst
+
+  ---
+  -- Output_Freezing_Point_Warning --
+  ---
+
+  procedure Freezing_Point_Warning (N : Node_Id; S : String) is
+  begin
+ Error_Msg_String (1 .. S'Length) := S;
+ Error_Msg_Strlen := S'Length;
+
+ if Ada_Version >= Ada_2012 then
+Error_Msg_NE ("type& is frozen by ~??", N, Typ);
+Error_Msg_N
+  ("\an equality operator cannot be declared after this point??",
+   N);
+
+ else
+Error_Msg_NE ("type& is frozen by ~ (Ada 2012)?y?", N, Typ);
+Error_Msg_N
+  ("\an equality operator cannot be declared after this point"
+   & " (Ada 2012)?y?", N);
+ end if;
+  end Freezing_Point_Warning;
+
+  
+  -- Is_Actual_Of_Instantiation --
+  
+
+  function Is_Actual_Of_Instantiation
+(E: Entity_Id;
+ Inst : Node_Id) return Boolean
+  is
+ Assoc : Node_Id;
+
+  begin
+ if Present (Generic_Associations (Inst)) then
+Assoc := First (Generic_Associations (Inst));
+
+while Present (Assoc) loop
+   if Present (Explicit_Generic_Actual_Parameter (Assoc))
+ and then
+   Is_Entity_Name (Explicit_Generic_Actual_Parameter (Assoc))
+ and then
+   Entity (Explicit_Generic_Actual_Parameter (Assoc)) = E
+   then
+  return True;
+   end if;
+
+   Next (Assoc);
+end loop;
+ end if;
+
+ return False;
+  end Is_Actual_Of_Instantiation;
+
+  --  Local variable
+
+  Decl : Node_Id;
+
+   --  Start of processing for Check_Untagged_Equality
 
begin
-  --  This check applies only if we have a subprogram declaration with an
-  --  untagged record type that is conformant to the predefined operator.
+  --  This check applies only if we have a subprogram declaration or a
+  --  subprogram body that is not a completion, for an untagged record
+  --  type, and that is conformant with the predefined operator.
 
-  if Nkind (Decl) /= N_Subprogram_Declaration
+  if (Nkind (Eq_Decl) /= N_Subprogram_Declaration
+   and then not (Nkind (Eq_Decl) = N_Subprogram_Body
+  and then Acts_As_Spec (Eq_Decl)))
 or else not Is_Record_Type (Typ)

[Ada] Fix crash on frontend inlining of functions with single returns

[Pierre-Marie de Rodat via Gcc-patches]

When examining expression of the first declaration of the inlined body
make sure that this declaration is in fact an object declaration.

Tested on x86_64-pc-linux-gnu, committed on trunk

gcc/ada/

* inline.adb (Has_Single_Return): Add guard for the subsequent
call to Expression.diff --git a/gcc/ada/inline.adb b/gcc/ada/inline.adb
--- a/gcc/ada/inline.adb
+++ b/gcc/ada/inline.adb
@@ -4648,6 +4648,7 @@ package body Inline is
  return
Present (Declarations (N))
  and then Present (First (Declarations (N)))
+ and then Nkind (First (Declarations (N))) = N_Object_Declaration
  and then Entity (Expression (Return_Statement)) =
 Defining_Identifier (First (Declarations (N)));
   end if;

[Ada] Clarify hardening command-line options that require explicit choices

[Pierre-Marie de Rodat via Gcc-patches]

Prefixes -fzero-call-used-regs and -fstrub could be mistaken for full
command-line options with the references to them in the GNAT RM.  Make
it clearer that they require explicit choices.

Tested on x86_64-pc-linux-gnu, committed on trunk

gcc/ada/

* doc/gnat_rm/security_hardening_features.rst: Clarify the need
for choices after -fzero-call-used-regs and -fstrub.
* gnat_rm.texi: Regenerate.diff --git a/gcc/ada/doc/gnat_rm/security_hardening_features.rst b/gcc/ada/doc/gnat_rm/security_hardening_features.rst
--- a/gcc/ada/doc/gnat_rm/security_hardening_features.rst
+++ b/gcc/ada/doc/gnat_rm/security_hardening_features.rst
@@ -18,9 +18,10 @@ Register Scrubbing
 GNAT can generate code to zero-out hardware registers before returning
 from a subprogram.
 
-It can be enabled with the :switch:`-fzero-call-used-regs` command-line
-option, to affect all subprograms in a compilation, and with a
-:samp:`Machine_Attribute` pragma, to affect only specific subprograms.
+It can be enabled with the :switch:`-fzero-call-used-regs={choice}`
+command-line option, to affect all subprograms in a compilation, and
+with a :samp:`Machine_Attribute` pragma, to affect only specific
+subprograms.
 
 .. code-block:: ada
 
@@ -73,11 +74,11 @@ or a variable.)
  --  scrubbing of the stack space used by that subprogram.
 
 
-There are also :switch:`-fstrub` command-line options to control
-default settings.  For usage and more details on the command-line
-option, on the ``strub`` attribute, and their use with other
-programming languages, see :title:`Using the GNU Compiler Collection
-(GCC)`.
+There are also :switch:`-fstrub={choice}` command-line options to
+control default settings.  For usage and more details on the
+command-line options, on the ``strub`` attribute, and their use with
+other programming languages, see :title:`Using the GNU Compiler
+Collection (GCC)`.
 
 Note that Ada secondary stacks are not scrubbed.  The restriction
 ``No_Secondary_Stack`` avoids their use, and thus their accidental


diff --git a/gcc/ada/gnat_rm.texi b/gcc/ada/gnat_rm.texi
--- a/gcc/ada/gnat_rm.texi
+++ b/gcc/ada/gnat_rm.texi
@@ -21,7 +21,7 @@
 
 @copying
 @quotation
-GNAT Reference Manual , Jun 24, 2022
+GNAT Reference Manual , Jul 11, 2022
 
 AdaCore
 
@@ -28922,9 +28922,10 @@ change.
 GNAT can generate code to zero-out hardware registers before returning
 from a subprogram.
 
-It can be enabled with the @code{-fzero-call-used-regs} command-line
-option, to affect all subprograms in a compilation, and with a
-@code{Machine_Attribute} pragma, to affect only specific subprograms.
+It can be enabled with the @code{-fzero-call-used-regs=@emph{choice}}
+command-line option, to affect all subprograms in a compilation, and
+with a @code{Machine_Attribute} pragma, to affect only specific
+subprograms.
 
 @example
 procedure Foo;
@@ -28975,10 +28976,10 @@ pragma Machine_Attribute (Var, "strub");
 --  scrubbing of the stack space used by that subprogram.
 @end example
 
-There are also @code{-fstrub} command-line options to control
-default settings.  For usage and more details on the command-line
-option, on the @code{strub} attribute, and their use with other
-programming languages, see @cite{Using the GNU Compiler Collection (GCC)}.
+There are also @code{-fstrub=@emph{choice}} command-line options to
+control default settings.  For usage and more details on the
+command-line options, on the @code{strub} attribute, and their use with
+other programming languages, see @cite{Using the GNU Compiler Collection (GCC)}.
 
 Note that Ada secondary stacks are not scrubbed.  The restriction
 @code{No_Secondary_Stack} avoids their use, and thus their accidental

[Ada] Fix internal error on untagged record type with equality operator

[Pierre-Marie de Rodat via Gcc-patches]

After the binding interpretation issued under AI12-0413, a user-defined
primitive equality operator of an untagged record type hides the predefined
equality operator in an instantiation, but this does not apply if the
instantiation appears in the same declarative region as the type and
before the declaration of this user-defined operator.

Tested on x86_64-pc-linux-gnu, committed on trunk

gcc/ada/

* sem_res.adb (Resolve_Equality_Op): Make sure that the user-defined
operator of an untagged record type is declared ahead of an instance
before using it to resolve the equality operator in the instance.diff --git a/gcc/ada/sem_res.adb b/gcc/ada/sem_res.adb
--- a/gcc/ada/sem_res.adb
+++ b/gcc/ada/sem_res.adb
@@ -8967,7 +8967,14 @@ package body Sem_Res is
then
   Eq := Get_User_Defined_Equality (T);
 
-  if Present (Eq) then
+  --  We need to make sure that the instance is not within the
+  --  same declarative region as the type, or else that it lies
+  --  after the declaration of the user-defined "=" operator.
+
+  if Present (Eq)
+and then (not In_Same_Extended_Unit (Eq, N)
+   or else Earlier_In_Extended_Unit (Eq, N))
+  then
  if Is_Abstract_Subprogram (Eq) then
 Nondispatching_Call_To_Abstract_Operation (N, Eq);
  else

[Ada] Fix if expression returning slice

[Pierre-Marie de Rodat via Gcc-patches]

The compiler incorrectly assumed the prefix for a slice returned in one
branch of an if expression has its bounds known at compile time and would
crash when this is not true.

Tested on x86_64-pc-linux-gnu, committed on trunk

gcc/ada/

* exp_ch4.adb (Expand_N_If_Expression): Test for compile time
known bounds when handling slices.diff --git a/gcc/ada/exp_ch4.adb b/gcc/ada/exp_ch4.adb
--- a/gcc/ada/exp_ch4.adb
+++ b/gcc/ada/exp_ch4.adb
@@ -6174,7 +6174,13 @@ package body Exp_Ch4 is
Slice_Bnd : Node_Id) return Node_Id is
 
 begin
-   if Nkind (Elsex) = N_Slice then
+   --  We need to use the special processing for slices only if
+   --  they do not have compile-time known bounds; if they do, they
+   --  can be treated like any other expressions.
+
+   if Nkind (Elsex) = N_Slice
+ and then not Compile_Time_Known_Bounds (Etype (Elsex))
+   then
   if Compile_Time_Known_Value (Slice_Bnd)
 and then Expr_Value (Slice_Bnd) = Then_Bnd
   then
@@ -6230,7 +6236,11 @@ package body Exp_Ch4 is
  begin
 Get_First_Index_Bounds (Etype (Thenx), Then_Lo, Then_Hi);
 
-if Nkind (Elsex) = N_Slice then
+--  See the rationale in Build_New_Bound
+
+if Nkind (Elsex) = N_Slice
+  and then not Compile_Time_Known_Bounds (Etype (Elsex))
+then
Slice_Lo := Low_Bound (Discrete_Range (Elsex));
Slice_Hi := High_Bound (Discrete_Range (Elsex));
Get_First_Index_Bounds
@@ -6289,7 +6299,11 @@ package body Exp_Ch4 is
 
 Set_Suppress_Assignment_Checks (Last (Then_List));
 
-if Nkind (Elsex) = N_Slice then
+--  See the rationale in Build_New_Bound
+
+if Nkind (Elsex) = N_Slice
+  and then not Compile_Time_Known_Bounds (Etype (Elsex))
+then
Else_List := New_List (
  Make_Assignment_Statement (Loc,
Name   =>

[Ada] Fix proof of runtime unit System.Arith_64

[Pierre-Marie de Rodat via Gcc-patches]

After changes in provers and Why3, changes are needed to recover
automatic proof of System.Arith_64. This is the first part of it.

Tested on x86_64-pc-linux-gnu, committed on trunk

gcc/ada/

* libgnat/s-aridou.adb (Lemma_Mult_Div, Lemma_Powers): New
lemmas.
(Prove_Sign_Quotient): New local lemma.
(Prove_Signs): Expand definition of Big_R and Big_Q in the
postcondition. Add intermediate assertions.
(Double_Divide): Call new lemma.
(Lemma_Div_Eq): Provide body for proving lemma.
(Lemma_Powers_Of_2, Lemma_Shift_Without_Drop,
Prove_Dividend_Scaling, Prove_Multiplication, Prove_Z_Low): Call
lemmas, add intermediate assertions.diff --git a/gcc/ada/libgnat/s-aridou.adb b/gcc/ada/libgnat/s-aridou.adb
--- a/gcc/ada/libgnat/s-aridou.adb
+++ b/gcc/ada/libgnat/s-aridou.adb
@@ -438,6 +438,12 @@ is
  Ghost,
  Post => X * (Y + Z) = X * Y + X * Z;
 
+   procedure Lemma_Mult_Div (A, B : Big_Integer)
+   with
+ Ghost,
+ Pre  => B /= 0,
+ Post => A * B / B = A;
+
procedure Lemma_Mult_Non_Negative (X, Y : Big_Integer)
with
  Ghost,
@@ -469,6 +475,12 @@ is
  Post => not In_Double_Int_Range (Big_2xxDouble)
and then not In_Double_Int_Range (-Big_2xxDouble);
 
+   procedure Lemma_Powers (A : Big_Natural; B, C : Natural)
+   with
+ Ghost,
+ Pre  => B <= Natural'Last - C,
+ Post => A**B * A**C = A**(B + C);
+
procedure Lemma_Powers_Of_2 (M, N : Natural)
with
  Ghost,
@@ -606,7 +618,6 @@ is
is null;
procedure Lemma_Div_Ge (X, Y, Z : Big_Integer) is null;
procedure Lemma_Div_Lt (X, Y, Z : Big_Natural) is null;
-   procedure Lemma_Div_Eq (A, B, S, R : Big_Integer) is null;
procedure Lemma_Double_Big_2xxSingle is null;
procedure Lemma_Double_Shift (X : Double_Uns; S, S1 : Double_Uns) is null;
procedure Lemma_Double_Shift (X : Single_Uns; S, S1 : Natural) is null;
@@ -629,6 +640,7 @@ is
procedure Lemma_Mult_Non_Positive (X, Y : Big_Integer) is null;
procedure Lemma_Neg_Rem (X, Y : Big_Integer) is null;
procedure Lemma_Not_In_Range_Big2xx64 is null;
+   procedure Lemma_Powers (A : Big_Natural; B, C : Natural) is null;
procedure Lemma_Rem_Commutation (X, Y : Double_Uns) is null;
procedure Lemma_Rem_Is_Ident (X, Y : Big_Integer) is null;
procedure Lemma_Rem_Sign (X, Y : Big_Integer) is null;
@@ -864,6 +876,23 @@ is
 Post => abs Big_Q = Big (Qu);
   --  Proves correctness of the rounding of the unsigned quotient
 
+  procedure Prove_Sign_Quotient
+  with
+Ghost,
+Pre  => Mult /= 0
+  and then Quot = Big (X) / (Big (Y) * Big (Z))
+  and then Big_R = Big (X) rem (Big (Y) * Big (Z))
+  and then Big_Q =
+(if Round then
+   Round_Quotient (Big (X), Big (Y) * Big (Z), Quot, Big_R)
+ else Quot),
+Post =>
+  (if X >= 0 then
+ (if Den_Pos then Big_Q >= 0 else Big_Q <= 0)
+   else
+ (if Den_Pos then Big_Q <= 0 else Big_Q >= 0));
+  --  Proves the correct sign of the signed quotient Big_Q
+
   procedure Prove_Signs
   with
 Ghost,
@@ -880,7 +909,13 @@ is
   and then
 Q = (if (X >= 0) = Den_Pos then To_Int (Qu) else To_Int (-Qu))
   and then not (X = Double_Int'First and then Big (Y) * Big (Z) = -1),
-Post => Big (R) = Big_R and then Big (Q) = Big_Q;
+Post => Big (R) = Big (X) rem (Big (Y) * Big (Z))
+  and then
+(if Round then
+   Big (Q) = Round_Quotient (Big (X), Big (Y) * Big (Z),
+ Big (X) / (Big (Y) * Big (Z)),
+ Big (R))
+ else Big (Q) = Big (X) / (Big (Y) * Big (Z)));
   --  Proves final signs match the intended result after the unsigned
   --  division is done.
 
@@ -891,6 +926,7 @@ is
   procedure Prove_Overflow_Case is null;
   procedure Prove_Quotient_Zero is null;
   procedure Prove_Round_To_One is null;
+  procedure Prove_Sign_Quotient is null;
 
   -
   -- Prove_Rounding_Case --
@@ -1056,6 +1092,8 @@ is
 pragma Assert (Big (Double_Uns (Hi (T2))) >= 1);
 pragma Assert (Big (Double_Uns (Lo (T2))) >= 0);
 pragma Assert (Big (Double_Uns (Lo (T1))) >= 0);
+pragma Assert (Big_2xxSingle * Big (Double_Uns (Lo (T2)))
+ + Big (Double_Uns (Lo (T1))) >= 0);
 pragma Assert (Mult >= Big_2xxDouble * Big (Double_Uns (Hi (T2;
 pragma Assert (Mult >= Big_2xxDouble);
 if Hi (T2) > 1 then
@@ -1064,6 +1102,10 @@ is
  Mult > Big_2xxDouble);
 elsif Lo (T2) > 0 then
pragma Assert (Big (Double_Uns (Lo (T2))) > 0);
+   pragma Assert (Big_2xxSingle > 0);
+   pragma Assert (Big_2xxS

[Ada] Fix CodePeer warnings in GNAT sources

[Pierre-Marie de Rodat via Gcc-patches]

This patch fixes various redundant constructs or uninitialized variables
identified by CodePeer in the GNAT frontend and runtime sources.

Tested on x86_64-pc-linux-gnu, committed on trunk

gcc/ada/

* exp_ch6.adb (Expand_N_Extended_Return_Statement): Add default
initialization for Stmts.
* sem_ch12.adb (Analyze_Associations): Add default
initialization for Match.
* libgnat/a-ztenau.adb (Scan_Enum_Lit): Remove duplicated
boolean test.
* libgnat/g-spipat.adb (XMatch): Combine duplicated cases.diff --git a/gcc/ada/exp_ch6.adb b/gcc/ada/exp_ch6.adb
--- a/gcc/ada/exp_ch6.adb
+++ b/gcc/ada/exp_ch6.adb
@@ -5175,7 +5175,7 @@ package body Exp_Ch6 is
   Exp : Node_Id;
   HSS : Node_Id;
   Result  : Node_Id;
-  Stmts   : List_Id;
+  Stmts   : List_Id := No_List;
 
   Return_Stmt : Node_Id := Empty;
   --  Force initialization to facilitate static analysis


diff --git a/gcc/ada/libgnat/a-ztenau.adb b/gcc/ada/libgnat/a-ztenau.adb
--- a/gcc/ada/libgnat/a-ztenau.adb
+++ b/gcc/ada/libgnat/a-ztenau.adb
@@ -303,8 +303,6 @@ package body Ada.Wide_Wide_Text_IO.Enumeration_Aux is
 
 exit when
   Is_Character (WC)
-and then
-  not Is_Letter (To_Character (WC))
 and then
   not Is_Letter (To_Character (WC))
 and then


diff --git a/gcc/ada/libgnat/g-spipat.adb b/gcc/ada/libgnat/g-spipat.adb
--- a/gcc/ada/libgnat/g-spipat.adb
+++ b/gcc/ada/libgnat/g-spipat.adb
@@ -3961,7 +3961,7 @@ package body GNAT.Spitbol.Patterns is
 
  --  Any (one character case)
 
- when PC_Any_CH =>
+ when PC_Any_CH | PC_Char =>
 if Cursor < Length
   and then Subject (Cursor + 1) = Node.Char
 then
@@ -4103,9 +4103,10 @@ package body GNAT.Spitbol.Patterns is
 Pop_Region;
 goto Succeed;
 
- --  Assign on match. This node sets up for the eventual assignment
+ --  Write/assign on match. This node sets up for the eventual write
+ --  or assignment.
 
- when PC_Assign_OnM =>
+ when PC_Assign_OnM | PC_Write_OnM =>
 Stack (Stack_Base - 1).Node := Node;
 Push (CP_Assign'Access);
 Pop_Region;
@@ -4144,9 +4145,9 @@ package body GNAT.Spitbol.Patterns is
 Push (Node);
 goto Succeed;
 
- --  Break (one character case)
+ --  Break & BreakX (one character case)
 
- when PC_Break_CH =>
+ when PC_Break_CH | PC_BreakX_CH =>
 while Cursor < Length loop
if Subject (Cursor + 1) = Node.Char then
   goto Succeed;
@@ -4157,9 +4158,9 @@ package body GNAT.Spitbol.Patterns is
 
 goto Fail;
 
- --  Break (character set case)
+ --  Break & BreakX (character set case)
 
- when PC_Break_CS =>
+ when PC_Break_CS | PC_BreakX_CS =>
 while Cursor < Length loop
if Is_In (Subject (Cursor + 1), Node.CS) then
   goto Succeed;
@@ -4170,9 +4171,9 @@ package body GNAT.Spitbol.Patterns is
 
 goto Fail;
 
- --  Break (string function case)
+ --  Break & BreakX (string function case)
 
- when PC_Break_VF => declare
+ when PC_Break_VF | PC_BreakX_VF => declare
 U : constant VString := Node.VF.all;
 S : Big_String_Access;
 L : Natural;
@@ -4191,77 +4192,9 @@ package body GNAT.Spitbol.Patterns is
 goto Fail;
  end;
 
- --  Break (string pointer case)
+ --  Break & BreakX (string pointer case)
 
- when PC_Break_VP => declare
-U : constant VString := Node.VP.all;
-S : Big_String_Access;
-L : Natural;
-
- begin
-Get_String (U, S, L);
-
-while Cursor < Length loop
-   if Is_In (Subject (Cursor + 1), S (1 .. L)) then
-  goto Succeed;
-   else
-  Cursor := Cursor + 1;
-   end if;
-end loop;
-
-goto Fail;
- end;
-
- --  BreakX (one character case)
-
- when PC_BreakX_CH =>
-while Cursor < Length loop
-   if Subject (Cursor + 1) = Node.Char then
-  goto Succeed;
-   else
-  Cursor := Cursor + 1;
-   end if;
-end loop;
-
-goto Fail;
-
- --  BreakX (character set case)
-
- when PC_BreakX_CS =>
-while Cursor < Length loop
-   if Is_In (Subject (Cursor + 1), Node.CS) then
-  goto Succeed;
-   else
-  Cursor := Cursor + 1;
-   end if;
-end loop;
-
-goto Fail;
-
- --  BreakX (string function case)
-
- when PC_BreakX_VF => decl

[Ada] Refine type for checking number of pragma arguments

[Pierre-Marie de Rodat via Gcc-patches]

Code cleanup.

Tested on x86_64-pc-linux-gnu, committed on trunk

gcc/ada/

* par-prag.adb (Check_Arg_Count): Change parameter type from Int
to Nat, because this parameter is compared to Arg_Count variable
which is of type Nat. Also, it wouldn't make sense to check for
negative number of pragma arguments.diff --git a/gcc/ada/par-prag.adb b/gcc/ada/par-prag.adb
--- a/gcc/ada/par-prag.adb
+++ b/gcc/ada/par-prag.adb
@@ -65,7 +65,7 @@ function Prag (Pragma_Node : Node_Id; Semi : Source_Ptr) return Node_Id is
--  the routine for the argument one past the last present argument, but
--  that is the only case in which a non-present argument can be referenced.
 
-   procedure Check_Arg_Count (Required : Int);
+   procedure Check_Arg_Count (Required : Nat);
--  Check argument count for pragma = Required. If not give error and raise
--  Error_Resync.
 
@@ -155,7 +155,7 @@ function Prag (Pragma_Node : Node_Id; Semi : Source_Ptr) return Node_Id is
-- Check_Arg_Count --
-
 
-   procedure Check_Arg_Count (Required : Int) is
+   procedure Check_Arg_Count (Required : Nat) is
begin
   if Arg_Count /= Required then
  Error_Msg_N ("wrong number of arguments for pragma%", Pragma_Node);

[Ada] Use right implementation type for nonbinary-modulus ops

[Pierre-Marie de Rodat via Gcc-patches]

If the flag Opt.Expand_Nonbinary_Modular_Ops is set (which occurs if
-gnateg is specified) then we implement predefined operations for a
modular type whose modulus is not a power of two by converting the
operands to some other type (either a signed integer type or a modular
type with a power-of-two modulus), doing the operation in that
representation, and converting back.  If the bounds of the chosen type
are too narrow, then problems with intermediate overflow can result. But
there are performance advantages to choosing narrower bounds (and to
prefering an unsigned choice over a signed choice of the same size) when
multiple safe choices are available.

Tested on x86_64-pc-linux-gnu, committed on trunk

gcc/ada/

* exp_ch4.adb (Expand_Nonbinary_Modular_Op.Expand_Modular_Op):
Reimplement choice of which predefined type to use for the
implementation of a predefined operation of a modular type with
a non-power-of-two modulus.diff --git a/gcc/ada/exp_ch4.adb b/gcc/ada/exp_ch4.adb
--- a/gcc/ada/exp_ch4.adb
+++ b/gcc/ada/exp_ch4.adb
@@ -4177,43 +4177,82 @@ package body Exp_Ch4 is
   ---
 
   procedure Expand_Modular_Op is
+ --   We will convert to another type (not a nonbinary-modulus modular
+ --   type), evaluate the op in that representation, reduce the result,
+ --   and convert back to the original type. This means that the
+ --   backend does not have to deal with nonbinary-modulus ops.
+
  Op_Expr  : constant Node_Id := New_Op_Node (Nkind (N), Loc);
  Mod_Expr : constant Node_Id := New_Op_Node (N_Op_Mod, Loc);
 
- Target_Type   : Entity_Id;
-
+ Target_Type : Entity_Id;
   begin
- --  Convert nonbinary modular type operands into integer values. Thus
- --  we avoid never-ending loops expanding them, and we also ensure
- --  the back end never receives nonbinary modular type expressions.
-
- if Nkind (N) in N_Op_And | N_Op_Or | N_Op_Xor then
-Set_Left_Opnd (Op_Expr,
-  Unchecked_Convert_To (Standard_Unsigned,
-New_Copy_Tree (Left_Opnd (N;
-Set_Right_Opnd (Op_Expr,
-  Unchecked_Convert_To (Standard_Unsigned,
-New_Copy_Tree (Right_Opnd (N;
-Set_Left_Opnd (Mod_Expr,
-  Unchecked_Convert_To (Standard_Integer, Op_Expr));
-
- else
---  If the modulus of the type is larger than Integer'Last use a
---  larger type for the operands, to prevent spurious constraint
---  errors on large legal literals of the type.
+ --  Select a target type that is large enough to avoid spurious
+ --  intermediate overflow on pre-reduction computation (for
+ --  correctness) but is no larger than is needed (for performance).
 
-if Modulus (Etype (N)) > Int (Integer'Last) then
-   Target_Type := Standard_Long_Long_Integer;
+ declare
+Required_Size : Uint := RM_Size (Etype (N));
+Use_Unsigned  : Boolean := True;
+ begin
+case Nkind (N) is
+   when N_Op_Add =>
+  --  For example, if modulus is 255 then RM_Size will be 8
+  --  and the range of possible values (before reduction) will
+  --  be 0 .. 508; that range requires 9 bits.
+  Required_Size := Required_Size + 1;
+
+   when N_Op_Subtract =>
+  --  For example, if modulus is 255 then RM_Size will be 8
+  --  and the range of possible values (before reduction) will
+  --  be -254 .. 254; that range requires 9 bits, signed.
+  Use_Unsigned := False;
+  Required_Size := Required_Size + 1;
+
+   when N_Op_Multiply =>
+  --  For example, if modulus is 255 then RM_Size will be 8
+  --  and the range of possible values (before reduction) will
+  --  be 0 .. 64,516; that range requires 16 bits.
+  Required_Size := Required_Size * 2;
+
+   when others =>
+  null;
+end case;
+
+if Use_Unsigned then
+   if Required_Size <= Standard_Short_Short_Integer_Size then
+  Target_Type := Standard_Short_Short_Unsigned;
+   elsif Required_Size <= Standard_Short_Integer_Size then
+  Target_Type := Standard_Short_Unsigned;
+   elsif Required_Size <= Standard_Integer_Size then
+  Target_Type := Standard_Unsigned;
+   else
+  pragma Assert (Required_Size <= 64);
+  Target_Type := Standard_Unsigned_64;
+   end if;
+elsif Required_Size <= 8 then
+   Target_Type := Standard_Integer_8;
+elsif Required_Size <= 16 then
+   Target_Type

[Ada] Spurious use_type clause warning

[Pierre-Marie de Rodat via Gcc-patches]

This patch corrects an error in the compiler whereby a spurious
redundant use_type_clause warning gets issued when the clause appears in
the context_clause of a package preceding a with_clause for a package
with an identical use_clause in its specification.

Tested on x86_64-pc-linux-gnu, committed on trunk

gcc/ada/

* einfo.ads: Modify documentation for In_Use flag to include
scope stack manipulation.
* sem_ch8.adb (Use_One_Type): Add condition to return when
attempting to detect redundant use_type_clauses in child units
in certain cases.diff --git a/gcc/ada/einfo.ads b/gcc/ada/einfo.ads
--- a/gcc/ada/einfo.ads
+++ b/gcc/ada/einfo.ads
@@ -2309,6 +2309,10 @@ package Einfo is
 --   the corresponding entity. Reset at end of corresponding declarative
 --   part. The flag on a type is also used to determine the visibility of
 --   the primitive operators of the type.
+--
+--   Note that manipulation of scopes on the scope stack will also cause
+--   the flag to be set/unset since the setting of scopes affects
+--   visibility.
 
 --Is_Abstract_Subprogram
 --   Defined in all subprograms and entries. Set for abstract subprograms.


diff --git a/gcc/ada/sem_ch8.adb b/gcc/ada/sem_ch8.adb
--- a/gcc/ada/sem_ch8.adb
+++ b/gcc/ada/sem_ch8.adb
@@ -10758,15 +10758,26 @@ package body Sem_Ch8 is
  return;
   end if;
 
-  --  There is a redundant use_type_clause in a child unit.
-  --  Determine which of the units is more deeply nested. If a
+  --  If there is a redundant use_type_clause in a child unit
+  --  determine which of the units is more deeply nested. If a
   --  unit is a package instance, retrieve the entity and its
   --  scope from the instance spec.
 
   Ent1 := Entity_Of_Unit (Unit1);
   Ent2 := Entity_Of_Unit (Unit2);
 
-  if Scope (Ent2) = Standard_Standard then
+  --  When the scope of both units' entities are
+  --  Standard_Standard then neither Unit1 or Unit2 are child
+  --  units - so return in that case.
+
+  if Scope (Ent1) = Standard_Standard
+and then Scope (Ent2) = Standard_Standard
+  then
+ return;
+
+  --  Otherwise, determine if one of the units is not a child
+
+  elsif Scope (Ent2) = Standard_Standard then
  Error_Msg_Sloc := Sloc (Clause2);
  Err_No := Clause1;
 

[Ada] Extend No_Dependence restriction to code generation

[Pierre-Marie de Rodat via Gcc-patches]

This makes it possible to report violations of the No_Dependence restriction
during code generation, in other words outside of the Ada front-end proper.
These violations are supposed to be only for child units of System, so the
implementation is restricted to these cases.

Tested on x86_64-pc-linux-gnu, committed on trunk

gcc/ada/

* restrict.ads (type ND_Entry): Add System_Child component.
(Check_Restriction_No_Dependence_On_System): Declare.
* restrict.adb (Global_Restriction_No_Tasking): Move around.
(Violation_Of_No_Dependence): New procedure.
(Check_Restriction_No_Dependence): Call Violation_Of_No_Dependence
to report a violation.
(Check_Restriction_No_Dependence_On_System): New procedure.
(Set_Restriction_No_Dependenc): Set System_Child component if the
unit is a child of System.
* snames.ads-tmpl (Name_Arith_64): New package name.
(Name_Arith_128): Likewise.
(Name_Memory): Likewise.
(Name_Stack_Checking): Likewise.
* fe.h (Check_Restriction_No_Dependence_On_System): Declare.diff --git a/gcc/ada/fe.h b/gcc/ada/fe.h
--- a/gcc/ada/fe.h
+++ b/gcc/ada/fe.h
@@ -252,6 +252,8 @@ extern Boolean SJLJ_Exceptions		(void);
   restrict__check_no_implicit_protected_alloc
 #define Check_No_Implicit_Task_Alloc	\
   restrict__check_no_implicit_task_alloc
+#define Check_Restriction_No_Dependence_On_System \
+  restrict__check_restriction_no_dependence_on_system
 #define No_Exception_Handlers_Set	\
   restrict__no_exception_handlers_set
 #define No_Exception_Propagation_Active	\
@@ -262,6 +264,7 @@ extern void Check_Implicit_Dynamic_Code_Allowed	(Node_Id);
 extern void Check_No_Implicit_Heap_Alloc	(Node_Id);
 extern void Check_No_Implicit_Protected_Alloc	(Node_Id);
 extern void Check_No_Implicit_Task_Alloc	(Node_Id);
+extern void Check_Restriction_No_Dependence_On_System (Name_Id, Node_Id);
 extern Boolean No_Exception_Handlers_Set	(void);
 extern Boolean No_Exception_Propagation_Active	(void);
 


diff --git a/gcc/ada/restrict.adb b/gcc/ada/restrict.adb
--- a/gcc/ada/restrict.adb
+++ b/gcc/ada/restrict.adb
@@ -44,10 +44,6 @@ with Uname;  use Uname;
 
 package body Restrict is
 
-   Global_Restriction_No_Tasking : Boolean := False;
-   --  Set to True when No_Tasking is set in the run-time package System
-   --  or in a configuration pragmas file (for example, gnat.adc).
-

-- Package Local Declarations --

@@ -55,6 +51,10 @@ package body Restrict is
Config_Cunit_Boolean_Restrictions : Save_Cunit_Boolean_Restrictions;
--  Save compilation unit restrictions set by config pragma files
 
+   Global_Restriction_No_Tasking : Boolean := False;
+   --  Set to True when No_Tasking is set in the run-time package System
+   --  or in a configuration pragmas file (for example, gnat.adc).
+
Restricted_Profile_Result : Boolean := False;
--  This switch memoizes the result of Restricted_Profile function calls for
--  improved efficiency. Valid only if Restricted_Profile_Cached is True.
@@ -122,6 +122,11 @@ package body Restrict is
--  message is to be suppressed if this is an internal file and this file is
--  not the main unit. Returns True if message is to be suppressed.
 
+   procedure Violation_Of_No_Dependence (Unit : Int; N : Node_Id);
+   --  Called if a violation of restriction No_Dependence for Unit at node N
+   --  is found. This routine outputs the appropriate message, taking care of
+   --  warning vs real violation.
+
---
-- Abort_Allowed --
---
@@ -550,8 +555,6 @@ package body Restrict is
-
 
procedure Check_Restriction_No_Dependence (U : Node_Id; Err : Node_Id) is
-  DU : Node_Id;
-
begin
   --  Ignore call if node U is not in the main source unit. This avoids
   --  cascaded errors, e.g. when Ada.Containers units with other units.
@@ -567,26 +570,33 @@ package body Restrict is
   --  Loop through entries in No_Dependence table to check each one in turn
 
   for J in No_Dependences.First .. No_Dependences.Last loop
- DU := No_Dependences.Table (J).Unit;
+ if Same_Unit (No_Dependences.Table (J).Unit, U) then
+Violation_Of_No_Dependence (J, Err);
+return;
+ end if;
+  end loop;
+   end Check_Restriction_No_Dependence;
 
- if Same_Unit (U, DU) then
-Error_Msg_Sloc := Sloc (DU);
-Error_Msg_Node_1 := DU;
+   ---
+   -- Check_Restriction_No_Dependence_On_System --
+   ---
 
-if No_Dependences.Table (J).Warn then
-   Error_Msg
- ("?*?violation of restriction `No_Dependence '='> &`#",
-  Sloc (Err));
-else
-   Error_Msg
- ("|violat

[Ada] Do not create large objects for indefinite protected types

[Pierre-Marie de Rodat via Gcc-patches]

This plugs a small loophole in the Needs_Secondary_Stack predicate for
some protected types and record types containing protected components.

Tested on x86_64-pc-linux-gnu, committed on trunk

gcc/ada/

* sem_util.adb (Caller_Known_Size_Record): Make entry assertion
more robust and add guard for null argument.  For protected
types, invoke Caller_Known_Size_Record on
Corresponding_Record_Type.
(Needs_Secondary_Stack): Likewise.diff --git a/gcc/ada/sem_util.adb b/gcc/ada/sem_util.adb
--- a/gcc/ada/sem_util.adb
+++ b/gcc/ada/sem_util.adb
@@ -23305,7 +23305,7 @@ package body Sem_Util is
   --
 
   function Caller_Known_Size_Record (Typ : Entity_Id) return Boolean is
- pragma Assert (Typ = Underlying_Type (Typ));
+ pragma Assert (if Present (Typ) then Typ = Underlying_Type (Typ));
 
  function Depends_On_Discriminant (Typ : Entity_Id) return Boolean;
  --  Called for untagged record and protected types. Return True if Typ
@@ -23342,6 +23342,14 @@ package body Sem_Util is
  end Depends_On_Discriminant;
 
   begin
+ --  This is a protected type without Corresponding_Record_Type set,
+ --  typically because expansion is disabled. The safe thing to do is
+ --  to return True, so Needs_Secondary_Stack returns False.
+
+ if No (Typ) then
+return True;
+ end if;
+
  --  First see if we have a variant part and return False if it depends
  --  on discriminants.
 
@@ -23367,14 +23375,18 @@ package body Sem_Util is
 Underlying_Type (Etype (Comp));
 
begin
-  if Is_Record_Type (Comp_Type)
-or else
- Is_Protected_Type (Comp_Type)
-  then
+  if Is_Record_Type (Comp_Type) then
  if not Caller_Known_Size_Record (Comp_Type) then
 return False;
  end if;
 
+  elsif Is_Protected_Type (Comp_Type) then
+ if not Caller_Known_Size_Record
+  (Corresponding_Record_Type (Comp_Type))
+ then
+return False;
+ end if;
+
   elsif Is_Array_Type (Comp_Type) then
  if Size_Depends_On_Discriminant (Comp_Type) then
 return False;
@@ -23478,7 +23490,7 @@ package body Sem_Util is
begin
   --  This is a private type which is not completed yet. This can only
   --  happen in a default expression (of a formal parameter or of a
-  --  record component). Do not expand transient scope in this case.
+  --  record component). The safe thing to do is to return False.
 
   if No (Typ) then
  return False;
@@ -23533,12 +23545,17 @@ package body Sem_Util is
   elsif Is_Definite_Subtype (Typ) or else Is_Task_Type (Typ) then
  return Large_Max_Size_Mutable (Typ);
 
-  --  Indefinite (discriminated) record or protected type
+  --  Indefinite (discriminated) record type
 
-  elsif Is_Record_Type (Typ) or else Is_Protected_Type (Typ) then
+  elsif Is_Record_Type (Typ) then
  return not Caller_Known_Size_Record (Typ);
 
-  --  Unconstrained array
+  --  Indefinite (discriminated) protected type
+
+  elsif Is_Protected_Type (Typ) then
+ return not Caller_Known_Size_Record (Corresponding_Record_Type (Typ));
+
+  --  Unconstrained array type
 
   else
  pragma Assert (Is_Array_Type (Typ) and not Is_Definite_Subtype (Typ));

[Ada] Fix 0-sized secondary stack allocations

[Pierre-Marie de Rodat via Gcc-patches]

The Has_Enough_Free_Memory was not correctly reporting a completely full
chunk in the case of a 0-sized allocation.

Tested on x86_64-pc-linux-gnu, committed on trunk

gcc/ada/

* libgnat/s-secsta.adb (Has_Enough_Free_Memory): Check for full
chunk before computing the available size.diff --git a/gcc/ada/libgnat/s-secsta.adb b/gcc/ada/libgnat/s-secsta.adb
--- a/gcc/ada/libgnat/s-secsta.adb
+++ b/gcc/ada/libgnat/s-secsta.adb
@@ -506,12 +506,17 @@ package body System.Secondary_Stack is
   Mem_Size : Memory_Size) return Boolean
is
begin
+  --  First check if the chunk is full (Byte is > Memory'Last in that
+  --  case), then check there is enough free memory.
+
   --  Byte - 1 denotes the last occupied byte. Subtracting that byte from
   --  the memory capacity of the chunk yields the size of the free memory
   --  within the chunk. The chunk can fit the request as long as the free
   --  memory is as big as the request.
 
-  return Chunk.Size - (Byte - 1) >= Mem_Size;
+  return Chunk.Memory'Last >= Byte
+and then Chunk.Size - (Byte - 1) >= Mem_Size;
+
end Has_Enough_Free_Memory;
 
--

[Ada] Fix inconsistent comment about expansion of exception declarations

[Pierre-Marie de Rodat via Gcc-patches]

Code cleanup.

Tested on x86_64-pc-linux-gnu, committed on trunk

gcc/ada/

* exp_ch11.adb (Expand_N_Exception_Declaration): Sync comment
with declaration in System.Standard_Library.diff --git a/gcc/ada/exp_ch11.adb b/gcc/ada/exp_ch11.adb
--- a/gcc/ada/exp_ch11.adb
+++ b/gcc/ada/exp_ch11.adb
@@ -1136,7 +1136,7 @@ package body Exp_Ch11 is
   Set_Is_Statically_Allocated (Ex_Id);
 
   --  Create the aggregate list for type Standard.Exception_Type:
-  --  Handled_By_Other component: False
+  --  Not_Handled_By_Others component: False
 
   L := Empty_List;
   Append_To (L, New_Occurrence_Of (Standard_False, Loc));

[Ada] Don't check for misspelling of Not_A_Restriction_Id

[Pierre-Marie de Rodat via Gcc-patches]

When looking for a misspelling of a restriction identifier we should
ignore the Not_A_Restriction_Id literal, because it doesn't represent
any restriction.

Tested on x86_64-pc-linux-gnu, committed on trunk

gcc/ada/

* sem_prag.adb (Process_Restrictions_Or_Restriction_Warnings):
Fix range of iteration.diff --git a/gcc/ada/sem_prag.adb b/gcc/ada/sem_prag.adb
--- a/gcc/ada/sem_prag.adb
+++ b/gcc/ada/sem_prag.adb
@@ -10561,7 +10561,7 @@ package body Sem_Prag is
 
   --  Check for possible misspelling
 
-  for J in Restriction_Id loop
+  for J in All_Restrictions loop
  declare
 Rnm : constant String := Restriction_Id'Image (J);
 

[Ada] Ada 2020: Allow declarative items mixed with statements

[Pierre-Marie de Rodat via Gcc-patches]

This patch implements a syntactic language extension that allows
declarative items to appear in a sequence of statements.  For example:

for X in S'Range loop
Item : Character renames S (X);
Item := Transform (Item);
end loop;

Previously, declare/begin/end was required, which is just noise.

Tested on x86_64-pc-linux-gnu, committed on trunk

gcc/ada/

* par.adb (P_Declarative_Items): New function to parse a
sequence of declarative items.
(P_Sequence_Of_Statements): Add Handled flag, to indicate
whether to wrap the result in a block statement.
* par-ch3.adb (P_Declarative_Item): Rename P_Declarative_Items
to be P_Declarative_Item, because it really only parses a single
declarative item, and to avoid conflict with the new
P_Declarative_Items. Add In_Statements.  We keep the old
error-recovery mechanisms in place when In_Statements is False.
When True, we don't want to complain about statements, because
we are parsing a sequence of statements.
(P_Identifier_Declarations): If In_Statements, and we see what
looks like a statement, we no longer give an error. We return to
P_Sequence_Of_Statements with Done = True, so it can parse the
statement.
* par-ch5.adb (P_Sequence_Of_Statements): Call
P_Declarative_Items to parse declarative items that appear in
the statement list.  Remove error handling code that complained
about such items.  Check some errors conservatively.  Wrap the
result in a block statement when necessary.
* par-ch11.adb (P_Handled_Sequence_Of_Statements): Pass
Handled => True to P_Sequence_Of_Statements.
* types.ads (No, Present): New functions for querying
Source_Ptrs (equal, not equal No_Location).

patch.diff.gz
Description: application/gzip

[Ada] Annotate libraries with returning annotation

[Pierre-Marie de Rodat via Gcc-patches]

This patch annotates SPARK-annotated libraries with returning
annotations (Always_Return, Might_Not_Return) to remove the warnings
raised by GNATprove about missing annotations.

Tested on x86_64-pc-linux-gnu, committed on trunk

gcc/ada/

* libgnarl/a-reatim.ads, libgnat/a-cfdlli.ads,
libgnat/a-cfhama.ads, libgnat/a-cfhase.ads,
libgnat/a-cfinse.ads, libgnat/a-cfinve.ads,
libgnat/a-cforma.ads, libgnat/a-cforse.ads,
libgnat/a-chahan.ads, libgnat/a-cofove.ads,
libgnat/a-cofuma.ads, libgnat/a-cofuse.ads,
libgnat/a-cofuve.ads, libgnat/a-nbnbin.ads,
libgnat/a-nbnbre.ads, libgnat/a-ngelfu.ads,
libgnat/a-nlelfu.ads, libgnat/a-nllefu.ads,
libgnat/a-nselfu.ads, libgnat/a-nuelfu.ads,
libgnat/a-strbou.ads, libgnat/a-strfix.ads,
libgnat/a-strmap.ads, libgnat/a-strunb.ads,
libgnat/a-strunb__shared.ads,  libgnat/a-strsea.ads,
libgnat/a-textio.ads, libgnat/a-tideio.ads,
libgnat/a-tienio.ads, libgnat/a-tifiio.ads,
libgnat/a-tiflio.ads, libgnat/a-tiinio.ads,
libgnat/a-timoio.ads, libgnat/i-c.ads, libgnat/interfac.ads,
libgnat/interfac__2020.ads, libgnat/s-atacco.ads,
libgnat/s-stoele.ads: Annotate packages and subprograms with
returning annotations.

patch.diff.gz
Description: application/gzip

[Ada] Fix confusing error expression on an unknown restriction

[Pierre-Marie de Rodat via Gcc-patches]

When pragma Restriction is used with an unknown restriction identifier,
it is better to not process the restriction expression, as it will
likely produce confusing error message.

In particular, an odd message appeared when there was a typo in the
restriction identifier whose expression requires special processing
(e.g.  No_Dependence_On instead of No_Dependence).

Tested on x86_64-pc-linux-gnu, committed on trunk

gcc/ada/

* sem_prag.adb (Process_Restrictions_Or_Restriction_Warnings):
Do not process expression of unknown restrictions.diff --git a/gcc/ada/sem_prag.adb b/gcc/ada/sem_prag.adb
--- a/gcc/ada/sem_prag.adb
+++ b/gcc/ada/sem_prag.adb
@@ -10792,13 +10792,15 @@ package body Sem_Prag is
 
 else
R_Id := Get_Restriction_Id (Process_Restriction_Synonyms (Arg));
-   Analyze_And_Resolve (Expr, Any_Integer);
 
if R_Id not in All_Parameter_Restrictions then
   Error_Pragma_Arg
 ("invalid restriction parameter identifier", Arg);
+   end if;
+
+   Analyze_And_Resolve (Expr, Any_Integer);
 
-   elsif not Is_OK_Static_Expression (Expr) then
+   if not Is_OK_Static_Expression (Expr) then
   Flag_Non_Static_Expr
 ("value must be static expression!", Expr);
   raise Pragma_Exit;

[Ada] Simplify rewriting of attributes into Boolean literals

[Pierre-Marie de Rodat via Gcc-patches]

Code cleanup; semantics is unaffected.

Tested on x86_64-pc-linux-gnu, committed on trunk

gcc/ada/

* sem_attr.adb (Set_Boolean_Result): Simplify using
Boolean_Literals.diff --git a/gcc/ada/sem_attr.adb b/gcc/ada/sem_attr.adb
--- a/gcc/ada/sem_attr.adb
+++ b/gcc/ada/sem_attr.adb
@@ -12778,13 +12778,8 @@ package body Sem_Attr is

 
procedure Set_Boolean_Result (N : Node_Id; B : Boolean) is
-  Loc : constant Source_Ptr := Sloc (N);
begin
-  if B then
- Rewrite (N, New_Occurrence_Of (Standard_True, Loc));
-  else
- Rewrite (N, New_Occurrence_Of (Standard_False, Loc));
-  end if;
+  Rewrite (N, New_Occurrence_Of (Boolean_Literals (B), Sloc (N)));
end Set_Boolean_Result;
 

[Ada] Suppress warning in g-socthi__vxworks.adb

[Pierre-Marie de Rodat via Gcc-patches]

Follow-on to previous change, which missed the vxworks version of this
package.

Tested on x86_64-pc-linux-gnu, committed on trunk

gcc/ada/

* libgnat/g-socthi__vxworks.adb (C_Connect): Suppress new warning.diff --git a/gcc/ada/libgnat/g-socthi__vxworks.adb b/gcc/ada/libgnat/g-socthi__vxworks.adb
--- a/gcc/ada/libgnat/g-socthi__vxworks.adb
+++ b/gcc/ada/libgnat/g-socthi__vxworks.adb
@@ -190,7 +190,9 @@ package body GNAT.Sockets.Thin is
  return Res;
   end if;
 
-  declare
+  pragma Warnings (Off, "unreachable code");
+  declare -- unreachable if Thread_Blocking_IO is statically True
+ pragma Warnings (On, "unreachable code");
  WSet : aliased Fd_Set;
  Now  : aliased Timeval;
   begin

[Ada] Warn on unset objects in packages with no bodies

[Pierre-Marie de Rodat via Gcc-patches]

Fix an inconsistency, where GNAT was warning about references to unset
objects inside generic packages with no bodies but not inside ordinary
packages with no bodies.

Tested on x86_64-pc-linux-gnu, committed on trunk

gcc/ada/

* sem_ch7.adb (Analyze_Package_Declaration): Check references to
unset objects.

gcc/testsuite/

* gnat.dg/specs/discr5.ads: Expect new warnings.
* gnat.dg/specs/empty_variants.ads: Likewise.
* gnat.dg/specs/pack13.ads: Likewise.diff --git a/gcc/ada/sem_ch7.adb b/gcc/ada/sem_ch7.adb
--- a/gcc/ada/sem_ch7.adb
+++ b/gcc/ada/sem_ch7.adb
@@ -1253,6 +1253,13 @@ package body Sem_Ch7 is
   (Context  => N,
Is_Main_Unit => Parent (N) = Cunit (Main_Unit));
  end if;
+
+ --  Warn about references to unset objects, which is straightforward
+ --  for packages with no bodies. For packages with bodies this is more
+ --  complicated, because some of the objects might be set between spec
+ --  and body elaboration, in nested or child packages, etc.
+
+ Check_References (Id);
   end if;
 
   --  Set Body_Required indication on the compilation unit node


diff --git a/gcc/testsuite/gnat.dg/specs/discr5.ads b/gcc/testsuite/gnat.dg/specs/discr5.ads
--- a/gcc/testsuite/gnat.dg/specs/discr5.ads
+++ b/gcc/testsuite/gnat.dg/specs/discr5.ads
@@ -22,7 +22,7 @@ package Discr5 is
subtype Rt is R(True);
subtype Rf is R(False);
 
-   type R1 (D1 : Boolean) is new R (X) with record
+   type R1 (D1 : Boolean) is new R (X) with record -- { dg-warning "\"X\" may be referenced before it has a value" }
   FF : Float;
   case D1 is
  when True =>
@@ -38,7 +38,7 @@ package Discr5 is
subtype R1t is R1 (True);
subtype R1f is R1 (False);
 
-   type R2 (D2 : Boolean) is new R1 (Y) with record
+   type R2 (D2 : Boolean) is new R1 (Y) with record -- { dg-warning "\"Y\" may be referenced before it has a value" }
   FFF: System.Address;
   case D2 is
  when True =>
@@ -55,3 +55,4 @@ package Discr5 is
subtype R2f is R2 (False);
 
 end Discr5;
+


diff --git a/gcc/testsuite/gnat.dg/specs/empty_variants.ads b/gcc/testsuite/gnat.dg/specs/empty_variants.ads
--- a/gcc/testsuite/gnat.dg/specs/empty_variants.ads
+++ b/gcc/testsuite/gnat.dg/specs/empty_variants.ads
@@ -1,5 +1,4 @@
 --  { dg-do compile }
---  { dg-options "-gnatdF" }
 
 package Empty_Variants is

@@ -23,10 +22,11 @@ package Empty_Variants is

R : Rec;

-   I : Integer := R.I;
+   I : Integer := R.I; -- { dg-warning "\"R\.I\" may be referenced before it has a value" }
J : Integer := R.J;
K : Integer := R.K;
L : Integer := R.L;
M : Integer := R.L;
 
 end Empty_Variants;
+


diff --git a/gcc/testsuite/gnat.dg/specs/pack13.ads b/gcc/testsuite/gnat.dg/specs/pack13.ads
--- a/gcc/testsuite/gnat.dg/specs/pack13.ads
+++ b/gcc/testsuite/gnat.dg/specs/pack13.ads
@@ -20,6 +20,6 @@ package Pack13 is
 
   A : Arr;
 
-  package My_G is new G (Boolean, A(True).B);
+  package My_G is new G (Boolean, A(True).B); -- { dg-warning "\"A\" may be referenced before it has a value" }
 
 end Pack13;

[Ada] Make it clear that gnatmake passes the ball to gprbuild if -P is set

[Pierre-Marie de Rodat via Gcc-patches]

Also move -P switch description to the top of the switches list.

Tested on x86_64-pc-linux-gnu, committed on trunk

gcc/ada/

* makeusg.adb,
doc/gnat_ugn/building_executable_programs_with_gnat.rst: Move -P
to the top of switches list and make it clear that gnatmake
passes the ball to gprbuild if -P is set.
* gnat_ugn.texi: Regenerate.diff --git a/gcc/ada/doc/gnat_ugn/building_executable_programs_with_gnat.rst b/gcc/ada/doc/gnat_ugn/building_executable_programs_with_gnat.rst
--- a/gcc/ada/doc/gnat_ugn/building_executable_programs_with_gnat.rst
+++ b/gcc/ada/doc/gnat_ugn/building_executable_programs_with_gnat.rst
@@ -139,6 +139,17 @@ You may specify any of the following switches to ``gnatmake``:
   all other options.
 
 
+.. index:: -P  (gnatmake)
+
+:switch:`-P{project}`
+  Build GNAT project file ``project`` using GPRbuild. When this switch is
+  present, all other command-line switches are treated as GPRbuild switches
+  and not ``gnatmake`` switches.
+
+.. -- Comment:
+  :ref:`gnatmake_and_Project_Files`.
+
+
 .. index:: --GCC=compiler_name  (gnatmake)
 
 :switch:`--GCC={compiler_name}`
@@ -522,15 +533,6 @@ You may specify any of the following switches to ``gnatmake``:
 :switch:`-p`
   Same as :switch:`--create-missing-dirs`
 
-.. index:: -P  (gnatmake)
-
-:switch:`-P{project}`
-  Use project file ``project``. Only one such switch can be used.
-
-.. -- Comment:
-  :ref:`gnatmake_and_Project_Files`.
-
-
 .. index:: -q  (gnatmake)
 
 :switch:`-q`


diff --git a/gcc/ada/gnat_ugn.texi b/gcc/ada/gnat_ugn.texi
--- a/gcc/ada/gnat_ugn.texi
+++ b/gcc/ada/gnat_ugn.texi
@@ -21,7 +21,7 @@
 
 @copying
 @quotation
-GNAT User's Guide for Native Platforms , Jun 24, 2022
+GNAT User's Guide for Native Platforms , Jul 11, 2022
 
 AdaCore
 
@@ -7120,6 +7120,21 @@ If @code{--version} was not used, display usage, then exit disregarding
 all other options.
 @end table
 
+@geindex -P (gnatmake)
+
+
+@table @asis
+
+@item @code{-P@emph{project}}
+
+Build GNAT project file @code{project} using GPRbuild. When this switch is
+present, all other command-line switches are treated as GPRbuild switches
+and not @code{gnatmake} switches.
+@end table
+
+@c -- Comment:
+@c :ref:`gnatmake_and_Project_Files`.
+
 @geindex --GCC=compiler_name (gnatmake)
 
 
@@ -7620,19 +7635,6 @@ This switch cannot be used when invoking @code{gnatmake} with several
 Same as @code{--create-missing-dirs}
 @end table
 
-@geindex -P (gnatmake)
-
-
-@table @asis
-
-@item @code{-P@emph{project}}
-
-Use project file @code{project}. Only one such switch can be used.
-@end table
-
-@c -- Comment:
-@c :ref:`gnatmake_and_Project_Files`.
-
 @geindex -q (gnatmake)
 
 


diff --git a/gcc/ada/makeusg.adb b/gcc/ada/makeusg.adb
--- a/gcc/ada/makeusg.adb
+++ b/gcc/ada/makeusg.adb
@@ -54,6 +54,13 @@ begin
 
Display_Usage_Version_And_Help;
 
+   --  Line for -P
+
+   Write_Str ("  -Pproj   Build GNAT Project File proj using GPRbuild");
+   Write_Eol;
+   Write_Str ("   Treats all other switches as GPRbuild switches");
+   Write_Eol;
+
--  Line for -a
 
Write_Str ("  -a   Consider all files, even readonly ali files");
@@ -169,11 +176,6 @@ begin
Write_Str ("  -p   Create missing obj, lib and exec dirs");
Write_Eol;
 
-   --  Line for -P
-
-   Write_Str ("  -Pproj   Use GNAT Project File proj");
-   Write_Eol;
-
--  Line for -q
 
Write_Str ("  -q   Be quiet/terse");

[Ada] Accept aspect Yield on subprogram bodies acting as specs

[Pierre-Marie de Rodat via Gcc-patches]

A small fix for the aspect Yield defined in AI12-0279 for Ada 2022, to
accept aspect given for a subprogram body which acts as its own spec.

For example:

   procedure Switch with Yield => True is
   begin
  ...
   end Switch;

Tested on x86_64-pc-linux-gnu, committed on trunk

gcc/ada/

* sem_ch13.adb (Analyze_Aspect_Yield): Look at the entity kind,
not at the declaration kind.diff --git a/gcc/ada/sem_ch13.adb b/gcc/ada/sem_ch13.adb
--- a/gcc/ada/sem_ch13.adb
+++ b/gcc/ada/sem_ch13.adb
@@ -2724,13 +2724,11 @@ package body Sem_Ch13 is
Expr_Value : Boolean := False;
 
 begin
-   --  Check valid declarations for 'Yield
+   --  Check valid entity for 'Yield
 
-   if Nkind (N) in N_Abstract_Subprogram_Declaration
- | N_Entry_Declaration
- | N_Generic_Subprogram_Declaration
- | N_Subprogram_Declaration
- | N_Formal_Subprogram_Declaration
+   if (Is_Subprogram (E)
+ or else Is_Generic_Subprogram (E)
+ or else Is_Entry (E))
  and then not Within_Protected_Type (E)
then
   null;

[Ada] Vxworks7* - Makefile.rtl rtp vs rtp-smp cleanup - remove unused files

[Pierre-Marie de Rodat via Gcc-patches]

Only smp runtimes are built for vxworks7*, even though the -smp suffix
is removed during install. This change removes unused system packages
for rtp runtimes.

Tested on x86_64-pc-linux-gnu, committed on trunk

gcc/ada/

* libgnat/system-vxworks7-ppc-rtp.ads: Remove
* libgnat/system-vxworks7-x86-rtp.ads: Likewise.diff --git a/gcc/ada/libgnat/system-vxworks7-ppc-rtp.ads /dev/null
deleted file mode 100644
--- a/gcc/ada/libgnat/system-vxworks7-ppc-rtp.ads
+++ /dev/null
@@ -1,164 +0,0 @@
---
---  --
---GNAT RUN-TIME COMPONENTS  --
---  --
---   S Y S T E M--
---  --
--- S p e c  --
---  (VxWorks 7.x PPC RTP)   --
---  --
---  Copyright (C) 1992-2022, Free Software Foundation, Inc. --
---  --
--- This specification is derived from the Ada Reference Manual for use with --
--- GNAT. The copyright notice above, and the license provisions that follow --
--- apply solely to the  contents of the part following the private keyword. --
---  --
--- 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--
--- .  --
---  --
--- GNAT was originally developed  by the GNAT team at  New York University. --
--- Extensive contributions were provided by Ada Core Technologies Inc.  --
---  --
---
-
---  This is the VxWorks version of this package for RTPs
-
-package System is
-   pragma Pure;
-   --  Note that we take advantage of the implementation permission to make
-   --  this unit Pure instead of Preelaborable; see RM 13.7.1(15). In Ada
-   --  2005, this is Pure in any case (AI-362).
-
-   pragma No_Elaboration_Code_All;
-   --  Allow the use of that restriction in units that WITH this unit
-
-   type Name is (SYSTEM_NAME_GNAT);
-   System_Name : constant Name := SYSTEM_NAME_GNAT;
-
-   --  System-Dependent Named Numbers
-
-   Min_Int : constant := -2 ** (Standard'Max_Integer_Size - 1);
-   Max_Int : constant :=  2 ** (Standard'Max_Integer_Size - 1) - 1;
-
-   Max_Binary_Modulus: constant := 2 ** Standard'Max_Integer_Size;
-   Max_Nonbinary_Modulus : constant := 2 ** Integer'Size - 1;
-
-   Max_Base_Digits   : constant := Long_Long_Float'Digits;
-   Max_Digits: constant := Long_Long_Float'Digits;
-
-   Max_Mantissa  : constant := Standard'Max_Integer_Size - 1;
-   Fine_Delta: constant := 2.0 ** (-Max_Mantissa);
-
-   Tick  : constant := 1.0 / 60.0;
-
-   --  Storage-related Declarations
-
-   type Address is private;
-   pragma Preelaborable_Initialization (Address);
-   Null_Address : constant Address;
-
-   Storage_Unit : constant := 8;
-   Word_Size: constant := Standard'Word_Size;
-   Memory_Size  : constant := 2 ** Word_Size;
-
-   --  Address comparison
-
-   function "<"  (Left, Right : Address) return Boolean;
-   function "<=" (Left, Right : Address) return Boolean;
-   function ">"  (Left, Right : Address) return Boolean;
-   function ">=" (Left, Right : Addre

[Ada] Refine heuristics for unreachable-code warnings

[Pierre-Marie de Rodat via Gcc-patches]

This patch refines the heuristics for when we warn about unreachable
code, to avoid common false alarms.

Tested on x86_64-pc-linux-gnu, committed on trunk

gcc/ada/

* sem_ch5.adb (Check_Unreachable_Code): Refine heuristics.
* sem_util.ads, sem_util.adb (Is_Static_Constant_Name): Remove
this; instead we have a new function Is_Simple_Case in
Sem_Ch5.Check_Unreachable_Code.diff --git a/gcc/ada/sem_ch5.adb b/gcc/ada/sem_ch5.adb
--- a/gcc/ada/sem_ch5.adb
+++ b/gcc/ada/sem_ch5.adb
@@ -4393,6 +4393,31 @@ package body Sem_Ch5 is

 
procedure Check_Unreachable_Code (N : Node_Id) is
+
+  function Is_Simple_Case (N : Node_Id) return Boolean;
+  --  N is the condition of an if statement. True if N is simple enough
+  --  that we should not set Unblocked_Exit_Count in the special case
+  --  below.
+
+  
+  -- Is_Simple_Case --
+  
+
+  function Is_Simple_Case (N : Node_Id) return Boolean is
+  begin
+ return
+Is_Trivial_Boolean (N)
+   or else
+(Comes_From_Source (N)
+   and then Is_Static_Expression (N)
+   and then Nkind (N) in N_Identifier | N_Expanded_Name
+   and then Ekind (Entity (N)) = E_Constant)
+   or else
+(not In_Instance
+   and then Nkind (Original_Node (N)) = N_Op_Not
+   and then Is_Simple_Case (Right_Opnd (Original_Node (N;
+  end Is_Simple_Case;
+
   Error_Node : Node_Id;
   Nxt: Node_Id;
   P  : Node_Id;
@@ -4574,8 +4599,7 @@ package body Sem_Ch5 is
   and then No (Else_Statements (P))
   and then Is_OK_Static_Expression (Condition (P))
   and then Is_True (Expr_Value (Condition (P)))
-  and then not Is_Trivial_Boolean (Condition (P))
-  and then not Is_Static_Constant_Name (Condition (P))
+  and then not Is_Simple_Case (Condition (P))
 then
pragma Assert (Unblocked_Exit_Count = 2);
Unblocked_Exit_Count := 0;


diff --git a/gcc/ada/sem_util.adb b/gcc/ada/sem_util.adb
--- a/gcc/ada/sem_util.adb
+++ b/gcc/ada/sem_util.adb
@@ -21532,18 +21532,6 @@ package body Sem_Util is
 and then Entity (N) in Standard_True | Standard_False;
end Is_Trivial_Boolean;
 
-   -
-   -- Is_Static_Constant_Name --
-   -
-
-   function Is_Static_Constant_Name (N : Node_Id) return Boolean is
-   begin
-  return Comes_From_Source (N)
-and then Is_Static_Expression (N)
-and then Nkind (N) in N_Identifier | N_Expanded_Name
-and then Ekind (Entity (N)) = E_Constant;
-   end Is_Static_Constant_Name;
-
--
-- Is_Unchecked_Conversion_Instance --
--


diff --git a/gcc/ada/sem_util.ads b/gcc/ada/sem_util.ads
--- a/gcc/ada/sem_util.ads
+++ b/gcc/ada/sem_util.ads
@@ -2485,9 +2485,6 @@ package Sem_Util is
--  Determine whether source node N denotes "True" or "False". Note that
--  this is not true for expressions that got folded to True or False.
 
-   function Is_Static_Constant_Name (N : Node_Id) return Boolean;
-   --  True if N is a name that statically denotes a static constant.
-
function Is_Unchecked_Conversion_Instance (Id : Entity_Id) return Boolean;
--  Determine whether an arbitrary entity denotes an instance of function
--  Ada.Unchecked_Conversion.

[Ada] Ignore switches for controlling frontend warnings in GNATprove mode

[Pierre-Marie de Rodat via Gcc-patches]

In the special mode for GNATprove, ignore switches controlling frontend
warnings, like already done for the control of style checks warnings.
Also remove special handling of warning mode in Errout to make up for
the previous division of control between -gnatw (GNAT) and --warnings
(GNATprove).

Tested on x86_64-pc-linux-gnu, committed on trunk

gcc/ada/

* errout.adb (Record_Compilation_Errors): Remove global
variable.
(Compilation_Errors): Simplify.
(Initialize): Inline Reset_Warnings.
(Reset_Warnings): Remove.
* errout.ads (Reset_Warnings): Remove.
(Compilation_Errors): Update comment.
* gnat1drv.adb (Adjust_Global_Switches): Ignore all frontend
warnings in GNATprove mode, except regarding elaboration and
suspicious contracts.diff --git a/gcc/ada/errout.adb b/gcc/ada/errout.adb
--- a/gcc/ada/errout.adb
+++ b/gcc/ada/errout.adb
@@ -64,13 +64,6 @@ package body Errout is
Finalize_Called : Boolean := False;
--  Set True if the Finalize routine has been called
 
-   Record_Compilation_Errors : Boolean := False;
-   --  Record that a compilation error was witnessed during a given phase of
-   --  analysis for gnat2why. This is needed as Warning_Mode is modified twice
-   --  in gnat2why, hence Erroutc.Compilation_Errors can only return a suitable
-   --  value for each phase of analysis separately. This is updated at each
-   --  call to Compilation_Errors.
-
Warn_On_Instance : Boolean;
--  Flag set true for warning message to be posted on instance
 
@@ -252,17 +245,8 @@ package body Errout is
begin
   if not Finalize_Called then
  raise Program_Error;
-
-  --  Record that a compilation error was witnessed during a given phase of
-  --  analysis for gnat2why. This is needed as Warning_Mode is modified
-  --  twice in gnat2why, hence Erroutc.Compilation_Errors can only return a
-  --  suitable value for each phase of analysis separately.
-
   else
- Record_Compilation_Errors :=
-   Record_Compilation_Errors or else Erroutc.Compilation_Errors;
-
- return Record_Compilation_Errors;
+ return Erroutc.Compilation_Errors;
   end if;
end Compilation_Errors;
 
@@ -1914,7 +1898,10 @@ package body Errout is
 
   --  Reset counts for warnings
 
-  Reset_Warnings;
+  Warnings_Treated_As_Errors := 0;
+  Warnings_Detected := 0;
+  Warning_Info_Messages := 0;
+  Warnings_As_Errors_Count := 0;
 
   --  Initialize warnings tables
 
@@ -3414,18 +3401,6 @@ package body Errout is
   end loop;
end Remove_Warning_Messages;
 
-   
-   -- Reset_Warnings --
-   
-
-   procedure Reset_Warnings is
-   begin
-  Warnings_Treated_As_Errors := 0;
-  Warnings_Detected := 0;
-  Warning_Info_Messages := 0;
-  Warnings_As_Errors_Count := 0;
-   end Reset_Warnings;
-
--
-- Adjust_Name_Case --
--


diff --git a/gcc/ada/errout.ads b/gcc/ada/errout.ads
--- a/gcc/ada/errout.ads
+++ b/gcc/ada/errout.ads
@@ -858,11 +858,6 @@ package Errout is
--  Remove warnings on all elements of a list (Calls Remove_Warning_Messages
--  on each element of the list, see above).
 
-   procedure Reset_Warnings;
-   --  Reset the counts related to warnings. This is used both to initialize
-   --  these counts and to reset them after each phase of analysis for a given
-   --  value of Opt.Warning_Mode in gnat2why.
-
procedure Set_Ignore_Errors (To : Boolean);
--  Following a call to this procedure with To=True, all error calls are
--  ignored. A call with To=False restores the default treatment in which
@@ -910,11 +905,10 @@ package Errout is
--  matching Warnings Off pragma preceding this one.
 
function Compilation_Errors return Boolean;
-   --  Returns True if errors have been detected, or warnings in -gnatwe (treat
-   --  warnings as errors) mode. Note that it is mandatory to call Finalize
-   --  before calling this routine. To account for changes to Warning_Mode in
-   --  gnat2why between phases, the past or current presence of an error is
-   --  recorded in a global variable at each call.
+   --  Returns True if errors have been detected, or warnings when they are
+   --  treated as errors, which corresponds to switch -gnatwe in the compiler,
+   --  and other switches in other tools. Note that it is mandatory to call
+   --  Finalize before calling this routine.
 
procedure Error_Msg_CRT (Feature : String; N : Node_Id);
--  Posts a non-fatal message on node N saying that the feature identified


diff --git a/gcc/ada/gnat1drv.adb b/gcc/ada/gnat1drv.adb
--- a/gcc/ada/gnat1drv.adb
+++ b/gcc/ada/gnat1drv.adb
@@ -557,10 +557,14 @@ procedure Gnat1drv is
  Validity_Checks_On := False;
  Check_Validity_Of_Parameters := False;
 
- --  Turn off style check options since we are not interested in any
-  

[Ada] Fix buffer overrun for small string concatenation at -O0

[Pierre-Marie de Rodat via Gcc-patches]

The concatenation routines may read too much data on the source side when
the destination buffer is larger than the final result.  This change makes
sure that this does not happen any more and also removes obsolete stuff.

Tested on x86_64-pc-linux-gnu, committed on trunk

gcc/ada/

* rtsfind.ads (RE_Id): Remove RE_Str_Concat_Bounds_N values.
(RE_Unit_Table): Remove RE_Str_Concat_Bounds_N entries.
* libgnat/s-conca2.ads (Str_Concat_2): Adjust head comment.
(Str_Concat_Bounds_2): Delete.
* libgnat/s-conca2.adb (Str_Concat_2): Use the length of the last
input to size the last assignment.
(Str_Concat_Bounds_2): Delete.
* libgnat/s-conca3.ads (Str_Concat_3): Adjust head comment.
(Str_Concat_Bounds_3): Delete.
* libgnat/s-conca3.adb (Str_Concat_3): Use the length of the last
input to size the last assignment.
(Str_Concat_Bounds_3): Delete.
* libgnat/s-conca4.ads (Str_Concat_4): Adjust head comment.
(Str_Concat_Bounds_4): Delete.
* libgnat/s-conca4.adb (Str_Concat_4): Use the length of the last
input to size the last assignment.
(Str_Concat_Bounds_4): Delete.
* libgnat/s-conca5.ads (Str_Concat_5): Adjust head comment.
(Str_Concat_Bounds_5): Delete.
* libgnat/s-conca5.adb (Str_Concat_5): Use the length of the last
input to size the last assignment.
(Str_Concat_Bounds_5): Delete.
* libgnat/s-conca6.ads (Str_Concat_6): Adjust head comment.
(Str_Concat_Bounds_6): Delete.
* libgnat/s-conca6.adb (Str_Concat_6): Use the length of the last
input to size the last assignment.
(Str_Concat_Bounds_6): Delete.
* libgnat/s-conca7.ads (Str_Concat_7): Adjust head comment.
(Str_Concat_Bounds_7): Delete.
* libgnat/s-conca7.adb (Str_Concat_7): Use the length of the last
input to size the last assignment.
(Str_Concat_Bounds_7): Delete.
* libgnat/s-conca8.ads (Str_Concat_8): Adjust head comment.
(Str_Concat_Bounds_8): Delete.
* libgnat/s-conca8.adb (Str_Concat_8): Use the length of the last
input to size the last assignment.
(Str_Concat_Bounds_8): Delete.
* libgnat/s-conca9.ads (Str_Concat_9): Adjust head comment.
(Str_Concat_Bounds_9): Delete.
* libgnat/s-conca9.adb (Str_Concat_9): Use the length of the last
input to size the last assignment.
(Str_Concat_Bounds_9): Delete.diff --git a/gcc/ada/libgnat/s-conca2.adb b/gcc/ada/libgnat/s-conca2.adb
--- a/gcc/ada/libgnat/s-conca2.adb
+++ b/gcc/ada/libgnat/s-conca2.adb
@@ -46,26 +46,8 @@ package body System.Concat_2 is
   R (F .. L) := S1;
 
   F := L + 1;
-  L := R'Last;
+  L := F + S2'Length - 1;
   R (F .. L) := S2;
end Str_Concat_2;
 
-   -
-   -- Str_Concat_Bounds_2 --
-   -
-
-   procedure Str_Concat_Bounds_2
- (Lo, Hi : out Natural;
-  S1, S2 : String)
-   is
-   begin
-  if S1 = "" then
- Lo := S2'First;
- Hi := S2'Last;
-  else
- Lo := S1'First;
- Hi := S1'Last + S2'Length;
-  end if;
-   end Str_Concat_Bounds_2;
-
 end System.Concat_2;


diff --git a/gcc/ada/libgnat/s-conca2.ads b/gcc/ada/libgnat/s-conca2.ads
--- a/gcc/ada/libgnat/s-conca2.ads
+++ b/gcc/ada/libgnat/s-conca2.ads
@@ -36,15 +36,8 @@ package System.Concat_2 is
 
procedure Str_Concat_2 (R : out String; S1, S2 : String);
--  Performs the operation R := S1 & S2. The bounds of R are known to be
-   --  correct (usually set by a call to the Str_Concat_Bounds_2 procedure
-   --  below), so no bounds checks are required, and it is known that none of
+   --  sufficient so no bound checks are required, and it is known that none of
--  the input operands overlaps R. No assumptions can be made about the
--  lower bounds of any of the operands.
 
-   procedure Str_Concat_Bounds_2
- (Lo, Hi : out Natural;
-  S1, S2 : String);
-   --  Assigns to Lo..Hi the bounds of the result of concatenating the two
-   --  given strings, following the rules in the RM regarding null operands.
-
 end System.Concat_2;


diff --git a/gcc/ada/libgnat/s-conca3.adb b/gcc/ada/libgnat/s-conca3.adb
--- a/gcc/ada/libgnat/s-conca3.adb
+++ b/gcc/ada/libgnat/s-conca3.adb
@@ -29,8 +29,6 @@
 --  --
 --
 
-with System.Concat_2;
-
 package body System.Concat_3 is
 
pragma Suppress (All_Checks);
@@ -52,25 +50,8 @@ package body System.Concat_3 is
   R (F .. L) := S2;
 
   F := L + 1;
-  L := R'Last;
+  L := F + S3'Length - 1;
   R (F .. L) := S3;
end Str_Concat_3;
 
-   -
-   -- Str_Concat_Bounds_3 --
-   -
-
-   procedure Str_Concat_Bounds_3
- (Lo, Hi : out Nat

[Ada] Avoid namespace pollution for Next and Previous

[Pierre-Marie de Rodat via Gcc-patches]

This patch renames Next and Previous in a-convec.ads and other
containers to be _Next and _Previous, to avoid namespace pollution.  The
compiler now uses the leading-underscore names to look them up.

The scanner is changed to allow this.

Tested on x86_64-pc-linux-gnu, committed on trunk

gcc/ada/

* exp_ch5.adb (Expand_Iterator_Loop_Over_Array): Use _Next and
_Previous in the optimized expansion of "for ... of".  No longer
need to check parameter profiles for these, because the
leading-underscore names are unique.
* libgnat/a-convec.ads (_Next, _Previous): Renamings of Next and
Previous, to avoid namespace pollution.
* libgnat/a-cbdlli.ads, libgnat/a-cbhama.ads,
libgnat/a-cbhase.ads, libgnat/a-cbmutr.ads,
libgnat/a-cborma.ads, libgnat/a-cborse.ads,
libgnat/a-cdlili.ads, libgnat/a-cidlli.ads,
libgnat/a-cihama.ads, libgnat/a-cihase.ads,
libgnat/a-cimutr.ads, libgnat/a-ciorma.ads,
libgnat/a-ciorse.ads, libgnat/a-cobove.ads,
libgnat/a-cohama.ads, libgnat/a-cohase.ads,
libgnat/a-coinve.ads, libgnat/a-comutr.ads,
libgnat/a-coorma.ads, libgnat/a-coorse.ads: Likewise.  Also,
remove duplicated comments -- refer to one comment about _Next,
_Previous, Pseudo_Reference in libgnat/a-convec.ads. DRY.
* scng.adb (Scan): Allow leading underscores in identifiers in
the run-time library.
* snames.ads-tmpl (Name_uNext, Name_uPrevious): New names with
leading underscores.diff --git a/gcc/ada/exp_ch5.adb b/gcc/ada/exp_ch5.adb
--- a/gcc/ada/exp_ch5.adb
+++ b/gcc/ada/exp_ch5.adb
@@ -4924,7 +4924,8 @@ package body Exp_Ch5 is
 
--  In the optimized case, we make use of these:
 
-   -- procedure Next (Position : in out Cursor); -- instead of Iter.Next
+   -- procedure _Next (Position : in out Cursor); -- instead of Iter.Next
+   --(or _Previous for reverse loops)
 
-- function Pseudo_Reference
--   (Container : aliased Vector'Class) return Reference_Control_Type;
@@ -4939,6 +4940,11 @@ package body Exp_Ch5 is
--  pollute the namespace for clients. The compiler has no trouble breaking
--  privacy to call things in the private part of an instance.)
 
+   --  Note that Next and Previous are renamed as _Next and _Previous with
+   --  leading underscores. Leading underscores are illegal in Ada, but we
+   --  allow them in the run-time library. This allows us to avoid polluting
+   --  the user-visible namespaces.
+
--  Source:
 
--  for X of My_Vector loop
@@ -4989,7 +4995,7 @@ package body Exp_Ch5 is
--  X.Count := X.Count + 1;
--  ...
--
-   --  Next (Cur); -- or Prev
+   --  _Next (Cur); -- or _Previous
--  --  This is instead of "Cur := Next (Iter, Cur);"
--  end;
--  --  No finalization here
@@ -5015,13 +5021,14 @@ package body Exp_Ch5 is
   Stats: List_Id := Statements (N);
   --  Maybe wrapped in a conditional if a filter is present
 
-  Cursor: Entity_Id;
-  Decl  : Node_Id;
-  Iter_Type : Entity_Id;
-  Iterator  : Entity_Id;
-  Name_Init : Name_Id;
-  Name_Step : Name_Id;
-  New_Loop  : Node_Id;
+  Cursor : Entity_Id;
+  Decl   : Node_Id;
+  Iter_Type  : Entity_Id;
+  Iterator   : Entity_Id;
+  Name_Init  : Name_Id;
+  Name_Step  : Name_Id;
+  Name_Fast_Step : Name_Id;
+  New_Loop   : Node_Id;
 
   Fast_Element_Access_Op : Entity_Id := Empty;
   Fast_Step_Op   : Entity_Id := Empty;
@@ -5049,9 +5056,11 @@ package body Exp_Ch5 is
   if Reverse_Present (I_Spec) then
  Name_Init := Name_Last;
  Name_Step := Name_Previous;
+ Name_Fast_Step := Name_uPrevious;
   else
  Name_Init := Name_First;
  Name_Step := Name_Next;
+ Name_Fast_Step := Name_uNext;
   end if;
 
   --  The type of the iterator is the return type of the Iterate function
@@ -5189,14 +5198,13 @@ package body Exp_Ch5 is
 
 Iter_Pack := Scope (Root_Type (Etype (Iter_Type)));
 
---  Find declarations needed for "for ... of" optimization
+--  Find declarations needed for "for ... of" optimization.
 --  These declarations come from GNAT sources or sources
 --  derived from them. User code may include additional
 --  overloadings with similar names, and we need to perforn
 --  some reasonable resolution to find the needed primitives.
---  It is unclear whether this mechanism is fragile if a user
---  makes arbitrary changes to the private part of a package
---  that supports iterators.
+--  Note that we use _Next or _Previous to avoid picking up
+--  some arbitrary user-defined Next or Previous.
 
  

[Ada] Remove out-of-range warning in unreachable code

[Pierre-Marie de Rodat via Gcc-patches]

This patch removes a warning in examples like this:

if cond then
   return; -- or other jump
end if;
X := ...; -- where the value is out of range

where cond is known at compile time. It could, for example, be a generic
formal parameter that is known to be True in some instances.

As a side effect, this patch adds new warnings about unreachable code.

Tested on x86_64-pc-linux-gnu, committed on trunk

gcc/ada/

* gnatls.adb (Output_License_Information): Remove pragma
No_Return; call sites deal with Exit_Program.
* libgnat/g-socthi.adb (C_Connect): Suppress warning about
unreachable code.
* sem_ch5.adb (Check_Unreachable_Code): Special-case if
statements with static conditions.  If we remove unreachable
code (including the return statement) from a function, add
"raise Program_Error", so we won't warn about missing returns.
Remove Original_Node in test for N_Raise_Statement; it's not
needed.  Remove test for CodePeer_Mode; if Operating_Mode =
Generate_Code, then CodePeer_Mode can't be True.  Misc cleanup.
Do not reuse Nxt variable for unrelated purpose (the usage in
the Kill_Dead_Code loop is entirely local to the loop).
* sem_ch6.adb: Add check for Is_Transfer. Misc cleanup.
* sem_prag.adb: Minor.
* sem_res.adb: Minor.
* sem_util.adb: Minor cleanup.
(Is_Trivial_Boolean): Move to nonnested place, so it can be
called from elsewhere.
(Is_Static_Constant_Boolean): New function.
* sem_util.ads (Is_Trivial_Boolean): Export.
(Is_Static_Constant_Boolean): New function.diff --git a/gcc/ada/gnatls.adb b/gcc/ada/gnatls.adb
--- a/gcc/ada/gnatls.adb
+++ b/gcc/ada/gnatls.adb
@@ -189,7 +189,6 @@ procedure Gnatls is
--  Print usage message
 
procedure Output_License_Information;
-   pragma No_Return (Output_License_Information);
--  Output license statement, and if not found, output reference to COPYING
 
function Image (Restriction : Restriction_Id) return String;
@@ -894,8 +893,6 @@ procedure Gnatls is
  & " for license terms.");
 Write_Eol;
   end case;
-
-  Exit_Program (E_Success);
end Output_License_Information;
 
---


diff --git a/gcc/ada/libgnat/g-socthi.adb b/gcc/ada/libgnat/g-socthi.adb
--- a/gcc/ada/libgnat/g-socthi.adb
+++ b/gcc/ada/libgnat/g-socthi.adb
@@ -187,7 +187,9 @@ package body GNAT.Sockets.Thin is
  return Res;
   end if;
 
-  declare
+  pragma Warnings (Off, "unreachable code");
+  declare -- unreachable if Thread_Blocking_IO is statically True
+ pragma Warnings (On, "unreachable code");
  WSet : aliased Fd_Set;
  Now  : aliased Timeval;
 


diff --git a/gcc/ada/sem_ch5.adb b/gcc/ada/sem_ch5.adb
--- a/gcc/ada/sem_ch5.adb
+++ b/gcc/ada/sem_ch5.adb
@@ -4425,7 +4425,7 @@ package body Sem_Ch5 is
 
 if not (Present (Current_Subprogram)
 and then Ekind (Current_Subprogram) = E_Function
-and then (Nkind (Original_Node (N)) = N_Raise_Statement
+and then (Nkind (N) in N_Raise_Statement
 or else
   (Nkind (N) = N_Procedure_Call_Statement
and then Is_Entity_Name (Name (N))
@@ -,39 +,59 @@ package body Sem_Ch5 is
--  unreachable code, since it is useless and we don't want
--  to generate junk warnings.
 
-   --  We skip this step if we are not in code generation mode
-   --  or CodePeer mode.
+   --  We skip this step if we are not in code generation mode.
 
--  This is the one case where we remove dead code in the
--  semantics as opposed to the expander, and we do not want
--  to remove code if we are not in code generation mode, since
--  this messes up the tree or loses useful information for
-   --  CodePeer.
+   --  analysis tools such as CodePeer.
 
--  Note that one might react by moving the whole circuit to
--  exp_ch5, but then we lose the warning in -gnatc mode.
 
-   if Operating_Mode = Generate_Code
- and then not CodePeer_Mode
-   then
+   if Operating_Mode = Generate_Code then
   loop
- Nxt := Next (N);
-
- --  Quit deleting when we have nothing more to delete
- --  or if we hit a label (since someone could transfer
- --  control to a label, so we should not delete it).
+ declare
+Del : constant Node_Id := Next (N);
+--  Node to be possibly deleted
+ begin
+--  Quit deleting

[Ada] Fix spurious warning on unreferenced internal generic instance

[Pierre-Marie de Rodat via Gcc-patches]

This patch removes a spurious warning, saying that an internal entity of
a generic formal package is unreferenced. The immediate cause of this
warning is that the internal entity is explicitly flagged as coming from
source.

The explicit flagging was added decades ago to fix a missing
cross-reference in the ALI file. Apparently these days the
cross-references work fine without this flag.

Tested on x86_64-pc-linux-gnu, committed on trunk

gcc/ada/

* sem_ch12.adb (Analyze_Package_Instantiation): Remove dubious
call to Set_Comes_From_Source.diff --git a/gcc/ada/sem_ch12.adb b/gcc/ada/sem_ch12.adb
--- a/gcc/ada/sem_ch12.adb
+++ b/gcc/ada/sem_ch12.adb
@@ -4297,7 +4297,6 @@ package body Sem_Ch12 is
 
   if Nkind (N) = N_Package_Instantiation then
  Act_Decl_Id := New_Copy (Defining_Entity (N));
- Set_Comes_From_Source (Act_Decl_Id, True);
 
  if Nkind (Defining_Unit_Name (N)) = N_Defining_Program_Unit_Name then
 Act_Decl_Name :=

[Ada] Proper freezing for dispatching expression functions.

[Pierre-Marie de Rodat via Gcc-patches]

In the case of an expression function that is a primitive function of a
tagged type, freezing the tagged type needs to freeze the function (and
its return expression). A bug in this area could result in incorrect
behavior both at compile time and at run time. At compile time, freezing
rule violations could go undetected so that an illegal program could be
incorrectly accepted. At run time, a dispatching call to the primitive
function could end up dispatching through a not-yet-initialized slot in
the dispatch table, typically (although not always) resulting in a
segmentation fault.

Tested on x86_64-pc-linux-gnu, committed on trunk

gcc/ada/

* freeze.adb (Check_Expression_Function.Find_Constant): Add a
check that a type that is referenced as the prefix of an
attribute is fully declared.
(Freeze_And_Append): Do not freeze the profile when freezing an
expression function.
(Freeze_Entity): When a tagged type is frozen, also freeze any
primitive operations of the type that are expression functions.
* sem_ch6.adb (Analyze_Subprogram_Body_Helper): Do not prevent
freezing associated with an expression function body if the
function is a dispatching op.diff --git a/gcc/ada/freeze.adb b/gcc/ada/freeze.adb
--- a/gcc/ada/freeze.adb
+++ b/gcc/ada/freeze.adb
@@ -1470,6 +1470,10 @@ package body Freeze is
 if Is_Entity_Name (Prefix (Nod))
   and then Is_Type (Entity (Prefix (Nod)))
 then
+   if Expander_Active then
+  Check_Fully_Declared (Entity (Prefix (Nod)), N);
+   end if;
+
Freeze_Before (N, Entity (Prefix (Nod)));
 end if;
  end if;
@@ -2632,7 +2636,13 @@ package body Freeze is
   N  : Node_Id;
   Result : in out List_Id)
is
-  L : constant List_Id := Freeze_Entity (Ent, N);
+  --  Freezing an Expression_Function does not freeze its profile:
+  --  the formals will have been frozen otherwise before the E_F
+  --  can be called.
+
+  L : constant List_Id :=
+Freeze_Entity
+  (Ent, N, Do_Freeze_Profile => not Is_Expression_Function (Ent));
begin
   if Is_Non_Empty_List (L) then
  if Result = No_List then
@@ -7807,11 +7817,37 @@ package body Freeze is
  --  type itself is frozen, because the class-wide type refers to the
  --  tagged type which generates the class.
 
+ --  For a tagged type, freeze explicitly those primitive operations
+ --  that are expression functions, which otherwise have no clear
+ --  freeze point: these have to be frozen before the dispatch table
+ --  for the type is built, and before any explicit call to the
+ --  primitive, which would otherwise be the freeze point for it.
+
  if Is_Tagged_Type (E)
and then not Is_Class_Wide_Type (E)
and then Present (Class_Wide_Type (E))
  then
 Freeze_And_Append (Class_Wide_Type (E), N, Result);
+
+declare
+   Ops  : constant Elist_Id := Primitive_Operations (E);
+
+   Elmt : Elmt_Id;
+   Subp : Entity_Id;
+
+begin
+   if Ops /= No_Elist  then
+  Elmt := First_Elmt (Ops);
+  while Present (Elmt) loop
+ Subp := Node (Elmt);
+ if Is_Expression_Function (Subp) then
+Freeze_And_Append (Subp, N, Result);
+ end if;
+
+ Next_Elmt (Elmt);
+  end loop;
+   end if;
+end;
  end if;
   end if;
 


diff --git a/gcc/ada/sem_ch6.adb b/gcc/ada/sem_ch6.adb
--- a/gcc/ada/sem_ch6.adb
+++ b/gcc/ada/sem_ch6.adb
@@ -4508,7 +4508,16 @@ package body Sem_Ch6 is
 --  This also needs to be done in the case of an ignored Ghost
 --  expression function, where the expander isn't active.
 
-Set_Is_Frozen (Spec_Id);
+--  A further complication arises if the expression function is
+--  a primitive operation of a tagged type: in that case the
+--  function entity must be frozen before the dispatch table for
+--  the type is constructed, so it will be frozen like other local
+--  entities, at the end of the current scope.
+
+if not Is_Dispatching_Operation (Spec_Id) then
+   Set_Is_Frozen (Spec_Id);
+end if;
+
 Mask_Types := Mask_Unfrozen_Types (Spec_Id);
 
  elsif not Is_Frozen (Spec_Id)

[Ada] Fix missing Overflow and Range checks

[Pierre-Marie de Rodat via Gcc-patches]

While doing Preanalysis (as is the case during ghost code handling),
some range and/or overflow checks can be saved (see Saved_Checks in
checks.adb) and later one omitted as they would be redundant (see
Find_Check in checks.adb). In the case of ghost code, the node being
Preanalyzed is a temporary copy that is discarded, so its corresponding
check is not expanded later. The node that gets expanded later is not
having any checks expanded as it is wrongly assumed it has already been
done before.

As is already the case in Preanalyze_And_Resolve, this change suppresses
all checks during Preanalyze except for GNATprove mode.

Tested on x86_64-pc-linux-gnu, committed on trunk

gcc/ada/

* sem.adb (Preanalyze): Suppress checks when not in GNATprove
mode.
* sem_res.adb (Preanalyze_And_Resolve): Add cross reference in
comment to above procedure.
* sinfo.ads: Typo fix in comment.diff --git a/gcc/ada/sem.adb b/gcc/ada/sem.adb
--- a/gcc/ada/sem.adb
+++ b/gcc/ada/sem.adb
@@ -1338,7 +1338,15 @@ package body Sem is
   Full_Analysis := False;
   Expander_Mode_Save_And_Set (False);
 
-  Analyze (N);
+  --  See comment in sem_res.adb for Preanalyze_And_Resolve
+
+  if GNATprove_Mode
+or else Nkind (Parent (N)) = N_Simple_Return_Statement
+  then
+ Analyze (N);
+  else
+ Analyze (N, Suppress => All_Checks);
+  end if;
 
   Expander_Mode_Restore;
   Full_Analysis := Save_Full_Analysis;


diff --git a/gcc/ada/sem_res.adb b/gcc/ada/sem_res.adb
--- a/gcc/ada/sem_res.adb
+++ b/gcc/ada/sem_res.adb
@@ -2046,16 +2046,18 @@ package body Sem_Res is
   Full_Analysis := False;
   Expander_Mode_Save_And_Set (False);
 
+  --  See also Preanalyze_And_Resolve in sem.adb for similar handling
+
   --  Normally, we suppress all checks for this preanalysis. There is no
   --  point in processing them now, since they will be applied properly
   --  and in the proper location when the default expressions reanalyzed
   --  and reexpanded later on. We will also have more information at that
   --  point for possible suppression of individual checks.
 
-  --  However, in SPARK mode, most expansion is suppressed, and this
-  --  later reanalysis and reexpansion may not occur. SPARK mode does
+  --  However, in GNATprove mode, most expansion is suppressed, and this
+  --  later reanalysis and reexpansion may not occur. GNATprove mode does
   --  require the setting of checking flags for proof purposes, so we
-  --  do the SPARK preanalysis without suppressing checks.
+  --  do the GNATprove preanalysis without suppressing checks.
 
   --  This special handling for SPARK mode is required for example in the
   --  case of Ada 2012 constructs such as quantified expressions, which are


diff --git a/gcc/ada/sinfo.ads b/gcc/ada/sinfo.ads
--- a/gcc/ada/sinfo.ads
+++ b/gcc/ada/sinfo.ads
@@ -554,9 +554,9 @@ package Sinfo is
--  The tree after this light expansion should be fully analyzed
--  semantically, which sometimes requires the insertion of semantic
--  preanalysis, for example for subprogram contracts and pragma
-   --  check/assert. In particular, all expression must have their proper type,
-   --  and semantic links should be set between tree nodes (partial to full
-   --  view, etc.) Some kinds of nodes should be either absent, or can be
+   --  check/assert. In particular, all expressions must have their proper
+   --  type, and semantic links should be set between tree nodes (partial to
+   --  full view, etc.). Some kinds of nodes should be either absent, or can be
--  ignored by the formal verification backend:
 
--  N_Object_Renaming_Declaration: can be ignored safely

[Ada] Add one more leading underscore to couple of exported symbols

[Pierre-Marie de Rodat via Gcc-patches]

For the sake of consistency with other runtime units.

Tested on x86_64-pc-linux-gnu, committed on trunk

gcc/ada/

* libgnat/s-stchop.ads: Use a double underscore prefix for symbols.diff --git a/gcc/ada/libgnat/s-stchop.ads b/gcc/ada/libgnat/s-stchop.ads
--- a/gcc/ada/libgnat/s-stchop.ads
+++ b/gcc/ada/libgnat/s-stchop.ads
@@ -72,7 +72,7 @@ package System.Stack_Checking.Operations is
 private
Cache : aliased Stack_Access := Null_Stack;
 
-   pragma Export (C, Cache, "_gnat_stack_cache");
-   pragma Export (C, Stack_Check, "_gnat_stack_check");
+   pragma Export (C, Cache, "__gnat_stack_cache");
+   pragma Export (C, Stack_Check, "__gnat_stack_check");
 
 end System.Stack_Checking.Operations;

[Ada] Ignore exceptions in task termination handlers

[Pierre-Marie de Rodat via Gcc-patches]

This patch fixes a bug in which if the environment task has a specific
termination handler, and that handler raises an exception, the handler
is called recursively, causing infinite recursion. The RM requires such
exceptions to be ignored.

Tested on x86_64-pc-linux-gnu, committed on trunk

gcc/ada/

* libgnarl/s-solita.adb (Task_Termination_Handler_T): Ignore all
exceptions propagated by Specific_Handler.
* libgnarl/s-tassta.adb, libgnarl/s-taskin.ads: Minor.diff --git a/gcc/ada/libgnarl/s-solita.adb b/gcc/ada/libgnarl/s-solita.adb
--- a/gcc/ada/libgnarl/s-solita.adb
+++ b/gcc/ada/libgnarl/s-solita.adb
@@ -188,7 +188,14 @@ package body System.Soft_Links.Tasking is
   --  fall-back handler applies only to the dependent tasks of the task".
 
   if Self_Id.Common.Specific_Handler /= null then
- Self_Id.Common.Specific_Handler.all (Cause, Self_Id, EO);
+ begin
+Self_Id.Common.Specific_Handler.all (Cause, Self_Id, EO);
+ exception
+--  RM-C.7.3(16) requires all exceptions raised here to be ignored
+
+when others =>
+   null;
+ end;
   end if;
end Task_Termination_Handler_T;
 


diff --git a/gcc/ada/libgnarl/s-taskin.ads b/gcc/ada/libgnarl/s-taskin.ads
--- a/gcc/ada/libgnarl/s-taskin.ads
+++ b/gcc/ada/libgnarl/s-taskin.ads
@@ -1168,7 +1168,7 @@ package System.Tasking is
   --
   --  Protection: Self.L. Once a task has set Self.Stage to Completing, it
   --  has exclusive access to this field.
-   end record;
+   end record; -- Ada_Task_Control_Block
 

-- Initialization --


diff --git a/gcc/ada/libgnarl/s-tassta.adb b/gcc/ada/libgnarl/s-tassta.adb
--- a/gcc/ada/libgnarl/s-tassta.adb
+++ b/gcc/ada/libgnarl/s-tassta.adb
@@ -1307,10 +1307,8 @@ package body System.Tasking.Stages is
   if TH /= null then
  begin
 TH.all (Cause, Self_ID, EO);
-
  exception
-
---  RM-C.7.3 requires all exceptions raised here to be ignored
+--  RM-C.7.3(16) requires all exceptions raised here to be ignored
 
 when others =>
null;

[Ada] Add new unbounded and indefinite formal doubly linked list

[Pierre-Marie de Rodat via Gcc-patches]

Before this patch, the only formal doubly linked lists were bounded and
definite. This means that it is necessary to provide their maximum
length or capacity at instantiation and that they can only be used with
definite element types.

The formal lists added by this patch are unbounded and indefinite.
Their length grows dynamically until Count_Type'Last. This makes them
easier to use but requires the use of dynamic allocation and controlled
types.

Tested on x86_64-pc-linux-gnu, committed on trunk

gcc/ada/

* libgnat/a-cfidll.adb, libgnat/a-cfidll.ads: Implementation
files of the formal unbounded indefinite list.
* Makefile.rtl, impunit.adb: Take into account the add of the
new files.

patch.diff.gz
Description: application/gzip

[Ada] Clean up scanner

[Pierre-Marie de Rodat via Gcc-patches]

This patch removes some obsolete code in the scanner and related files,
and corrects some comments. Tok_Special is used only by the
preprocessor, and uses only the two characters '#' and '$'.

It might be simpler to have a single flag indicating we're scanning for
preprocessing, instead of the Special_Characters array and the
End_Of_Line_Is_Token flag, but that's for another day.

Tested on x86_64-pc-linux-gnu, committed on trunk

gcc/ada/

* scans.ads: Fix obsolete comments about Tok_Special, and give
Special_Character a predicate assuring it is one of the two
characters used in preprocessing.
* scng.ads: Clean up comments.
* scng.adb: Clean up handling of Tok_Special.  Remove comment
about '@' (target_name), which doesn't seem very helpful.
Set_Special_Character will now blow up if given anything other
than '#' and '$', because of the predicate on Special_Character;
it's not clear why it used to say "when others => null;".
Remove Comment_Is_Token, which is not used.
* scn.ads: Remove commented-out use clause.  Remove redundant
comment.
* ali-util.adb: Use "is null" for do-nothing procedures.
* gprep.adb (Post_Scan): Use "is null".diff --git a/gcc/ada/ali-util.adb b/gcc/ada/ali-util.adb
--- a/gcc/ada/ali-util.adb
+++ b/gcc/ada/ali-util.adb
@@ -42,15 +42,12 @@ package body ALI.Util is
--  empty, because we don't want to report any errors when computing
--  a source checksum.
 
-   procedure Post_Scan;
+   procedure Post_Scan is null;
 
-   procedure Error_Msg (Msg : String; Flag_Location : Source_Ptr);
-
-   procedure Error_Msg_S (Msg : String);
-
-   procedure Error_Msg_SC (Msg : String);
-
-   procedure Error_Msg_SP (Msg : String);
+   procedure Error_Msg (Msg : String; Flag_Location : Source_Ptr) is null;
+   procedure Error_Msg_S (Msg : String) is null;
+   procedure Error_Msg_SC (Msg : String) is null;
+   procedure Error_Msg_SP (Msg : String) is null;
 
--  Instantiation of Styleg, needed to instantiate Scng
 
@@ -85,47 +82,6 @@ package body ALI.Util is
   return Checksum1 = Checksum2 and then Checksum1 /= Checksum_Error;
end Checksums_Match;
 
-   ---
-   -- Error_Msg --
-   ---
-
-   procedure Error_Msg (Msg : String; Flag_Location : Source_Ptr) is
-  pragma Warnings (Off, Msg);
-  pragma Warnings (Off, Flag_Location);
-   begin
-  null;
-   end Error_Msg;
-
-   -
-   -- Error_Msg_S --
-   -
-
-   procedure Error_Msg_S (Msg : String) is
-  pragma Warnings (Off, Msg);
-   begin
-  null;
-   end Error_Msg_S;
-
-   --
-   -- Error_Msg_SC --
-   --
-
-   procedure Error_Msg_SC (Msg : String) is
-  pragma Warnings (Off, Msg);
-   begin
-  null;
-   end Error_Msg_SC;
-
-   --
-   -- Error_Msg_SP --
-   --
-
-   procedure Error_Msg_SP (Msg : String) is
-  pragma Warnings (Off, Msg);
-   begin
-  null;
-   end Error_Msg_SP;
-
---
-- Get_File_Checksum --
---
@@ -192,15 +148,6 @@ package body ALI.Util is
   Interfaces.Reset;
end Initialize_ALI_Source;
 
-   ---
-   -- Post_Scan --
-   ---
-
-   procedure Post_Scan is
-   begin
-  null;
-   end Post_Scan;
-
--
-- Read_Withed_ALIs --
--


diff --git a/gcc/ada/gprep.adb b/gcc/ada/gprep.adb
--- a/gcc/ada/gprep.adb
+++ b/gcc/ada/gprep.adb
@@ -93,8 +93,8 @@ package body GPrep is
procedure Display_Copyright;
--  Display the copyright notice
 
-   procedure Post_Scan;
-   --  Null procedure, needed by instantiation of Scng below
+   procedure Post_Scan is null;
+   --  Needed by instantiation of Scng below
 
package Scanner is new Scng
  (Post_Scan,
@@ -327,15 +327,6 @@ package body GPrep is
   New_Line (Outfile.all);
end New_EOL_To_Outfile;
 
-   ---
-   -- Post_Scan --
-   ---
-
-   procedure Post_Scan is
-   begin
-  null;
-   end Post_Scan;
-

-- Preprocess_Infile_Name --



diff --git a/gcc/ada/scans.ads b/gcc/ada/scans.ads
--- a/gcc/ada/scans.ads
+++ b/gcc/ada/scans.ads
@@ -210,15 +210,11 @@ package Scans is
 
   Tok_End_Of_Line,
   --  Represents an end of line. Not used during normal compilation scans
-  --  where end of line is ignored. Active for preprocessor scanning and
-  --  also when scanning project files (where it is needed because of ???)
+  --  where end of line is ignored. Active for preprocessor scanning.
 
   Tok_Special,
-  --  AI12-0125-03 : target name as abbreviation for LHS
-
-  --  Otherwise used only in preprocessor scanning (to represent one of
-  --  the characters '#', '$', '?', '@', '`', '\', '^', '~', or '_'. The
-  --  character value itself is stored in 

[Ada] Warn about unreachable code after calls with No_Return

[Pierre-Marie de Rodat via Gcc-patches]

GNAT was already warning about unreachable code after raise/goto/exit
statements, but not after calls to procedures with No_Return. Now this
warning is extended.

Also, previously the warning was suppressed for unreachable RETURN after
RAISE statements. Now this suppression is narrowed to functions, because
only in function such a RETURN statement might be indeed needed (where
it is the only RETURN statement of a function).

Tested on x86_64-pc-linux-gnu, committed on trunk

gcc/ada/

* sem_ch5.adb (Check_Unreachable_Code): Extend suppression to
calls with No_Return aspect, but narrow it to functions.
* sem_res.adb (Resolve_Call): Warn about unreachable code after
calls with No_Return.diff --git a/gcc/ada/sem_ch5.adb b/gcc/ada/sem_ch5.adb
--- a/gcc/ada/sem_ch5.adb
+++ b/gcc/ada/sem_ch5.adb
@@ -4418,12 +4418,20 @@ package body Sem_Ch5 is
  elsif Comes_From_Source (Nxt)
and then Is_Statement (Nxt)
  then
---  Special very annoying exception. If we have a return that
---  follows a raise, then we allow it without a warning, since
---  the Ada RM annoyingly requires a useless return here.
-
-if Nkind (Original_Node (N)) /= N_Raise_Statement
-  or else Nkind (Nxt) /= N_Simple_Return_Statement
+--  Special very annoying exception. Ada RM 6.5(5) annoyingly
+--  requires functions to have at least one return statement, so
+--  don't complain about a simple return that follows a raise or a
+--  call to procedure with No_Return.
+
+if not (Present (Current_Subprogram)
+and then Ekind (Current_Subprogram) = E_Function
+and then (Nkind (Original_Node (N)) = N_Raise_Statement
+or else
+  (Nkind (N) = N_Procedure_Call_Statement
+   and then Is_Entity_Name (Name (N))
+   and then Present (Entity (Name (N)))
+   and then No_Return (Entity (Name (N)
+and then Nkind (Nxt) = N_Simple_Return_Statement)
 then
--  The rather strange shenanigans with the warning message
--  here reflects the fact that Kill_Dead_Code is very good at


diff --git a/gcc/ada/sem_res.adb b/gcc/ada/sem_res.adb
--- a/gcc/ada/sem_res.adb
+++ b/gcc/ada/sem_res.adb
@@ -62,6 +62,7 @@ with Sem_Case;   use Sem_Case;
 with Sem_Cat;use Sem_Cat;
 with Sem_Ch3;use Sem_Ch3;
 with Sem_Ch4;use Sem_Ch4;
+with Sem_Ch5;use Sem_Ch5;
 with Sem_Ch6;use Sem_Ch6;
 with Sem_Ch8;use Sem_Ch8;
 with Sem_Ch13;   use Sem_Ch13;
@@ -7193,6 +7194,14 @@ package body Sem_Res is
 
   Analyze_Dimension_Call (N, Nam);
 
+  --  Check unreachable code after calls to procedures with No_Return
+
+  if Ekind (Nam) = E_Procedure
+and then No_Return (Nam)
+  then
+ Check_Unreachable_Code (N);
+  end if;
+
   --  All done, evaluate call and deal with elaboration issues
 
   Eval_Call (N);

[Ada] Remove excessive guard in detection of access-to-variable objects

[Pierre-Marie de Rodat via Gcc-patches]

It is safe to call Is_Access_Variable without calling
Is_Access_Object_Type before. Compiler cleanup only; semantics is
unaffected.

Tested on x86_64-pc-linux-gnu, committed on trunk

gcc/ada/

* sem_util.adb (Is_Variable): Remove excessive guard.diff --git a/gcc/ada/sem_util.adb b/gcc/ada/sem_util.adb
--- a/gcc/ada/sem_util.adb
+++ b/gcc/ada/sem_util.adb
@@ -21896,7 +21896,6 @@ package body Sem_Util is
   or else (K = E_Component
 and then not In_Protected_Function (E))
   or else (Present (Etype (E))
-and then Is_Access_Object_Type (Etype (E))
 and then Is_Access_Variable (Etype (E))
 and then Is_Dereferenced (N))
   or else K = E_Out_Parameter

[Ada] Support ghost generic formal parameters

[Pierre-Marie de Rodat via Gcc-patches]

This adds support in GNAT for ghost generic formal parameters, as
included in SPARK RM 6.9.

Tested on x86_64-pc-linux-gnu, committed on trunk

gcc/ada/

* ghost.adb (Check_Ghost_Context): Delay checking for generic
associations.
(Check_Ghost_Context_In_Generic_Association): Perform ghost
checking in analyzed generic associations.
(Check_Ghost_Formal_Procedure_Or_Package): Check SPARK RM
6.9(13-14) for formal procedures and packages.
(Check_Ghost_Formal_Variable): Check SPARK RM 6.9(13-14) for
variables.
* ghost.ads: Declarations for the above.
* sem_ch12.adb (Analyze_Associations): Apply delayed checking
for generic associations.
(Analyze_Formal_Object_Declaration): Same.
(Analyze_Formal_Subprogram_Declaration): Same.
(Instantiate_Formal_Package): Same.
(Instantiate_Formal_Subprogram): Same.
(Instantiate_Object): Same.  Copy ghost aspect to newly declared
object for actual for IN formal object. Use new function
Get_Enclosing_Deep_Object to retrieve root object.
(Instantiate_Type): Copy ghost aspect to declared subtype for
actual for formal type.
* sem_prag.adb (Analyze_Pragma): Recognize new allowed
declarations.
* sem_util.adb (Copy_Ghost_Aspect): Copy the ghost aspect
between nodes.
(Get_Enclosing_Deep_Object): New function to return enclosing
deep object (or root for reachable part).
* sem_util.ads (Copy_Ghost_Aspect): Same.
(Get_Enclosing_Deep_Object): Same.
* libgnat/s-imageu.ads: Declare formal subprograms as ghost.
* libgnat/s-valuei.ads: Same.
* libgnat/s-valuti.ads: Same.diff --git a/gcc/ada/ghost.adb b/gcc/ada/ghost.adb
--- a/gcc/ada/ghost.adb
+++ b/gcc/ada/ghost.adb
@@ -472,6 +472,13 @@ package body Ghost is
if Is_Ignored_Ghost_Node (Par) then
   return True;
 
+   --  It is not possible to check correct use of Ghost entities
+   --  in generic instantiations until after the generic has been
+   --  resolved. Postpone that verification to after resolution.
+
+   elsif Nkind (Par) = N_Generic_Association then
+  return True;
+
--  A reference to a Ghost entity can appear within an aspect
--  specification (SPARK RM 6.9(10)). The precise checking will
--  occur when analyzing the corresponding pragma. We make an
@@ -521,19 +528,6 @@ package body Ghost is
then
   return True;
 
-   --  In the context of an instantiation, accept currently Ghost
-   --  arguments for formal subprograms, as SPARK does not provide
-   --  a way to distinguish Ghost formal parameters from non-Ghost
-   --  ones. Illegal use of such arguments in a non-Ghost context
-   --  will lead to errors inside the instantiation.
-
-   elsif Nkind (Parent (Par)) = N_Generic_Association
- and then (Nkind (Par) in N_Has_Entity
-and then Present (Entity (Par))
-and then Is_Subprogram (Entity (Par)))
-   then
-  return True;
-
elsif Is_OK_Declaration (Par) then
   return True;
 
@@ -680,6 +674,128 @@ package body Ghost is
   end if;
end Check_Ghost_Context;
 
+   
+   -- Check_Ghost_Context_In_Generic_Association --
+   
+
+   procedure Check_Ghost_Context_In_Generic_Association
+ (Actual : Node_Id;
+  Formal : Entity_Id)
+   is
+  function Emit_Error_On_Ghost_Reference
+(N : Node_Id)
+ return Traverse_Result;
+  --  Determine wether N denotes a reference to a ghost entity, and if so
+  --  issue an error.
+
+  ---
+  -- Emit_Error_On_Ghost_Reference --
+  ---
+
+  function Emit_Error_On_Ghost_Reference
+(N : Node_Id)
+ return Traverse_Result
+  is
+  begin
+ if Is_Entity_Name (N)
+   and then Present (Entity (N))
+   and then Is_Ghost_Entity (Entity (N))
+ then
+Error_Msg_N ("ghost entity cannot appear in this context", N);
+Error_Msg_Sloc := Sloc (Formal);
+Error_Msg_NE ("\formal & was not declared as ghost #", N, Formal);
+return Abandon;
+ end if;
+
+ return OK;
+  end Emit_Error_On_Ghost_Reference;
+
+  procedure Check_Ghost_References is
+new Traverse_Proc (Emit_Error_On_Ghost_Reference);
+
+   --  Start of processing for Check_Ghost_Context_In_Generic_Association
+
+   begin
+  --  The context is ghost when it appears within a Ghost package or
+  --  subpr

[Ada] Simplify regular expression that matches 8 consecutive digits

[Pierre-Marie de Rodat via Gcc-patches]

Makefile cleanup; behaviour is unaffected.

Tested on x86_64-pc-linux-gnu, committed on trunk

gcc/ada/

* gcc-interface/Make-lang.in (ada/generated/gnatvsn.ads):
Simplify regular expression. The "interval expression",
i.e. \{8\} is part of the POSIX regular expressions, so it
should not be a problem for modern implementations of sed.diff --git a/gcc/ada/gcc-interface/Make-lang.in b/gcc/ada/gcc-interface/Make-lang.in
--- a/gcc/ada/gcc-interface/Make-lang.in
+++ b/gcc/ada/gcc-interface/Make-lang.in
@@ -1158,7 +1158,7 @@ ada/generated/gnatvsn.ads: ada/gnatvsn.ads BASE-VER ada/GNAT_DATE
 	s=`cat $(srcdir)/BASE-VER | sed -e "s/\([0-9]*\)\.\([0-9]*\)\..*/-\1\2/g"`; \
 	d=`if test -f $(srcdir)/ada/GNAT_DATE; then \
cat $(srcdir)/ada/GNAT_DATE; else date +%Y%m%d; fi`; \
-	cat $< | sed -e "/Version/s/(\([0-9][0-9][0-9][0-9][0-9][0-9][0-9][0-9]\).*)/($$d$$s)/g" >$@
+	cat $< | sed -e "/Version/s/(\([0-9]\{8\}\).*)/($$d$$s)/g" >$@
 
 ada/gnatvsn.o : ada/gnatvsn.adb ada/generated/gnatvsn.ads
 	$(CC) -c $(ALL_ADAFLAGS) $(ADA_INCLUDES) $< $(ADA_OUTPUT_OPTION)

[Ada] Deferred constant considered as not preelaborable

[Pierre-Marie de Rodat via Gcc-patches]

Fix detection of non-preelaborable constructs for checking SPARK
elaboration rules, which was tagging deferred constant declarations as
not preelaborable.

Tested on x86_64-pc-linux-gnu, committed on trunk

gcc/ada/

* sem_util.adb (Is_Non_Preelaborable_Construct): Fix for
deferred constants.diff --git a/gcc/ada/sem_util.adb b/gcc/ada/sem_util.adb
--- a/gcc/ada/sem_util.adb
+++ b/gcc/ada/sem_util.adb
@@ -18952,8 +18952,9 @@ package body Sem_Util is
if Has_Init_Expression (Nod) then
   Visit (Expression (Nod));
 
-   elsif not Has_Preelaborable_Initialization
-   (Etype (Defining_Entity (Nod)))
+   elsif not Constant_Present (Nod)
+ and then not Has_Preelaborable_Initialization
+(Etype (Defining_Entity (Nod)))
then
   raise Non_Preelaborable;
end if;

[Ada] Indexing error when calling GNAT.Regpat.Match

[Pierre-Marie de Rodat via Gcc-patches]

This patch corrects an error in the compiler whereby a buffer sizing
error fails to get raised when compiling a regex expression with an
insufficiently sized Pattern_Matcher as the documentation indicated.
This, in turn, could lead to indexing errors when attempting to call
Match with the malformed regex program buffer.

Tested on x86_64-pc-linux-gnu, committed on trunk

gcc/ada/

* libgnat/s-regpat.adb, libgnat/s-regpat.ads (Compile): Add a
new defaulted parameter Error_When_Too_Small to trigger an
error, if specified true, when Matcher is too small to hold the
compiled regex program.diff --git a/gcc/ada/libgnat/s-regpat.adb b/gcc/ada/libgnat/s-regpat.adb
--- a/gcc/ada/libgnat/s-regpat.adb
+++ b/gcc/ada/libgnat/s-regpat.adb
@@ -359,10 +359,11 @@ package body System.Regpat is
-
 
procedure Compile
- (Matcher : out Pattern_Matcher;
-  Expression  : String;
-  Final_Code_Size : out Program_Size;
-  Flags   : Regexp_Flags := No_Flags)
+ (Matcher  : out Pattern_Matcher;
+  Expression   : String;
+  Final_Code_Size  : out Program_Size;
+  Flags: Regexp_Flags := No_Flags;
+  Error_When_Too_Small : Boolean := True)
is
   --  We can't allocate space until we know how big the compiled form
   --  will be, but we can't compile it (and thus know how big it is)
@@ -1994,6 +1995,12 @@ package body System.Regpat is
   end if;
 
   PM.Flags := Flags;
+
+  --  Raise the appropriate error when Matcher does not have enough space
+
+  if Error_When_Too_Small and then Matcher.Size < Final_Code_Size then
+ raise Expression_Error with "Pattern_Matcher is too small";
+  end if;
end Compile;
 
function Compile
@@ -2009,7 +2016,7 @@ package body System.Regpat is
   Size  : Program_Size;
 
begin
-  Compile (Dummy, Expression, Size, Flags);
+  Compile (Dummy, Expression, Size, Flags, Error_When_Too_Small => False);
 
   if Size <= Dummy.Size then
  return Pattern_Matcher'
@@ -2023,17 +2030,13 @@ package body System.Regpat is
 Program  =>
   Dummy.Program
 (Dummy.Program'First .. Dummy.Program'First + Size - 1));
-  else
- --  We have to recompile now that we know the size
- --  ??? Can we use Ada 2005's return construct ?
-
- declare
-Result : Pattern_Matcher (Size);
- begin
-Compile (Result, Expression, Size, Flags);
-return Result;
- end;
   end if;
+
+  return
+ Result : Pattern_Matcher (Size)
+  do
+ Compile (Result, Expression, Size, Flags);
+  end return;
end Compile;
 
procedure Compile


diff --git a/gcc/ada/libgnat/s-regpat.ads b/gcc/ada/libgnat/s-regpat.ads
--- a/gcc/ada/libgnat/s-regpat.ads
+++ b/gcc/ada/libgnat/s-regpat.ads
@@ -403,10 +403,11 @@ package System.Regpat is
--  (e.g. case sensitivity,...).
 
procedure Compile
- (Matcher : out Pattern_Matcher;
-  Expression  : String;
-  Final_Code_Size : out Program_Size;
-  Flags   : Regexp_Flags := No_Flags);
+ (Matcher  : out Pattern_Matcher;
+  Expression   : String;
+  Final_Code_Size  : out Program_Size;
+  Flags: Regexp_Flags := No_Flags;
+  Error_When_Too_Small : Boolean := True);
--  Compile a regular expression into internal code
 
--  This procedure is significantly faster than the Compile function since
@@ -426,7 +427,25 @@ package System.Regpat is
--  expression.
--
--  This function raises Storage_Error if Matcher is too small to hold
-   --  the resulting code (i.e. Matcher.Size has too small a value).
+   --  the resulting code (i.e. Matcher.Size has too small a value) only when
+   --  the paramter Error_When_Too_Small is set to True. Otherwise, no error
+   --  will be raised and the required size will be placed in the
+   --  Final_Code_Size parameter.
+   --
+   --  Thus when Error_When_Too_Small is specified as false a check will need
+   --  to be made to ensure successful compilation - as in:
+   --
+   -- ...
+   -- Compile
+   --   (Matcher, Expr, Code_Size, Flags, Error_When_Too_Small => False);
+   --
+   -- if Matcher.Size < Code_Size then
+   --declare
+   --   New_Matcher : Pattern_Matcher (1..Code_Size);
+   --begin
+   --   Compile (New_Matcher, Expr, Code_Size, Flags);
+   --end;
+   -- end if;
--
--  Expression_Error is raised if the string Expression does not contain
--  a valid regular expression.

[Ada] Spurious non-callable warning on prefixed call in class condition

[Pierre-Marie de Rodat via Gcc-patches]

This patch corrects an error in the compiler whereby a function call in
prefix notation within a class condition causes a spurious error
claiming the name in the call is a non-callable entity when there exists
a type extension in the same unit extended with a component featuring
the same name as the function in question.

Tested on x86_64-pc-linux-gnu, committed on trunk

gcc/ada/

* sem_ch4.adb (Analyze_Selected_Component): Add condition to
avoid interpreting derived type components as candidates for
selected components in preanalysis of inherited class
conditions.diff --git a/gcc/ada/sem_ch4.adb b/gcc/ada/sem_ch4.adb
--- a/gcc/ada/sem_ch4.adb
+++ b/gcc/ada/sem_ch4.adb
@@ -5158,11 +5158,26 @@ package body Sem_Ch4 is
 
   elsif Is_Record_Type (Prefix_Type) then
 
- --  Find component with given name. In an instance, if the node is
- --  known as a prefixed call, do not examine components whose
- --  visibility may be accidental.
+ --  Find a component with the given name. If the node is a prefixed
+ --  call, do not examine components whose visibility may be
+ --  accidental.
 
- while Present (Comp) and then not Is_Prefixed_Call (N) loop
+ while Present (Comp)
+   and then not Is_Prefixed_Call (N)
+
+   --  When the selector has been resolved to a function then we may be
+   --  looking at a prefixed call which has been preanalyzed already as
+   --  part of a class condition. In such cases it is possible for a
+   --  derived type to declare a component which has the same name as
+   --  a primitive used in a parent's class condition.
+
+   --  Avoid seeing components as possible interpretations of the
+   --  selected component when this is true.
+
+   and then not (Inside_Class_Condition_Preanalysis
+  and then Present (Entity (Sel))
+  and then Ekind (Entity (Sel)) = E_Function)
+ loop
 if Chars (Comp) = Chars (Sel)
   and then Is_Visible_Component (Comp, N)
 then

[Ada] Improve code generated for aggregates of VFA type

[Pierre-Marie de Rodat via Gcc-patches]

This avoids using a full access for constants internally generated from
assignments of aggregates with a Volatile_Full_Access type.

Tested on x86_64-pc-linux-gnu, committed on trunk

gcc/ada/

* gcc-interface/gigi.h (simple_constant_p): Declare.
* gcc-interface/decl.cc (gnat_to_gnu_entity) : Strip
the qualifiers from the type of a simple constant.
(simple_constant_p): New predicate.
* gcc-interface/trans.cc (node_is_atomic): Return true for objects
with atomic type except for simple constants.
(node_is_volatile_full_access): Return false for simple constants
with VFA type.diff --git a/gcc/ada/gcc-interface/decl.cc b/gcc/ada/gcc-interface/decl.cc
--- a/gcc/ada/gcc-interface/decl.cc
+++ b/gcc/ada/gcc-interface/decl.cc
@@ -660,8 +660,8 @@ gnat_to_gnu_entity (Entity_Id gnat_entity, tree gnu_expr, bool definition)
 	 like variables.  */
   if (definition
 	  && !gnu_expr
-	  && No (Address_Clause (gnat_entity))
 	  && !No_Initialization (gnat_decl)
+	  && No (Address_Clause (gnat_entity))
 	  && No (gnat_renamed_obj))
 	{
 	  gnu_decl = error_mark_node;
@@ -781,6 +781,11 @@ gnat_to_gnu_entity (Entity_Id gnat_entity, tree gnu_expr, bool definition)
 	if (kind == E_Loop_Parameter)
 	  gnu_type = get_base_type (gnu_type);
 
+	/* If this is a simple constant, strip the qualifiers from its type,
+	   since the constant represents only its value.  */
+	else if (simple_constant_p (gnat_entity))
+	  gnu_type = TYPE_MAIN_VARIANT (gnu_type);
+
 	/* Reject non-renamed objects whose type is an unconstrained array or
 	   any object whose type is a dummy type or void.  */
 	if ((TREE_CODE (gnu_type) == UNCONSTRAINED_ARRAY_TYPE
@@ -9541,6 +9546,19 @@ promote_object_alignment (tree gnu_type, tree gnu_size, Entity_Id gnat_entity)
   return align;
 }
 
+/* Return whether GNAT_ENTITY is a simple constant, i.e. it represents only
+   its value and reading it has no side effects.  */
+
+bool
+simple_constant_p (Entity_Id gnat_entity)
+{
+  return Ekind (gnat_entity) == E_Constant
+	 && Present (Constant_Value (gnat_entity))
+	 && !No_Initialization (gnat_entity)
+	 && No (Address_Clause (gnat_entity))
+	 && No (Renamed_Object (gnat_entity));
+}
+
 /* Verify that TYPE is something we can implement atomically.  If not, issue
an error for GNAT_ENTITY.  COMPONENT_P is true if we are being called to
process a component type.  */


diff --git a/gcc/ada/gcc-interface/gigi.h b/gcc/ada/gcc-interface/gigi.h
--- a/gcc/ada/gcc-interface/gigi.h
+++ b/gcc/ada/gcc-interface/gigi.h
@@ -998,6 +998,10 @@ extern Entity_Id get_debug_scope (Node_Id gnat_node, bool *is_subprogram);
should be synchronized with Exp_Dbug.Debug_Renaming_Declaration.  */
 extern bool can_materialize_object_renaming_p (Node_Id expr);
 
+/* Return whether GNAT_ENTITY is a simple constant, i.e. it represents only
+   its value and reading it has no side effects.  */
+extern bool simple_constant_p (Entity_Id gnat_entity);
+
 /* Return the size of TYPE, which must be a positive power of 2.  */
 extern unsigned int resolve_atomic_size (tree type);
 


diff --git a/gcc/ada/gcc-interface/trans.cc b/gcc/ada/gcc-interface/trans.cc
--- a/gcc/ada/gcc-interface/trans.cc
+++ b/gcc/ada/gcc-interface/trans.cc
@@ -4111,9 +4111,11 @@ node_is_atomic (Node_Id gnat_node)
 case N_Identifier:
 case N_Expanded_Name:
   gnat_entity = Entity (gnat_node);
-  if (Ekind (gnat_entity) != E_Variable)
+  if (!Is_Object (gnat_entity))
 	break;
-  return Is_Atomic (gnat_entity) || Is_Atomic (Etype (gnat_entity));
+  return Is_Atomic (gnat_entity)
+	 || (Is_Atomic (Etype (gnat_entity))
+		 && !simple_constant_p (gnat_entity));
 
 case N_Selected_Component:
   return Is_Atomic (Etype (gnat_node))
@@ -4152,7 +4154,8 @@ node_is_volatile_full_access (Node_Id gnat_node)
   if (!Is_Object (gnat_entity))
 	break;
   return Is_Volatile_Full_Access (gnat_entity)
-	 || Is_Volatile_Full_Access (Etype (gnat_entity));
+	 || (Is_Volatile_Full_Access (Etype (gnat_entity))
+		 && !simple_constant_p (gnat_entity));
 
 case N_Selected_Component:
   return Is_Volatile_Full_Access (Etype (gnat_node))

[Ada] Small tweak to gnat_to_gnu_subprog_type

[Pierre-Marie de Rodat via Gcc-patches]

No functional changes.

Tested on x86_64-pc-linux-gnu, committed on trunk

gcc/ada/

* gcc-interface/decl.cc (gnat_to_gnu_subprog_type): Constify a
local variable and move a couple of others around.diff --git a/gcc/ada/gcc-interface/decl.cc b/gcc/ada/gcc-interface/decl.cc
--- a/gcc/ada/gcc-interface/decl.cc
+++ b/gcc/ada/gcc-interface/decl.cc
@@ -5777,10 +5777,9 @@ gnat_to_gnu_subprog_type (Entity_Id gnat_subprog, bool definition,
 			  bool debug_info_p, tree *param_list)
 {
   const Entity_Kind kind = Ekind (gnat_subprog);
+  const Entity_Id gnat_return_type = Etype (gnat_subprog);
   const bool method_p = is_cplusplus_method (gnat_subprog);
   const bool variadic = IN (Convention (gnat_subprog), Convention_C_Variadic);
-  Entity_Id gnat_return_type = Etype (gnat_subprog);
-  Entity_Id gnat_param;
   tree gnu_type = present_gnu_tree (gnat_subprog)
 		  ? TREE_TYPE (get_gnu_tree (gnat_subprog)) : NULL_TREE;
   tree gnu_return_type;
@@ -5810,7 +5809,6 @@ gnat_to_gnu_subprog_type (Entity_Id gnat_subprog, bool definition,
   bool return_by_direct_ref_p = false;
   bool return_by_invisi_ref_p = false;
   bool incomplete_profile_p = false;
-  int num;
 
   /* Look into the return type and get its associated GCC tree if it is not
  void, and then compute various flags for the subprogram type.  But make
@@ -5944,6 +5942,8 @@ gnat_to_gnu_subprog_type (Entity_Id gnat_subprog, bool definition,
 
   /* Loop over the parameters and get their associated GCC tree.  While doing
  this, build a copy-in copy-out structure if we need one.  */
+  Entity_Id gnat_param;
+  int num;
   for (gnat_param = First_Formal_With_Extras (gnat_subprog), num = 0;
Present (gnat_param);
gnat_param = Next_Formal_With_Extras (gnat_param), num++)

[Ada] Handle secondary stack memory allocations alignment

[Pierre-Marie de Rodat via Gcc-patches]

To accomodate cases where objects allocated on the secondary stack
needed a more constrained alignement than Standard'Maximum_Alignement,
the alignment for all allocations in the full runtime were forced on to
be aligned on Standard'Maximum_Alignement*2. This changes removes this
workaround and correctly handles the over-alignment in all runtimes.

This change modifies the SS_Allocate procedure to accept a new Alignment
parameter and to dynamically realign the pointer returned by the memory
allocation (Allocate_* functions or dedicated stack allocations for
zfp/cert).

It also simplifies the 0-sized allocations by not allocating any memory
if pointer is already correctly aligned (already the case in cert and
zfp runtimes).

Tested on x86_64-pc-linux-gnu, committed on trunk

gcc/ada/

* libgnat/s-secsta.ads (SS_Allocate): Add new Alignment
parameter.
(Memory_Alignment): Remove.
* libgnat/s-secsta.adb (Align_Addr): New.
(SS_Allocate): Add new Alignment parameter. Realign pointer if
needed. Don't allocate anything for 0-sized allocations.
* gcc-interface/utils2.cc (build_call_alloc_dealloc_proc): Add
allocated object's alignment as last parameter to allocation
invocation.diff --git a/gcc/ada/gcc-interface/utils2.cc b/gcc/ada/gcc-interface/utils2.cc
--- a/gcc/ada/gcc-interface/utils2.cc
+++ b/gcc/ada/gcc-interface/utils2.cc
@@ -2139,6 +2139,8 @@ build_call_alloc_dealloc_proc (tree gnu_obj, tree gnu_size, tree gnu_type,
 			   Entity_Id gnat_proc, Entity_Id gnat_pool)
 {
   tree gnu_proc = gnat_to_gnu (gnat_proc);
+  tree gnu_align = size_int (TYPE_ALIGN (gnu_type) / BITS_PER_UNIT);
+
   tree gnu_call;
 
   /* A storage pool's underlying type is a record type for both predefined
@@ -2154,7 +2156,6 @@ build_call_alloc_dealloc_proc (tree gnu_obj, tree gnu_size, tree gnu_type,
 
   tree gnu_pool = gnat_to_gnu (gnat_pool);
   tree gnu_pool_addr = build_unary_op (ADDR_EXPR, NULL_TREE, gnu_pool);
-  tree gnu_align = size_int (TYPE_ALIGN (gnu_type) / BITS_PER_UNIT);
 
   gnu_size = convert (gnu_size_type, gnu_size);
   gnu_align = convert (gnu_size_type, gnu_align);
@@ -2178,6 +2179,7 @@ build_call_alloc_dealloc_proc (tree gnu_obj, tree gnu_size, tree gnu_type,
   tree gnu_size_type = gnat_to_gnu_type (gnat_size_type);
 
   gnu_size = convert (gnu_size_type, gnu_size);
+  gnu_align = convert (gnu_size_type, gnu_align);
 
   if (DECL_BUILT_IN_CLASS (gnu_proc) == BUILT_IN_FRONTEND
 	  && DECL_FE_FUNCTION_CODE (gnu_proc) == BUILT_IN_RETURN_SLOT)
@@ -2191,7 +2193,7 @@ build_call_alloc_dealloc_proc (tree gnu_obj, tree gnu_size, tree gnu_type,
 
 	  gnu_call = DECL_RESULT (current_function_decl);
 
-	  /* The allocation has alreay been done by the caller so we check that
+	  /* The allocation has already been done by the caller so we check that
 	 we are not going to overflow the return slot.  */
 	  if (TYPE_CI_CO_LIST (TREE_TYPE (current_function_decl)))
 	gnu_ret_size
@@ -2216,7 +2218,7 @@ build_call_alloc_dealloc_proc (tree gnu_obj, tree gnu_size, tree gnu_type,
 	gnu_call = build_call_n_expr (gnu_proc, 2, gnu_obj, gnu_size);
 
   else
-	gnu_call = build_call_n_expr (gnu_proc, 1, gnu_size);
+	gnu_call = build_call_n_expr (gnu_proc, 2, gnu_size, gnu_align);
 }
 
   return gnu_call;
@@ -2334,7 +2336,7 @@ maybe_wrap_free (tree data_ptr, tree data_type)
 
 /* Build a GCC tree to call an allocation or deallocation function.
If GNU_OBJ is nonzero, it is an object to deallocate.  Otherwise,
-   generate an allocator.
+   generate an allocation.
 
GNU_SIZE is the number of bytes to allocate and GNU_TYPE is the contained
object type, used to determine the to-be-honored address alignment.


diff --git a/gcc/ada/libgnat/s-secsta.adb b/gcc/ada/libgnat/s-secsta.adb
--- a/gcc/ada/libgnat/s-secsta.adb
+++ b/gcc/ada/libgnat/s-secsta.adb
@@ -550,22 +550,52 @@ package body System.Secondary_Stack is
 
procedure SS_Allocate
  (Addr : out Address;
-  Storage_Size : Storage_Count)
+  Storage_Size : Storage_Count;
+  Alignment: SSE.Storage_Count := Standard'Maximum_Alignment)
is
+
   function Round_Up (Size : Storage_Count) return Memory_Size;
   pragma Inline (Round_Up);
   --  Round Size up to the nearest multiple of the maximum alignment
 
+  function Align_Addr (Addr : Address) return Address;
+  pragma Inline (Align_Addr);
+  --  Align Addr to the next multiple of Alignment
+
+  
+  -- Align_Addr --
+  
+
+  function Align_Addr (Addr : Address) return Address is
+ Int_Algn : constant Integer_Address := Integer_Address (Alignment);
+ Int_Addr : constant Integer_Address := To_Integer (Addr);
+  begin
+
+ --  L : Alignment
+ --  A : Standard'Maximum_Alignment
+
+ --   Addr
+ --  L | L   L
+ --  A--A--A--A--

[Ada] Missing error on tagged type conversion

[Pierre-Marie de Rodat via Gcc-patches]

The compiler does not report an error on a type conversion to/from a
tagged type whose parent type is an interface type and there is no
relationship between the source and target types. This bug has been
dormant since January/2016.

This patch also improves the text of errors reported on interface type
conversions suggesting how to fix these errors.

Tested on x86_64-pc-linux-gnu, committed on trunk

gcc/ada/

* sem_res.adb (Resolve_Type_Conversion): Code cleanup since the
previous static check has been moved to Valid_Tagged_Conversion.
(Valid_Tagged_Conversion): Fix the code checking conversion
to/from interface types since incorrectly returns True when the
parent type of the operand type (or the target type) is an
interface type; add missing static checks on interface type
conversions.diff --git a/gcc/ada/sem_res.adb b/gcc/ada/sem_res.adb
--- a/gcc/ada/sem_res.adb
+++ b/gcc/ada/sem_res.adb
@@ -31,6 +31,7 @@ with Debug_A;use Debug_A;
 with Einfo;  use Einfo;
 with Einfo.Entities; use Einfo.Entities;
 with Einfo.Utils;use Einfo.Utils;
+with Elists; use Elists;
 with Errout; use Errout;
 with Expander;   use Expander;
 with Exp_Ch6;use Exp_Ch6;
@@ -12308,26 +12309,7 @@ package body Sem_Res is
 --  Conversion to interface type
 
 elsif Is_Interface (Target) then
-
-   --  Handle subtypes
-
-   if Ekind (Opnd) in E_Protected_Subtype | E_Task_Subtype then
-  Opnd := Etype (Opnd);
-   end if;
-
-   if Is_Class_Wide_Type (Opnd)
- or else Interface_Present_In_Ancestor
-   (Typ   => Opnd,
-Iface => Target)
-   then
-  Expand_Interface_Conversion (N);
-   else
-  Error_Msg_Name_1 := Chars (Etype (Target));
-  Error_Msg_Name_2 := Chars (Opnd);
-  Error_Msg_N
-("wrong interface conversion (% is not a progenitor "
- & "of %)", N);
-   end if;
+   Expand_Interface_Conversion (N);
 end if;
  end;
   end if;
@@ -13621,29 +13603,115 @@ package body Sem_Res is
   Conversion_Check (False,
 "downward conversion of tagged objects not allowed");
 
- --  Ada 2005 (AI-251): The conversion to/from interface types is
- --  always valid. The types involved may be class-wide (sub)types.
+ --  Ada 2005 (AI-251): A conversion is valid if the operand and target
+ --  types are both class-wide types and the specific type associated
+ --  with at least one of them is an interface type (RM 4.6 (23.1/2));
+ --  at run-time a check will verify the validity of this interface
+ --  type conversion.
 
- elsif Is_Interface (Etype (Base_Type (Target_Type)))
-   or else Is_Interface (Etype (Base_Type (Opnd_Type)))
+ elsif Is_Class_Wide_Type (Target_Type)
+and then Is_Class_Wide_Type (Opnd_Type)
+and then (Is_Interface (Target_Type)
+or else Is_Interface (Opnd_Type))
  then
 return True;
 
- --  If the operand is a class-wide type obtained through a limited_
- --  with clause, and the context includes the nonlimited view, use
- --  it to determine whether the conversion is legal.
+ --  Report errors
+
+ elsif Is_Class_Wide_Type (Target_Type)
+   and then Is_Interface (Target_Type)
+   and then not Is_Interface (Opnd_Type)
+   and then not Interface_Present_In_Ancestor
+  (Typ   => Opnd_Type,
+   Iface => Target_Type)
+ then
+Error_Msg_Name_1 := Chars (Etype (Target_Type));
+Error_Msg_Name_2 := Chars (Opnd_Type);
+Conversion_Error_N
+  ("wrong interface conversion (% is not a progenitor "
+   & "of %)", N);
+return False;
 
  elsif Is_Class_Wide_Type (Opnd_Type)
-   and then From_Limited_With (Opnd_Type)
-   and then Present (Non_Limited_View (Etype (Opnd_Type)))
-   and then Is_Interface (Non_Limited_View (Etype (Opnd_Type)))
+   and then Is_Interface (Opnd_Type)
+   and then not Is_Interface (Target_Type)
+   and then not Interface_Present_In_Ancestor
+  (Typ   => Target_Type,
+   Iface => Opnd_Type)
  then
-return True;
+Error_Msg_Name_1 := Chars (Etype (Opnd_Type));
+Error_Msg_Name_2 := Chars (Target_Type);
+Conversion_Error_N
+  ("wrong interface conversion (% is not a progenitor "
+   & "of %)", N);
 
- elsif Is_Access_Type (Opnd_Type)
-   and then Is_Interf

[Ada] Fix spurious error for aggregate with box component choice

[Pierre-Marie de Rodat via Gcc-patches]

It comes from the Volatile_Full_Access (or Atomic) aspect: the aggregate is
effectively analyzed/resolved twice and this does not work.  It is fixed by
calling Is_Full_Access_Aggregate before resolution.

Tested on x86_64-pc-linux-gnu, committed on trunk

gcc/ada/

* exp_aggr.adb (Expand_Record_Aggregate): Do not call
Is_Full_Access_Aggregate here.
* freeze.ads (Is_Full_Access_Aggregate): Delete.
* freeze.adb (Is_Full_Access_Aggregate): Move to...
(Freeze_Entity): Do not call Is_Full_Access_Aggregate here.
* sem_aggr.adb (Is_Full_Access_Aggregate): ...here
(Resolve_Aggregate): Call Is_Full_Access_Aggregate here.diff --git a/gcc/ada/exp_aggr.adb b/gcc/ada/exp_aggr.adb
--- a/gcc/ada/exp_aggr.adb
+++ b/gcc/ada/exp_aggr.adb
@@ -8779,19 +8779,10 @@ package body Exp_Aggr is
--  Start of processing for Expand_Record_Aggregate
 
begin
-  --  If the aggregate is to be assigned to a full access variable, we have
-  --  to prevent a piecemeal assignment even if the aggregate is to be
-  --  expanded. We create a temporary for the aggregate, and assign the
-  --  temporary instead, so that the back end can generate an atomic move
-  --  for it.
-
-  if Is_Full_Access_Aggregate (N) then
- return;
-
   --  No special management required for aggregates used to initialize
   --  statically allocated dispatch tables
 
-  elsif Is_Static_Dispatch_Table_Aggregate (N) then
+  if Is_Static_Dispatch_Table_Aggregate (N) then
  return;
 
   --  Case pattern aggregates need to remain as aggregates


diff --git a/gcc/ada/freeze.adb b/gcc/ada/freeze.adb
--- a/gcc/ada/freeze.adb
+++ b/gcc/ada/freeze.adb
@@ -2309,67 +2309,6 @@ package body Freeze is
   end loop;
end Check_Unsigned_Type;
 
-   --
-   -- Is_Full_Access_Aggregate --
-   --
-
-   function Is_Full_Access_Aggregate (N : Node_Id) return Boolean is
-  Loc   : constant Source_Ptr := Sloc (N);
-  New_N : Node_Id;
-  Par   : Node_Id;
-  Temp  : Entity_Id;
-  Typ   : Entity_Id;
-
-   begin
-  Par := Parent (N);
-
-  --  Array may be qualified, so find outer context
-
-  if Nkind (Par) = N_Qualified_Expression then
- Par := Parent (Par);
-  end if;
-
-  if not Comes_From_Source (Par) then
- return False;
-  end if;
-
-  case Nkind (Par) is
- when N_Assignment_Statement =>
-Typ := Etype (Name (Par));
-
-if not Is_Full_Access (Typ)
-  and then not Is_Full_Access_Object (Name (Par))
-then
-   return False;
-end if;
-
- when N_Object_Declaration =>
-Typ := Etype (Defining_Identifier (Par));
-
-if not Is_Full_Access (Typ)
-  and then not Is_Full_Access (Defining_Identifier (Par))
-then
-   return False;
-end if;
-
- when others =>
-return False;
-  end case;
-
-  Temp := Make_Temporary (Loc, 'T', N);
-  New_N :=
-Make_Object_Declaration (Loc,
-  Defining_Identifier => Temp,
-  Constant_Present=> True,
-  Object_Definition   => New_Occurrence_Of (Typ, Loc),
-  Expression  => Relocate_Node (N));
-  Insert_Before (Par, New_N);
-  Analyze (New_N);
-
-  Set_Expression (Par, New_Occurrence_Of (Temp, Loc));
-  return True;
-   end Is_Full_Access_Aggregate;
-
---
-- Explode_Initialization_Compound_Statement --
---
@@ -6447,20 +6386,6 @@ package body Freeze is
  then
 Set_Encoded_Interface_Name
   (E, Get_Default_External_Name (E));
-
- --  If entity is an atomic object appearing in a declaration and
- --  the expression is an aggregate, assign it to a temporary to
- --  ensure that the actual assignment is done atomically rather
- --  than component-wise (the assignment to the temp may be done
- --  component-wise, but that is harmless).
-
- elsif Is_Full_Access (E)
-   and then Nkind (Parent (E)) = N_Object_Declaration
-   and then Present (Expression (Parent (E)))
-   and then Nkind (Expression (Parent (E))) = N_Aggregate
-   and then Is_Full_Access_Aggregate (Expression (Parent (E)))
- then
-null;
  end if;
 
  --  Subprogram case


diff --git a/gcc/ada/freeze.ads b/gcc/ada/freeze.ads
--- a/gcc/ada/freeze.ads
+++ b/gcc/ada/freeze.ads
@@ -177,15 +177,6 @@ package Freeze is
--  True when we are processing the body of a primitive with no previous
--  spec defined after R is frozen (see Check_Dispatching_Operation).
 
-   function Is_Full_Access_Aggregate (N : Node_Id) return Boolean;
-   --  If a full access object is initialized with an ag

[Ada] Remove old vxworks from Makefile.rtl - e500 port.

[Pierre-Marie de Rodat via Gcc-patches]

The powerpc e500 port has been LTS'd

Tested on x86_64-pc-linux-gnu, committed on trunk

gcc/ada/

* libgnat/system-vxworks7-e500-kernel.ads: Remove.
* libgnat/system-vxworks7-e500-rtp-smp.ads: Likewise.
* libgnat/system-vxworks7-e500-rtp.ads: Likewise.diff --git a/gcc/ada/libgnat/system-vxworks7-e500-kernel.ads /dev/null
deleted file mode 100644
--- a/gcc/ada/libgnat/system-vxworks7-e500-kernel.ads
+++ /dev/null
@@ -1,160 +0,0 @@
---
---  --
---GNAT RUN-TIME COMPONENTS  --
---  --
---   S Y S T E M--
---  --
--- S p e c  --
---  (VxWorks 7 Kernel Version E500) --
---  --
---  Copyright (C) 1992-2022, Free Software Foundation, Inc. --
---  --
--- This specification is derived from the Ada Reference Manual for use with --
--- GNAT. The copyright notice above, and the license provisions that follow --
--- apply solely to the  contents of the part following the private keyword. --
---  --
--- 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--
--- .  --
---  --
--- GNAT was originally developed  by the GNAT team at  New York University. --
--- Extensive contributions were provided by Ada Core Technologies Inc.  --
---  --
---
-
-package System is
-   pragma Pure;
-   --  Note that we take advantage of the implementation permission to make
-   --  this unit Pure instead of Preelaborable; see RM 13.7.1(15). In Ada
-   --  2005, this is Pure in any case (AI-362).
-
-   pragma No_Elaboration_Code_All;
-   --  Allow the use of that restriction in units that WITH this unit
-
-   type Name is (SYSTEM_NAME_GNAT);
-   System_Name : constant Name := SYSTEM_NAME_GNAT;
-
-   --  System-Dependent Named Numbers
-
-   Min_Int : constant := -2 ** (Standard'Max_Integer_Size - 1);
-   Max_Int : constant :=  2 ** (Standard'Max_Integer_Size - 1) - 1;
-
-   Max_Binary_Modulus: constant := 2 ** Standard'Max_Integer_Size;
-   Max_Nonbinary_Modulus : constant := 2 ** Integer'Size - 1;
-
-   Max_Base_Digits   : constant := Long_Long_Float'Digits;
-   Max_Digits: constant := Long_Long_Float'Digits;
-
-   Max_Mantissa  : constant := Standard'Max_Integer_Size - 1;
-   Fine_Delta: constant := 2.0 ** (-Max_Mantissa);
-
-   Tick  : constant := 1.0 / 60.0;
-
-   --  Storage-related Declarations
-
-   type Address is private;
-   pragma Preelaborable_Initialization (Address);
-   Null_Address : constant Address;
-
-   Storage_Unit : constant := 8;
-   Word_Size: constant := Standard'Word_Size;
-   Memory_Size  : constant := 2 ** Word_Size;
-
-   --  Address comparison
-
-   function "<"  (Left, Right : Address) return Boolean;
-   function "<=" (Left, Right : Address) return Boolean;
-   function ">"  (Left, Right : Address) return Boolean;
-   function ">=" (Left, Right : Address) return Boolean;
-   function "="  (Left, Right : Address) return Boolean;
-
-   pragma Import (Intrins

[Ada] Cleanup use of local scalars in GNAT.Socket.Get_Address_Info

[Pierre-Marie de Rodat via Gcc-patches]

A cleanup opportunity spotted while working on improved detection of
uninitialised local scalar objects.

Tested on x86_64-pc-linux-gnu, committed on trunk

gcc/ada/

* libgnat/g-socket.adb (Get_Address_Info): Reduce scope of the
Found variable; avoid repeated assignment inside the loop.diff --git a/gcc/ada/libgnat/g-socket.adb b/gcc/ada/libgnat/g-socket.adb
--- a/gcc/ada/libgnat/g-socket.adb
+++ b/gcc/ada/libgnat/g-socket.adb
@@ -1036,7 +1036,6 @@ package body GNAT.Sockets is
 
   R : C.int;
   Iter  : Addrinfo_Access;
-  Found : Boolean;
 
   function To_Array return Address_Info_Array;
   --  Convert taken from OS addrinfo list A into Address_Info_Array
@@ -1046,8 +1045,6 @@ package body GNAT.Sockets is
   --
 
   function To_Array return Address_Info_Array is
- Result : Address_Info_Array (1 .. 8);
-
  procedure Unsupported;
  --  Calls Unknown callback if defiend
 
@@ -1066,6 +1063,9 @@ package body GNAT.Sockets is
 end if;
  end Unsupported;
 
+ Found  : Boolean;
+ Result : Address_Info_Array (1 .. 8);
+
   --  Start of processing for To_Array
 
   begin
@@ -1087,8 +1087,8 @@ package body GNAT.Sockets is
if Result (J).Addr.Family = Family_Unspec then
   Unsupported;
else
+  Found := False;
   for M in Modes'Range loop
- Found := False;
  if Modes (M) = Iter.ai_socktype then
 Result (J).Mode := M;
 Found := True;

[Ada] Vxworks7* - Makefile.rtl rtp vs rtp-smp cleanup

[Pierre-Marie de Rodat via Gcc-patches]

Only smp runtimes are built for vxworks7*, even though the -smp suffix
is removed during install. Therefore, in general, the build macros for
the non-smp runtimes are superfluous except on the legacy ppc-vxworks6
target where both the smp and non-smp runtime are built.  Lastly, an
error message is added if a runtime build is commanded that doesn't
exist, rather then letting the build mysteriously fail.

Tested on x86_64-pc-linux-gnu, committed on trunk

gcc/ada/

* Makefile.rtl [arm,aarch64 vxworks7]: Remove rtp and kernel
build macros and set an error variable if needed.
[x86,x86_vxworks7]: Likewise.
[ppc,ppc64]: Set an error variable if needed.
(rts-err): New phony Makefile target.
(setup-rts): Depend on rts-err.diff --git a/gcc/ada/Makefile.rtl b/gcc/ada/Makefile.rtl
--- a/gcc/ada/Makefile.rtl
+++ b/gcc/ada/Makefile.rtl
@@ -1124,6 +1124,7 @@ ifeq ($(strip $(filter-out powerpc% wrs vxworks vxworks7%, $(target_cpu) $(targe
 
   EH_MECHANISM=-gcc
 
+  # The rtp and kernel sections must be retained for the sake of ppc-vx6
   ifeq ($(strip $(filter-out rtp,$(THREAD_KIND))),)
 LIBGNAT_TARGET_PAIRS += \
 s-vxwext.ads

[Ada] Restore accidentally removed part of a comment about unset references

[Pierre-Marie de Rodat via Gcc-patches]

Fix an unintentionally removed comment.

Tested on x86_64-pc-linux-gnu, committed on trunk

gcc/ada/

* sem_res.adb (Resolve_Actuals): Restore first sentence of a
comment.diff --git a/gcc/ada/sem_res.adb b/gcc/ada/sem_res.adb
--- a/gcc/ada/sem_res.adb
+++ b/gcc/ada/sem_res.adb
@@ -4620,6 +4620,7 @@ package body Sem_Res is
  ("invalid use of untagged formal incomplete type", A);
 end if;
 
+--  For mode IN, if actual is an entity, and the type of the formal
 --  has warnings suppressed, then we reset Never_Set_In_Source for
 --  the calling entity. The reason for this is to catch cases like
 --  GNAT.Spitbol.Patterns.Vstring_Var where the called subprogram

[Ada] Fix incorrect itype sharing for case expression in limited type return

[Pierre-Marie de Rodat via Gcc-patches]

The compiler aborts with an internal error in gigi, but the problem is an
itype incorrectly shared between several branches of an if_statement that
has been created for a Build-In-Place return.

Three branches of this if_statement contain an allocator statement and
the latter two have been obtained as the result of calling New_Copy_Tree
on the first; now the initialization expression of the first had also been
obtained as the result of calling New_Copy_Tree on the original tree, and
these chained calls to New_Copy_Tree run afoul of an issue with the copy
of itypes after the rewrite of an aggregate as an expression with actions.

Fixing this issue looks quite delicate, so this fixes the incorrect sharing
by replacing the chained calls to New_Copy_Tree with repeated calls on the
original expression, which is more elegant in any case.

Tested on x86_64-pc-linux-gnu, committed on trunk

gcc/ada/

* exp_ch3.adb (Make_Allocator_For_BIP_Return): New local function.
(Expand_N_Object_Declaration): Use it to build the three allocators
for a Build-In-Place return with an unconstrained type.  Update the
head comment after other recent changes.diff --git a/gcc/ada/exp_ch3.adb b/gcc/ada/exp_ch3.adb
--- a/gcc/ada/exp_ch3.adb
+++ b/gcc/ada/exp_ch3.adb
@@ -7980,16 +7980,11 @@ package body Exp_Ch3 is
 --  the value one, then the caller has passed access to an
 --  existing object for use as the return object. If the value
 --  is two, then the return object must be allocated on the
---  secondary stack. Otherwise, the object must be allocated in
---  a storage pool. We generate an if statement to test the
---  implicit allocation formal and initialize a local access
---  value appropriately, creating allocators in the secondary
---  stack and global heap cases. The special formal also exists
---  and must be tested when the function has a tagged result,
---  even when the result subtype is constrained, because in
---  general such functions can be called in dispatching contexts
---  and must be handled similarly to functions with a class-wide
---  result.
+--  secondary stack. If the value is three, then the return
+--  object must be allocated on the heap. Otherwise, the object
+--  must be allocated in a storage pool. We generate an if
+--  statement to test the BIP_Alloc_Form formal and initialize
+--  a local access value appropriately.
 
 if Needs_BIP_Alloc_Form (Func_Id) then
declare
@@ -8005,6 +8000,73 @@ package body Exp_Ch3 is
   Pool_Id  : constant Entity_Id :=
 Make_Temporary (Loc, 'P');
 
+  function Make_Allocator_For_BIP_Return return Node_Id;
+  --  Make an allocator for the BIP return being processed
+
+  ---
+  -- Make_Allocator_For_BIP_Return --
+  ---
+
+  function Make_Allocator_For_BIP_Return return Node_Id is
+ Alloc : Node_Id;
+
+  begin
+ if Present (Expr_Q)
+   and then not Is_Delayed_Aggregate (Expr_Q)
+   and then not No_Initialization (N)
+ then
+--  Always use the type of the expression for the
+--  qualified expression, rather than the result type.
+--  In general we cannot always use the result type
+--  for the allocator, because the expression might be
+--  of a specific type, such as in the case of an
+--  aggregate or even a nonlimited object when the
+--  result type is a limited class-wide interface type.
+
+Alloc :=
+  Make_Allocator (Loc,
+Expression =>
+  Make_Qualified_Expression (Loc,
+Subtype_Mark =>
+  New_Occurrence_Of (Etype (Expr_Q), Loc),
+Expression   => New_Copy_Tree (Expr_Q)));
+
+ else
+--  If the function returns a class-wide type we cannot
+--  use the return type for the allocator. Instead we
+--  use the type of the expression, which must be an
+--  aggregate of a definite type.
+
+if Is_Class_Wide_Type (Ret_Obj_Typ) then
+   Alloc :=
+ Make_Allocator (Loc,
+   Expression =>
+

[Ada] Incorrect emptying of CUDA global subprograms

[Pierre-Marie de Rodat via Gcc-patches]

This patch corrects an error in the compiler whereby no
Corresponding_Spec was set for emptied CUDA global subprograms - leading
to a malformed tree.

Tested on x86_64-pc-linux-gnu, committed on trunk

gcc/ada/

* gnat_cuda.adb (Empty_CUDA_Global_Subprogram): Set
Specification and Corresponding_Spec to match the original
Kernel_Body.diff --git a/gcc/ada/gnat_cuda.adb b/gcc/ada/gnat_cuda.adb
--- a/gcc/ada/gnat_cuda.adb
+++ b/gcc/ada/gnat_cuda.adb
@@ -165,17 +165,20 @@ package body GNAT_CUDA is
 
   Kernel_Elm := First_Elmt (Kernels);
   while Present (Kernel_Elm) loop
- Kernel := Node (Kernel_Elm);
+ Kernel  := Node (Kernel_Elm);
  Kernel_Body := Subprogram_Body (Kernel);
- Loc := Sloc (Kernel_Body);
+ Loc := Sloc (Kernel_Body);
 
  Null_Body := Make_Subprogram_Body (Loc,
-   Specification  => Subprogram_Specification (Kernel),
+   Specification  => Specification (Kernel_Body),
Declarations   => New_List,
Handled_Statement_Sequence =>
  Make_Handled_Sequence_Of_Statements (Loc,
Statements => New_List (Make_Null_Statement (Loc;
 
+ Set_Corresponding_Spec (Null_Body,
+   Corresponding_Spec (Kernel_Body));
+
  Rewrite (Kernel_Body, Null_Body);
 
  Next_Elmt (Kernel_Elm);

[Ada] Remove explicit call to Make_Unchecked_Type_Conversion

[Pierre-Marie de Rodat via Gcc-patches]

Respect a comment in sinfo.ads, which says: "Unchecked type conversion
nodes should be created by calling Tbuild.Unchecked_Convert_To, rather
than by directly calling Nmake.Make_Unchecked_Type_Conversion."

No test appears to be affected by this change, so this is just a
cleanup.

Tested on x86_64-pc-linux-gnu, committed on trunk

gcc/ada/

* exp_ch6.adb (Build_Static_Check_Helper_Call): Replace explicit
call to Make_Unchecked_Type_Conversion with a call to
Unchecked_Convert_To.
* tbuild.adb (Unchecked_Convert_To): Fix whitespace.diff --git a/gcc/ada/exp_ch6.adb b/gcc/ada/exp_ch6.adb
--- a/gcc/ada/exp_ch6.adb
+++ b/gcc/ada/exp_ch6.adb
@@ -7578,9 +7578,7 @@ package body Exp_Ch6 is
   and then Etype (F) /= Etype (A)
 then
Append_To (Actuals,
- Make_Unchecked_Type_Conversion (Loc,
-   New_Occurrence_Of (Etype (F), Loc),
-   New_Copy_Tree (A)));
+ Unchecked_Convert_To (Etype (F), New_Copy_Tree (A)));
 else
Append_To (Actuals, New_Copy_Tree (A));
 end if;


diff --git a/gcc/ada/tbuild.adb b/gcc/ada/tbuild.adb
--- a/gcc/ada/tbuild.adb
+++ b/gcc/ada/tbuild.adb
@@ -882,8 +882,8 @@ package body Tbuild is
   --  We don't really want to allow E_Void here, but existing code passes
   --  it.
 
-  Loc : constant Source_Ptr := Sloc (Expr);
-  Result  : Node_Id;
+  Loc: constant Source_Ptr := Sloc (Expr);
+  Result : Node_Id;
 
begin
   --  If the expression is already of the correct type, then nothing

[Ada] Warn about obsolete uses of renamed Ada 83 packages

[Pierre-Marie de Rodat via Gcc-patches]

Ada 83 packages like Unchecked_Conversion or Text_IO are obsolete since
Ada 95. GNAT now warns about their uses when warnings on obsolescent
featured (Annex J) is active.

Tested on x86_64-pc-linux-gnu, committed on trunk

gcc/ada/

* doc/gnat_ugn/building_executable_programs_with_gnat.rst
(Warning Message Control): Update description of switch -gnatwj.
* gnat_ugn.texi: Regenerate.
* sem_ch10.adb (Analyze_With_Clause): Warn on WITH clauses for
obsolete renamed units; in Ada 83 mode do not consider
predefined renamings to be obsolete.

gcc/testsuite/

* gnat.dg/renaming1.adb: Update WITH clause.
* gnat.dg/renaming1.ads: Likewise.
* gnat.dg/warn29.adb: Likewise.diff --git a/gcc/ada/doc/gnat_ugn/building_executable_programs_with_gnat.rst b/gcc/ada/doc/gnat_ugn/building_executable_programs_with_gnat.rst
--- a/gcc/ada/doc/gnat_ugn/building_executable_programs_with_gnat.rst
+++ b/gcc/ada/doc/gnat_ugn/building_executable_programs_with_gnat.rst
@@ -3277,8 +3277,7 @@ of the pragma in the :title:`GNAT_Reference_manual`).
   If this warning option is activated, then warnings are generated for
   calls to subprograms marked with ``pragma Obsolescent`` and
   for use of features in Annex J of the Ada Reference Manual. In the
-  case of Annex J, not all features are flagged. In particular use
-  of the renamed packages (like ``Text_IO``) and use of package
+  case of Annex J, not all features are flagged. In particular, uses of package
   ``ASCII`` are not flagged, since these are very common and
   would generate many annoying positive warnings. The default is that
   such warnings are not generated.


diff --git a/gcc/ada/gnat_ugn.texi b/gcc/ada/gnat_ugn.texi
--- a/gcc/ada/gnat_ugn.texi
+++ b/gcc/ada/gnat_ugn.texi
@@ -11383,8 +11383,7 @@ This switch disables warnings on overlapping actuals in a call.
 If this warning option is activated, then warnings are generated for
 calls to subprograms marked with @code{pragma Obsolescent} and
 for use of features in Annex J of the Ada Reference Manual. In the
-case of Annex J, not all features are flagged. In particular use
-of the renamed packages (like @code{Text_IO}) and use of package
+case of Annex J, not all features are flagged. In particular, uses of package
 @code{ASCII} are not flagged, since these are very common and
 would generate many annoying positive warnings. The default is that
 such warnings are not generated.


diff --git a/gcc/ada/sem_ch10.adb b/gcc/ada/sem_ch10.adb
--- a/gcc/ada/sem_ch10.adb
+++ b/gcc/ada/sem_ch10.adb
@@ -2597,11 +2597,19 @@ package body Sem_Ch10 is
   --  Note: this is not quite right if the user defines one of these units
   --  himself, but that's a marginal case, and fixing it is hard ???
 
-  if Restriction_Check_Required (No_Obsolescent_Features) then
- if In_Predefined_Renaming (U) then
+  if Ada_Version >= Ada_95
+and then In_Predefined_Renaming (U)
+  then
+ if Restriction_Check_Required (No_Obsolescent_Features) then
 Check_Restriction (No_Obsolescent_Features, N);
 Restriction_Violation := True;
  end if;
+
+ if Warn_On_Obsolescent_Feature then
+Error_Msg_N
+  ("renamed predefined unit is an obsolescent feature "
+   & "(RM J.1)?j?", N);
+ end if;
   end if;
 
   --  Check No_Implementation_Units violation


diff --git a/gcc/testsuite/gnat.dg/renaming1.adb b/gcc/testsuite/gnat.dg/renaming1.adb
--- a/gcc/testsuite/gnat.dg/renaming1.adb
+++ b/gcc/testsuite/gnat.dg/renaming1.adb
@@ -1,12 +1,12 @@
 -- { dg-do compile}
 -- { dg-options "-gnatwa" }
 
-with Text_IO;
-use Text_IO;
+with Ada.Text_IO;
+use Ada.Text_IO;
 package body renaming1 is
-   procedure Fo (A : Text_IO.File_Access) is
+   procedure Fo (A : Ada.Text_IO.File_Access) is
begin
-  if A = Text_IO.Standard_Output then
+  if A = Ada.Text_IO.Standard_Output then
  null;
   end if;
end Fo;


diff --git a/gcc/testsuite/gnat.dg/renaming1.ads b/gcc/testsuite/gnat.dg/renaming1.ads
--- a/gcc/testsuite/gnat.dg/renaming1.ads
+++ b/gcc/testsuite/gnat.dg/renaming1.ads
@@ -1,4 +1,4 @@
-with Text_IO;
+with Ada.Text_IO;
 package renaming1 is
-   procedure Fo (A : Text_IO.File_Access);
+   procedure Fo (A : Ada.Text_IO.File_Access);
 end;


diff --git a/gcc/testsuite/gnat.dg/warn29.adb b/gcc/testsuite/gnat.dg/warn29.adb
--- a/gcc/testsuite/gnat.dg/warn29.adb
+++ b/gcc/testsuite/gnat.dg/warn29.adb
@@ -1,7 +1,7 @@
 --  { dg-do compile }
 --  { dg-options "-gnatwa" }
 
-with Text_IO; use Text_IO;
+with Ada.Text_IO; use Ada.Text_IO;
 
 package body Warn29 is
procedure P (X : T; Y : Integer) is

[Ada] Couple of small cleanups for Cloned_Subtype

[Pierre-Marie de Rodat via Gcc-patches]

No functional changes.

Tested on x86_64-pc-linux-gnu, committed on trunk

gcc/ada/

* exp_util.adb (Make_Subtype_From_Expr): Do not set field to Empty.
* sem_util.adb (Visit_Itype): Remove ??? comment.diff --git a/gcc/ada/exp_util.adb b/gcc/ada/exp_util.adb
--- a/gcc/ada/exp_util.adb
+++ b/gcc/ada/exp_util.adb
@@ -10213,8 +10213,8 @@ package body Exp_Util is
 
   elsif Is_Class_Wide_Type (Unc_Typ) then
  declare
-CW_Subtype : Entity_Id;
-EQ_Typ : Entity_Id := Empty;
+CW_Subtype : constant Entity_Id :=
+   New_Class_Wide_Subtype (Unc_Typ, E);
 
  begin
 --  A class-wide equivalent type is not needed on VM targets
@@ -10237,11 +10237,10 @@ package body Exp_Util is
   Set_Etype (Unc_Typ, Base_Type (Full_View (Etype (Unc_Typ;
end if;
 
-   EQ_Typ := Make_CW_Equivalent_Type (Unc_Typ, E);
+   Set_Equivalent_Type
+ (CW_Subtype, Make_CW_Equivalent_Type (Unc_Typ, E));
 end if;
 
-CW_Subtype := New_Class_Wide_Subtype (Unc_Typ, E);
-Set_Equivalent_Type (CW_Subtype, EQ_Typ);
 Set_Cloned_Subtype (CW_Subtype, Base_Type (Unc_Typ));
 
 return New_Occurrence_Of (CW_Subtype, Loc);


diff --git a/gcc/ada/sem_util.adb b/gcc/ada/sem_util.adb
--- a/gcc/ada/sem_util.adb
+++ b/gcc/ada/sem_util.adb
@@ -25146,8 +25146,7 @@ package body Sem_Util is
  end if;
 
  --  If a record subtype is simply copied, the entity list will be
- --  shared. Thus cloned_Subtype must be set to indicate the sharing.
- --  ??? What does this do?
+ --  shared, so Cloned_Subtype must be set to indicate this.
 
  if Ekind (Itype) in E_Class_Wide_Subtype | E_Record_Subtype then
 Set_Cloned_Subtype (New_Itype, Itype);

[Ada] Remove kludge for validity checks on Long_Float type

[Pierre-Marie de Rodat via Gcc-patches]

This patch reverts a fix for a spurious warning for validity checks on
type Long_Float. This fix was dubious (as it was only affecting
Long_Float and not Float) and apparently is no longer needed.

Cleanup related to improved detection of uninitialised scalar objects.

Tested on x86_64-pc-linux-gnu, committed on trunk

gcc/ada/

* sem_attr.adb (Note_Possible_Modification): Revert a
special-case for validity checks on Long_Float type.
* snames.ads-tmpl (Name_Attr_Long_Float): Remove name added
exclusively for the mentioned fix.diff --git a/gcc/ada/sem_attr.adb b/gcc/ada/sem_attr.adb
--- a/gcc/ada/sem_attr.adb
+++ b/gcc/ada/sem_attr.adb
@@ -11145,43 +11145,10 @@ package body Sem_Attr is
  =>
 --  Note possible modification if we have a variable
 
-if Is_Variable (P) then
-   declare
-  PN : constant Node_Id := Parent (N);
-  Nm : Node_Id;
-
-  Note : Boolean := True;
-  --  Skip this for the case of Unrestricted_Access occurring
-  --  in the context of a Valid check, since this otherwise
-  --  leads to a missed warning (the Valid check does not
-  --  really modify!) If this case, Note will be reset to
-  --  False.
-
-  --  Skip it as well if the type is an Access_To_Constant,
-  --  given that no use of the value can modify the prefix.
-
-   begin
-  if Attr_Id = Attribute_Unrestricted_Access
-and then Nkind (PN) = N_Function_Call
-  then
- Nm := Name (PN);
-
- if Nkind (Nm) = N_Expanded_Name
-   and then Chars (Nm) = Name_Valid
-   and then Nkind (Prefix (Nm)) = N_Identifier
-   and then Chars (Prefix (Nm)) = Name_Attr_Long_Float
- then
-Note := False;
- end if;
-
-  elsif Is_Access_Constant (Typ) then
- Note := False;
-  end if;
-
-  if Note then
- Note_Possible_Modification (P, Sure => False);
-  end if;
-   end;
+if Is_Variable (P)
+  and then not Is_Access_Constant (Typ)
+then
+   Note_Possible_Modification (P, Sure => False);
 end if;
 
 --  Case where prefix is an entity name


diff --git a/gcc/ada/snames.ads-tmpl b/gcc/ada/snames.ads-tmpl
--- a/gcc/ada/snames.ads-tmpl
+++ b/gcc/ada/snames.ads-tmpl
@@ -776,7 +776,6 @@ package Snames is
Name_Allow  : constant Name_Id := N + $;
Name_Amount : constant Name_Id := N + $;
Name_As_Is  : constant Name_Id := N + $;
-   Name_Attr_Long_Float: constant Name_Id := N + $;
Name_Assertion  : constant Name_Id := N + $;
Name_Assertions : constant Name_Id := N + $;
Name_Attribute_Name : constant Name_Id := N + $;

[Ada] Remove repeated setting of Never_Set_In_Source

[Pierre-Marie de Rodat via Gcc-patches]

Formal parameters have their flag Never_Set_In_Source set at the
beginning of Process_Formals routine (regardless of the parameter mode).
There is no need to set it again when Process_Formals calls
Set_Formal_Mode (for parameters of mode IN OUT and OUT).

Code cleanup related to improved detection of uninitialised objects;
behaviour is unaffected.

Tested on x86_64-pc-linux-gnu, committed on trunk

gcc/ada/

* sem_ch6.adb (Set_Formal_Mode): Remove unnecessary setting of
Never_Set_In_Source.diff --git a/gcc/ada/sem_ch6.adb b/gcc/ada/sem_ch6.adb
--- a/gcc/ada/sem_ch6.adb
+++ b/gcc/ada/sem_ch6.adb
@@ -13298,10 +13298,9 @@ package body Sem_Ch6 is
 Mutate_Ekind (Formal_Id, E_In_Out_Parameter);
 
  else
-Mutate_Ekind(Formal_Id, E_Out_Parameter);
-Set_Never_Set_In_Source (Formal_Id, True);
-Set_Is_True_Constant(Formal_Id, False);
-Set_Current_Value   (Formal_Id, Empty);
+Mutate_Ekind (Formal_Id, E_Out_Parameter);
+Set_Is_True_Constant (Formal_Id, False);
+Set_Current_Value(Formal_Id, Empty);
  end if;
 
   else

[Ada] Remove use of a global name buffer when locating a file

[Pierre-Marie de Rodat via Gcc-patches]

Code cleanup; semantics is unaffected.

Tested on x86_64-pc-linux-gnu, committed on trunk

gcc/ada/

* osint.adb (Locate_File): Use Name_Find with a parameter and
not with a global buffer.diff --git a/gcc/ada/osint.adb b/gcc/ada/osint.adb
--- a/gcc/ada/osint.adb
+++ b/gcc/ada/osint.adb
@@ -1904,10 +1904,8 @@ package body Osint is
 if Dir_Name'Length = 0 then
Found := N;
 else
-   Name_Len := Full_Name'Length - 1;
-   Name_Buffer (1 .. Name_Len) :=
- Full_Name (1 .. Full_Name'Last - 1);
-   Found := Name_Find;
+   Found :=
+ Name_Find (Full_Name (Full_Name'First .. Full_Name'Last - 1));
 end if;
  end if;
   end;

[Ada] Reuse Get_Pragma_Arg to handle pragma argument associations

[Pierre-Marie de Rodat via Gcc-patches]

Code cleanup related to looking at pragma Thread_Local_Storage.
Semantics is unaffected.

Tested on x86_64-pc-linux-gnu, committed on trunk

gcc/ada/

* exp_ch3.adb (Build_Init_Statements): Reuse Get_Pragma_Arg.
* exp_prag.adb (Arg_N): Likewise.diff --git a/gcc/ada/exp_ch3.adb b/gcc/ada/exp_ch3.adb
--- a/gcc/ada/exp_ch3.adb
+++ b/gcc/ada/exp_ch3.adb
@@ -3319,11 +3319,9 @@ package body Exp_Ch3 is
 --  Pragma case
 
 if Nkind (Ritem) = N_Pragma then
-   Exp := First (Pragma_Argument_Associations (Ritem));
-
-   if Nkind (Exp) = N_Pragma_Argument_Association then
-  Exp := Expression (Exp);
-   end if;
+   Exp :=
+ Get_Pragma_Arg
+   (First (Pragma_Argument_Associations (Ritem)));
 
--  Conversion for Priority expression
 


diff --git a/gcc/ada/exp_prag.adb b/gcc/ada/exp_prag.adb
--- a/gcc/ada/exp_prag.adb
+++ b/gcc/ada/exp_prag.adb
@@ -105,12 +105,10 @@ package body Exp_Prag is
  end if;
   end loop;
 
-  if Present (Arg)
-and then Nkind (Arg) = N_Pragma_Argument_Association
-  then
- return Expression (Arg);
+  if Present (Arg) then
+ return Get_Pragma_Arg (Arg);
   else
- return Arg;
+ return Empty;
   end if;
end Arg_N;
 

[Ada] Fix spurious error on object renaming with ghost type

[Pierre-Marie de Rodat via Gcc-patches]

Renaming of an object of ghost type leads to a spurious error.  Now
fixed.

Tested on x86_64-pc-linux-gnu, committed on trunk

gcc/ada/

* ghost.adb (Is_OK_Ghost_Context): Detect ghost type inside object
renaming.diff --git a/gcc/ada/ghost.adb b/gcc/ada/ghost.adb
--- a/gcc/ada/ghost.adb
+++ b/gcc/ada/ghost.adb
@@ -508,7 +508,16 @@ package body Ghost is
elsif Nkind (Parent (Par)) in N_Generic_Instantiation
| N_Renaming_Declaration
| N_Generic_Renaming_Declaration
-   and then Par = Name (Parent (Par))
+ and then Par = Name (Parent (Par))
+   then
+  return True;
+
+   --  In the case of the renaming of a ghost object, the type
+   --  itself may be ghost.
+
+   elsif Nkind (Parent (Par)) = N_Object_Renaming_Declaration
+ and then (Par = Subtype_Mark (Parent (Par))
+ or else Par = Access_Definition (Parent (Par)))
then
   return True;
 

[Ada] Reorder processing of default expressions to avoid repeated calls

[Pierre-Marie de Rodat via Gcc-patches]

Code cleanup related to improved detection of uninitialised objects;
semantics is unaffected.

Tested on x86_64-pc-linux-gnu, committed on trunk

gcc/ada/

* sem_ch6.adb (Process_Formals): Avoid repeated calls to
Expression.diff --git a/gcc/ada/sem_ch6.adb b/gcc/ada/sem_ch6.adb
--- a/gcc/ada/sem_ch6.adb
+++ b/gcc/ada/sem_ch6.adb
@@ -12985,10 +12985,10 @@ package body Sem_Ch6 is
  Set_Formal_Mode (Formal);
 
  if Ekind (Formal) = E_In_Parameter then
-Set_Default_Value (Formal, Expression (Param_Spec));
+Default := Expression (Param_Spec);
 
-if Present (Expression (Param_Spec)) then
-   Default := Expression (Param_Spec);
+if Present (Default) then
+   Set_Default_Value (Formal, Default);
 
if Is_Scalar_Type (Etype (Default)) then
   if Nkind (Parameter_Type (Param_Spec)) /=

[Ada] Fix comments mentioning ancient flags related to objects references

[Pierre-Marie de Rodat via Gcc-patches]

Flag May_Be_Modified under go a series of renamings between 1996 and
2002.  It was changed to Not_Assigned, then to Not_Source_Assigned and
finally to Never_Set_In_Source. Fix remaining references in comments.

Tested on x86_64-pc-linux-gnu, committed on trunk

gcc/ada/

* sem_util.ads (Note_Possible_Modification): Fix occurrence of
May_Be_Modified in comment.
* sem_warn.ads (Check_Unset_Reference): Fix occurrence of
Not_Assigned in comment.diff --git a/gcc/ada/sem_util.ads b/gcc/ada/sem_util.ads
--- a/gcc/ada/sem_util.ads
+++ b/gcc/ada/sem_util.ads
@@ -2872,7 +2872,7 @@ package Sem_Util is
--  This routine is called if the sub-expression N maybe the target of
--  an assignment (e.g. it is the left side of an assignment, used as
--  an out parameters, or used as prefixes of access attributes). It
-   --  sets May_Be_Modified in the associated entity if there is one,
+   --  sets Never_Set_In_Source in the associated entity if there is one,
--  taking into account the rule that in the case of renamed objects,
--  it is the flag in the renamed object that must be set.
--


diff --git a/gcc/ada/sem_warn.ads b/gcc/ada/sem_warn.ads
--- a/gcc/ada/sem_warn.ads
+++ b/gcc/ada/sem_warn.ads
@@ -86,15 +86,15 @@ package Sem_Warn is
--  N is the node for an expression which occurs in a reference position,
--  e.g. as the right side of an assignment. This procedure checks to see
--  if the node is a reference to a variable entity where the entity has
-   --  Not_Assigned set. If so, the Unset_Reference field is set if it is not
-   --  the first occurrence. No warning is posted, instead warnings will be
-   --  posted later by Check_References. The reason we do things that
-   --  way is that if there are no assignments anywhere, we prefer to flag
-   --  the entity, rather than a reference to it. Note that for the purposes
-   --  of this routine, a type conversion or qualified expression whose
-   --  expression is an entity is also processed. The reason that we do not
-   --  process these at the point of occurrence is that both these constructs
-   --  can occur in non-reference positions (e.g. as out parameters).
+   --  Never_Set_In_Source set. If so, the Unset_Reference field is set if it
+   --  is not the first occurrence. No warning is posted, instead warnings will
+   --  be posted later by Check_References. The reason we do things that way is
+   --  that if there are no assignments anywhere, we prefer to flag the entity,
+   --  rather than a reference to it. Note that for the purposes of this
+   --  routine, a type conversion or qualified expression whose expression is
+   --  an entity is also processed. The reason that we do not process these
+   --  at the point of occurrence is that both these constructs can occur in
+   --  non-reference positions (e.g. as out parameters).
 
procedure Check_Unused_Withs (Spec_Unit : Unit_Number_Type := No_Unit);
--  This routine performs two kinds of checks. It checks that all with'ed

[Ada] qnx-7.1: ACATS cxag001 failure on qnx - realpath

[Pierre-Marie de Rodat via Gcc-patches]

The implementation of __gnat_full_name uses the CRTL realpath, however
this function returns a null string so use the default implementation
instead.

Tested on x86_64-pc-linux-gnu, committed on trunk

gcc/ada/

* cstreams.c (__gnat_full_name) [QNX]: Remove block.diff --git a/gcc/ada/cstreams.c b/gcc/ada/cstreams.c
--- a/gcc/ada/cstreams.c
+++ b/gcc/ada/cstreams.c
@@ -202,19 +202,6 @@ __gnat_full_name (char *nam, char *buffer)
  getcwd approach instead. */
   realpath (nam, buffer);
 
-#elif defined (__QNX__)
-
-  int length;
-
-  if (__gnat_is_absolute_path (nam, strlen (nam)))
-realpath (nam, buffer);
-  else
-{
-  length = __gnat_max_path_len;
-  __gnat_get_current_dir (buffer, &length);
-  strncat (buffer, nam, __gnat_max_path_len - length - 1);
-}
-
 #elif defined (__vxworks)
 
   /* On VxWorks systems, an absolute path can be represented (depending on

[Ada] Fix dangling bounds for array result of BIP functions

[Pierre-Marie de Rodat via Gcc-patches]

The implementation of the build-in-place return protocol for functions
whose result type is an unconstrained array type generates dangling
references to local bounds built on the stack for the result as soon as
these bounds are not static.  The reason is that the implementation
treats the return object, either explicitly present in the source or
synthesized by the compiler, as a regular constrained object until very
late in the game, although it needs to be ultimately rewritten as the
renaming of the dereference of an allocator with unconstrained designated
type in order for the bounds to be part of the allocation.

Recently a partial fix was implemented for the case where the result is an
aggregate, by preventing the return object from being expanded after it has
been analyzed.  However, it does not work for the general case of extended
return statements, because the statements therein are still analyzed with
the constrained version of the return object so, after it is changed into
the unconstrained renaming, this yields (sub)type mismatches.

Therefore this change goes the other way around: it rolls back the partial
fix and instead performs the transformation of the return object into the
unconstrained renaming during the expansion of its declaration, in other
words before statements referencing it, if any, are analyzed, thus ensuring
that they see the final version of the object.

Tested on x86_64-pc-linux-gnu, committed on trunk

gcc/ada/

* exp_aggr.adb (Expand_Array_Aggregate): Remove obsolete code.
Delay the expansion of aggregates initializing return objects of
build-in-place functions.
* exp_ch3.ads (Ensure_Activation_Chain_And_Master): Delete.
* exp_ch3.adb (Ensure_Activation_Chain_And_Master): Fold back to...
(Expand_N_Object_Declaration): ...here.
Perform the expansion of return objects of build-in-place functions
here instead of...
* exp_ch6.ads (Is_Build_In_Place_Return_Object): Declare.
* exp_ch6.adb (Expand_N_Extended_Return_Statement): ...here.
(Is_Build_In_Place_Result_Type): Alphabetize.
(Is_Build_In_Place_Return_Object): New predicate.
* exp_ch7.adb (Enclosing_Function): Delete.
(Process_Object_Declaration): Tidy up handling of return objects.
* sem_ch3.adb (Analyze_Object_Declaration): Do not decorate and
freeze the actual type if it is the same as the nominal type.
* sem_ch6.adb: Remove use and with clauses for Exp_Ch3.
(Analyze_Function_Return): Analyze again all return objects.
(Create_Extra_Formals): Do not force the definition of an Itype
if the subprogram is a compilation unit.

patch.diff.gz
Description: application/gzip

[Ada] Remove redundant protection against empty lists

[Pierre-Marie de Rodat via Gcc-patches]

Calls to First on No_List intentionally return Empty node, so explicit
guards against No_List are unnecessary. Code cleanup; semantics is
unaffected.

Tested on x86_64-pc-linux-gnu, committed on trunk

gcc/ada/

* exp_code.adb (Setup_Asm_IO_Args): Remove guard against No_List.
* par_sco.adb (Process_Decisions): Likewise.
* sem_ch13.adb (Check_Component_List): Likewise.
* sem_ch6.adb (FCL): Likewise.diff --git a/gcc/ada/exp_code.adb b/gcc/ada/exp_code.adb
--- a/gcc/ada/exp_code.adb
+++ b/gcc/ada/exp_code.adb
@@ -471,11 +471,7 @@ package body Exp_Code is
   --  Case of list of arguments
 
   elsif Nkind (Arg) = N_Aggregate then
- if Expressions (Arg) = No_List then
-Operand_Var := Empty;
- else
-Operand_Var := First (Expressions (Arg));
- end if;
+ Operand_Var := First (Expressions (Arg));
 
   --  Otherwise must be default (no operands) case
 


diff --git a/gcc/ada/par_sco.adb b/gcc/ada/par_sco.adb
--- a/gcc/ada/par_sco.adb
+++ b/gcc/ada/par_sco.adb
@@ -480,13 +480,11 @@ package body Par_SCO is
   N : Node_Id;
 
begin
-  if L /= No_List then
- N := First (L);
- while Present (N) loop
-Process_Decisions (N, T, Pragma_Sloc);
-Next (N);
- end loop;
-  end if;
+  N := First (L);
+  while Present (N) loop
+ Process_Decisions (N, T, Pragma_Sloc);
+ Next (N);
+  end loop;
end Process_Decisions;
 
--  Version taking a node


diff --git a/gcc/ada/sem_ch13.adb b/gcc/ada/sem_ch13.adb
--- a/gcc/ada/sem_ch13.adb
+++ b/gcc/ada/sem_ch13.adb
@@ -12135,24 +12135,22 @@ package body Sem_Ch13 is
 begin
--  Gather discriminants into Comp
 
-   if DS /= No_List then
-  Citem := First (DS);
-  while Present (Citem) loop
- if Nkind (Citem) = N_Discriminant_Specification then
-declare
-   Ent : constant Entity_Id :=
-   Defining_Identifier (Citem);
-begin
-   if Ekind (Ent) = E_Discriminant then
-  Ncomps := Ncomps + 1;
-  Comps (Ncomps) := Ent;
-   end if;
-end;
- end if;
+   Citem := First (DS);
+   while Present (Citem) loop
+  if Nkind (Citem) = N_Discriminant_Specification then
+ declare
+Ent : constant Entity_Id :=
+Defining_Identifier (Citem);
+ begin
+if Ekind (Ent) = E_Discriminant then
+   Ncomps := Ncomps + 1;
+   Comps (Ncomps) := Ent;
+end if;
+ end;
+  end if;
 
- Next (Citem);
-  end loop;
-   end if;
+  Next (Citem);
+   end loop;
 
--  Gather component entities into Comp
 


diff --git a/gcc/ada/sem_ch6.adb b/gcc/ada/sem_ch6.adb
--- a/gcc/ada/sem_ch6.adb
+++ b/gcc/ada/sem_ch6.adb
@@ -9988,17 +9988,8 @@ package body Sem_Ch6 is
  N2 : Node_Id;
 
   begin
- if L1 = No_List then
-N1 := Empty;
- else
-N1 := First (L1);
- end if;
-
- if L2 = No_List then
-N2 := Empty;
- else
-N2 := First (L2);
- end if;
+ N1 := First (L1);
+ N2 := First (L2);
 
  --  Compare two lists, skipping rewrite insertions (we want to compare
  --  the original trees, not the expanded versions).

[Ada] Misc cleanup related to finalization

[Pierre-Marie de Rodat via Gcc-patches]

This patch cleans up some code issues found while working on
finalization, and adds some debugging aids.

Tested on x86_64-pc-linux-gnu, committed on trunk

gcc/ada/

* exp_ch7.adb: Change two constants Is_Protected_Body and
Is_Prot_Body to be Is_Protected_Subp_Body; these are not true
for protected bodies, but for protected subprogram bodies.
(Expand_Cleanup_Actions): No need to search for
Activation_Chain_Entity; just use Activation_Chain_Entity.
* sem_ch8.adb (Find_Direct_Name): Use Entyp constant.
* atree.adb, atree.ads, atree.h, nlists.adb, nlists.ads
(Parent): Provide nonoverloaded versions of Parent, so that they
can be easily found in the debugger.
* debug_a.adb, debug_a.ads: Clarify that we're talking about the
-gnatda switch; switches are case sensitive.  Print out the
Chars field if appropriate, which makes it easier to find things
in the output.
(Debug_Output_Astring): Simplify. Also fix an off-by-one
bug ("for I in Vbars'Length .." should have been "for I in
Vbars'Length + 1 ..").  Before, it was printing Debug_A_Depth +
1 '|' characters if Debug_A_Depth > Vbars'Length.diff --git a/gcc/ada/atree.adb b/gcc/ada/atree.adb
--- a/gcc/ada/atree.adb
+++ b/gcc/ada/atree.adb
@@ -1966,7 +1966,7 @@ package body Atree is
   end if;
end Paren_Count;
 
-   function Parent (N : Node_Or_Entity_Id) return Node_Or_Entity_Id is
+   function Node_Parent (N : Node_Or_Entity_Id) return Node_Or_Entity_Id is
begin
   pragma Assert (Present (N));
 
@@ -1975,7 +1975,7 @@ package body Atree is
   else
  return Node_Or_Entity_Id (Link (N));
   end if;
-   end Parent;
+   end Node_Parent;
 
-
-- Present --
@@ -2292,12 +2292,12 @@ package body Atree is
-- Set_Parent --

 
-   procedure Set_Parent (N : Node_Or_Entity_Id; Val : Node_Or_Entity_Id) is
+   procedure Set_Node_Parent (N : Node_Or_Entity_Id; Val : Node_Or_Entity_Id) is
begin
   pragma Assert (Present (N));
   pragma Assert (not In_List (N));
   Set_Link (N, Union_Id (Val));
-   end Set_Parent;
+   end Set_Node_Parent;
 

-- Set_Reporting_Proc --


diff --git a/gcc/ada/atree.ads b/gcc/ada/atree.ads
--- a/gcc/ada/atree.ads
+++ b/gcc/ada/atree.ads
@@ -446,10 +446,15 @@ package Atree is
--  Tests given Id for equality with the Empty node. This allows notations
--  like "if No (Variant_Part)" as opposed to "if Variant_Part = Empty".
 
-   function Parent (N : Node_Or_Entity_Id) return Node_Or_Entity_Id;
+   function Node_Parent (N : Node_Or_Entity_Id) return Node_Or_Entity_Id;
+   pragma Inline (Node_Parent);
+   function Parent (N : Node_Or_Entity_Id) return Node_Or_Entity_Id
+ renames Node_Parent;
pragma Inline (Parent);
--  Returns the parent of a node if the node is not a list member, or else
--  the parent of the list containing the node if the node is a list member.
+   --  Parent has the same name as the one in Nlists; Node_Parent can be used
+   --  more easily in the debugger.
 
function Paren_Count (N : Node_Id) return Nat;
pragma Inline (Paren_Count);
@@ -465,7 +470,10 @@ package Atree is
--  Note that this routine is used only in very peculiar cases. In normal
--  cases, the Original_Node link is set by calls to Rewrite.
 
-   procedure Set_Parent (N : Node_Or_Entity_Id; Val : Node_Or_Entity_Id);
+   procedure Set_Node_Parent (N : Node_Or_Entity_Id; Val : Node_Or_Entity_Id);
+   pragma Inline (Set_Node_Parent);
+   procedure Set_Parent (N : Node_Or_Entity_Id; Val : Node_Or_Entity_Id)
+ renames Set_Node_Parent;
pragma Inline (Set_Parent);
 
procedure Set_Paren_Count (N : Node_Id; Val : Nat);


diff --git a/gcc/ada/atree.h b/gcc/ada/atree.h
--- a/gcc/ada/atree.h
+++ b/gcc/ada/atree.h
@@ -35,7 +35,7 @@
 extern "C" {
 #endif
 
-#define Parent atree__parent
+#define Parent atree__node_parent
 extern Node_Id Parent (Node_Id);
 
 #define Original_Node atree__original_node


diff --git a/gcc/ada/debug_a.adb b/gcc/ada/debug_a.adb
--- a/gcc/ada/debug_a.adb
+++ b/gcc/ada/debug_a.adb
@@ -25,6 +25,7 @@
 
 with Atree;  use Atree;
 with Debug;  use Debug;
+with Namet;  use Namet;
 with Sinfo;  use Sinfo;
 with Sinfo.Nodes;use Sinfo.Nodes;
 with Sinput; use Sinput;
@@ -33,7 +34,7 @@ with Output; use Output;
 package body Debug_A is
 
Debug_A_Depth : Natural := 0;
-   --  Output for the debug A flag is preceded by a sequence of vertical bar
+   --  Output for the -gnatda switch is preceded by a sequence of vertical bar
--  characters corresponding to the recursion depth of the actions being
--  recorded (analysis, expansion, resolution and evaluation of nodes)
--  This variable records the depth.
@@ -66,7 +67,7 @@ package body Debug_A is
 
procedure Debug_A_Entry (S : String; N : Node_Id) is
b

[Ada] Remove return statements after procedure calls that don't return

[Pierre-Marie de Rodat via Gcc-patches]

A new warning about unreachable code that follows calls to procedures
with No_Return would flag many unnecessary return statements. Those
returns statements were applied inconsistently, so this patch is
actually more a style cleanup.

Tested on x86_64-pc-linux-gnu, committed on trunk

gcc/ada/

* sem_attr.adb, sem_prag.adb: Remove dead return statements
after calls to Error_Attr, Error_Pragma, Error_Pragma_Arg and
Placement_Error. All these calls raise exceptions that are
handled to gently recover from errors.diff --git a/gcc/ada/sem_attr.adb b/gcc/ada/sem_attr.adb
--- a/gcc/ada/sem_attr.adb
+++ b/gcc/ada/sem_attr.adb
@@ -1090,7 +1090,6 @@ package body Sem_Attr is
 
else
   Error_Attr ("% attribute cannot be applied to type", P);
-  return;
end if;
 end if;
  end if;
@@ -1429,7 +1428,6 @@ package body Sem_Attr is
 
 else
Placement_Error;
-   return;
 end if;
 
  --  'Old attribute reference ok in a _Postconditions procedure
@@ -1445,7 +1443,6 @@ package body Sem_Attr is
 
  else
 Placement_Error;
-return;
  end if;
 
  --  Find the related subprogram subject to the aspect or pragma
@@ -1715,14 +1712,12 @@ package body Sem_Attr is
 
 else
Placement_Error;
-   return;
 end if;
 
  --  Otherwise the placement of the attribute is illegal
 
  else
 Placement_Error;
-return;
  end if;
 
  --  Find the related subprogram subject to the aspect or pragma
@@ -3666,7 +3661,6 @@ package body Sem_Attr is
 
  else
 Error_Attr ("invalid entry name", N);
-return;
  end if;
 
  for J in reverse 0 .. Scope_Stack.Last loop
@@ -3945,7 +3939,6 @@ package body Sem_Attr is
else
   Error_Attr ("invalid entry family name", P);
end if;
-   return;
 
 else
Ent := Entity (Prefix (P));
@@ -3960,7 +3953,6 @@ package body Sem_Attr is
 
  else
 Error_Attr ("invalid entry name", N);
-return;
  end if;
 
  for J in reverse 0 .. Scope_Stack.Last loop
@@ -4479,7 +4471,6 @@ package body Sem_Attr is
 
  if not Legal or else No (Spec_Id) then
 Error_Attr ("attribute % must apply to entry family", P);
-return;
  end if;
 
  --  Legality checks
@@ -5898,7 +5889,6 @@ package body Sem_Attr is
 
  elsif not Legal then
 Error_Attr ("prefix of % attribute must be a function", P);
-return;
  end if;
 
  --  Attribute 'Result is part of a _Postconditions procedure. There is


diff --git a/gcc/ada/sem_prag.adb b/gcc/ada/sem_prag.adb
--- a/gcc/ada/sem_prag.adb
+++ b/gcc/ada/sem_prag.adb
@@ -4585,7 +4585,6 @@ package body Sem_Prag is
 
  else
 Pragma_Misplaced;
-return;
  end if;
 
  --  If we get here, then the pragma is legal
@@ -4600,7 +4599,6 @@ package body Sem_Prag is
and then Ekind (Scope (Spec_Id)) /= E_Protected_Type
  then
 Pragma_Misplaced;
-return;
 
  --  When the related context is an anonymous object created for a
  --  simple concurrent type, the type must be a task
@@ -4610,7 +4608,6 @@ package body Sem_Prag is
and then Ekind (Etype (Spec_Id)) /= E_Task_Type
  then
 Pragma_Misplaced;
-return;
  end if;
 
  --  A pragma that applies to a Ghost entity becomes Ghost for the
@@ -4926,7 +4923,6 @@ package body Sem_Prag is
 
  else
 Pragma_Misplaced;
-return;
  end if;
 
  Subp_Id := Defining_Entity (Subp_Decl);
@@ -4991,7 +4987,6 @@ package body Sem_Prag is
   N_Task_Body  | N_Task_Body_Stub
  then
 Pragma_Misplaced;
-return;
  end if;
 
  Body_Id := Defining_Entity (Body_Decl);
@@ -5002,14 +4997,12 @@ package body Sem_Prag is
 
  if No (Spec_Id) then
 Error_Pragma ("pragma % cannot apply to a stand alone body");
-return;
 
  --  Catch the case where the subprogram body is a subunit and acts as
  --  the third declaration of the subprogram.
 
  elsif Nkind (Parent (Body_Decl)) = N_Subunit then
 Error_Pragma ("pragma % cannot apply to a subunit");
-return;
  end if;
 
  --  A refined pragma can only apply to the body [stub] of a subprogram
@@ -5034,7 +5027,6 @@ package body Sem_Prag is
 Error_Pragma
   (Fix_Msg (Spec_Id, "pragma % must apply to the body of "
& "subprogram declared in a package specification"));
-return;
 

[Ada] Annotate GNAT.Sockets with No_Return aspects

[Pierre-Marie de Rodat via Gcc-patches]

Opportunity for extra annotations spotted while fixing detection of
unreachable code that follows calls to procedures annotated with
No_Return.

Tested on x86_64-pc-linux-gnu, committed on trunk

gcc/ada/

* libgnat/g-socket.adb (Raise_Host_Error): Add No_Return aspect.
(Raise_GAI_Error): Likewise.
* libgnat/g-socket.ads (Raise_Socket_Error): Likewise.diff --git a/gcc/ada/libgnat/g-socket.adb b/gcc/ada/libgnat/g-socket.adb
--- a/gcc/ada/libgnat/g-socket.adb
+++ b/gcc/ada/libgnat/g-socket.adb
@@ -191,12 +191,14 @@ package body GNAT.Sockets is
else Value);
--  Removes dot at the end of error message
 
-   procedure Raise_Host_Error (H_Error : Integer; Name : String);
+   procedure Raise_Host_Error (H_Error : Integer; Name : String)
+   with No_Return;
--  Raise Host_Error exception with message describing error code (note
--  hstrerror seems to be obsolete) from h_errno. Name is the name
--  or address that was being looked up.
 
-   procedure Raise_GAI_Error (RC : C.int; Name : String);
+   procedure Raise_GAI_Error (RC : C.int; Name : String)
+   with No_Return;
--  Raise Host_Error with exception message in case of errors in
--  getaddrinfo and getnameinfo.
 


diff --git a/gcc/ada/libgnat/g-socket.ads b/gcc/ada/libgnat/g-socket.ads
--- a/gcc/ada/libgnat/g-socket.ads
+++ b/gcc/ada/libgnat/g-socket.ads
@@ -1593,7 +1593,7 @@ private
Wait_For_A_Full_Reception : constant Request_Flag_Type := 4;
Send_End_Of_Record: constant Request_Flag_Type := 8;
 
-   procedure Raise_Socket_Error (Error : Integer);
+   procedure Raise_Socket_Error (Error : Integer) with No_Return;
--  Raise Socket_Error with an exception message describing the error code
--  from errno.
 

[Ada] Remove repeated analysis for pragma Thread_Local_Storage

[Pierre-Marie de Rodat via Gcc-patches]

When analysing pragma Thread_Local_Storage its argument is analysed by
the call to Check_Arg_Is_Library_Level_Local_Name. There is no need to
reanalyse it. Code cleanup; behaviour is not affected.

Tested on x86_64-pc-linux-gnu, committed on trunk

gcc/ada/

* sem_prag.adb (Analyze_Pragma): Remove unnecessary call to
Analyze.diff --git a/gcc/ada/sem_prag.adb b/gcc/ada/sem_prag.adb
--- a/gcc/ada/sem_prag.adb
+++ b/gcc/ada/sem_prag.adb
@@ -24861,7 +24861,6 @@ package body Sem_Prag is
 Check_Arg_Is_Library_Level_Local_Name (Arg1);
 
 Id := Get_Pragma_Arg (Arg1);
-Analyze (Id);
 
 if not Is_Entity_Name (Id)
   or else Ekind (Entity (Id)) /= E_Variable

[Ada] Remove unnecessary dead code after calls to nonreturning procedures

[Pierre-Marie de Rodat via Gcc-patches]

A new warning about unreachable code that follows calls to procedures
with No_Return would flag some dead defensive code. Comments next to
this code suggest that it was added to please some ancient version of
the compiler, but recent releases of GNAT do not require such a code.

Tested on x86_64-pc-linux-gnu, committed on trunk

gcc/ada/

* gnatls.adb (Corresponding_Sdep_Entry): Remove dead return
statement in defensive path; there is another return statement
for a normal execution of this routine, so rule Ada RM 6.5(5),
which requires function to have at least one return statement is
still satisfied.
(Gnatls): Remove dead, call to nonreturning Exit_Program after
Output_License_Information which itself does not return.
* libgnat/a-exstat.adb (Bad_EO): Remove raise statement that was
meant to please some ancient version of GNAT.
* libgnat/g-awk.adb (Raise_With_Info): Likewise.
* sem_attr.adb (Check_Reference): Remove dead return statement;
rule Ada RM 6.5(5), which requires function to have at least one
return statement is still satisfied.
(Analyze_Attribute): Remove dead exit statement.
(Check_Reference): Same as above.
* sem_ch12.adb (Instantiate_Formal_Package): Remove dead raise
statement; it was inconsistent with other calls to
Abandon_Instantiation, which are not followed by a raise
statement.
* sem_prag.adb (Process_Convention): Remove dead defensive
assignment.
(Interrupt_State): Remove dead defensive exit statement.
(Do_SPARK_Mode): Likewise.
* sfn_scan.adb (Scan_String): Remove dead defensive assignment.diff --git a/gcc/ada/gnatls.adb b/gcc/ada/gnatls.adb
--- a/gcc/ada/gnatls.adb
+++ b/gcc/ada/gnatls.adb
@@ -319,7 +319,6 @@ procedure Gnatls is
   Write_Eol;
   Error_Msg ("wrong ALI format, can't find dependency line for $ in {");
   Exit_Program (E_Fatal);
-  return No_Sdep_Id;
end Corresponding_Sdep_Entry;
 
-
@@ -2051,7 +2050,6 @@ begin
if License then
   if Arg_Count = 2 then
  Output_License_Information;
- Exit_Program (E_Success);
 
   else
  Set_Standard_Error;


diff --git a/gcc/ada/libgnat/a-exstat.adb b/gcc/ada/libgnat/a-exstat.adb
--- a/gcc/ada/libgnat/a-exstat.adb
+++ b/gcc/ada/libgnat/a-exstat.adb
@@ -109,13 +109,6 @@ package body Stream_Attributes is
  Raise_Exception
(Program_Error'Identity,
 "bad exception occurrence in stream input");
-
- --  The following junk raise of Program_Error is required because
- --  this is a No_Return procedure, and unfortunately Raise_Exception
- --  can return (this particular call can't, but the back end is not
- --  clever enough to know that).
-
- raise Program_Error;
   end Bad_EO;
 
   procedure Next_String is


diff --git a/gcc/ada/libgnat/g-awk.adb b/gcc/ada/libgnat/g-awk.adb
--- a/gcc/ada/libgnat/g-awk.adb
+++ b/gcc/ada/libgnat/g-awk.adb
@@ -1211,7 +1211,6 @@ package body GNAT.AWK is
   Exceptions.Raise_Exception
 (E,
  '[' & Filename & ':' & Line & "] " & Message);
-  raise Constraint_Error; -- to please GNAT as this is a No_Return proc
end Raise_With_Info;
 
---


diff --git a/gcc/ada/sem_attr.adb b/gcc/ada/sem_attr.adb
--- a/gcc/ada/sem_attr.adb
+++ b/gcc/ada/sem_attr.adb
@@ -4747,7 +4747,6 @@ package body Sem_Attr is
   Error_Attr
 ("prefix of attribute % cannot reference local entities",
  Nod);
-  return Abandon;
else
   return OK;
end if;
@@ -4989,7 +4988,6 @@ package body Sem_Attr is
 else
Error_Attr
  ("attribute % cannot appear in body or accept statement", N);
-   exit;
 end if;
  end loop;
 
@@ -5383,7 +5381,6 @@ package body Sem_Attr is
   Error_Attr
 ("prefix of attribute % cannot reference local entities",
  Nod);
-  return Abandon;
 
--  Otherwise keep inspecting the prefix
 


diff --git a/gcc/ada/sem_ch12.adb b/gcc/ada/sem_ch12.adb
--- a/gcc/ada/sem_ch12.adb
+++ b/gcc/ada/sem_ch12.adb
@@ -10572,7 +10572,6 @@ package body Sem_Ch12 is
  Error_Msg_N
("expect package instance to instantiate formal", Actual);
  Abandon_Instantiation (Actual);
- raise Program_Error;
 
   else
  Actual_Pack := Entity (Actual);


diff --git a/gcc/ada/sem_prag.adb b/gcc/ada/sem_prag.adb
--- a/gcc/ada/sem_prag.adb
+++ b/gcc/ada/sem_prag.adb
@@ -8336,7 +8336,6 @@ package body Sem_Prag is
Error_Pragma_Arg
  ("argument of pragma% must be subprogram or access type",
   Arg2);
-   

[Ada] Remove exception propagation during bootstrap

[Pierre-Marie de Rodat via Gcc-patches]

To help the bootstrap path, we want to keep the compiler free from any
exception propagation during bootstrap. This has been broken recently in
various places.

Also introduce a way to more easily detect such breakage via the
-DNO_EXCEPTION_PROPAGATION which can now be used as part of BOOT_CFLAGS.

Tested on x86_64-pc-linux-gnu, committed on trunk

gcc/ada/

* exp_imgv.adb (Build_Enumeration_Image_Tables): Also disable
perfect hash in GNAT_Mode.
* raise-gcc.c (__gnat_Unwind_RaiseException): Add support for
disabling exception propagation.
* sem_eval.adb (Compile_Time_Known_Value): Update comment and
remove wrong call to Check_Error_Detected.
* sem_prag.adb (Check_Loop_Pragma_Grouping, Analyze_Pragma):
Remove exception propagation during bootstrap.diff --git a/gcc/ada/exp_imgv.adb b/gcc/ada/exp_imgv.adb
--- a/gcc/ada/exp_imgv.adb
+++ b/gcc/ada/exp_imgv.adb
@@ -289,12 +289,14 @@ package body Exp_Imgv is
  --  If the unit where the type is declared is the main unit, and the
  --  number of literals is greater than Threshold_For_Size when we are
  --  optimizing for size, and the restriction No_Implicit_Loops is not
- --  active, and -gnatd_h is not specified, generate the hash function.
+ --  active, and -gnatd_h is not specified, and not GNAT_Mode, generate
+ --  the hash function.
 
  if In_Main_Unit
and then (Optimize_Size = 0 or else Nlit > Threshold_For_Size)
and then not Restriction_Active (No_Implicit_Loops)
and then not Debug_Flag_Underscore_H
+   and then not GNAT_Mode
  then
 declare
LB : constant Positive := 2 * Positive (Nlit) + 1;


diff --git a/gcc/ada/raise-gcc.c b/gcc/ada/raise-gcc.c
--- a/gcc/ada/raise-gcc.c
+++ b/gcc/ada/raise-gcc.c
@@ -1377,6 +1377,10 @@ __gnat_cleanupunwind_handler (int version ATTRIBUTE_UNUSED,
 _Unwind_Reason_Code
 __gnat_Unwind_RaiseException (_Unwind_Exception *e)
 {
+#ifdef NO_EXCEPTION_PROPAGATION
+  abort();
+#endif
+
 #ifdef __USING_SJLJ_EXCEPTIONS__
   return _Unwind_SjLj_RaiseException (e);
 #else


diff --git a/gcc/ada/sem_eval.adb b/gcc/ada/sem_eval.adb
--- a/gcc/ada/sem_eval.adb
+++ b/gcc/ada/sem_eval.adb
@@ -1816,10 +1816,10 @@ package body Sem_Eval is
 
begin
   --  Never known at compile time if bad type or raises Constraint_Error
-  --  or empty (latter case occurs only as a result of a previous error).
+  --  or empty (which can occur as a result of a previous error or in the
+  --  case of e.g. an imported constant).
 
   if No (Op) then
- Check_Error_Detected;
  return False;
 
   elsif Op = Error


diff --git a/gcc/ada/sem_prag.adb b/gcc/ada/sem_prag.adb
--- a/gcc/ada/sem_prag.adb
+++ b/gcc/ada/sem_prag.adb
@@ -6152,15 +6152,11 @@ package body Sem_Prag is
  
 
  procedure Check_Loop_Pragma_Grouping (Loop_Stmt : Node_Id) is
-Stop_Search : exception;
---  This exception is used to terminate the recursive descent of
---  routine Check_Grouping.
-
-procedure Check_Grouping (L : List_Id);
+function Check_Grouping (L : List_Id) return Boolean;
 --  Find the first group of pragmas in list L and if successful,
 --  ensure that the current pragma is part of that group. The
---  routine raises Stop_Search once such a check is performed to
---  halt the recursive descent.
+--  routine returns True once such a check is performed to
+--  stop the analysis.
 
 procedure Grouping_Error (Prag : Node_Id);
 pragma No_Return (Grouping_Error);
@@ -6171,7 +6167,7 @@ package body Sem_Prag is
 -- Check_Grouping --
 
 
-procedure Check_Grouping (L : List_Id) is
+function Check_Grouping (L : List_Id) return Boolean is
HSS  : Node_Id;
Stmt : Node_Id;
Prag : Node_Id := Empty; -- init to avoid warning
@@ -6219,7 +6215,7 @@ package body Sem_Prag is
--  Stop the search as the placement is legal.
 
if Stmt = N then
-  raise Stop_Search;
+  return True;
 
--  Skip group members, but keep track of the
--  last pragma in the group.
@@ -6266,15 +6262,21 @@ package body Sem_Prag is
   elsif Nkind (Stmt) = N_Block_Statement then
  HSS := Handled_Statement_Sequence (Stmt);
 
- Check_Grouping (Declarations (Stmt));
+ if Check_Grouping (Declarations (Stmt)) then
+return True;
+ end if;
 
  if Present (HSS) then
-

[Ada] Cleanup repeated code for aggregate constraints checks

[Pierre-Marie de Rodat via Gcc-patches]

Code cleanup related to examining uses of Check_Unset_Reference for
improved detection of uninitialised scalar objects. Semantics is
unaffected.

Tested on x86_64-pc-linux-gnu, committed on trunk

gcc/ada/

* sem_util.adb (Aggregate_Constraint_Checks): Fix whitespace;
refactor repeated code; replace a ??? comment with an
explanation based on the comment for the routine spec.diff --git a/gcc/ada/sem_util.adb b/gcc/ada/sem_util.adb
--- a/gcc/ada/sem_util.adb
+++ b/gcc/ada/sem_util.adb
@@ -1153,7 +1153,7 @@ package body Sem_Util is
  (Exp   : Node_Id;
   Check_Typ : Entity_Id)
is
-  Exp_Typ : constant Entity_Id  := Etype (Exp);
+  Exp_Typ : constant Entity_Id := Etype (Exp);
 
begin
   if Raises_Constraint_Error (Exp) then
@@ -1236,12 +1236,12 @@ package body Sem_Util is
 and then Is_Scalar_Type (Check_Typ)
 and then Exp_Typ /= Check_Typ
   then
+ --  If expression is a constant, it is worthwhile checking whether it
+ --  is a bound of the type.
+
  if Is_Entity_Name (Exp)
and then Ekind (Entity (Exp)) = E_Constant
  then
---  If expression is a constant, it is worthwhile checking whether
---  it is a bound of the type.
-
 if (Is_Entity_Name (Type_Low_Bound (Check_Typ))
  and then Entity (Exp) = Entity (Type_Low_Bound (Check_Typ)))
   or else
@@ -1249,20 +1249,15 @@ package body Sem_Util is
  and then Entity (Exp) = Entity (Type_High_Bound (Check_Typ)))
 then
return;
-
-else
-   Rewrite (Exp, Convert_To (Check_Typ, Relocate_Node (Exp)));
-   Analyze_And_Resolve (Exp, Check_Typ);
-   Check_Unset_Reference (Exp);
 end if;
+ end if;
 
- --  Could use a comment on this case ???
+ --  Change Exp into Check_Typ'(Exp) to ensure that range checks are
+ --  performed at run time.
 
- else
-Rewrite (Exp, Convert_To (Check_Typ, Relocate_Node (Exp)));
-Analyze_And_Resolve (Exp, Check_Typ);
-Check_Unset_Reference (Exp);
- end if;
+ Rewrite (Exp, Convert_To (Check_Typ, Relocate_Node (Exp)));
+ Analyze_And_Resolve (Exp, Check_Typ);
+ Check_Unset_Reference (Exp);
 
   end if;
end Aggregate_Constraint_Checks;

[Ada] Spurious error on qualified prefix in Pack.Func'Result

[Pierre-Marie de Rodat via Gcc-patches]

When using a qualified name such as Pack.Func as the prefix of a 'Result
attribute reference, the prefix is not fully resolved and may contain a
chain of homonyms. Look for the expected function in the homonym chain
instead of issuing an error if the first one is not the expected one.

Tested on x86_64-pc-linux-gnu, committed on trunk

gcc/ada/

* sem_attr.adb (Analyze_Attribute): Take into account the
possibility of homonyms.diff --git a/gcc/ada/sem_attr.adb b/gcc/ada/sem_attr.adb
--- a/gcc/ada/sem_attr.adb
+++ b/gcc/ada/sem_attr.adb
@@ -5835,6 +5835,12 @@ package body Sem_Attr is
 
 elsif Present (Over_Id) and then Pref_Id = Over_Id then
return True;
+
+--  When a qualified name is used for the prefix, homonyms may come
+--  before the current function in the homonym chain.
+
+elsif Has_Homonym (Pref_Id) then
+   return Denote_Same_Function (Homonym (Pref_Id), Spec_Id);
 end if;
 
 --  Otherwise the prefix does not denote the related subprogram

[Ada] Cleanup in error about unreachable code

[Pierre-Marie de Rodat via Gcc-patches]

Cleanup only; behaviour is unaffected.

Tested on x86_64-pc-linux-gnu, committed on trunk

gcc/ada/

* sem_ch5.adb (Check_Unreachable_Code): Avoid explicit use of
Sloc; this should also help when we finally use Source_Span for
prettier error messages.diff --git a/gcc/ada/sem_ch5.adb b/gcc/ada/sem_ch5.adb
--- a/gcc/ada/sem_ch5.adb
+++ b/gcc/ada/sem_ch5.adb
@@ -4468,8 +4468,7 @@ package body Sem_Ch5 is
   end loop;
end if;
 
-   Error_Msg
- ("??unreachable code!", Sloc (Error_Node), Error_Node);
+   Error_Msg_N ("??unreachable code!", Error_Node);
 end if;
 
  --  If the unconditional transfer of control instruction is the

[Ada] Remove redundant guard for call to List_Length with a No_List

[Pierre-Marie de Rodat via Gcc-patches]

Code cleanup related to a new detection of uninitialised local scalar
objects; semantics is unaffected.

Tested on x86_64-pc-linux-gnu, committed on trunk

gcc/ada/

* sem_ch5.adb (Analyze_Block_Statement): Call to List_Length with
No_List is safe and will return zero.diff --git a/gcc/ada/sem_ch5.adb b/gcc/ada/sem_ch5.adb
--- a/gcc/ada/sem_ch5.adb
+++ b/gcc/ada/sem_ch5.adb
@@ -1376,11 +1376,7 @@ package body Sem_Ch5 is
  --  Initialize unblocked exit count for statements of begin block
  --  plus one for each exception handler that is present.
 
- Unblocked_Exit_Count := 1;
-
- if Present (EH) then
-Unblocked_Exit_Count := Unblocked_Exit_Count + List_Length (EH);
- end if;
+ Unblocked_Exit_Count := 1 + List_Length (EH);
 
  --  If a label is present analyze it and mark it as referenced
 

[Ada] Perform object rewriting as renaming only in the expander

[Pierre-Marie de Rodat via Gcc-patches]

The rewriting as renaming optimization for object declarations is done
partly during analysis, guarded with Expander_Active, and partly during
expansion, so it makes sense to do it entirely during expansion.

This merges the two cases and removes obsolete or unnecessary conditions
guarding the transformation in the process.

Tested on x86_64-pc-linux-gnu, committed on trunk

gcc/ada/

* exp_ch3.adb (Expand_N_Object_Declaration): Rewrite as a renaming
for any nonaliased local object with nominal unconstrained subtype
originally initialized with the result of a function call that has
been rewritten as the dereference of a reference to the result.
* sem_ch3.adb (Analyze_Object_Declaration): Do not do it herediff --git a/gcc/ada/exp_ch3.adb b/gcc/ada/exp_ch3.adb
--- a/gcc/ada/exp_ch3.adb
+++ b/gcc/ada/exp_ch3.adb
@@ -7675,59 +7675,54 @@ package body Exp_Ch3 is
 
 Rewrite_As_Renaming :=
 
-  --  If the object declaration appears in the form
+  --  The declaration cannot be rewritten if it has got constraints
+  --  in other words the nominal subtype must be unconstrained.
 
-  --Obj : Typ := Func (...);
+  Is_Entity_Name (Original_Node (Obj_Def))
 
-  --  where Typ needs finalization and is returned on the secondary
-  --  stack, the declaration can be rewritten into a dereference of
-  --  the reference to the result built on the secondary stack (see
-  --  Expand_Ctrl_Function_Call for this expansion of the call):
+--  The aliased case has to be excluded because the expression
+--  will not be aliased in the general case.
 
-  --type Axx is access all Typ;
-  --Rxx : constant Axx := Func (...)'reference;
-  --Obj : Typ renames Rxx.all;
+and then not Aliased_Present (N)
 
-  --  This avoids an extra copy and a pair of Adjust/Finalize calls
+--  If the object declaration originally appears in the form
 
-  ((not Is_Library_Level_Entity (Def_Id)
- and then Nkind (Expr_Q) = N_Explicit_Dereference
- and then not Comes_From_Source (Expr_Q)
- and then Nkind (Original_Node (Expr_Q)) = N_Function_Call
- and then Needs_Finalization (Typ)
- and then not Is_Class_Wide_Type (Typ))
+--Obj : Typ := Func (...);
 
---  If the initializing expression is for a variable with flag
---  OK_To_Rename set, then transform:
+--  and has been rewritten as the dereference of a reference
+--  to the function result built either on the primary or the
+--  secondary stack, then the declaration can be rewritten as
+--  the renaming of this dereference:
 
--- Obj : Typ := Expr;
+--type Axx is access all Typ;
+--Rxx : constant Axx := Func (...)'reference;
+--Obj : Typ renames Rxx.all;
 
---  into
+--  This avoids an extra copy and, in the case where Typ needs
+--  finalization, a pair of Adjust/Finalize calls (see below).
 
--- Obj : Typ renames Expr;
+and then
+  ((not Is_Library_Level_Entity (Def_Id)
+ and then Nkind (Expr_Q) = N_Explicit_Dereference
+ and then not Comes_From_Source (Expr_Q)
+ and then Nkind (Original_Node (Expr_Q)) = N_Function_Call
+ and then not Is_Class_Wide_Type (Typ))
 
---  provided that Obj is not aliased. The aliased case has to
---  be excluded because Expr will not be aliased in general.
+   --  If the initializing expression is a variable with the
+   --  flag OK_To_Rename set, then transform:
 
-   or else (not Aliased_Present (N)
- and then (OK_To_Rename_Ref (Expr_Q)
-or else
-   (Nkind (Expr_Q) = N_Slice
- and then
-OK_To_Rename_Ref (Prefix (Expr_Q))
+   -- Obj : Typ := Expr;
 
-  --  The declaration cannot be rewritten if it has got constraints
-  --  in other words the nominal subtype must be unconstrained.
+   --  into
+
+   -- Obj : Typ renames Expr;
 
-  and then Is_Entity_Name (Original_Node (Obj_Def))
+   or else OK_To_Rename_Ref (Expr_Q)
 
-  --  ??? Likewise if there are any aspect specifications, because
-  --  otherwise we duplicate that corresponding implicit attribute
-  -- 

[Ada] Combine system.ads files - vxworks6 constants.

[Pierre-Marie de Rodat via Gcc-patches]

Systemitize Word_Size and Memory_Size declarations rather than hard code
with numerical values or OS specific Long_Integer size.

Tested on x86_64-pc-linux-gnu, committed on trunk

gcc/ada/

* libgnat/system-vxworks-ppc-kernel.ads (Word_Size): Compute
based on Standard'Word_Size.
(Memory_Size): Compute based on Word_Size.
* libgnat/system-vxworks-ppc-rtp-smp.ads: Likewise.
* libgnat/system-vxworks-ppc-rtp.ads: Likewise.diff --git a/gcc/ada/libgnat/system-vxworks-ppc-kernel.ads b/gcc/ada/libgnat/system-vxworks-ppc-kernel.ads
--- a/gcc/ada/libgnat/system-vxworks-ppc-kernel.ads
+++ b/gcc/ada/libgnat/system-vxworks-ppc-kernel.ads
@@ -69,8 +69,8 @@ package System is
Null_Address : constant Address;
 
Storage_Unit : constant := 8;
-   Word_Size: constant := 32;
-   Memory_Size  : constant := 2 ** 32;
+   Word_Size: constant := Standard'Word_Size;
+   Memory_Size  : constant := 2 ** Word_Size;
 
--  Address comparison
 


diff --git a/gcc/ada/libgnat/system-vxworks-ppc-rtp-smp.ads b/gcc/ada/libgnat/system-vxworks-ppc-rtp-smp.ads
--- a/gcc/ada/libgnat/system-vxworks-ppc-rtp-smp.ads
+++ b/gcc/ada/libgnat/system-vxworks-ppc-rtp-smp.ads
@@ -71,8 +71,8 @@ package System is
Null_Address : constant Address;
 
Storage_Unit : constant := 8;
-   Word_Size: constant := 32;
-   Memory_Size  : constant := 2 ** 32;
+   Word_Size: constant := Standard'Word_Size;
+   Memory_Size  : constant := 2 ** Word_Size;
 
--  Address comparison
 


diff --git a/gcc/ada/libgnat/system-vxworks-ppc-rtp.ads b/gcc/ada/libgnat/system-vxworks-ppc-rtp.ads
--- a/gcc/ada/libgnat/system-vxworks-ppc-rtp.ads
+++ b/gcc/ada/libgnat/system-vxworks-ppc-rtp.ads
@@ -71,8 +71,8 @@ package System is
Null_Address : constant Address;
 
Storage_Unit : constant := 8;
-   Word_Size: constant := 32;
-   Memory_Size  : constant := 2 ** 32;
+   Word_Size: constant := Standard'Word_Size;
+   Memory_Size  : constant := 2 ** Word_Size;
 
--  Address comparison
 

[Ada] Add RM reference to check for functions without a return statement

[Pierre-Marie de Rodat via Gcc-patches]

Add comment to explain why we have an error and not just a warning.

Tested on x86_64-pc-linux-gnu, committed on trunk

gcc/ada/

* sem_ch6.adb (Check_Missing_Return): Add reference to an RM rule.diff --git a/gcc/ada/sem_ch6.adb b/gcc/ada/sem_ch6.adb
--- a/gcc/ada/sem_ch6.adb
+++ b/gcc/ada/sem_ch6.adb
@@ -3568,6 +3568,10 @@ package body Sem_Ch6 is
Id := Body_Id;
 end if;
 
+--  A function body shall contain at least one return statement
+--  that applies to the function body, unless the function contains
+--  code_statements; RM 6.5(5).
+
 if Return_Present (Id) then
Check_Returns (HSS, 'F', Missing_Ret);
 

[Ada] Remove comment about a long gone formal verification mode

[Pierre-Marie de Rodat via Gcc-patches]

Remove outdated a comment about the very first SPARK experiments
in GNAT.

Tested on x86_64-pc-linux-gnu, committed on trunk

gcc/ada/

* sem_ch6.adb (Check_Missing_Return): Remove outdated comment.diff --git a/gcc/ada/sem_ch6.adb b/gcc/ada/sem_ch6.adb
--- a/gcc/ada/sem_ch6.adb
+++ b/gcc/ada/sem_ch6.adb
@@ -2987,9 +2987,7 @@ package body Sem_Ch6 is
 
   procedure Check_Missing_Return;
   --  Checks for a function with a no return statements, and also performs
-  --  the warning checks implemented by Check_Returns. In formal mode, also
-  --  verify that a function ends with a RETURN and that a procedure does
-  --  not contain any RETURN.
+  --  the warning checks implemented by Check_Returns.
 
   function Disambiguate_Spec return Entity_Id;
   --  When a primitive is declared between the private view and the full

[Ada] Remove redundant guards in detection of unreachable code

[Pierre-Marie de Rodat via Gcc-patches]

Routine Check_Unreachable_Code is only called on nodes belonging to a
list of statements (and it wouldn't make sense to call it on anything
else).

Tested on x86_64-pc-linux-gnu, committed on trunk

gcc/ada/

* sem_ch5.adb (Check_Unreachable_Code): Remove redundant guard;
the call to Present wasn't needed either.diff --git a/gcc/ada/sem_ch5.adb b/gcc/ada/sem_ch5.adb
--- a/gcc/ada/sem_ch5.adb
+++ b/gcc/ada/sem_ch5.adb
@@ -4398,7 +4398,7 @@ package body Sem_Ch5 is
   P  : Node_Id;
 
begin
-  if Is_List_Member (N) and then Comes_From_Source (N) then
+  if Comes_From_Source (N) then
  Nxt := Original_Node (Next (N));
 
  --  Skip past pragmas
@@ -4415,8 +4415,7 @@ package body Sem_Ch5 is
 
  --  Otherwise see if we have a real statement following us
 
- elsif Present (Nxt)
-   and then Comes_From_Source (Nxt)
+ elsif Comes_From_Source (Nxt)
and then Is_Statement (Nxt)
  then
 --  Special very annoying exception. If we have a return that

[Ada] Fix clearly unintentional dead analysis of attribute Code_Address

[Pierre-Marie de Rodat via Gcc-patches]

A new warning about unreachable code that follows calls to procedures
with No_Return would flag a clearly unintentional dead call to
Set_Address_Taken in analysis of Code_Address attribute.

This patch resurrects the dead code, which is worth fixing regardless of
the new warning.

Tested on x86_64-pc-linux-gnu, committed on trunk

gcc/ada/

* sem_attr.adb (Analyze_Attribute): Move call to
Set_Address_Taken so that it is executed when the prefix
attribute is legal.diff --git a/gcc/ada/sem_attr.adb b/gcc/ada/sem_attr.adb
--- a/gcc/ada/sem_attr.adb
+++ b/gcc/ada/sem_attr.adb
@@ -3746,11 +3746,11 @@ package body Sem_Attr is
 Ekind (Entity (P)) /= E_Procedure)
  then
 Error_Attr ("invalid prefix for % attribute", P);
-Set_Address_Taken (Entity (P));
 
  --  Issue an error if the prefix denotes an eliminated subprogram
 
  else
+Set_Address_Taken (Entity (P));
 Check_For_Eliminated_Subprogram (P, Entity (P));
  end if;
 

[Ada] Remove unimplemented convert_addresses declaration

[Pierre-Marie de Rodat via Gcc-patches]

convert_addresses is declared in adaint.h but is never referenced, so
remove it.

Tested on x86_64-pc-linux-gnu, committed on trunk

gcc/ada/

* adaint.h (convert_addresses): Remove function declaration.diff --git a/gcc/ada/adaint.h b/gcc/ada/adaint.h
--- a/gcc/ada/adaint.h
+++ b/gcc/ada/adaint.h
@@ -254,8 +254,6 @@ extern char  *__gnat_to_host_dir_spec  (char *, int);
 extern char  *__gnat_to_host_file_spec (char *);
 extern char  *__gnat_to_canonical_path_spec	   (char *);
 extern void   __gnat_adjust_os_resource_limits	   (void);
-extern void   convert_addresses			   (const char *, void *, int,
-		void *, int *);
 extern int__gnat_copy_attribs		   (char *, char *, int);
 extern int__gnat_feof		  	   (FILE *);
 extern int__gnat_ferror(FILE *);

[Ada] Remove old vxworks6 from Makefile.rtl

[Pierre-Marie de Rodat via Gcc-patches]

Pre vxworks7 code excepting legacy vxworks6 code is removed from
Makefile.rtl and unused files are deleted.

Tested on x86_64-pc-linux-gnu, committed on trunk

gcc/ada/

* Makefile.rtl (*vxworks*): Remove most pre-vxworks7 code.
* vxworks-arm-link.spec: Remove.
* vxworks-e500-link.spec: Likewise.
* vxworks-smp-arm-link.spec: Likewise.
* vxworks-smp-e500-link.spec: Likewise.
* vxworks-smp-x86-link.spec: Likewise.
* libgnat/system-vxworks-arm-rtp-smp.ads: Likewise.
* libgnat/system-vxworks-arm-rtp.ads: Likewise.
* libgnat/system-vxworks-arm.ads: Likewise.
* libgnat/system-vxworks-e500-kernel.ads: Likewise.
* libgnat/system-vxworks-e500-rtp-smp.ads: Likewise.
* libgnat/system-vxworks-e500-rtp.ads: Likewise.
* libgnat/system-vxworks-x86-kernel.ads: Likewise.
* libgnat/system-vxworks-x86-rtp-smp.ads: Likewise.
* libgnat/system-vxworks-x86-rtp.ads: Likewise.

patch.diff.gz
Description: application/gzip

[Ada] Use static stack allocation for small string if-expressions

[Pierre-Marie de Rodat via Gcc-patches]

This changes the expanded code generated for if-expressions of 1-dimensional
arrays to create a static temporary on the stack if a small upper bound can
be computed for the length of a subtype covering the result.  Static stack
allocation is preferred over dynamic allocation for code generation purpose.

This also contains a couple of enhancements to the support code for checks,
so as to avoid generating useless checks during the modified expansion.

Tested on x86_64-pc-linux-gnu, committed on trunk

gcc/ada/

* checks.adb (Apply_Length_Check_On_Assignment): Return early if
the Suppress_Assignment_Checks flag is set.
(Selected_Range_Checks): Deal with conditional expressions.
* exp_ch4.adb (Too_Large_Length_For_Array): New constant.
(Expand_Concatenate): Use it in lieu of Too_Large_Max_Length.
(Expand_N_If_Expression): If the result has a unidimensional array
type but the dependent expressions have constrained subtypes with
known bounds, create a static temporary on the stack with a subtype
covering the result.
(Get_First_Index_Bounds): Deal with string literals.
* uintp.ads (Uint_256): New deferred constant.
* sinfo.ads (Suppress_Assignment_Checks): Document new usage.diff --git a/gcc/ada/checks.adb b/gcc/ada/checks.adb
--- a/gcc/ada/checks.adb
+++ b/gcc/ada/checks.adb
@@ -2297,6 +2297,15 @@ package body Checks is
   Assign : constant Node_Id := Parent (Target);
 
begin
+  --  Do not apply length checks if parent is still an assignment statement
+  --  with Suppress_Assignment_Checks flag set.
+
+  if Nkind (Assign) = N_Assignment_Statement
+and then Suppress_Assignment_Checks (Assign)
+  then
+ return;
+  end if;
+
   --  No check is needed for the initialization of an object whose
   --  nominal subtype is unconstrained.
 
@@ -6462,7 +6471,7 @@ package body Checks is
   end if;
 
   --  Do not set range check flag if parent is assignment statement or
-  --  object declaration with Suppress_Assignment_Checks flag set
+  --  object declaration with Suppress_Assignment_Checks flag set.
 
   if Nkind (Parent (N)) in N_Assignment_Statement | N_Object_Declaration
 and then Suppress_Assignment_Checks (Parent (N))
@@ -10500,6 +10509,11 @@ package body Checks is
   --  Returns expression to compute:
   --N'First or N'Last using Duplicate_Subexpr_No_Checks
 
+  function Is_Cond_Expr_Ge (N : Node_Id; V : Node_Id) return Boolean;
+  function Is_Cond_Expr_Le (N : Node_Id; V : Node_Id) return Boolean;
+  --  Return True if N is a conditional expression whose dependent
+  --  expressions are all known and greater/lower than or equal to V.
+
   function Range_E_Cond
 (Exptyp : Entity_Id;
  Typ: Entity_Id;
@@ -10522,6 +10536,16 @@ package body Checks is
   --  Return expression to compute:
   --Exp'First < Typ'First or else Exp'Last > Typ'Last
 
+  function "<" (Left, Right : Node_Id) return Boolean
+  is (if Is_Floating_Point_Type (S_Typ)
+  then Expr_Value_R (Left) < Expr_Value_R (Right)
+  else Expr_Value   (Left) < Expr_Value   (Right));
+  function "<=" (Left, Right : Node_Id) return Boolean
+  is (if Is_Floating_Point_Type (S_Typ)
+  then Expr_Value_R (Left) <= Expr_Value_R (Right)
+  else Expr_Value   (Left) <= Expr_Value   (Right));
+  --  Convenience comparison functions of integer or floating point values
+
   ---
   -- Add_Check --
   ---
@@ -10702,6 +10726,60 @@ package body Checks is
   Make_Integer_Literal (Loc, Indx)));
   end Get_N_Last;
 
+  -
+  -- Is_Cond_Expr_Ge --
+  -
+
+  function Is_Cond_Expr_Ge (N : Node_Id; V : Node_Id) return Boolean is
+  begin
+ --  Only if expressions are relevant for the time being
+
+ if Nkind (N) = N_If_Expression then
+declare
+   Cond  : constant Node_Id := First (Expressions (N));
+   Thenx : constant Node_Id := Next (Cond);
+   Elsex : constant Node_Id := Next (Thenx);
+
+begin
+   return Compile_Time_Known_Value (Thenx)
+ and then V <= Thenx
+ and then
+   ((Compile_Time_Known_Value (Elsex) and then V <= Elsex)
+or else Is_Cond_Expr_Ge (Elsex, V));
+end;
+
+ else
+return False;
+ end if;
+  end Is_Cond_Expr_Ge;
+
+  -
+  -- Is_Cond_Expr_Le --
+  -
+
+  function Is_Cond_Expr_Le (N : Node_Id; V : Node_Id) return Boolean is
+  begin
+ --  Only if expressions are relevant for the time being
+
+ if Nkind (N) = N_If_Expression then
+declare
+   Cond  : constant Node_Id := First (Ex

[Ada] Enforce deferred constant completion rules

[Pierre-Marie de Rodat via Gcc-patches]

If a constrained subtype is given when a deferred constant is declared,
then the subtype given in the completion is required (at compile time)
to be subject to a statically matching constraint. This rule was not
properly enforced in some cases and constructs that should have been
rejected were incorrectly accepted.

Tested on x86_64-pc-linux-gnu, committed on trunk

gcc/ada/

* sem_ch3.adb (Check_Possible_Deferred_Completion): Delete
Prev_Obj_Def formal parameter.  Reorganize code so that
statically matching check is also performed in the case where
the subtype given in the initial declaration is constrained and
the subtype given in the completion is not.diff --git a/gcc/ada/sem_ch3.adb b/gcc/ada/sem_ch3.adb
--- a/gcc/ada/sem_ch3.adb
+++ b/gcc/ada/sem_ch3.adb
@@ -13126,7 +13126,6 @@ package body Sem_Ch3 is
 
   procedure Check_Possible_Deferred_Completion
 (Prev_Id  : Entity_Id;
- Prev_Obj_Def : Node_Id;
  Curr_Obj_Def : Node_Id);
   --  Determine whether the two object definitions describe the partial
   --  and the full view of a constrained deferred constant. Generate
@@ -13146,15 +13145,16 @@ package body Sem_Ch3 is
 
   procedure Check_Possible_Deferred_Completion
 (Prev_Id  : Entity_Id;
- Prev_Obj_Def : Node_Id;
  Curr_Obj_Def : Node_Id)
   is
+ Curr_Typ : Entity_Id;
+ Prev_Typ : constant Entity_Id := Etype (Prev_Id);
+ Anon_Acc : constant Boolean := Is_Anonymous_Access_Type (Prev_Typ);
+ Mismatch : Boolean := False;
   begin
- if Nkind (Prev_Obj_Def) = N_Subtype_Indication
-   and then Present (Constraint (Prev_Obj_Def))
-   and then Nkind (Curr_Obj_Def) = N_Subtype_Indication
-   and then Present (Constraint (Curr_Obj_Def))
- then
+ if Anon_Acc then
+null;
+ elsif Nkind (Curr_Obj_Def) = N_Subtype_Indication then
 declare
Loc: constant Source_Ptr := Sloc (N);
Def_Id : constant Entity_Id  := Make_Temporary (Loc, 'S');
@@ -13167,13 +13167,32 @@ package body Sem_Ch3 is
 begin
Insert_Before_And_Analyze (N, Decl);
Set_Etype (Id, Def_Id);
-
-   if not Subtypes_Statically_Match (Etype (Prev_Id), Def_Id) then
-  Error_Msg_Sloc := Sloc (Prev_Id);
-  Error_Msg_N ("subtype does not statically match deferred "
-   & "declaration #", N);
-   end if;
+   Curr_Typ := Def_Id;
 end;
+ else
+Curr_Typ := Etype (Curr_Obj_Def);
+ end if;
+
+ if Anon_Acc then
+if Nkind (Curr_Obj_Def) /= N_Access_Definition then
+   Mismatch := True;
+elsif Has_Null_Exclusion (Prev_Typ)
+  and then not Null_Exclusion_Present (Curr_Obj_Def)
+then
+   Mismatch := True;
+end if;
+--  ??? Another check needed: mismatch if disagreement
+--  between designated types/profiles .
+ else
+Mismatch :=
+  Is_Constrained (Prev_Typ)
+and then not Subtypes_Statically_Match (Prev_Typ, Curr_Typ);
+ end if;
+
+ if Mismatch then
+Error_Msg_Sloc := Sloc (Prev_Id);
+Error_Msg_N ("subtype does not statically match deferred "
+ & "declaration #", N);
  end if;
   end Check_Possible_Deferred_Completion;
 
@@ -13316,7 +13335,6 @@ package body Sem_Ch3 is
 
  Check_Possible_Deferred_Completion
(Prev_Id  => Prev,
-Prev_Obj_Def => Object_Definition (Parent (Prev)),
 Curr_Obj_Def => Obj_Def);
 
  Set_Full_View (Prev, Id);

[Ada] Fix missing error on 'Access of constrained array

[Pierre-Marie de Rodat via Gcc-patches]

For X'Access, the designated subtype of the access type must statically
match the nominal subtype of X.  This patch fixes a bug where the error
was not detected when there is an unrelated declaration of the form "Y :
T := X;", where T is an unconstrained array subtype.

Tested on x86_64-pc-linux-gnu, committed on trunk

gcc/ada/

* exp_util.adb (Expand_Subtype_From_Expr): Generate a new
subtype when Is_Constr_Subt_For_UN_Aliased is True, so the
Is_Constr_Subt_For_U_Nominal flag will not be set on the
preexisting subtype.
* sem_attr.adb, sem_ch3.adb: Minor.diff --git a/gcc/ada/exp_util.adb b/gcc/ada/exp_util.adb
--- a/gcc/ada/exp_util.adb
+++ b/gcc/ada/exp_util.adb
@@ -113,7 +113,7 @@ package body Exp_Util is
  (Header_Num => Type_Map_Header,
   Key=> Entity_Id,
   Element=> Node_Or_Entity_Id,
-  No_element => Empty,
+  No_Element => Empty,
   Hash   => Type_Map_Hash,
   Equal  => "=");
 
@@ -5730,8 +5730,17 @@ package body Exp_Util is
 or else not Is_Array_Type (Exp_Typ)
 or else not Aliased_Present (N))
   then
- if Is_Itype (Exp_Typ) then
+ if Is_Itype (Exp_Typ)
 
+   --  If Exp_Typ was created for a previous declaration whose nominal
+   --  subtype is unconstrained, and that declaration is aliased,
+   --  we need to generate a new subtype, because otherwise the
+   --  Is_Constr_Subt_For_U_Nominal flag will be set on the wrong
+   --  subtype, causing failure to detect non-statically-matching
+   --  subtypes on 'Access of the previously-declared object.
+
+   and then not Is_Constr_Subt_For_UN_Aliased (Exp_Typ)
+ then
 --  Within an initialization procedure, a selected component
 --  denotes a component of the enclosing record, and it appears as
 --  an actual in a call to its own initialization procedure. If
@@ -5770,7 +5779,7 @@ package body Exp_Util is
 --  This type is marked as an itype even though it has an explicit
 --  declaration since otherwise Is_Generic_Actual_Type can get
 --  set, resulting in the generation of spurious errors. (See
---  sem_ch8.Analyze_Package_Renaming and sem_type.covers)
+--  sem_ch8.Analyze_Package_Renaming and Sem_Type.Covers.)
 
 Set_Is_Itype (T);
 Set_Associated_Node_For_Itype (T, Exp);


diff --git a/gcc/ada/sem_attr.adb b/gcc/ada/sem_attr.adb
--- a/gcc/ada/sem_attr.adb
+++ b/gcc/ada/sem_attr.adb
@@ -11632,9 +11632,7 @@ package body Sem_Attr is
end if;
 end if;
 
-if (Attr_Id = Attribute_Access
-  or else
-Attr_Id = Attribute_Unchecked_Access)
+if Attr_Id in Attribute_Access | Attribute_Unchecked_Access
   and then (Ekind (Btyp) = E_General_Access_Type
  or else Ekind (Btyp) = E_Anonymous_Access_Type)
 then


diff --git a/gcc/ada/sem_ch3.adb b/gcc/ada/sem_ch3.adb
--- a/gcc/ada/sem_ch3.adb
+++ b/gcc/ada/sem_ch3.adb
@@ -18276,7 +18276,7 @@ package body Sem_Ch3 is
 
begin
   --  If the parent is a component_definition node we climb to the
-  --  component_declaration node
+  --  component_declaration node.
 
   if Nkind (P) = N_Component_Definition then
  P := Parent (P);