tree-ssa-structalias.c (create_variable_info_for): Also mark first field in a struct.

* tree-ssa-structalias.c (create_variable_info_for): Also mark
        first field in a struct.
        (intra_create_variable_infos): Don't deal with flag_argument_noalias.

fortran/
        * trans-expr.c (gfc_conv_substring): Don't evaluate casted decl early,
        change order of length calculation to (end - start) + 1.
        (gfc_get_interface_mapping_array): Adjust call to
        gfc_get_nodesc_array_type.
        * trans-array.c (gfc_trans_create_temp_array,
        gfc_build_constant_array_constructor, gfc_conv_expr_descriptor): Ditto.
        * trans-stmt.c (gfc_trans_pointer_assign_need_temp): Ditto.
        * trans.c (gfc_add_modify): Assignment between base type and nontarget
        type are equal enough.
        (gfc_call_malloc): Use prvoid_type_node for return value of
        __builtin_malloc.
        (gfc_allocate_with_status): Ditto.
        * trans-types.c (gfc_array_descriptor_base): Double size of this array.
        (gfc_init_types): Build prvoid_type_node.
        (gfc_build_array_type): New bool parameter "restricted".
        (gfc_get_nodesc_array_type): Ditto, build restrict qualified pointers,
        if it's true.
        (gfc_get_array_descriptor_base): Ditto.
        (gfc_get_array_type_bounds): Ditto.
        (gfc_sym_type): Use symbol attributes to feed calls to above functions.
        (gfc_get_derived_type): Ditto.
        * trans.h (struct lang_type): Add nontarget_type member.
        * trans-types.h (prvoid_type_node): Declare.
        (gfc_get_array_type_bounds, gfc_get_nodesc_array_type): Declare new
        parameter.
        * trans-decl.c (gfc_finish_var_decl): Give scalars that can't be
        aliased a type with a different alias set than the base type.
        (gfc_build_dummy_array_decl): Adjust call to gfc_get_nodesc_array_type.

testsuite/
        * gfortran.dg/vect/vect-gems.f90: New test.
        * gcc.dg/tree-ssa/alias-1.c: Remove, it checks something broken.

From-SVN: r150934

gcc/ChangeLog

@@ -1,3 +1,9 @@
+2009-08-18  Michael Matz  <matz@suse.de>
+
+	* tree-ssa-structalias.c (create_variable_info_for): Also mark
+	first field in a struct.
+	(intra_create_variable_infos): Don't deal with flag_argument_noalias.
+
 2009-08-18  Uros Bizjak  <ubizjak@gmail.com>
 
 	* config/alpha/alpha.c (alpha_output_mi_thunk_osf): Allocate insn

gcc/fortran/ChangeLog

@@ -1,3 +1,34 @@
+2009-08-18  Michael Matz  <matz@suse.de>
+
+	* trans-expr.c (gfc_conv_substring): Don't evaluate casted decl early,
+	change order of length calculation to (end - start) + 1.
+	(gfc_get_interface_mapping_array): Adjust call to
+	gfc_get_nodesc_array_type.
+	* trans-array.c (gfc_trans_create_temp_array,
+	gfc_build_constant_array_constructor, gfc_conv_expr_descriptor): Ditto.
+	* trans-stmt.c (gfc_trans_pointer_assign_need_temp): Ditto.
+	* trans.c (gfc_add_modify): Assignment between base type and nontarget
+	type are equal enough.
+	(gfc_call_malloc): Use prvoid_type_node for return value of
+	__builtin_malloc.
+	(gfc_allocate_with_status): Ditto.
+	* trans-types.c (gfc_array_descriptor_base): Double size of this array.
+	(gfc_init_types): Build prvoid_type_node.
+	(gfc_build_array_type): New bool parameter "restricted".
+	(gfc_get_nodesc_array_type): Ditto, build restrict qualified pointers,
+	if it's true.
+	(gfc_get_array_descriptor_base): Ditto.
+	(gfc_get_array_type_bounds): Ditto.
+	(gfc_sym_type): Use symbol attributes to feed calls to above functions.
+	(gfc_get_derived_type): Ditto.
+	* trans.h (struct lang_type): Add nontarget_type member.
+	* trans-types.h (prvoid_type_node): Declare.
+	(gfc_get_array_type_bounds, gfc_get_nodesc_array_type): Declare new
+	parameter.
+	* trans-decl.c (gfc_finish_var_decl): Give scalars that can't be
+	aliased a type with a different alias set than the base type.
+	(gfc_build_dummy_array_decl): Adjust call to gfc_get_nodesc_array_type.
+
 2009-08-18  Janus Weil  <janus@gcc.gnu.org>
 	    Paul Thomas  <pault@gcc.gnu.org>
 

gcc/fortran/trans-array.c

@@ -725,7 +725,7 @@ gfc_trans_create_temp_array (stmtblock_t * pre, stmtblock_t * post,
   /* Initialize the descriptor.  */
   type =
     gfc_get_array_type_bounds (eltype, info->dimen, loop->from, loop->to, 1,
-			       GFC_ARRAY_UNKNOWN);
+			       GFC_ARRAY_UNKNOWN, true);
   desc = gfc_create_var (type, "atmp");
   GFC_DECL_PACKED_ARRAY (desc) = 1;
 
@@ -1715,7 +1715,7 @@ gfc_build_constant_array_constructor (gfc_expr * expr, tree type)
 	as.upper[i] = gfc_int_expr (tmp - 1);
       }
 
-  tmptype = gfc_get_nodesc_array_type (type, &as, PACKED_STATIC);
+  tmptype = gfc_get_nodesc_array_type (type, &as, PACKED_STATIC, true);
 
   init = build_constructor_from_list (tmptype, nreverse (list));
 
@@ -5250,7 +5250,7 @@ gfc_conv_expr_descriptor (gfc_se * se, gfc_expr * expr, gfc_ss * ss)
 	  parmtype = gfc_get_element_type (TREE_TYPE (desc));
 	  parmtype = gfc_get_array_type_bounds (parmtype, loop.dimen,
 						loop.from, loop.to, 0,
-						GFC_ARRAY_UNKNOWN);
+						GFC_ARRAY_UNKNOWN, false);
 	  parm = gfc_create_var (parmtype, "parm");
 	}
 

gcc/fortran/trans-decl.c

@@ -578,6 +578,29 @@ gfc_finish_var_decl (tree decl, gfc_symbol * sym)
   if (sym->attr.threadprivate
       && (TREE_STATIC (decl) || DECL_EXTERNAL (decl)))
     DECL_TLS_MODEL (decl) = decl_default_tls_model (decl);
+
+  if (!sym->attr.target
+      && !sym->attr.pointer
+      && !sym->attr.proc_pointer
+      /* For now, don't bother with aggregate types.  We would need
+         to adjust DECL_CONTEXT of all field decls.  */
+      && !AGGREGATE_TYPE_P (TREE_TYPE (decl)))
+    {
+      tree type = TREE_TYPE (decl);
+      if (!TYPE_LANG_SPECIFIC (type))
+	TYPE_LANG_SPECIFIC (type) = (struct lang_type *)
+	  ggc_alloc_cleared (sizeof (struct lang_type));
+      if (!TYPE_LANG_SPECIFIC (type)->nontarget_type)
+	{
+	  alias_set_type set = new_alias_set ();
+	  type = build_distinct_type_copy (type);
+	  TYPE_ALIAS_SET (type) = set;
+	  TYPE_LANG_SPECIFIC (type)->nontarget_type = type;
+	}
+      else
+	type = TYPE_LANG_SPECIFIC (type)->nontarget_type;
+      TREE_TYPE (decl) = type;
+    }
 }
 
 
@@ -840,7 +863,8 @@ gfc_build_dummy_array_decl (gfc_symbol * sym, tree dummy)
 	}
 
       type = gfc_typenode_for_spec (&sym->ts);
-      type = gfc_get_nodesc_array_type (type, sym->as, packed);
+      type = gfc_get_nodesc_array_type (type, sym->as, packed,
+					!sym->attr.target);
     }
   else
     {

gcc/fortran/trans-expr.c

@@ -374,8 +374,10 @@ gfc_conv_substring (gfc_se * se, gfc_ref * ref, int kind,
     gfc_conv_string_parameter (se);
   else
     {
+      tmp = start.expr;
+      STRIP_NOPS (tmp);
       /* Avoid multiple evaluation of substring start.  */
-      if (!CONSTANT_CLASS_P (start.expr) && !DECL_P (start.expr))
+      if (!CONSTANT_CLASS_P (tmp) && !DECL_P (tmp))
 	start.expr = gfc_evaluate_now (start.expr, &se->pre);
 
       /* Change the start of the string.  */
@@ -397,7 +399,9 @@ gfc_conv_substring (gfc_se * se, gfc_ref * ref, int kind,
       gfc_conv_expr_type (&end, ref->u.ss.end, gfc_charlen_type_node);
       gfc_add_block_to_block (&se->pre, &end.pre);
     }
-  if (!CONSTANT_CLASS_P (end.expr) && !DECL_P (end.expr))
+  tmp = end.expr;
+  STRIP_NOPS (tmp);
+  if (!CONSTANT_CLASS_P (tmp) && !DECL_P (tmp))
     end.expr = gfc_evaluate_now (end.expr, &se->pre);
 
   if (gfc_option.rtcheck & GFC_RTCHECK_BOUNDS)
@@ -440,9 +444,9 @@ gfc_conv_substring (gfc_se * se, gfc_ref * ref, int kind,
     }
 
   tmp = fold_build2 (MINUS_EXPR, gfc_charlen_type_node,
-		     build_int_cst (gfc_charlen_type_node, 1),
+		     end.expr, start.expr);
-		     start.expr);
+  tmp = fold_build2 (PLUS_EXPR, gfc_charlen_type_node,
-  tmp = fold_build2 (PLUS_EXPR, gfc_charlen_type_node, end.expr, tmp);
+		     build_int_cst (gfc_charlen_type_node, 1), tmp);
   tmp = fold_build2 (MAX_EXPR, gfc_charlen_type_node, tmp,
 		     build_int_cst (gfc_charlen_type_node, 0));
   se->string_length = tmp;
@@ -1611,7 +1615,9 @@ gfc_get_interface_mapping_array (stmtblock_t * block, gfc_symbol * sym,
   tree var;
 
   type = gfc_typenode_for_spec (&sym->ts);
-  type = gfc_get_nodesc_array_type (type, sym->as, packed);
+  type = gfc_get_nodesc_array_type (type, sym->as, packed,
+				    !sym->attr.target && !sym->attr.pointer
+				    && !sym->attr.proc_pointer);
 
   var = gfc_create_var (type, "ifm");
   gfc_add_modify (block, var, fold_convert (type, data));

gcc/fortran/trans-stmt.c

@@ -2694,7 +2694,7 @@ gfc_trans_pointer_assign_need_temp (gfc_expr * expr1, gfc_expr * expr2,
       parmtype = gfc_get_element_type (TREE_TYPE (desc));
       parmtype = gfc_get_array_type_bounds (parmtype, loop.dimen,
                                             loop.from, loop.to, 1,
-					    GFC_ARRAY_UNKNOWN);
+					    GFC_ARRAY_UNKNOWN, true);
 
       /* Allocate temporary for nested forall construct.  */
       tmp1 = allocate_temp_for_forall_nest (nested_forall_info, parmtype,

gcc/fortran/trans-types.c

@@ -59,6 +59,7 @@ tree gfc_array_index_type;
 tree gfc_array_range_type;
 tree gfc_character1_type_node;
 tree pvoid_type_node;
+tree prvoid_type_node;
 tree ppvoid_type_node;
 tree pchar_type_node;
 tree pfunc_type_node;
@@ -67,7 +68,7 @@ tree gfc_charlen_type_node;
 
 static GTY(()) tree gfc_desc_dim_type;
 static GTY(()) tree gfc_max_array_element_size;
-static GTY(()) tree gfc_array_descriptor_base[GFC_MAX_DIMENSIONS];
+static GTY(()) tree gfc_array_descriptor_base[2 * GFC_MAX_DIMENSIONS];
 
 /* Arrays for all integral and real kinds.  We'll fill this in at runtime
    after the target has a chance to process command-line options.  */
@@ -866,6 +867,7 @@ gfc_init_types (void)
 #undef PUSH_TYPE
 
   pvoid_type_node = build_pointer_type (void_type_node);
+  prvoid_type_node = build_qualified_type (pvoid_type_node, TYPE_QUAL_RESTRICT);
   ppvoid_type_node = build_pointer_type (pvoid_type_node);
   pchar_type_node = build_pointer_type (gfc_character1_type_node);
   pfunc_type_node
@@ -1202,7 +1204,7 @@ gfc_is_nodesc_array (gfc_symbol * sym)
 
 static tree
 gfc_build_array_type (tree type, gfc_array_spec * as,
-		      enum gfc_array_kind akind)
+		      enum gfc_array_kind akind, bool restricted)
 {
   tree lbound[GFC_MAX_DIMENSIONS];
   tree ubound[GFC_MAX_DIMENSIONS];
@@ -1220,7 +1222,8 @@ gfc_build_array_type (tree type, gfc_array_spec * as,
 
   if (as->type == AS_ASSUMED_SHAPE)
     akind = GFC_ARRAY_ASSUMED_SHAPE;
-  return gfc_get_array_type_bounds (type, as->rank, lbound, ubound, 0, akind);
+  return gfc_get_array_type_bounds (type, as->rank, lbound, ubound, 0, akind,
+				    restricted);
 }
 
 /* Returns the struct descriptor_dimension type.  */
@@ -1365,7 +1368,8 @@ gfc_get_dtype (tree type)
    to the value of PACKED.  */
 
 tree
-gfc_get_nodesc_array_type (tree etype, gfc_array_spec * as, gfc_packed packed)
+gfc_get_nodesc_array_type (tree etype, gfc_array_spec * as, gfc_packed packed,
+			   bool restricted)
 {
   tree range;
   tree type;
@@ -1474,6 +1478,10 @@ gfc_get_nodesc_array_type (tree etype, gfc_array_spec * as, gfc_packed packed)
   /* TODO: use main type if it is unbounded.  */
   GFC_TYPE_ARRAY_DATAPTR_TYPE (type) =
     build_pointer_type (build_array_type (etype, range));
+  if (restricted)
+    GFC_TYPE_ARRAY_DATAPTR_TYPE (type) =
+      build_qualified_type (GFC_TYPE_ARRAY_DATAPTR_TYPE (type),
+			    TYPE_QUAL_RESTRICT);
 
   if (known_stride)
     {
@@ -1519,6 +1527,8 @@ gfc_get_nodesc_array_type (tree etype, gfc_array_spec * as, gfc_packed packed)
       /* For dummy arrays and automatic (heap allocated) arrays we
 	 want a pointer to the array.  */
       type = build_pointer_type (type);
+      if (restricted)
+	type = build_qualified_type (type, TYPE_QUAL_RESTRICT);
       GFC_ARRAY_TYPE_P (type) = 1;
       TYPE_LANG_SPECIFIC (type) = TYPE_LANG_SPECIFIC (TREE_TYPE (type));
     }
@@ -1528,14 +1538,15 @@ gfc_get_nodesc_array_type (tree etype, gfc_array_spec * as, gfc_packed packed)
 /* Return or create the base type for an array descriptor.  */
 
 static tree
-gfc_get_array_descriptor_base (int dimen)
+gfc_get_array_descriptor_base (int dimen, bool restricted)
 {
   tree fat_type, fieldlist, decl, arraytype;
   char name[16 + GFC_RANK_DIGITS + 1];
+  int idx = 2 * (dimen - 1) + restricted;
 
   gcc_assert (dimen >= 1 && dimen <= GFC_MAX_DIMENSIONS);
-  if (gfc_array_descriptor_base[dimen - 1])
+  if (gfc_array_descriptor_base[idx])
-    return gfc_array_descriptor_base[dimen - 1];
+    return gfc_array_descriptor_base[idx];
 
   /* Build the type node.  */
   fat_type = make_node (RECORD_TYPE);
@@ -1545,7 +1556,8 @@ gfc_get_array_descriptor_base (int dimen)
 
   /* Add the data member as the first element of the descriptor.  */
   decl = build_decl (input_location,
-		     FIELD_DECL, get_identifier ("data"), ptr_type_node);
+		     FIELD_DECL, get_identifier ("data"),
+		     restricted ? prvoid_type_node : ptr_type_node);
 
   DECL_CONTEXT (decl) = fat_type;
   fieldlist = decl;
@@ -1585,7 +1597,7 @@ gfc_get_array_descriptor_base (int dimen)
   gfc_finish_type (fat_type);
   TYPE_DECL_SUPPRESS_DEBUG (TYPE_STUB_DECL (fat_type)) = 1;
 
-  gfc_array_descriptor_base[dimen - 1] = fat_type;
+  gfc_array_descriptor_base[idx] = fat_type;
   return fat_type;
 }
 
@@ -1594,15 +1606,18 @@ gfc_get_array_descriptor_base (int dimen)
 tree
 gfc_get_array_type_bounds (tree etype, int dimen, tree * lbound,
 			   tree * ubound, int packed,
-			   enum gfc_array_kind akind)
+			   enum gfc_array_kind akind, bool restricted)
 {
   char name[8 + GFC_RANK_DIGITS + GFC_MAX_SYMBOL_LEN];
   tree fat_type, base_type, arraytype, lower, upper, stride, tmp, rtype;
   const char *type_name;
   int n;
 
-  base_type = gfc_get_array_descriptor_base (dimen);
+  base_type = gfc_get_array_descriptor_base (dimen, restricted);
   fat_type = build_distinct_type_copy (base_type);
+  /* Make sure that nontarget and target array type have the same canonical
+     type (and same stub decl for debug info).  */
+  base_type = gfc_get_array_descriptor_base (dimen, false);
   TYPE_CANONICAL (fat_type) = base_type;
   TYPE_STUB_DECL (fat_type) = TYPE_STUB_DECL (base_type);
 
@@ -1684,6 +1699,8 @@ gfc_get_array_type_bounds (tree etype, int dimen, tree * lbound,
     rtype = gfc_array_range_type;
   arraytype = build_array_type (etype, rtype);
   arraytype = build_pointer_type (arraytype);
+  if (restricted)
+    arraytype = build_qualified_type (arraytype, TYPE_QUAL_RESTRICT);
   GFC_TYPE_ARRAY_DATAPTR_TYPE (fat_type) = arraytype;
 
   /* This will generate the base declarations we need to emit debug
@@ -1723,6 +1740,7 @@ gfc_sym_type (gfc_symbol * sym)
 {
   tree type;
   int byref;
+  bool restricted;
 
   /* Procedure Pointers inside COMMON blocks.  */
   if (sym->attr.proc_pointer && sym->attr.in_common)
@@ -1757,6 +1775,8 @@ gfc_sym_type (gfc_symbol * sym)
   else
     byref = 0;
 
+  restricted = !sym->attr.target && !sym->attr.pointer
+               && !sym->attr.proc_pointer;
   if (sym->attr.dimension)
     {
       if (gfc_is_nodesc_array (sym))
@@ -1769,7 +1789,8 @@ gfc_sym_type (gfc_symbol * sym)
 	    {
 	      type = gfc_get_nodesc_array_type (type, sym->as,
 						byref ? PACKED_FULL
-						      : PACKED_STATIC);
+						      : PACKED_STATIC,
+						restricted);
 	      byref = 0;
 	    }
         }
@@ -1780,7 +1801,7 @@ gfc_sym_type (gfc_symbol * sym)
 	    akind = GFC_ARRAY_POINTER;
 	  else if (sym->attr.allocatable)
 	    akind = GFC_ARRAY_ALLOCATABLE;
-	  type = gfc_build_array_type (type, sym->as, akind);
+	  type = gfc_build_array_type (type, sym->as, akind, restricted);
 	}
     }
   else
@@ -1801,7 +1822,11 @@ gfc_sym_type (gfc_symbol * sym)
       if (sym->attr.optional || sym->ns->proc_name->attr.entry_master)
 	type = build_pointer_type (type);
       else
-	type = build_reference_type (type);
+	{
+	  type = build_reference_type (type);
+	  if (restricted)
+	    type = build_qualified_type (type, TYPE_QUAL_RESTRICT);
+	}
     }
 
   return (type);
@@ -2100,11 +2125,14 @@ gfc_get_derived_type (gfc_symbol * derived)
 		akind = GFC_ARRAY_ALLOCATABLE;
 	      /* Pointers to arrays aren't actually pointer types.  The
 	         descriptors are separate, but the data is common.  */
-	      field_type = gfc_build_array_type (field_type, c->as, akind);
+	      field_type = gfc_build_array_type (field_type, c->as, akind,
+						 !c->attr.target
+						 && !c->attr.pointer);
 	    }
 	  else
 	    field_type = gfc_get_nodesc_array_type (field_type, c->as,
-						    PACKED_STATIC);
+						    PACKED_STATIC,
+						    !c->attr.target);
 	}
       else if (c->attr.pointer)
 	field_type = build_pointer_type (field_type);

gcc/fortran/trans-types.h

@@ -29,6 +29,7 @@ extern GTY(()) tree gfc_array_range_type;
 extern GTY(()) tree gfc_character1_type_node;
 extern GTY(()) tree ppvoid_type_node;
 extern GTY(()) tree pvoid_type_node;
+extern GTY(()) tree prvoid_type_node;
 extern GTY(()) tree pchar_type_node;
 
 /* This is the type used to hold the lengths of character variables.
@@ -72,8 +73,8 @@ tree gfc_build_uint_type (int);
 
 tree gfc_get_element_type (tree);
 tree gfc_get_array_type_bounds (tree, int, tree *, tree *, int,
-				enum gfc_array_kind);
+				enum gfc_array_kind, bool);
-tree gfc_get_nodesc_array_type (tree, gfc_array_spec *, gfc_packed);
+tree gfc_get_nodesc_array_type (tree, gfc_array_spec *, gfc_packed, bool);
 
 /* Add a field of given name and type to a UNION_TYPE or RECORD_TYPE.  */
 tree gfc_add_field_to_struct (tree *, tree, tree, tree);

gcc/fortran/trans.c

@@ -159,11 +159,21 @@ gfc_add_modify (stmtblock_t * pblock, tree lhs, tree rhs)
   tree tmp;
 
 #ifdef ENABLE_CHECKING
+  tree t1, t2;
+  t1 = TREE_TYPE (rhs);
+  t2 = TREE_TYPE (lhs);
+  /* ??? This is actually backwards, we should test the "base" type
+     from which the nontarget_type was copied, but we don't have this
+     backlink.  This will do for now, it's for checking anyway.  */
+  if (TYPE_LANG_SPECIFIC (t1))
+    t1 = TYPE_LANG_SPECIFIC (t1)->nontarget_type;
+  if (TYPE_LANG_SPECIFIC (t2))
+    t2 = TYPE_LANG_SPECIFIC (t2)->nontarget_type;
   /* Make sure that the types of the rhs and the lhs are the same
      for scalar assignments.  We should probably have something
      similar for aggregates, but right now removing that check just
      breaks everything.  */
-  gcc_assert (TREE_TYPE (rhs) == TREE_TYPE (lhs)
+  gcc_assert (t1 == t2
 	      || AGGREGATE_TYPE_P (TREE_TYPE (lhs)));
 #endif
 
@@ -509,7 +519,7 @@ gfc_call_malloc (stmtblock_t * block, tree type, tree size)
     size = fold_convert (size_type_node, size);
 
   /* Create a variable to hold the result.  */
-  res = gfc_create_var (pvoid_type_node, NULL);
+  res = gfc_create_var (prvoid_type_node, NULL);
 
   /* size < 0 ?  */
   negative = fold_build2 (LT_EXPR, boolean_type_node, size,
@@ -529,9 +539,9 @@ gfc_call_malloc (stmtblock_t * block, tree type, tree size)
 		      build_int_cst (size_type_node, 1));
 
   gfc_add_modify (&block2, res,
-		  build_call_expr_loc (input_location,
+		  fold_convert (prvoid_type_node,
-				   built_in_decls[BUILT_IN_MALLOC], 1,
+				build_call_expr_loc (input_location,
-		       size));
+				   built_in_decls[BUILT_IN_MALLOC], 1, size)));
   null_result = fold_build2 (EQ_EXPR, boolean_type_node, res,
 			     build_int_cst (pvoid_type_node, 0));
   msg = gfc_build_addr_expr (pchar_type_node, gfc_build_localized_cstring_const
@@ -601,7 +611,7 @@ gfc_allocate_with_status (stmtblock_t * block, tree size, tree status)
     size = fold_convert (size_type_node, size);
 
   /* Create a variable to hold the result.  */
-  res = gfc_create_var (pvoid_type_node, NULL);
+  res = gfc_create_var (prvoid_type_node, NULL);
 
   /* Set the optional status variable to zero.  */
   if (status != NULL_TREE && !integer_zerop (status))
@@ -633,7 +643,7 @@ gfc_allocate_with_status (stmtblock_t * block, tree size, tree status)
 		      fold_build1 (INDIRECT_REF, status_type, status),
 			   build_int_cst (status_type, LIBERROR_ALLOCATION));
       gfc_add_modify (&set_status_block, res,
-			   build_int_cst (pvoid_type_node, 0));
+			   build_int_cst (prvoid_type_node, 0));
 
       tmp = fold_build2 (EQ_EXPR, boolean_type_node, status,
 			 build_int_cst (TREE_TYPE (status), 0));
@@ -644,11 +654,12 @@ gfc_allocate_with_status (stmtblock_t * block, tree size, tree status)
   /* The allocation itself.  */
   gfc_start_block (&alloc_block);
   gfc_add_modify (&alloc_block, res,
-		  build_call_expr_loc (input_location,
+		  fold_convert (prvoid_type_node,
+				build_call_expr_loc (input_location,
 				   built_in_decls[BUILT_IN_MALLOC], 1,
 					fold_build2 (MAX_EXPR, size_type_node,
 						     size,
-						     build_int_cst (size_type_node, 1))));
+						     build_int_cst (size_type_node, 1)))));
 
   msg = gfc_build_addr_expr (pchar_type_node, gfc_build_localized_cstring_const
 						("Out of memory"));
@@ -671,7 +682,7 @@ gfc_allocate_with_status (stmtblock_t * block, tree size, tree status)
 
   tmp = fold_build3 (COND_EXPR, void_type_node,
 		     fold_build2 (EQ_EXPR, boolean_type_node, res,
-				  build_int_cst (pvoid_type_node, 0)),
+				  build_int_cst (prvoid_type_node, 0)),
 		     tmp, build_empty_stmt (input_location));
   gfc_add_expr_to_block (&alloc_block, tmp);
 
@@ -723,7 +734,7 @@ gfc_allocate_array_with_status (stmtblock_t * block, tree mem, tree size,
     size = fold_convert (size_type_node, size);
 
   /* Create a variable to hold the result.  */
-  res = gfc_create_var (pvoid_type_node, NULL);
+  res = gfc_create_var (type, NULL);
   null_mem = fold_build2 (EQ_EXPR, boolean_type_node, mem,
 			  build_int_cst (type, 0));
 

gcc/fortran/trans.h

@@ -629,6 +629,7 @@ struct GTY(())	lang_type	 {
   tree dataptr_type;
   tree span;
   tree base_decl[2];
+  tree nontarget_type;
 };
 
 struct GTY(()) lang_decl {

gcc/testsuite/ChangeLog

@@ -1,3 +1,8 @@
+2009-08-18  Michael Matz  <matz@suse.de>
+
+	* gfortran.dg/vect/vect-gems.f90: New test.
+	* gcc.dg/tree-ssa/alias-1.c: Remove, it checks something broken.
+
 2009-08-18  DJ Delorie  <dj@redhat.com>
 
 	* lib/wrapper.exp: Move load of target-libpath.exp from here...

gcc/testsuite/gcc.dg/tree-ssa/alias-1.c

@@ -1,17 +0,0 @@
-/* { dg-options "-O2 -fargument-noalias-global -fdump-tree-optimized" } */
-int f;
-void link_error ();
-
-void g(int *i)
-{
-  *i = 0;
-  f = 1;
-  if (*i != 0)
-    link_error ();
-}
-
-
-/* We should have removed the link_error on the tree level as we told GCC
-   that *i cannot point to f via the option -fargument-noalias-global. */
-/* { dg-final { scan-tree-dump-times "link_error" 0 "optimized"} } */
-/* { dg-final { cleanup-tree-dump "optimized" } } */

gcc/testsuite/gfortran.dg/vect/vect-gems.f90

@@ -0,0 +1,57 @@
+! { dg-do compile }
+! { dg-require-effective-target vect_double }
+
+MODULE UPML_mod
+
+IMPLICIT NONE
+
+PUBLIC UPMLupdateE
+
+PRIVATE
+
+real(kind=8), dimension(:,:,:), allocatable :: Dx_ilow
+
+real(kind=8), dimension(:), allocatable :: aye, aze
+real(kind=8), dimension(:), allocatable :: bye, bze
+real(kind=8), dimension(:), allocatable :: fxh, cxh
+
+real(kind=8) :: epsinv
+real(kind=8) :: dxinv, dyinv, dzinv
+
+integer :: xstart, ystart, zstart, xstop, ystop, zstop
+
+CONTAINS
+
+SUBROUTINE UPMLupdateE(nx,ny,nz,Hx,Hy,Hz,Ex,Ey,Ez)
+
+integer, intent(in) :: nx, ny, nz
+real(kind=8), intent(inout),                                                &
+         dimension(xstart:xstop+1,ystart:ystop+1,zstart:zstop+1) :: Ex, Ey, Ez
+real(kind=8), intent(inout),                                                &
+         allocatable :: Hx(:,:,:), Hy(:,:,:), Hz(:,:,:)
+
+integer :: i, j, k
+real(kind=8) :: Dxold, Dyold, Dzold
+
+do k=zstart+1,zstop
+  do j=ystart+1,ystop
+    do i=xstart+1,0
+
+      Dxold = Dx_ilow(i,j,k)
+
+      Dx_ilow(i,j,k) = aye(j) * Dx_ilow(i,j,k) +                              &
+                       bye(j) * ((Hz(i,j,k  )-Hz(i,j-1,k))*dyinv +            &
+                                 (Hy(i,j,k-1)-Hy(i,j,k  ))*dzinv)
+
+      Ex(i,j,k) = aze(k) * Ex(i,j,k) +                                        &
+                  bze(k) * (cxh(i)*Dx_ilow(i,j,k) - fxh(i)*Dxold) * epsinv
+    end do
+  end do
+end do
+
+END SUBROUTINE UPMLupdateE
+
+END MODULE UPML_mod
+
+! { dg-final { scan-tree-dump-times "vectorized 1 loops" 1 "vect"  } }
+! { dg-final { cleanup-tree-dump "vect" } }

gcc/tree-ssa-structalias.c

@@ -4519,6 +4519,13 @@ create_variable_info_for (tree decl, const char *name)
       vi->size = fo->size;
       vi->offset = fo->offset;
       vi->may_have_pointers = fo->may_have_pointers;
+      if (vi->is_global_var
+	  && (!flag_whole_program || !in_ipa_mode)
+	  && vi->may_have_pointers)
+	{
+	  if (fo->only_restrict_pointers)
+	    make_constraint_from_restrict (vi, "GLOBAL_RESTRICT");
+	}
       for (i = VEC_length (fieldoff_s, fieldstack) - 1;
 	   i >= 1 && VEC_iterate (fieldoff_s, fieldstack, i, fo);
 	   i--)
@@ -4611,43 +4618,8 @@ intra_create_variable_infos (void)
       if (!could_have_pointers (t))
 	continue;
 
-      /* If flag_argument_noalias is set, then function pointer
+      for (p = get_vi_for_tree (t); p; p = p->next)
-	 arguments are guaranteed not to point to each other.  In that
+	make_constraint_from (p, nonlocal_id);
-	 case, create an artificial variable PARM_NOALIAS and the
-	 constraint ARG = &PARM_NOALIAS.  */
-      if (POINTER_TYPE_P (TREE_TYPE (t)) && flag_argument_noalias > 0)
-	{
-	  varinfo_t vi;
-	  var_ann_t ann;
-
-	  vi = make_constraint_from_heapvar (get_vi_for_tree (t),
-					     "PARM_NOALIAS");
-	  ann = get_var_ann (vi->decl);
-	  if (flag_argument_noalias == 1)
-	    {
-	      ann->noalias_state = NO_ALIAS;
-	      make_copy_constraint (vi, nonlocal_id);
-	    }
-	  else if (flag_argument_noalias == 2)
-	    {
-	      ann->noalias_state = NO_ALIAS_GLOBAL;
-	      make_constraint_from (vi, vi->id);
-	    }
-	  else if (flag_argument_noalias == 3)
-	    {
-	      ann->noalias_state = NO_ALIAS_ANYTHING;
-	      make_constraint_from (vi, vi->id);
-	    }
-	  else
-	    gcc_unreachable ();
-	}
-      else
-	{
-	  varinfo_t arg_vi = get_vi_for_tree (t);
-
-	  for (p = arg_vi; p; p = p->next)
-	    make_constraint_from (p, nonlocal_id);
-	}
       if (POINTER_TYPE_P (TREE_TYPE (t))
 	  && TYPE_RESTRICT (TREE_TYPE (t)))
 	make_constraint_from_restrict (get_vi_for_tree (t), "PARM_RESTRICT");