ada-tree.h (DECL_INVARIANT_P): New macro.

	* gcc-interface/ada-tree.h (DECL_INVARIANT_P): New macro.
	* gcc-interface/gigi.h (enum standard_datatypes): Remove
	ADT_longjmp_decl and add ADT_not_handled_by_others_decl.
	(longjmp_decl): Delete.
	(not_handled_by_others_decl): New macro.
	(build_simple_component_ref): Delete.
	(build_component_ref): Adjust prototype.
	* gcc-interface/decl.c (gnat_to_gnu_entity): Adjust calls to
	build_component_ref.
	(gnat_to_gnu_field): Set DECL_INVARIANT_P on discriminants
	without default value.
	* gcc-interface/trans.c (gigi): Reorder initialization sequence
	and add not_handled_by_others_decl.
	(Attribute_to_gnu): Adjust calls to build_component_ref.
	(Subprogram_Body_to_gnu): Likewise.
	(Call_to_gnu): Likewise.
	(Exception_Handler_to_gnu_sjlj): Likewise.
	(gnat_to_gnu): Likewise.
	(range_check_info_d): Add inserted_cond field.
	(Loop_Statement_to_gnu): Make two passes on the recorded range checks.
	(build_noreturn_cond): New static function.
	(Raise_Error_to_gnu): Record range checks in loops at -O1 and above.
	(make_invariant): New static function.
	(Loop_Statement_to_gnu): Use it to compute invariant expressions for
	the loop bounds if possible, but do not require it if loop unswitching
	is enabled.
	* gcc-interface/utils.c (convert_to_fat_pointer): Likewise.
	(convert): Likewise.
	(maybe_unconstrained_array): Likewise.  Call it instead of
	build_simple_component_ref and add guard for CONSTRUCTORs.
	(unchecked_convert): Likewise.
	* gcc-interface/utils2.c (compare_fat_pointers): Likewise.
	(build_simple_component_ref): Remove COMPONENT parameter, unify
	code dealing with VIEW_CONVERT_EXPR and make it more general,
	remove special treatment for CONSTRUCTORs of template types.
	(build_component_ref): Remove COMPONENT parameter and adjust call
	to build_simple_component_ref.
	(maybe_wrap_malloc): Likewise.
	(build_allocator): Likewise.
	(gnat_invariant_expr): Look through overflow checks, deal with
	addition and subtraction of constants and take into account
	DECL_INVARIANT_P for the COMPONENT_REF case.

From-SVN: r230575

gcc/ada/ChangeLog

 2015-11-18  Eric Botcazou  <ebotcazou@adacore.com>
 
+	* gcc-interface/ada-tree.h (DECL_INVARIANT_P): New macro.
+	* gcc-interface/gigi.h (enum standard_datatypes): Remove
+	ADT_longjmp_decl and add ADT_not_handled_by_others_decl.
+	(longjmp_decl): Delete.
+	(not_handled_by_others_decl): New macro.
+	(build_simple_component_ref): Delete.
+	(build_component_ref): Adjust prototype.
+	* gcc-interface/decl.c (gnat_to_gnu_entity): Adjust calls to
+	build_component_ref.
+	(gnat_to_gnu_field): Set DECL_INVARIANT_P on discriminants
+	without default value.
+	* gcc-interface/trans.c (gigi): Reorder initialization sequence
+	and add not_handled_by_others_decl.
+	(Attribute_to_gnu): Adjust calls to build_component_ref.
+	(Subprogram_Body_to_gnu): Likewise.
+	(Call_to_gnu): Likewise.
+	(Exception_Handler_to_gnu_sjlj): Likewise.
+	(gnat_to_gnu): Likewise.
+	(range_check_info_d): Add inserted_cond field.
+	(Loop_Statement_to_gnu): Make two passes on the recorded range checks.
+	(build_noreturn_cond): New static function.
+	(Raise_Error_to_gnu): Record range checks in loops at -O1 and above.
+	(make_invariant): New static function.
+	(Loop_Statement_to_gnu): Use it to compute invariant expressions for
+	the loop bounds if possible, but do not require it if loop unswitching
+	is enabled.
+	* gcc-interface/utils.c (convert_to_fat_pointer): Likewise.
+	(convert): Likewise.
+	(maybe_unconstrained_array): Likewise.  Call it instead of
+	build_simple_component_ref and add guard for CONSTRUCTORs.
+	(unchecked_convert): Likewise.
+	* gcc-interface/utils2.c (compare_fat_pointers): Likewise.
+	(build_simple_component_ref): Remove COMPONENT parameter, unify
+	code dealing with VIEW_CONVERT_EXPR and make it more general,
+	remove special treatment for CONSTRUCTORs of template types.
+	(build_component_ref): Remove COMPONENT parameter and adjust call
+	to build_simple_component_ref.
+	(maybe_wrap_malloc): Likewise.
+	(build_allocator): Likewise.
+	(gnat_invariant_expr): Look through overflow checks, deal with
+	addition and subtraction of constants and take into account
+	DECL_INVARIANT_P for the COMPONENT_REF case.
+
+2015-11-18  Eric Botcazou  <ebotcazou@adacore.com>
+
 	* gcc-interface/misc.c: Move global variables to the top of the file.
 	(gnat_handle_option): Remove obsolete ATTRIBUTE_UNUSED markers.
 	(gnat_init_options): Minor tweak.

gcc/ada/gcc-interface/ada-tree.h

@@ -405,10 +405,14 @@ do {						   \
 #define DECL_ELABORATION_PROC_P(NODE) \
   DECL_LANG_FLAG_3 (FUNCTION_DECL_CHECK (NODE))
 
-/* Nonzero in a DECL if it is made for a pointer that points to something which
-   is readonly.  */
+/* Nonzero in a CONST_DECL, VAR_DECL or PARM_DECL if it is made for a pointer
+   that points to something which is readonly.  */
 #define DECL_POINTS_TO_READONLY_P(NODE) DECL_LANG_FLAG_4 (NODE)
 
+/* Nonzero in a FIELD_DECL if it is invariant once set, for example if it is
+   a discriminant of a discriminated type without default expression.  */
+#define DECL_INVARIANT_P(NODE) DECL_LANG_FLAG_4 (FIELD_DECL_CHECK (NODE))
+
 /* In a FIELD_DECL corresponding to a discriminant, contains the
    discriminant number.  */
 #define DECL_DISCRIMINANT_NUMBER(NODE) DECL_INITIAL (FIELD_DECL_CHECK (NODE))

gcc/ada/gcc-interface/decl.c

@@ -1291,7 +1291,7 @@ gnat_to_gnu_entity (Entity_Id gnat_entity, tree gnu_expr, int definition)
 		    else
 		      gnu_expr
 			= build_component_ref
-			    (gnu_expr, NULL_TREE,
+			    (gnu_expr,
 			     DECL_CHAIN (TYPE_FIELDS (TREE_TYPE (gnu_expr))),
 			     false);
 		  }
@@ -1335,8 +1335,8 @@ gnat_to_gnu_entity (Entity_Id gnat_entity, tree gnu_expr, int definition)
 	      add_stmt_with_node
 		(build_binary_op (INIT_EXPR, NULL_TREE,
 				  build_component_ref
-				  (gnu_new_var, NULL_TREE,
-				   TYPE_FIELDS (gnu_new_type), false),
+				  (gnu_new_var, TYPE_FIELDS (gnu_new_type),
+				   false),
 				  gnu_expr),
 		 gnat_entity);
 
@@ -1345,8 +1345,8 @@ gnat_to_gnu_entity (Entity_Id gnat_entity, tree gnu_expr, int definition)
 	    gnu_expr
 	      = build_unary_op
 		(ADDR_EXPR, NULL_TREE,
-		 build_component_ref (gnu_new_var, NULL_TREE,
-				      TYPE_FIELDS (gnu_new_type), false));
+		 build_component_ref (gnu_new_var, TYPE_FIELDS (gnu_new_type),
+				      false));
 	    TREE_CONSTANT (gnu_expr) = 1;
 
 	    used_by_ref = true;
@@ -6778,8 +6778,12 @@ gnat_to_gnu_field (Entity_Id gnat_field, tree gnu_record_type, int packed,
   TREE_THIS_VOLATILE (gnu_field) = TREE_SIDE_EFFECTS (gnu_field) = is_volatile;
 
   if (Ekind (gnat_field) == E_Discriminant)
-    DECL_DISCRIMINANT_NUMBER (gnu_field)
-      = UI_To_gnu (Discriminant_Number (gnat_field), sizetype);
+    {
+      DECL_INVARIANT_P (gnu_field)
+	= No (Discriminant_Default_Value (gnat_field));
+      DECL_DISCRIMINANT_NUMBER (gnu_field)
+	= UI_To_gnu (Discriminant_Number (gnat_field), sizetype);
+    }
 
   return gnu_field;
 }

gcc/ada/gcc-interface/gigi.h

@@ -408,17 +408,18 @@ enum standard_datatypes
   /* Identifier for the name of the Exception_Data type.  */
   ADT_exception_data_name_id,
 
-  /* Types and decls used by our temporary exception mechanism.  See
-     init_gigi_decls for details.  */
+  /* Types and decls used by the SJLJ exception mechanism.  */
   ADT_jmpbuf_type,
   ADT_jmpbuf_ptr_type,
   ADT_get_jmpbuf_decl,
   ADT_set_jmpbuf_decl,
   ADT_get_excptr_decl,
+  ADT_not_handled_by_others_decl,
   ADT_setjmp_decl,
-  ADT_longjmp_decl,
   ADT_update_setjmp_buf_decl,
   ADT_raise_nodefer_decl,
+
+  /* Types and decls used by the ZCX exception mechanism.  */
   ADT_reraise_zcx_decl,
   ADT_set_exception_parameter_decl,
   ADT_begin_handler_decl,
@@ -427,6 +428,7 @@ enum standard_datatypes
   ADT_others_decl,
   ADT_all_others_decl,
   ADT_unhandled_others_decl,
+
   ADT_LAST};
 
 /* Define kind of exception information associated with raise statements.  */
@@ -475,13 +477,14 @@ extern GTY(()) tree gnat_raise_decls_ext[(int) LAST_REASON_CODE + 1];
 #define get_jmpbuf_decl gnat_std_decls[(int) ADT_get_jmpbuf_decl]
 #define set_jmpbuf_decl gnat_std_decls[(int) ADT_set_jmpbuf_decl]
 #define get_excptr_decl gnat_std_decls[(int) ADT_get_excptr_decl]
+#define not_handled_by_others_decl \
+	  gnat_std_decls[(int) ADT_not_handled_by_others_decl]
 #define setjmp_decl gnat_std_decls[(int) ADT_setjmp_decl]
-#define longjmp_decl gnat_std_decls[(int) ADT_longjmp_decl]
 #define update_setjmp_buf_decl gnat_std_decls[(int) ADT_update_setjmp_buf_decl]
 #define raise_nodefer_decl gnat_std_decls[(int) ADT_raise_nodefer_decl]
 #define reraise_zcx_decl gnat_std_decls[(int) ADT_reraise_zcx_decl]
 #define set_exception_parameter_decl \
-          gnat_std_decls[(int) ADT_set_exception_parameter_decl]
+	  gnat_std_decls[(int) ADT_set_exception_parameter_decl]
 #define begin_handler_decl gnat_std_decls[(int) ADT_begin_handler_decl]
 #define others_decl gnat_std_decls[(int) ADT_others_decl]
 #define all_others_decl gnat_std_decls[(int) ADT_all_others_decl]
@@ -896,16 +899,10 @@ extern tree build_call_raise_range (int msg, Node_Id gnat_node,
    same as build_constructor in the language-independent tree.c.  */
 extern tree gnat_build_constructor (tree type, vec<constructor_elt, va_gc> *v);
 
-/* Return a COMPONENT_REF to access a field that is given by COMPONENT,
-   an IDENTIFIER_NODE giving the name of the field, FIELD, a FIELD_DECL,
-   for the field, or both.  Don't fold the result if NO_FOLD_P.  */
-extern tree build_simple_component_ref (tree record_variable, tree component,
-					tree field, bool no_fold_p);
-
-/* Likewise, but generate a Constraint_Error if the reference could not be
-   found.  */
-extern tree build_component_ref (tree record_variable, tree component,
-                                 tree field, bool no_fold_p);
+/* Return a COMPONENT_REF to access FIELD in RECORD, or NULL_EXPR and generate
+   a Constraint_Error if the field is not found in the record.  Don't fold the
+   result if NO_FOLD is true.  */
+extern tree build_component_ref (tree record, tree field, bool no_fold);
 
 /* Build a GCC tree to call an allocation or deallocation function.
    If GNU_OBJ is nonzero, it is an object to deallocate.  Otherwise,

gcc/ada/gcc-interface/utils.c

@@ -3970,11 +3970,9 @@ convert_to_fat_pointer (tree type, tree expr)
 	  expr = build_unary_op (INDIRECT_REF, NULL_TREE, expr);
 	  template_addr
 	    = build_unary_op (ADDR_EXPR, NULL_TREE,
-			      build_component_ref (expr, NULL_TREE, field,
-						   false));
+			      build_component_ref (expr, field, false));
 	  expr = build_unary_op (ADDR_EXPR, NULL_TREE,
-				 build_component_ref (expr, NULL_TREE,
-						      DECL_CHAIN (field),
+				 build_component_ref (expr, DECL_CHAIN (field),
 						      false));
 	}
     }
@@ -4110,8 +4108,7 @@ convert (tree type, tree expr)
 
       /* Otherwise, build an explicit component reference.  */
       else
-	unpadded
-	  = build_component_ref (expr, NULL_TREE, TYPE_FIELDS (etype), false);
+	unpadded = build_component_ref (expr, TYPE_FIELDS (etype), false);
 
       return convert (type, unpadded);
     }
@@ -4132,8 +4129,8 @@ convert (tree type, tree expr)
   if (ecode == RECORD_TYPE && TYPE_JUSTIFIED_MODULAR_P (etype)
       && code != UNCONSTRAINED_ARRAY_TYPE
       && TYPE_MAIN_VARIANT (type) != TYPE_MAIN_VARIANT (etype))
-    return convert (type, build_component_ref (expr, NULL_TREE,
-					       TYPE_FIELDS (etype), false));
+    return
+      convert (type, build_component_ref (expr, TYPE_FIELDS (etype), false));
 
   /* If converting to a type that contains a template, convert to the data
      type and then build the template. */
@@ -4393,7 +4390,7 @@ convert (tree type, tree expr)
       do {
 	tree field = TYPE_FIELDS (child_etype);
 	if (DECL_NAME (field) == parent_name_id && TREE_TYPE (field) == type)
-	  return build_component_ref (expr, NULL_TREE, field, false);
+	  return build_component_ref (expr, field, false);
 	child_etype = TREE_TYPE (field);
       } while (TREE_CODE (child_etype) == RECORD_TYPE);
     }
@@ -4489,8 +4486,7 @@ convert (tree type, tree expr)
       /* If converting fat pointer to normal or thin pointer, get the pointer
 	 to the array and then convert it.  */
       if (TYPE_IS_FAT_POINTER_P (etype))
-	expr
-	  = build_component_ref (expr, NULL_TREE, TYPE_FIELDS (etype), false);
+	expr = build_component_ref (expr, TYPE_FIELDS (etype), false);
 
       return fold (convert_to_pointer (type, expr));
 
@@ -4715,13 +4711,11 @@ maybe_unconstrained_array (tree exp)
 	      tree op1
 		= build_unary_op (INDIRECT_REF, NULL_TREE,
 				  build_component_ref (TREE_OPERAND (exp, 1),
-						       NULL_TREE,
 						       TYPE_FIELDS (type),
 						       false));
 	      tree op2
 		= build_unary_op (INDIRECT_REF, NULL_TREE,
 				  build_component_ref (TREE_OPERAND (exp, 2),
-						       NULL_TREE,
 						       TYPE_FIELDS (type),
 						       false));
 
@@ -4732,8 +4726,8 @@ maybe_unconstrained_array (tree exp)
 	  else
 	    {
 	      exp = build_unary_op (INDIRECT_REF, NULL_TREE,
-				    build_component_ref (exp, NULL_TREE,
-						         TYPE_FIELDS (type),
+				    build_component_ref (exp,
+							 TYPE_FIELDS (type),
 						         false));
 	      TREE_READONLY (exp) = read_only;
 	      TREE_THIS_NOTRAP (exp) = no_trap;
@@ -4754,18 +4748,23 @@ maybe_unconstrained_array (tree exp)
 	  && TYPE_CONTAINS_TEMPLATE_P (TREE_TYPE (TYPE_FIELDS (type))))
 	{
 	  exp = convert (TREE_TYPE (TYPE_FIELDS (type)), exp);
+	  code = TREE_CODE (exp);
 	  type = TREE_TYPE (exp);
 	}
 
       if (TYPE_CONTAINS_TEMPLATE_P (type))
 	{
-	  exp = build_simple_component_ref (exp, NULL_TREE,
-					    DECL_CHAIN (TYPE_FIELDS (type)),
-					    false);
+	  /* If the array initializer is a box, return NULL_TREE.  */
+	  if (code == CONSTRUCTOR && CONSTRUCTOR_NELTS (exp) < 2)
+	    return NULL_TREE;
+
+	  exp = build_component_ref (exp, DECL_CHAIN (TYPE_FIELDS (type)),
+				     false);
+	  type = TREE_TYPE (exp);
 
 	  /* If the array type is padded, convert to the unpadded type.  */
-	  if (exp && TYPE_IS_PADDING_P (TREE_TYPE (exp)))
-	    exp = convert (TREE_TYPE (TYPE_FIELDS (TREE_TYPE (exp))), exp);
+	  if (TYPE_IS_PADDING_P (type))
+	    exp = convert (TREE_TYPE (TYPE_FIELDS (type)), exp);
 	}
       break;
 
@@ -4915,7 +4914,7 @@ unchecked_convert (tree type, tree expr, bool notrunc_p)
       finish_record_type (rec_type, field, 1, false);
 
       expr = unchecked_convert (rec_type, expr, notrunc_p);
-      expr = build_component_ref (expr, NULL_TREE, field, false);
+      expr = build_component_ref (expr, field, false);
       expr = fold_build1 (NOP_EXPR, type, expr);
     }
 
@@ -4986,8 +4985,7 @@ unchecked_convert (tree type, tree expr, bool notrunc_p)
 	  tree rec_type = maybe_pad_type (type, TYPE_SIZE (etype), 0, Empty,
 					  false, false, false, true);
 	  expr = unchecked_convert (rec_type, expr, notrunc_p);
-	  expr = build_component_ref (expr, NULL_TREE, TYPE_FIELDS (rec_type),
-				      false);
+	  expr = build_component_ref (expr, TYPE_FIELDS (rec_type), false);
 	}
     }
 

gcc/testsuite/ChangeLog

 2015-11-18  Eric Botcazou  <ebotcazou@adacore.com>
 
+	* gnat.dg/loop_optimization19.adb: New test.
+	* gnat.dg/loop_optimization20.adb: Likewise.
+	* gnat.dg/loop_optimization21.ad[sb]: Likewise.
+
+2015-11-18  Eric Botcazou  <ebotcazou@adacore.com>
+
 	* gnat.dg/opt52.adb: New test.
 
 2015-11-18  Nathan Sidwell  <nathan@codesourcery.com>

gcc/testsuite/gnat.dg/loop_optimization19.adb

+-- { dg-do compile }
+-- { dg-options "-O -fdump-tree-optimized" }
+
+procedure Loop_Optimization19 is
+
+  type Array_T is array (Positive range <>) of Integer;
+  type Obj_T (Length : Natural) is
+    record
+      Elements : Array_T (1 .. Length);
+    end record;
+
+  type T is access Obj_T;
+
+  function Equal (S1, S2 : T) return Boolean;
+  pragma No_Inline (Equal);
+
+  function Equal (S1, S2 : T) return Boolean is
+  begin
+    if S1.Length = S2.Length then
+      for I in 1 .. S1.Length loop
+        if S1.Elements (I) /= S2.Elements (I) then
+          return False;
+        end if;
+      end loop;
+     return True;
+    else
+      return False;
+    end if;
+  end Equal;
+
+  A : T := new Obj_T (Length => 10);
+  B : T := new Obj_T (Length => 20);
+  C : T := new Obj_T (Length => 30);
+
+begin
+  if Equal (A, B) then
+    raise Program_Error;
+  else
+    if Equal (B, C) then
+      raise Program_Error;
+    end if;
+  end if;
+end;
+
+-- { dg-final { scan-tree-dump-not "Index_Check" "optimized" } }

gcc/testsuite/gnat.dg/loop_optimization20.adb

+-- { dg-do compile }
+-- { dg-options "-O -fdump-tree-optimized" }
+
+procedure Loop_Optimization20 is
+
+  type Array_T is array (Positive range <>) of Integer;
+  type Obj_T (Length : Natural) is
+    record
+      Elements : Array_T (1 .. Length);
+    end record;
+
+  type T is access Obj_T;
+
+  function Is_Null (S1 : Obj_T) return Boolean;
+  pragma No_Inline (Is_Null);
+
+  function Is_Null (S1 : Obj_T) return Boolean is
+  begin
+    for I in 1 .. S1.Length loop
+      if S1.Elements (I) /= 0 then
+        return False;
+      end if;
+    end loop;
+    return True;
+  end;
+
+  A : T := new Obj_T'(Length => 10, Elements => (others => 0));
+
+begin
+  if not Is_Null (A.all) then
+    raise Program_Error;
+  end if;
+end;
+
+-- { dg-final { scan-tree-dump-not "Index_Check" "optimized" } }

gcc/testsuite/gnat.dg/loop_optimization21.adb

+-- { dg-do compile }
+-- { dg-options "-O -fdump-tree-optimized" }
+
+package body Loop_Optimization21 is
+
+  function Min (X : in Item_Vector) return Item is
+    Tmp_Min : Item;
+  begin
+    Tmp_Min := X (X'First);
+    for I in X'First + 1 .. X'Last loop
+      if X (I) <= Tmp_Min then
+        Tmp_Min := X (I);
+      end if;
+    end loop;
+    return Tmp_Min;
+  end Min;
+
+end Loop_Optimization21;
+
+-- { dg-final { scan-tree-dump-times "Index_Check" 1 "optimized" } }

gcc/testsuite/gnat.dg/loop_optimization21.ads

+package Loop_Optimization21 is
+
+  type Item is new Float;
+
+  type Item_Vector is array (Positive range <>) of Item;
+
+  function Min (X : Item_Vector) return Item;
+
+end Loop_Optimization21;