sem_dim.adb (Analyze_Dimension_Binary_Op): Accept with a warning to compare a dimensioned expression with a literal.

gcc/ada/

2017-10-20  Yannick Moy  <moy@adacore.com>

	* sem_dim.adb (Analyze_Dimension_Binary_Op): Accept with a warning to
	compare a dimensioned expression with a literal.
	(Dim_Warning_For_Numeric_Literal): Do not issue a warning for the
	special value zero.
	* doc/gnat_ugn/gnat_and_program_execution.rst: Update description of
	dimensionality system in GNAT.
	* gnat_ugn.texi: Regenerate.

2017-10-20  Yannick Moy  <moy@adacore.com>

	* sem_ch6.adb (Analyze_Expression_Function.Freeze_Expr_Types): Remove
	inadequate silencing of errors.
	* sem_util.adb (Check_Part_Of_Reference): Do not issue an error when
	checking the subprogram body generated from an expression function,
	when this is done as part of the preanalysis done on expression
	functions, as the subprogram body may not yet be attached in the AST.
	The error if any will be issued later during the analysis of the body.
	(Is_Aliased_View): Trivial rewrite with Is_Formal_Object.

2017-10-20  Arnaud Charlet  <charlet@adacore.com>

	* sem_ch8.adb (Update_Chain_In_Scope): Add missing [-gnatwu] marker for
	warning on ineffective use clause.

2017-10-20  Eric Botcazou  <ebotcazou@adacore.com>

	* exp_ch11.ads (Warn_If_No_Local_Raise): Declare.
	* exp_ch11.adb (Expand_Exception_Handlers): Use Warn_If_No_Local_Raise
	to issue the warning on the absence of local raise.
	(Possible_Local_Raise): Do not issue the warning for Call_Markers.
	(Warn_If_No_Local_Raise): New procedure to issue the warning on the
	absence of local raise.
	* sem_elab.adb: Add with and use clauses for Exp_Ch11.
	(Record_Elaboration_Scenario): Call Possible_Local_Raise in the cases
	where a scenario could give rise to raising Program_Error.
	* sem_elab.adb: Typo fixes.
	* fe.h (Warn_If_No_Local_Raise): Declare.
	* gcc-interface/gigi.h (get_exception_label): Change return type.
	* gcc-interface/trans.c (gnu_constraint_error_label_stack): Change to
	simple vector of Entity_Id.
	(gnu_storage_error_label_stack): Likewise.
	(gnu_program_error_label_stack): Likewise.
	(gigi): Adjust to above changes.
	(Raise_Error_to_gnu): Likewise.
	(gnat_to_gnu) <N_Goto_Statement>: Set TREE_USED on the label.
	(N_Push_Constraint_Error_Label): Push the label onto the stack.
	(N_Push_Storage_Error_Label): Likewise.
	(N_Push_Program_Error_Label): Likewise.
	(N_Pop_Constraint_Error_Label): Pop the label from the stack and issue
	a warning on the absence of local raise.
	(N_Pop_Storage_Error_Label): Likewise.
	(N_Pop_Program_Error_Label): Likewise.
	(push_exception_label_stack): Delete.
	(get_exception_label): Change return type to Entity_Id and adjust.
	* gcc-interface/utils2.c (build_goto_raise): Change type of first
	parameter to Entity_Id and adjust.  Set TREE_USED on the label.
	(build_call_raise): Adjust calls to get_exception_label and also
	build_goto_raise.
	(build_call_raise_column): Likewise.
	(build_call_raise_range): Likewise.
	* doc/gnat_ugn/building_executable_programs_with_gnat.rst (-gnatw.x):
	Document actual default behavior.

2017-10-20  Piotr Trojanek  <trojanek@adacore.com>

	* einfo.ads: Minor consistent punctuation in comment.  All numbered
	items in the comment of Is_Internal are now terminated with a period.

2017-10-20  Piotr Trojanek  <trojanek@adacore.com>

	* exp_util.adb (Build_Temporary): Mark created temporary entity as
	internal.

2017-10-20  Piotr Trojanek  <trojanek@adacore.com>

	* sem_type.adb (In_Generic_Actual): Simplified.

2017-10-20  Justin Squirek  <squirek@adacore.com>

	* sem_ch12.adb (Check_Formal_Package_Instance): Add sanity check to
	verify a renaming exists for a generic formal before comparing it to
	the actual as defaulted formals will not have a renamed_object.

2017-10-20  Javier Miranda  <miranda@adacore.com>

	* exp_ch6.adb (Replace_Returns): Fix wrong management of
	N_Block_Statement nodes.

gcc/testsuite/

2017-10-20  Justin Squirek  <squirek@adacore.com>

	* gnat.dg/default_pkg_actual.adb, gnat.dg/default_pkg_actual2.adb: New
	testcases.

From-SVN: r253945

3 files changed, 48 insertions, 53 deletions

diff --git a/gcc/ada/gcc-interface/gigi.h b/gcc/ada/gcc-interface/gigi.h
index 4ddd0f0..a957de5 100644
--- a/gcc/ada/gcc-interface/gigi.h
+++ b/gcc/ada/gcc-interface/gigi.h
@@ -312,9 +312,9 @@ extern void post_error_ne_tree (const char *msg, Node_Id node, Entity_Id ent,
 extern void post_error_ne_tree_2 (const char *msg, Node_Id node, Entity_Id ent,
                                   tree t, int num);
 
-/* Return a label to branch to for the exception type in KIND or NULL_TREE
+/* Return a label to branch to for the exception type in KIND or Empty
    if none.  */
-extern tree get_exception_label (char kind);
+extern Entity_Id get_exception_label (char kind);
 
 /* If nonzero, pretend we are allocating at global level.  */
 extern int force_global;
diff --git a/gcc/ada/gcc-interface/trans.c b/gcc/ada/gcc-interface/trans.c
index a757937..0e46e5a 100644
--- a/gcc/ada/gcc-interface/trans.c
+++ b/gcc/ada/gcc-interface/trans.c
@@ -211,9 +211,9 @@ typedef struct loop_info_d *loop_info;
 static GTY(()) vec<loop_info, va_gc> *gnu_loop_stack;
 
 /* The stacks for N_{Push,Pop}_*_Label.  */
-static GTY(()) vec<tree, va_gc> *gnu_constraint_error_label_stack;
-static GTY(()) vec<tree, va_gc> *gnu_storage_error_label_stack;
-static GTY(()) vec<tree, va_gc> *gnu_program_error_label_stack;
+static vec<Entity_Id> gnu_constraint_error_label_stack;
+static vec<Entity_Id> gnu_storage_error_label_stack;
+static vec<Entity_Id> gnu_program_error_label_stack;
 
 /* Map GNAT tree codes to GCC tree codes for simple expressions.  */
 static enum tree_code gnu_codes[Number_Node_Kinds];
@@ -226,7 +226,6 @@ static void record_code_position (Node_Id);
 static void insert_code_for (Node_Id);
 static void add_cleanup (tree, Node_Id);
 static void add_stmt_list (List_Id);
-static void push_exception_label_stack (vec<tree, va_gc> **, Entity_Id);
 static tree build_stmt_group (List_Id, bool);
 static inline bool stmt_group_may_fallthru (void);
 static enum gimplify_status gnat_gimplify_stmt (tree *);
@@ -647,9 +646,10 @@ gigi (Node_Id gnat_root,
   gnat_install_builtins ();
 
   vec_safe_push (gnu_except_ptr_stack, NULL_TREE);
-  vec_safe_push (gnu_constraint_error_label_stack, NULL_TREE);
-  vec_safe_push (gnu_storage_error_label_stack, NULL_TREE);
-  vec_safe_push (gnu_program_error_label_stack, NULL_TREE);
+
+  gnu_constraint_error_label_stack.safe_push (Empty);
+  gnu_storage_error_label_stack.safe_push (Empty);
+  gnu_program_error_label_stack.safe_push (Empty);
 
   /* Process any Pragma Ident for the main unit.  */
   if (Present (Ident_String (Main_Unit)))
@@ -5614,7 +5614,7 @@ Raise_Error_to_gnu (Node_Id gnat_node, tree *gnu_result_type_p)
   const bool with_extra_info
     = Exception_Extra_Info
       && !No_Exception_Handlers_Set ()
-      && !get_exception_label (kind);
+      && No (get_exception_label (kind));
   tree gnu_result = NULL_TREE, gnu_cond = NULL_TREE;
 
   /* The following processing is not required for correctness.  Its purpose is
@@ -7271,8 +7271,9 @@ gnat_to_gnu (Node_Id gnat_node)
       break;
 
     case N_Goto_Statement:
-      gnu_result
-	= build1 (GOTO_EXPR, void_type_node, gnat_to_gnu (Name (gnat_node)));
+      gnu_expr = gnat_to_gnu (Name (gnat_node));
+      gnu_result = build1 (GOTO_EXPR, void_type_node, gnu_expr);
+      TREE_USED (gnu_expr) = 1;
       break;
 
     /***************************/
@@ -7492,30 +7493,36 @@ gnat_to_gnu (Node_Id gnat_node)
       break;
 
     case N_Push_Constraint_Error_Label:
-      push_exception_label_stack (&gnu_constraint_error_label_stack,
-				  Exception_Label (gnat_node));
+      gnu_constraint_error_label_stack.safe_push (Exception_Label (gnat_node));
       break;
 
     case N_Push_Storage_Error_Label:
-      push_exception_label_stack (&gnu_storage_error_label_stack,
-				  Exception_Label (gnat_node));
+      gnu_storage_error_label_stack.safe_push (Exception_Label (gnat_node));
       break;
 
     case N_Push_Program_Error_Label:
-      push_exception_label_stack (&gnu_program_error_label_stack,
-				  Exception_Label (gnat_node));
+      gnu_program_error_label_stack.safe_push (Exception_Label (gnat_node));
       break;
 
     case N_Pop_Constraint_Error_Label:
-      gnu_constraint_error_label_stack->pop ();
+      gnat_temp = gnu_constraint_error_label_stack.pop ();
+      if (Present (gnat_temp)
+	  && !TREE_USED (gnat_to_gnu_entity (gnat_temp, NULL_TREE, false)))
+	Warn_If_No_Local_Raise (gnat_temp);
       break;
 
     case N_Pop_Storage_Error_Label:
-      gnu_storage_error_label_stack->pop ();
+      gnat_temp = gnu_storage_error_label_stack.pop ();
+      if (Present (gnat_temp)
+	  && !TREE_USED (gnat_to_gnu_entity (gnat_temp, NULL_TREE, false)))
+	Warn_If_No_Local_Raise (gnat_temp);
       break;
 
     case N_Pop_Program_Error_Label:
-      gnu_program_error_label_stack->pop ();
+      gnat_temp = gnu_program_error_label_stack.pop ();
+      if (Present (gnat_temp)
+	  && !TREE_USED (gnat_to_gnu_entity (gnat_temp, NULL_TREE, false)))
+	Warn_If_No_Local_Raise (gnat_temp);
       break;
 
     /******************************/
@@ -8029,20 +8036,6 @@ gnat_to_gnu_external (Node_Id gnat_node)
   return gnu_result;
 }
 
-/* Subroutine of above to push the exception label stack.  GNU_STACK is
-   a pointer to the stack to update and GNAT_LABEL, if present, is the
-   label to push onto the stack.  */
-
-static void
-push_exception_label_stack (vec<tree, va_gc> **gnu_stack, Entity_Id gnat_label)
-{
-  tree gnu_label = (Present (gnat_label)
-		    ? gnat_to_gnu_entity (gnat_label, NULL_TREE, false)
-		    : NULL_TREE);
-
-  vec_safe_push (*gnu_stack, gnu_label);
-}
-
 /* Return true if the statement list STMT_LIST is empty.  */
 
 static bool
@@ -10226,28 +10219,28 @@ post_error_ne_tree_2 (const char *msg, Node_Id node, Entity_Id ent, tree t,
   post_error_ne_tree (msg, node, ent, t);
 }
 
-/* Return a label to branch to for the exception type in KIND or NULL_TREE
+/* Return a label to branch to for the exception type in KIND or Empty
    if none.  */
 
-tree
+Entity_Id
 get_exception_label (char kind)
 {
   switch (kind)
     {
     case N_Raise_Constraint_Error:
-      return gnu_constraint_error_label_stack->last ();
+      return gnu_constraint_error_label_stack.last ();
 
     case N_Raise_Storage_Error:
-      return gnu_storage_error_label_stack->last ();
+      return gnu_storage_error_label_stack.last ();
 
     case N_Raise_Program_Error:
-      return gnu_program_error_label_stack->last ();
+      return gnu_program_error_label_stack.last ();
 
     default:
-      break;
+      return Empty;
     }
 
-  return NULL_TREE;
+  gcc_unreachable ();
 }
 
 /* Return the decl for the current elaboration procedure.  */
diff --git a/gcc/ada/gcc-interface/utils2.c b/gcc/ada/gcc-interface/utils2.c
index 6f109c7..dcd4134 100644
--- a/gcc/ada/gcc-interface/utils2.c
+++ b/gcc/ada/gcc-interface/utils2.c
@@ -1787,9 +1787,10 @@ build_call_n_expr (tree fndecl, int n, ...)
    MSG gives the exception's identity for the call to Local_Raise, if any.  */
 
 static tree
-build_goto_raise (tree label, int msg)
+build_goto_raise (Entity_Id gnat_label, int msg)
 {
-  tree gnu_result = build1 (GOTO_EXPR, void_type_node, label);
+  tree gnu_label = gnat_to_gnu_entity (gnat_label, NULL_TREE, false);
+  tree gnu_result = build1 (GOTO_EXPR, void_type_node, gnu_label);
   Entity_Id local_raise = Get_Local_Raise_Call_Entity ();
 
   /* If Local_Raise is present, build Local_Raise (Exception'Identity).  */
@@ -1807,6 +1808,7 @@ build_goto_raise (tree label, int msg)
 	= build2 (COMPOUND_EXPR, void_type_node, gnu_call, gnu_result);
     }
 
+  TREE_USED (gnu_label) = 1;
   return gnu_result;
 }
 
@@ -1859,13 +1861,13 @@ expand_sloc (Node_Id gnat_node, tree *filename, tree *line, tree *col)
 tree
 build_call_raise (int msg, Node_Id gnat_node, char kind)
 {
+  Entity_Id gnat_label = get_exception_label (kind);
   tree fndecl = gnat_raise_decls[msg];
-  tree label = get_exception_label (kind);
   tree filename, line;
 
   /* If this is to be done as a goto, handle that case.  */
-  if (label)
-    return build_goto_raise (label, msg);
+  if (Present (gnat_label))
+    return build_goto_raise (gnat_label, msg);
 
   expand_sloc (gnat_node, &filename, &line, NULL);
 
@@ -1883,13 +1885,13 @@ build_call_raise (int msg, Node_Id gnat_node, char kind)
 tree
 build_call_raise_column (int msg, Node_Id gnat_node, char kind)
 {
+  Entity_Id gnat_label = get_exception_label (kind);
   tree fndecl = gnat_raise_decls_ext[msg];
-  tree label = get_exception_label (kind);
   tree filename, line, col;
 
   /* If this is to be done as a goto, handle that case.  */
-  if (label)
-    return build_goto_raise (label, msg);
+  if (Present (gnat_label))
+    return build_goto_raise (gnat_label, msg);
 
   expand_sloc (gnat_node, &filename, &line, &col);
 
@@ -1908,13 +1910,13 @@ tree
 build_call_raise_range (int msg, Node_Id gnat_node, char kind,
 			tree index, tree first, tree last)
 {
+  Entity_Id gnat_label = get_exception_label (kind);
   tree fndecl = gnat_raise_decls_ext[msg];
-  tree label = get_exception_label (kind);
   tree filename, line, col;
 
   /* If this is to be done as a goto, handle that case.  */
-  if (label)
-    return build_goto_raise (label, msg);
+  if (Present (gnat_label))
+    return build_goto_raise (gnat_label, msg);
 
   expand_sloc (gnat_node, &filename, &line, &col);