2012-07-15  Tobias Burnus  <burnus@net-b.de>

	PR fortran/48820
	* array.c (match_array_element_spec, gfc_match_array_spec,
	spec_size, gfc_array_dimen_size): Add support for
	assumed-rank arrays.
	* check.c (dim_rank_check): Ditto.
	* class.c (gfc_add_component_ref): Ditto.
	(gfc_build_class_symbol): Regard assumed-rank arrays
	as having GFC_MAX_DIMENSIONS. And build extra class
	container for a scalar pointer class.
	* decl.c (merge_array_spec): Add support for
	assumed-rank arrays.
	* dump-parse-tree.c (show_array_spec): Ditto.
	* expr.c (gfc_is_simply_contiguous): Ditto.
	* gfortran.h (array_type): Ditto.
	(gfc_array_spec, gfc_expr): Add comment to "rank" field.
	* interface.c (compare_type_rank, compare_parameter,
	argument_rank_mismatch, gfc_procedure_use): Ditto.
	(compare_actual_formal): Fix NULL() to optional-dummy
	handling for polymorphic dummies.
	* module.c (mio_typespec): Add support for
	assumed-rank arrays.
	* resolve.c (resolve_formal_arglist, resolve_global_procedure,
	expression_shape, resolve_variable, resolve_symbol,
	resolve_fl_var_and_proc, resolve_actual_arglist,
	resolve_elemental_actual, update_ppc_arglist,
	check_typebound_baseobject, gfc_resolve_finalizers,
	resolve_typebound_procedure, gfc_resolve_expr,
	gfc_resolve_finalizers): Ditto.
	(assumed_rank_type_expr_allowed): Renamed static variable
	from assumed_type_expr_allowed.
	* simplify.c (simplify_bound, gfc_simplify_range): Add
	support for assumed-rank arrays.
	* trans-array.c (gfc_conv_array_parameter): Ditto.
	(gfc_get_descriptor_dimension): New function, which returns
	the descriptor.
	(gfc_conv_descriptor_dimension): Use it.
	(gfc_conv_descriptor_stride_get, gfc_conv_array_parameter):
	Handle GFC_ARRAY_ASSUMED_RANK_CONT and AS_ASSUMED_RANK.
	* trans-array.h (gfc_get_descriptor_dimension): New prototype.
	* trans-decl. (gfc_build_dummy_array_decl,
	gfc_trans_deferred_vars, add_argument_checking): Add
	support for assumed-rank arrays.
	* trans-expr.c (gfc_conv_expr_present, gfc_conv_variable,
	gfc_conv_procedure_call): Ditto.
	(get_scalar_to_descriptor_type, class_array_data_assign,
	conv_scalar_to_descriptor): New static functions.
	(gfc_conv_derived_to_class, gfc_conv_class_to_class): Use
	them.
	* trans-intrinsic.c (get_rank_from_desc): New function.
	(gfc_conv_intrinsic_rank, gfc_conv_associated): Use it.
	* trans-types.c (gfc_array_descriptor_base_caf,
	gfc_array_descriptor_base): Make space for scalar array.
	(gfc_is_nodesc_array, gfc_is_nodesc_array,
	gfc_build_array_type, gfc_get_array_descriptor_base): Add
	support for assumed-rank arrays.
	* trans.h (gfc_array_kind): Add GFC_ARRAY_ASSUMED_RANK and
	GFC_ARRAY_ASSUMED_RANK_CONT.

2012-07-15  Tobias Burnus  <burnus@net-b.de>

	PR fortran/48820
	* gfortran.dg/assumed_rank_1.f90: New.
	* gfortran.dg/assumed_rank_1_c.c: New.
	* gfortran.dg/assumed_rank_2.f90: New.
	* gfortran.dg/assumed_rank_4.f90: New.
	* gfortran.dg/assumed_rank_5.f90: New.
	* gfortran.dg/assumed_rank_6.f90: New.
	* gfortran.dg/assumed_rank_7.f90: New.
	* gfortran.dg/assumed_rank_8.f90: New.
	* gfortran.dg/assumed_rank_8_c.c: New.
	* gfortran.dg/assumed_rank_9.f90: New.
	* gfortran.dg/assumed_rank_10.f90: New.

diff --git a/gcc/fortran/array.c b/gcc/fortran/array.c
index 51528b4..e1fa4b2 100644
--- a/gcc/fortran/array.c
+++ b/gcc/fortran/array.c
@@ -390,9 +390,11 @@ match_array_element_spec (gfc_array_spec *as)
 {
   gfc_expr **upper, **lower;
   match m;
+  int rank;
 
-  lower = &as->lower[as->rank + as->corank - 1];
-  upper = &as->upper[as->rank + as->corank - 1];
+  rank = as->rank == -1 ? 0 : as->rank;
+  lower = &as->lower[rank + as->corank - 1];
+  upper = &as->upper[rank + as->corank - 1];
 
   if (gfc_match_char ('*') == MATCH_YES)
     {
@@ -458,6 +460,20 @@ gfc_match_array_spec (gfc_array_spec **asp, bool match_dim, bool match_codim)
       goto coarray;
     }
 
+  if (gfc_match (" .. )") == MATCH_YES)
+    {
+      as->type = AS_ASSUMED_RANK;
+      as->rank = -1;
+
+      if (gfc_notify_std (GFC_STD_F2008_TS, "TS 29113: Assumed-rank array "
+			  "at %C") == FAILURE)
+	goto cleanup;
+
+      if (!match_codim)
+	goto done;
+      goto coarray;
+    }
+
   for (;;)
     {
       as->rank++;
@@ -536,6 +552,9 @@ gfc_match_array_spec (gfc_array_spec **asp, bool match_dim, bool match_codim)
 
 	    gfc_error ("Bad specification for assumed size array at %C");
 	    goto cleanup;
+
+	  case AS_ASSUMED_RANK:
+	    gcc_unreachable (); 
 	  }
 
       if (gfc_match_char (')') == MATCH_YES)
@@ -642,6 +661,9 @@ coarray:
 	    case AS_ASSUMED_SIZE:
 	      gfc_error ("Bad specification for assumed size array at %C");
 	      goto cleanup;
+
+	    case AS_ASSUMED_RANK:
+	      gcc_unreachable (); 
 	  }
 
       if (gfc_match_char (']') == MATCH_YES)
@@ -1960,6 +1982,9 @@ spec_size (gfc_array_spec *as, mpz_t *result)
   mpz_t size;
   int d;
 
+  if (as->type == AS_ASSUMED_RANK)
+    return FAILURE;
+
   mpz_init_set_ui (*result, 1);
 
   for (d = 0; d < as->rank; d++)
@@ -2116,6 +2141,9 @@ gfc_array_dimen_size (gfc_expr *array, int dimen, mpz_t *result)
   if (array->ts.type == BT_CLASS)
     return FAILURE;
 
+  if (array->rank == -1)
+    return FAILURE;
+
   if (dimen < 0 || array == NULL || dimen > array->rank - 1)
     gfc_internal_error ("gfc_array_dimen_size(): Bad dimension");
 
diff --git a/gcc/fortran/check.c b/gcc/fortran/check.c
index 407052f..404a534 100644
--- a/gcc/fortran/check.c
+++ b/gcc/fortran/check.c
@@ -620,6 +620,10 @@ dim_rank_check (gfc_expr *dim, gfc_expr *array, int allow_assumed)
   else
     rank = array->rank;
 
+  /* Assumed-rank array.  */
+  if (rank == -1)
+    rank = GFC_MAX_DIMENSIONS;
+
   if (array->expr_type == EXPR_VARIABLE)
     {
       ar = gfc_find_array_ref (array);
diff --git a/gcc/fortran/class.c b/gcc/fortran/class.c
index fc083dc..21a91ba 100644
--- a/gcc/fortran/class.c
+++ b/gcc/fortran/class.c
@@ -220,7 +220,7 @@ gfc_add_component_ref (gfc_expr *e, const char *name)
 void
 gfc_add_class_array_ref (gfc_expr *e)
 {
-  int rank =  CLASS_DATA (e)->as->rank;
+  int rank = CLASS_DATA (e)->as->rank;
   gfc_array_spec *as = CLASS_DATA (e)->as;
   gfc_ref *ref = NULL;
   gfc_add_component_ref (e, "_data");
@@ -498,6 +498,7 @@ gfc_build_class_symbol (gfc_typespec *ts, symbol_attribute *attr,
   gfc_symbol *fclass;
   gfc_symbol *vtab;
   gfc_component *c;
+  int rank;
 
   if (as && *as && (*as)->type == AS_ASSUMED_SIZE)
     {
@@ -518,11 +519,14 @@ gfc_build_class_symbol (gfc_typespec *ts, symbol_attribute *attr,
     return SUCCESS;
 
   /* Determine the name of the encapsulating type.  */
+  rank = !(*as) || (*as)->rank == -1 ? GFC_MAX_DIMENSIONS : (*as)->rank;
   get_unique_hashed_string (tname, ts->u.derived);
   if ((*as) && attr->allocatable)
-    sprintf (name, "__class_%s_%d_%da", tname, (*as)->rank, (*as)->corank);
+    sprintf (name, "__class_%s_%d_%da", tname, rank, (*as)->corank);
+  else if ((*as) && attr->pointer)
+    sprintf (name, "__class_%s_%d_%dp", tname, rank, (*as)->corank);
   else if ((*as))
-    sprintf (name, "__class_%s_%d_%d", tname, (*as)->rank, (*as)->corank);
+    sprintf (name, "__class_%s_%d_%d", tname, rank, (*as)->corank);
   else if (attr->pointer)
     sprintf (name, "__class_%s_p", tname);
   else if (attr->allocatable)
diff --git a/gcc/fortran/decl.c b/gcc/fortran/decl.c
index c3644b6..959a57b 100644
--- a/gcc/fortran/decl.c
+++ b/gcc/fortran/decl.c
@@ -594,7 +594,7 @@ merge_array_spec (gfc_array_spec *from, gfc_array_spec *to, bool copy)
 {
   int i;
 
-  if (to->rank == 0 && from->rank > 0)
+  if (to->rank == 0 && from->rank != 0)
     {
       to->rank = from->rank;
       to->type = from->type;
@@ -622,20 +622,24 @@ merge_array_spec (gfc_array_spec *from, gfc_array_spec *to, bool copy)
     }
   else if (to->corank == 0 && from->corank > 0)
     {
+      int rank;
+
       to->corank = from->corank;
       to->cotype = from->cotype;
 
+      rank = to->rank == -1 ? 0 : to->rank;
+
       for (i = 0; i < from->corank; i++)
 	{
 	  if (copy)
 	    {
-	      to->lower[to->rank + i] = gfc_copy_expr (from->lower[i]);
-	      to->upper[to->rank + i] = gfc_copy_expr (from->upper[i]);
+	      to->lower[rank + i] = gfc_copy_expr (from->lower[i]);
+	      to->upper[rank + i] = gfc_copy_expr (from->upper[i]);
 	    }
 	  else
 	    {
-	      to->lower[to->rank + i] = from->lower[i];
-	      to->upper[to->rank + i] = from->upper[i];
+	      to->lower[rank + i] = from->lower[i];
+	      to->upper[rank + i] = from->upper[i];
 	    }
 	}
     }
diff --git a/gcc/fortran/dump-parse-tree.c b/gcc/fortran/dump-parse-tree.c
index 26c5201..681dc8d 100644
--- a/gcc/fortran/dump-parse-tree.c
+++ b/gcc/fortran/dump-parse-tree.c
@@ -166,7 +166,7 @@ show_array_spec (gfc_array_spec *as)
 
   fprintf (dumpfile, "(%d [%d]", as->rank, as->corank);
 
-  if (as->rank + as->corank > 0)
+  if (as->rank + as->corank > 0 || as->rank == -1)
     {
       switch (as->type)
       {
@@ -174,6 +174,7 @@ show_array_spec (gfc_array_spec *as)
 	case AS_DEFERRED:      c = "AS_DEFERRED";      break;
 	case AS_ASSUMED_SIZE:  c = "AS_ASSUMED_SIZE";  break;
 	case AS_ASSUMED_SHAPE: c = "AS_ASSUMED_SHAPE"; break;
+	case AS_ASSUMED_RANK:  c = "AS_ASSUMED_RANK";  break;
 	default:
 	  gfc_internal_error ("show_array_spec(): Unhandled array shape "
 			      "type.");
diff --git a/gcc/fortran/expr.c b/gcc/fortran/expr.c
index a107369..6afd9f3 100644
--- a/gcc/fortran/expr.c
+++ b/gcc/fortran/expr.c
@@ -4442,7 +4442,8 @@ gfc_is_simply_contiguous (gfc_expr *expr, bool strict)
 	    || (!part_ref
 		&& !sym->attr.contiguous
 		&& (sym->attr.pointer
-		      || sym->as->type == AS_ASSUMED_SHAPE))))
+		    || sym->as->type == AS_ASSUMED_RANK
+		    || sym->as->type == AS_ASSUMED_SHAPE))))
     return false;
 
   if (!ar || ar->type == AR_FULL)
diff --git a/gcc/fortran/gfortran.h b/gcc/fortran/gfortran.h
index 6d75e63..03c306a 100644
--- a/gcc/fortran/gfortran.h
+++ b/gcc/fortran/gfortran.h
@@ -135,7 +135,8 @@ expr_t;
 /* Array types.  */
 typedef enum
 { AS_EXPLICIT = 1, AS_ASSUMED_SHAPE, AS_DEFERRED,
-  AS_ASSUMED_SIZE, AS_IMPLIED_SHAPE, AS_UNKNOWN
+  AS_ASSUMED_SIZE, AS_IMPLIED_SHAPE, AS_ASSUMED_RANK,
+  AS_UNKNOWN
 }
 array_type;
 
@@ -917,7 +918,7 @@ gfc_typespec;
 /* Array specification.  */
 typedef struct
 {
-  int rank;	/* A rank of zero means that a variable is a scalar.  */
+  int rank;	/* A scalar has a rank of 0, an assumed-rank array has -1.  */
   int corank;
   array_type type, cotype;
   struct gfc_expr *lower[GFC_MAX_DIMENSIONS], *upper[GFC_MAX_DIMENSIONS];
@@ -1694,7 +1695,7 @@ typedef struct gfc_expr
 
   gfc_typespec ts;	/* These two refer to the overall expression */
 
-  int rank;
+  int rank;		/* 0 indicates a scalar, -1 an assumed-rank array.  */
   mpz_t *shape;		/* Can be NULL if shape is unknown at compile time */
 
   /* Nonnull for functions and structure constructors, may also used to hold the
diff --git a/gcc/fortran/interface.c b/gcc/fortran/interface.c
index 6f40ba7..64efbcb 100644
--- a/gcc/fortran/interface.c
+++ b/gcc/fortran/interface.c
@@ -512,7 +512,9 @@ compare_type_rank (gfc_symbol *s1, gfc_symbol *s2)
   r1 = (s1->as != NULL) ? s1->as->rank : 0;
   r2 = (s2->as != NULL) ? s2->as->rank : 0;
 
-  if (r1 != r2)
+  if (r1 != r2
+      && (!s1->as || s1->as->type != AS_ASSUMED_RANK)
+      && (!s2->as || s2->as->type != AS_ASSUMED_RANK))
     return 0;			/* Ranks differ.  */
 
   return gfc_compare_types (&s1->ts, &s2->ts)
@@ -1635,7 +1637,14 @@ static void
 argument_rank_mismatch (const char *name, locus *where,
 			int rank1, int rank2)
 {
-  if (rank1 == 0)
+
+  /* TS 29113, C407b.  */
+  if (rank2 == -1)
+    {
+      gfc_error ("The assumed-rank array at %L requires that the dummy argument"
+		 " '%s' has assumed-rank", where, name);
+    }
+  else if (rank1 == 0)
     {
       gfc_error ("Rank mismatch in argument '%s' at %L "
 		 "(scalar and rank-%d)", name, where, rank2);
@@ -1743,7 +1752,7 @@ compare_parameter (gfc_symbol *formal, gfc_expr *actual,
     }
 
   /* F2008, 12.5.2.5; IR F08/0073.  */
-  if (formal->ts.type == BT_CLASS
+  if (formal->ts.type == BT_CLASS && actual->expr_type != EXPR_NULL
       && ((CLASS_DATA (formal)->attr.class_pointer
 	   && !formal->attr.intent == INTENT_IN)
           || CLASS_DATA (formal)->attr.allocatable))
@@ -1860,7 +1869,8 @@ compare_parameter (gfc_symbol *formal, gfc_expr *actual,
 		     " is modified",  &actual->where, formal->name);
     }
 
-  if (symbol_rank (formal) == actual->rank)
+  /* If the rank is the same or the formal argument has assumed-rank.  */
+  if (symbol_rank (formal) == actual->rank || symbol_rank (formal) == -1)
     return 1;
 
   if (actual->ts.type == BT_CLASS && CLASS_DATA (actual)->as
@@ -2289,11 +2299,21 @@ compare_actual_formal (gfc_actual_arglist **ap, gfc_formal_arglist *formal,
 	  return 0;
 	}
 
-      if (a->expr->expr_type == EXPR_NULL && !f->sym->attr.pointer
-	  && (f->sym->attr.allocatable || !f->sym->attr.optional
-	      || (gfc_option.allow_std & GFC_STD_F2008) == 0))
-	{
-	  if (where && (f->sym->attr.allocatable || !f->sym->attr.optional))
+      if (a->expr->expr_type == EXPR_NULL
+	  && ((f->sym->ts.type != BT_CLASS && !f->sym->attr.pointer
+	       && (f->sym->attr.allocatable || !f->sym->attr.optional
+		   || (gfc_option.allow_std & GFC_STD_F2008) == 0))
+	      || (f->sym->ts.type == BT_CLASS
+		  && !CLASS_DATA (f->sym)->attr.class_pointer
+		  && (CLASS_DATA (f->sym)->attr.allocatable
+		      || !f->sym->attr.optional
+		      || (gfc_option.allow_std & GFC_STD_F2008) == 0))))
+	{
+	  if (where
+	      && (!f->sym->attr.optional
+		  || (f->sym->ts.type != BT_CLASS && f->sym->attr.allocatable)
+		  || (f->sym->ts.type == BT_CLASS
+			 && CLASS_DATA (f->sym)->attr.allocatable)))
 	    gfc_error ("Unexpected NULL() intrinsic at %L to dummy '%s'",
 		       where, f->sym->name);
 	  else if (where)
@@ -2991,6 +3011,15 @@ gfc_procedure_use (gfc_symbol *sym, gfc_actual_arglist **ap, locus *where)
 	      gfc_error ("MOLD argument to NULL required at %L", &a->expr->where);
 	      return;
 	    }
+
+	  /* TS 29113, C407b.  */
+	  if (a->expr && a->expr->expr_type == EXPR_VARIABLE
+	      && symbol_rank (a->expr->symtree->n.sym) == -1)
+	    {
+	      gfc_error ("Assumed-rank argument requires an explicit interface "
+			 "at %L", &a->expr->where);
+	      return;
+	    }
 	}
 
       return;
diff --git a/gcc/fortran/module.c b/gcc/fortran/module.c
index 6fe23a2..4a5a869 100644
--- a/gcc/fortran/module.c
+++ b/gcc/fortran/module.c
@@ -2341,6 +2341,7 @@ mio_typespec (gfc_typespec *ts)
 
 static const mstring array_spec_types[] = {
     minit ("EXPLICIT", AS_EXPLICIT),
+    minit ("ASSUMED_RANK", AS_ASSUMED_RANK),
     minit ("ASSUMED_SHAPE", AS_ASSUMED_SHAPE),
     minit ("DEFERRED", AS_DEFERRED),
     minit ("ASSUMED_SIZE", AS_ASSUMED_SIZE),
diff --git a/gcc/fortran/resolve.c b/gcc/fortran/resolve.c
index 5be1857..3534e63 100644
--- a/gcc/fortran/resolve.c
+++ b/gcc/fortran/resolve.c
@@ -64,7 +64,8 @@ static code_stack *cs_base = NULL;
 static int forall_flag;
 static int do_concurrent_flag;
 
-static bool assumed_type_expr_allowed = false;
+/* Nonzero for assumed rank and for assumed type.  */
+static bool assumed_rank_type_expr_allowed = false;
 
 /* Nonzero if we're inside a OpenMP WORKSHARE or PARALLEL WORKSHARE block.  */
 
@@ -240,7 +241,7 @@ resolve_formal_arglist (gfc_symbol *proc)
 
   if (gfc_elemental (proc)
       || sym->attr.pointer || sym->attr.allocatable
-      || (sym->as && sym->as->rank > 0))
+      || (sym->as && sym->as->rank != 0))
     {
       proc->attr.always_explicit = 1;
       sym->attr.always_explicit = 1;
@@ -251,6 +252,7 @@ resolve_formal_arglist (gfc_symbol *proc)
   for (f = proc->formal; f; f = f->next)
     {
       sym = f->sym;
+      gfc_array_spec *as;
 
       if (sym == NULL)
 	{
@@ -284,23 +286,34 @@ resolve_formal_arglist (gfc_symbol *proc)
 	    gfc_set_default_type (sym, 1, sym->ns);
 	}
 
-      gfc_resolve_array_spec (sym->as, 0);
+      as = sym->ts.type == BT_CLASS && sym->attr.class_ok
+	   ? CLASS_DATA (sym)->as : sym->as;
+
+      gfc_resolve_array_spec (as, 0);
 
       /* We can't tell if an array with dimension (:) is assumed or deferred
 	 shape until we know if it has the pointer or allocatable attributes.
       */
-      if (sym->as && sym->as->rank > 0 && sym->as->type == AS_DEFERRED
-	  && !(sym->attr.pointer || sym->attr.allocatable)
+      if (as && as->rank > 0 && as->type == AS_DEFERRED
+	  && ((sym->ts.type != BT_CLASS
+	       && !(sym->attr.pointer || sym->attr.allocatable))
+              || (sym->ts.type == BT_CLASS
+		  && !(CLASS_DATA (sym)->attr.class_pointer
+		       || CLASS_DATA (sym)->attr.allocatable)))
 	  && sym->attr.flavor != FL_PROCEDURE)
 	{
-	  sym->as->type = AS_ASSUMED_SHAPE;
-	  for (i = 0; i < sym->as->rank; i++)
-	    sym->as->lower[i] = gfc_get_int_expr (gfc_default_integer_kind,
-						  NULL, 1);
+	  as->type = AS_ASSUMED_SHAPE;
+	  for (i = 0; i < as->rank; i++)
+	    as->lower[i] = gfc_get_int_expr (gfc_default_integer_kind, NULL, 1);
 	}
 
-      if ((sym->as && sym->as->rank > 0 && sym->as->type == AS_ASSUMED_SHAPE)
+      if ((as && as->rank > 0 && as->type == AS_ASSUMED_SHAPE)
+	  || (as && as->type == AS_ASSUMED_RANK)
 	  || sym->attr.pointer || sym->attr.allocatable || sym->attr.target
+	  || (sym->ts.type == BT_CLASS && sym->attr.class_ok
+	      && (CLASS_DATA (sym)->attr.class_pointer
+		  || CLASS_DATA (sym)->attr.allocatable
+		  || CLASS_DATA (sym)->attr.target))
 	  || sym->attr.optional)
 	{
 	  proc->attr.always_explicit = 1;
@@ -1600,7 +1613,7 @@ resolve_actual_arglist (gfc_actual_arglist *arg, procedure_type ptype,
   gfc_expr *e;
   int save_need_full_assumed_size;
 
-  assumed_type_expr_allowed = true;
+  assumed_rank_type_expr_allowed = true;
 
   for (; arg; arg = arg->next)
     {
@@ -1833,8 +1846,18 @@ resolve_actual_arglist (gfc_actual_arglist *arg, procedure_type ptype,
 		     "component", &e->where);
           return FAILURE;
         }
+
+      /* TS29113, C407b and C535b: Assumed-type and assumed-rank are only
+	 allowed for the first argument.
+	 Cf. http://j3-fortran.org/pipermail/j3/2012-June/005419.html
+	 FIXME: It doesn't work reliably as inquiry_argument is not set
+	 for all inquiry functions in resolve_function; the reason is that
+	 the function-name resolution happens too late in that function.  */
+      if (inquiry_argument)
+	assumed_rank_type_expr_allowed = false;
+
     }
-  assumed_type_expr_allowed = false;
+  assumed_rank_type_expr_allowed = false;
 
   return SUCCESS;
 }
@@ -1896,7 +1919,7 @@ resolve_elemental_actual (gfc_expr *expr, gfc_code *c)
   /* The rank of an elemental is the rank of its array argument(s).  */
   for (arg = arg0; arg; arg = arg->next)
     {
-      if (arg->expr != NULL && arg->expr->rank > 0)
+      if (arg->expr != NULL && arg->expr->rank != 0)
 	{
 	  rank = arg->expr->rank;
 	  if (arg->expr->expr_type == EXPR_VARIABLE
@@ -2195,6 +2218,15 @@ resolve_global_procedure (gfc_symbol *sym, locus *where,
 			   sym->name, &sym->declared_at, arg->sym->name);
 		break;
 	      }
+	    /* TS 29113, 6.2.  */
+	    else if (arg->sym && arg->sym->as
+		     && arg->sym->as->type == AS_ASSUMED_RANK)
+	      {
+		gfc_error ("Procedure '%s' at %L with assumed-rank dummy "
+			   "argument '%s' must have an explicit interface",
+			   sym->name, &sym->declared_at, arg->sym->name);
+		break;
+	      }
 	    /* F2008, 12.4.2.2 (2c)  */
 	    else if (arg->sym->attr.codimension)
 	      {
@@ -2220,6 +2252,15 @@ resolve_global_procedure (gfc_symbol *sym, locus *where,
 			   sym->name, &sym->declared_at, arg->sym->name);
 		break;
 	      }
+	    /* As assumed-type is unlimited polymorphic (cf. above).
+	       See also  TS 29113, Note 6.1.  */
+	    else if (arg->sym->ts.type == BT_ASSUMED)
+	      {
+		gfc_error ("Procedure '%s' at %L with assumed-type dummy "
+			   "argument '%s' must have an explicit interface",
+			   sym->name, &sym->declared_at, arg->sym->name);
+		break;
+	      }
 	}
 
       if (def_sym->attr.function)
@@ -4965,7 +5006,7 @@ expression_shape (gfc_expr *e)
   mpz_t array[GFC_MAX_DIMENSIONS];
   int i;
 
-  if (e->rank == 0 || e->shape != NULL)
+  if (e->rank <= 0 || e->shape != NULL)
     return;
 
   for (i = 0; i < e->rank; i++)
@@ -5068,13 +5109,26 @@ resolve_variable (gfc_expr *e)
   sym = e->symtree->n.sym;
 
   /* TS 29113, 407b.  */
-  if (e->ts.type == BT_ASSUMED && !assumed_type_expr_allowed)
+  if (e->ts.type == BT_ASSUMED && !assumed_rank_type_expr_allowed)
     {
       gfc_error ("Invalid expression with assumed-type variable %s at %L",
 		 sym->name, &e->where);
       return FAILURE;
     }
 
+  /* TS 29113, C535b.  */
+  if (((sym->ts.type == BT_CLASS && sym->attr.class_ok
+	&& CLASS_DATA (sym)->as
+	&& CLASS_DATA (sym)->as->type == AS_ASSUMED_RANK)
+       || (sym->ts.type != BT_CLASS && sym->as
+	   && sym->as->type == AS_ASSUMED_RANK))
+      && !assumed_rank_type_expr_allowed)
+    {
+      gfc_error ("Assumed-rank variable %s at %L may only be used as actual "
+		 "argument", sym->name, &e->where);
+      return FAILURE;
+    }
+
   /* TS 29113, 407b.  */
   if (e->ts.type == BT_ASSUMED && e->ref
       && !(e->ref->type == REF_ARRAY && e->ref->u.ar.type == AR_FULL
@@ -5085,6 +5139,22 @@ resolve_variable (gfc_expr *e)
       return FAILURE;
     }
 
+  /* TS 29113, C535b.  */
+  if (((sym->ts.type == BT_CLASS && sym->attr.class_ok
+	&& CLASS_DATA (sym)->as
+	&& CLASS_DATA (sym)->as->type == AS_ASSUMED_RANK)
+       || (sym->ts.type != BT_CLASS && sym->as
+	   && sym->as->type == AS_ASSUMED_RANK))
+      && e->ref
+      && !(e->ref->type == REF_ARRAY && e->ref->u.ar.type == AR_FULL
+           && e->ref->next == NULL))
+    {
+      gfc_error ("Assumed-rank variable %s at %L shall not have a subobject "
+		 "reference", sym->name, &e->ref->u.ar.where);
+      return FAILURE;
+    }
+
+
   /* If this is an associate-name, it may be parsed with an array reference
      in error even though the target is scalar.  Fail directly in this case.
      TODO Understand why class scalar expressions must be excluded.  */
@@ -5585,7 +5655,7 @@ update_ppc_arglist (gfc_expr* e)
     return FAILURE;
 
   /* F08:R739.  */
-  if (po->rank > 0)
+  if (po->rank != 0)
     {
       gfc_error ("Passed-object at %L must be scalar", &e->where);
       return FAILURE;
@@ -5633,7 +5703,7 @@ check_typebound_baseobject (gfc_expr* e)
 
   /* F08:C1230. If the procedure called is NOPASS,
      the base object must be scalar.  */
-  if (e->value.compcall.tbp->nopass && base->rank > 0)
+  if (e->value.compcall.tbp->nopass && base->rank != 0)
     {
       gfc_error ("Base object for NOPASS type-bound procedure call at %L must"
 		 " be scalar", &e->where);
@@ -6295,15 +6365,20 @@ gfc_try
 gfc_resolve_expr (gfc_expr *e)
 {
   gfc_try t;
-  bool inquiry_save;
+  bool inquiry_save, assumed_rank_type_save;
 
   if (e == NULL)
     return SUCCESS;
 
   /* inquiry_argument only applies to variables.  */
   inquiry_save = inquiry_argument;
+  assumed_rank_type_save = assumed_rank_type_expr_allowed;
+
   if (e->expr_type != EXPR_VARIABLE)
-    inquiry_argument = false;
+    {
+      inquiry_argument = false;
+      assumed_rank_type_expr_allowed = false;
+    }
 
   switch (e->expr_type)
     {
@@ -6393,6 +6468,7 @@ gfc_resolve_expr (gfc_expr *e)
     fixup_charlen (e);
 
   inquiry_argument = inquiry_save;
+  assumed_rank_type_expr_allowed = assumed_rank_type_save;
 
   return t;
 }
@@ -10320,10 +10396,10 @@ resolve_fl_var_and_proc (gfc_symbol *sym, int mp_flag)
 
       if (allocatable)
 	{
-	  if (dimension)
+	  if (dimension && as->type != AS_ASSUMED_RANK)
 	    {
-	      gfc_error ("Allocatable array '%s' at %L must have "
-			 "a deferred shape", sym->name, &sym->declared_at);
+	      gfc_error ("Allocatable array '%s' at %L must have a deferred "
+			 "shape or assumed rank", sym->name, &sym->declared_at);
 	      return FAILURE;
 	    }
 	  else if (gfc_notify_std (GFC_STD_F2003, "Scalar object '%s' at %L "
@@ -10332,10 +10408,10 @@ resolve_fl_var_and_proc (gfc_symbol *sym, int mp_flag)
 	    return FAILURE;
 	}
 
-      if (pointer && dimension)
+      if (pointer && dimension && as->type != AS_ASSUMED_RANK)
 	{
-	  gfc_error ("Array pointer '%s' at %L must have a deferred shape",
-		     sym->name, &sym->declared_at);
+	  gfc_error ("Array pointer '%s' at %L must have a deferred shape or "
+		     "deferred rank", sym->name, &sym->declared_at);
 	  return FAILURE;
 	}
     }
@@ -10949,7 +11025,7 @@ gfc_resolve_finalizers (gfc_symbol* derived)
 	}
 
       /* Warn if the procedure is non-scalar and not assumed shape.  */
-      if (gfc_option.warn_surprising && arg->as && arg->as->rank > 0
+      if (gfc_option.warn_surprising && arg->as && arg->as->rank != 0
 	  && arg->as->type != AS_ASSUMED_SHAPE)
 	gfc_warning ("Non-scalar FINAL procedure at %L should have assumed"
 		     " shape argument", &arg->declared_at);
@@ -11478,7 +11554,7 @@ resolve_typebound_procedure (gfc_symtree* stree)
 	}
   
       gcc_assert (me_arg->ts.type == BT_CLASS);
-      if (CLASS_DATA (me_arg)->as && CLASS_DATA (me_arg)->as->rank > 0)
+      if (CLASS_DATA (me_arg)->as && CLASS_DATA (me_arg)->as->rank != 0)
 	{
 	  gfc_error ("Passed-object dummy argument of '%s' at %L must be"
 		     " scalar", proc->name, &where);
@@ -12492,6 +12568,20 @@ resolve_symbol (gfc_symbol *sym)
 		       &sym->declared_at);
 	  return;
 	}
+      /* TS 29113, C535a.  */
+      if (as->type == AS_ASSUMED_RANK && !sym->attr.dummy)
+	{
+	  gfc_error ("Assumed-rank array at %L must be a dummy argument",
+		     &sym->declared_at);
+	  return;
+	}
+      if (as->type == AS_ASSUMED_RANK
+	  && (sym->attr.codimension || sym->attr.value))
+	{
+	  gfc_error ("Assumed-rank array at %L may not have the VALUE or "
+		     "CODIMENSION attribute", &sym->declared_at);
+	  return;
+	}
     }
 
   /* Make sure symbols with known intent or optional are really dummy
@@ -12564,6 +12654,13 @@ resolve_symbol (gfc_symbol *sym)
 		     sym->name, &sym->declared_at);
 	  return;
 	}
+      if (sym->attr.intent == INTENT_OUT)
+    	{
+	  gfc_error ("Assumed-type variable %s at %L may not have the "
+		     "INTENT(OUT) attribute",
+		     sym->name, &sym->declared_at);
+	  return;
+	}
       if (sym->attr.dimension && sym->as->type == AS_EXPLICIT)
 	{
 	  gfc_error ("Assumed-type variable %s at %L shall not be an "
diff --git a/gcc/fortran/simplify.c b/gcc/fortran/simplify.c
index c7145d6..afc4bc4 100644
--- a/gcc/fortran/simplify.c
+++ b/gcc/fortran/simplify.c
@@ -2935,7 +2935,6 @@ gfc_simplify_iparity (gfc_expr *array, gfc_expr *dim, gfc_expr *mask)
 }
 
 
-
 gfc_expr *
 gfc_simplify_is_iostat_end (gfc_expr *x)
 {
@@ -3381,7 +3380,8 @@ simplify_bound (gfc_expr *array, gfc_expr *dim, gfc_expr *kind, int upper)
 
  done:
 
-  if (as && (as->type == AS_DEFERRED || as->type == AS_ASSUMED_SHAPE))
+  if (as && (as->type == AS_DEFERRED || as->type == AS_ASSUMED_SHAPE
+	     || as->type == AS_ASSUMED_RANK))
     return NULL;
 
   if (dim == NULL)
@@ -3443,13 +3443,16 @@ simplify_bound (gfc_expr *array, gfc_expr *dim, gfc_expr *kind, int upper)
 
       d = mpz_get_si (dim->value.integer);
 
-      if (d < 1 || d > array->rank
+      if ((d < 1 || d > array->rank)
 	  || (d == array->rank && as && as->type == AS_ASSUMED_SIZE && upper))
 	{
 	  gfc_error ("DIM argument at %L is out of bounds", &dim->where);
 	  return &gfc_bad_expr;
 	}
 
+      if (as && as->type == AS_ASSUMED_RANK)
+	return NULL;
+
       return simplify_bound_dim (array, kind, d, upper, as, ref, false);
     }
 }
@@ -4780,6 +4783,10 @@ gfc_simplify_range (gfc_expr *e)
 gfc_expr *
 gfc_simplify_rank (gfc_expr *e)
 {
+  /* Assumed rank.  */
+  if (e->rank == -1)
+    return NULL;
+
   return gfc_get_int_expr (gfc_default_integer_kind, &e->where, e->rank);
 }
 
diff --git a/gcc/fortran/trans-array.c b/gcc/fortran/trans-array.c
index d289ac3..ba108dc 100644
--- a/gcc/fortran/trans-array.c
+++ b/gcc/fortran/trans-array.c
@@ -81,7 +81,7 @@ along with GCC; see the file COPYING3.  If not see
 #include "system.h"
 #include "coretypes.h"
 #include "tree.h"
-#include "gimple.h"
+#include "gimple.h"		/* For create_tmp_var_name.  */
 #include "diagnostic-core.h"	/* For internal_error/fatal_error.  */
 #include "flags.h"
 #include "gfortran.h"
@@ -247,12 +247,11 @@ gfc_conv_descriptor_dtype (tree desc)
 			  desc, field, NULL_TREE);
 }
 
-static tree
-gfc_conv_descriptor_dimension (tree desc, tree dim)
+
+tree
+gfc_get_descriptor_dimension (tree desc)
 {
-  tree field;
-  tree type;
-  tree tmp;
+  tree type, field;
 
   type = TREE_TYPE (desc);
   gcc_assert (GFC_DESCRIPTOR_TYPE_P (type));
@@ -262,10 +261,19 @@ gfc_conv_descriptor_dimension (tree desc, tree dim)
 	  && TREE_CODE (TREE_TYPE (field)) == ARRAY_TYPE
 	  && TREE_CODE (TREE_TYPE (TREE_TYPE (field))) == RECORD_TYPE);
 
-  tmp = fold_build3_loc (input_location, COMPONENT_REF, TREE_TYPE (field),
-			 desc, field, NULL_TREE);
-  tmp = gfc_build_array_ref (tmp, dim, NULL);
-  return tmp;
+  return fold_build3_loc (input_location, COMPONENT_REF, TREE_TYPE (field),
+			  desc, field, NULL_TREE);
+}
+
+
+static tree
+gfc_conv_descriptor_dimension (tree desc, tree dim)
+{
+  tree tmp;
+
+  tmp = gfc_get_descriptor_dimension (desc);
+
+  return gfc_build_array_ref (tmp, dim, NULL);
 }
 
 
@@ -311,6 +319,7 @@ gfc_conv_descriptor_stride_get (tree desc, tree dim)
   if (integer_zerop (dim)
       && (GFC_TYPE_ARRAY_AKIND (type) == GFC_ARRAY_ALLOCATABLE
 	  ||GFC_TYPE_ARRAY_AKIND (type) == GFC_ARRAY_ASSUMED_SHAPE_CONT
+	  ||GFC_TYPE_ARRAY_AKIND (type) == GFC_ARRAY_ASSUMED_RANK_CONT
 	  ||GFC_TYPE_ARRAY_AKIND (type) == GFC_ARRAY_POINTER_CONT))
     return gfc_index_one_node;
 
@@ -6900,9 +6909,10 @@ gfc_conv_array_parameter (gfc_se * se, gfc_expr * expr, gfc_ss * ss, bool g77,
 	}
 
       if (!sym->attr.pointer
-	    && sym->as
-	    && sym->as->type != AS_ASSUMED_SHAPE 
-            && !sym->attr.allocatable)
+	  && sym->as
+	  && sym->as->type != AS_ASSUMED_SHAPE 
+	  && sym->as->type != AS_ASSUMED_RANK 
+	  && !sym->attr.allocatable)
         {
 	  /* Some variables are declared directly, others are declared as
 	     pointers and allocated on the heap.  */
@@ -6938,10 +6948,12 @@ gfc_conv_array_parameter (gfc_se * se, gfc_expr * expr, gfc_ss * ss, bool g77,
   no_pack = ((sym && sym->as
 		  && !sym->attr.pointer
 		  && sym->as->type != AS_DEFERRED
+		  && sym->as->type != AS_ASSUMED_RANK
 		  && sym->as->type != AS_ASSUMED_SHAPE)
 		      ||
 	     (ref && ref->u.ar.as
 		  && ref->u.ar.as->type != AS_DEFERRED
+		  && ref->u.ar.as->type != AS_ASSUMED_RANK
 		  && ref->u.ar.as->type != AS_ASSUMED_SHAPE)
 		      ||
 	     gfc_is_simply_contiguous (expr, false));
diff --git a/gcc/fortran/trans-array.h b/gcc/fortran/trans-array.h
index 9bafb94..b7ab806 100644
--- a/gcc/fortran/trans-array.h
+++ b/gcc/fortran/trans-array.h
@@ -154,6 +154,7 @@ tree gfc_conv_descriptor_data_get (tree);
 tree gfc_conv_descriptor_data_addr (tree);
 tree gfc_conv_descriptor_offset_get (tree);
 tree gfc_conv_descriptor_dtype (tree);
+tree gfc_get_descriptor_dimension (tree);
 tree gfc_conv_descriptor_stride_get (tree, tree);
 tree gfc_conv_descriptor_lbound_get (tree, tree);
 tree gfc_conv_descriptor_ubound_get (tree, tree);
diff --git a/gcc/fortran/trans-decl.c b/gcc/fortran/trans-decl.c
index 75a2160..f1b7444 100644
--- a/gcc/fortran/trans-decl.c
+++ b/gcc/fortran/trans-decl.c
@@ -933,7 +933,8 @@ gfc_build_dummy_array_decl (gfc_symbol * sym, tree dummy)
   int n;
   bool known_size;
 
-  if (sym->attr.pointer || sym->attr.allocatable)
+  if (sym->attr.pointer || sym->attr.allocatable
+      || (sym->as && sym->as->type == AS_ASSUMED_RANK))
     return dummy;
 
   /* Add to list of variables if not a fake result variable.  */
@@ -3669,6 +3670,7 @@ gfc_trans_deferred_vars (gfc_symbol * proc_sym, gfc_wrapped_block * block)
 	      gfc_trans_dummy_array_bias (sym, sym->backend_decl, block);
 	      break;
 
+	    case AS_ASSUMED_RANK:
 	    case AS_DEFERRED:
 	      seen_trans_deferred_array = true;
 	      gfc_trans_deferred_array (sym, block);
@@ -4782,7 +4784,8 @@ add_argument_checking (stmtblock_t *block, gfc_symbol *sym)
 	   dummy argument is an array. (See "Sequence association" in
 	   Section 12.4.1.4 for F95 and 12.4.1.5 for F2003.)  */
 	if (fsym->attr.pointer || fsym->attr.allocatable
-	    || (fsym->as && fsym->as->type == AS_ASSUMED_SHAPE))
+	    || (fsym->as && (fsym->as->type == AS_ASSUMED_SHAPE
+			     || fsym->as->type == AS_ASSUMED_RANK)))
 	  {
 	    comparison = NE_EXPR;
 	    message = _("Actual string length does not match the declared one"
diff --git a/gcc/fortran/trans-expr.c b/gcc/fortran/trans-expr.c
index 34e0f69..7ec40b1 100644
--- a/gcc/fortran/trans-expr.c
+++ b/gcc/fortran/trans-expr.c
@@ -42,6 +42,48 @@ along with GCC; see the file COPYING3.  If not see
 #include "dependency.h"
 
 
+/* Convert a scalar to an array descriptor. To be used for assumed-rank
+   arrays.  */
+
+static tree
+get_scalar_to_descriptor_type (tree scalar, symbol_attribute attr)
+{
+  enum gfc_array_kind akind;
+
+  if (attr.pointer)
+    akind = GFC_ARRAY_POINTER_CONT;
+  else if (attr.allocatable)
+    akind = GFC_ARRAY_ALLOCATABLE;
+  else
+    akind = GFC_ARRAY_ASSUMED_SHAPE_CONT;
+
+  return gfc_get_array_type_bounds (TREE_TYPE (scalar), 0, 0, NULL, NULL, 1,
+				    akind, !(attr.pointer || attr.target));
+}
+
+static tree
+conv_scalar_to_descriptor (gfc_se *se, tree scalar, symbol_attribute attr)
+{
+  tree desc, type;  
+
+  type = get_scalar_to_descriptor_type (scalar, attr);
+  desc = gfc_create_var (type, "desc");
+  DECL_ARTIFICIAL (desc) = 1;
+  gfc_add_modify (&se->pre, gfc_conv_descriptor_dtype (desc),
+		  gfc_get_dtype (type));
+  gfc_conv_descriptor_data_set (&se->pre, desc, scalar);
+
+  /* Copy pointer address back - but only if it could have changed and
+     if the actual argument is a pointer and not, e.g., NULL().  */
+  if ((attr.pointer || attr.allocatable)
+       && attr.intent != INTENT_IN && POINTER_TYPE_P (TREE_TYPE (scalar)))
+    gfc_add_modify (&se->post, scalar,
+		    fold_convert (TREE_TYPE (scalar),
+				  gfc_conv_descriptor_data_get (desc)));
+  return desc;
+}
+
+
 /* This is the seed for an eventual trans-class.c
 
    The following parameters should not be used directly since they might
@@ -158,7 +200,34 @@ gfc_get_vptr_from_expr (tree expr)
   tmp = gfc_class_vptr_get (tmp);
   return tmp;
 }
- 
+
+
+static void
+class_array_data_assign (stmtblock_t *block, tree lhs_desc, tree rhs_desc,
+			 bool lhs_type)
+{
+  tree tmp, tmp2, type;
+
+  gfc_conv_descriptor_data_set (block, lhs_desc,
+				gfc_conv_descriptor_data_get (rhs_desc));
+  gfc_conv_descriptor_offset_set (block, lhs_desc,
+				  gfc_conv_descriptor_offset_get (rhs_desc));
+
+  gfc_add_modify (block, gfc_conv_descriptor_dtype (lhs_desc),
+		  gfc_conv_descriptor_dtype (rhs_desc));
+
+  /* Assign the dimension as range-ref.  */
+  tmp = gfc_get_descriptor_dimension (lhs_desc);
+  tmp2 = gfc_get_descriptor_dimension (rhs_desc);
+
+  type = lhs_type ? TREE_TYPE (tmp) : TREE_TYPE (tmp2);
+  tmp = build4_loc (input_location, ARRAY_RANGE_REF, type, tmp,
+		    gfc_index_zero_node, NULL_TREE, NULL_TREE);
+  tmp2 = build4_loc (input_location, ARRAY_RANGE_REF, type, tmp2,
+		     gfc_index_zero_node, NULL_TREE, NULL_TREE);
+  gfc_add_modify (block, tmp, tmp2);
+}
+
 
 /* Takes a derived type expression and returns the address of a temporary
    class object of the 'declared' type.  If vptr is not NULL, this is
@@ -215,14 +284,33 @@ gfc_conv_derived_to_class (gfc_se *parmse, gfc_expr *e,
 	{
 	  parmse->ss = NULL;
 	  gfc_conv_expr_reference (parmse, e);
-	  tmp = fold_convert (TREE_TYPE (ctree), parmse->expr);
-	  gfc_add_modify (&parmse->pre, ctree, tmp);
+
+	  /* Scalar to an assumed-rank array.  */
+	  if (class_ts.u.derived->components->as)
+	    {
+	      tree type;
+	      type = get_scalar_to_descriptor_type (parmse->expr,
+						    gfc_expr_attr (e));
+	      gfc_add_modify (&parmse->pre, gfc_conv_descriptor_dtype (ctree),
+			      gfc_get_dtype (type));
+	      gfc_conv_descriptor_data_set (&parmse->pre, ctree, parmse->expr);
+	    }
+          else
+	    {
+	      tmp = fold_convert (TREE_TYPE (ctree), parmse->expr);
+	      gfc_add_modify (&parmse->pre, ctree, tmp);
+	    }
 	}
       else
 	{
 	  parmse->ss = ss;
 	  gfc_conv_expr_descriptor (parmse, e, ss);
-	  gfc_add_modify (&parmse->pre, ctree, parmse->expr);
+
+	  if (e->rank != class_ts.u.derived->components->as->rank)
+	    class_array_data_assign (&parmse->pre, ctree, parmse->expr,
+				     TREE_TYPE (parmse->expr));
+	  else
+	    gfc_add_modify (&parmse->pre, ctree, parmse->expr);
 	}
     }
 
@@ -260,7 +348,9 @@ gfc_conv_class_to_class (gfc_se *parmse, gfc_expr *e,
 	break;
     }
 
-  if (ref == NULL || class_ref == ref)
+  if ((ref == NULL || class_ref == ref)
+      && (!class_ts.u.derived->components->as
+	  || class_ts.u.derived->components->as->rank != -1))
     return;
 
   /* Test for FULL_ARRAY.  */
@@ -273,13 +363,42 @@ gfc_conv_class_to_class (gfc_se *parmse, gfc_expr *e,
 
   /* Set the data.  */
   ctree = gfc_class_data_get (var);
-  gfc_add_modify (&parmse->pre, ctree, parmse->expr);
+  if (class_ts.u.derived->components->as
+      && e->rank != class_ts.u.derived->components->as->rank)
+    {
+      if (e->rank == 0)
+	{
+	  tree type = get_scalar_to_descriptor_type (parmse->expr,
+						     gfc_expr_attr (e));
+	  gfc_add_modify (&parmse->pre, gfc_conv_descriptor_dtype (ctree),
+			  gfc_get_dtype (type));
+	  gfc_conv_descriptor_data_set (&parmse->pre, ctree,
+					gfc_class_data_get (parmse->expr));
+
+	}
+      else
+	class_array_data_assign (&parmse->pre, ctree, parmse->expr, false);
+    }
+  else
+    gfc_add_modify (&parmse->pre, ctree, parmse->expr);
 
   /* Return the data component, except in the case of scalarized array
      references, where nullification of the cannot occur and so there
      is no need.  */
   if (!elemental && full_array)
-    gfc_add_modify (&parmse->post, parmse->expr, ctree);
+    {
+      if (class_ts.u.derived->components->as
+	  && e->rank != class_ts.u.derived->components->as->rank)
+	{
+	  if (e->rank == 0)
+	    gfc_add_modify (&parmse->post, gfc_class_data_get (parmse->expr),
+			    gfc_conv_descriptor_data_get (ctree));
+	  else
+	    class_array_data_assign (&parmse->post, parmse->expr, ctree, true);
+	}
+      else
+	gfc_add_modify (&parmse->post, parmse->expr, ctree);
+    }
 
   /* Set the vptr.  */
   ctree = gfc_class_vptr_get (var);
@@ -730,7 +849,8 @@ gfc_conv_expr_present (gfc_symbol * sym)
      as actual argument to denote absent dummies. For array descriptors,
      we thus also need to check the array descriptor.  */
   if (!sym->attr.pointer && !sym->attr.allocatable
-      && sym->as && sym->as->type == AS_ASSUMED_SHAPE
+      && sym->as && (sym->as->type == AS_ASSUMED_SHAPE
+		     || sym->as->type == AS_ASSUMED_RANK)
       && (gfc_option.allow_std & GFC_STD_F2008) != 0)
     {
       tree tmp;
@@ -1325,7 +1445,8 @@ gfc_conv_variable (gfc_se * se, gfc_expr * expr)
 	  /* Dereference non-character pointer variables. 
 	     These must be dummies, results, or scalars.  */
 	  if ((sym->attr.pointer || sym->attr.allocatable
-	       || gfc_is_associate_pointer (sym))
+	       || gfc_is_associate_pointer (sym)
+	       || (sym->as && sym->as->type == AS_ASSUMED_RANK))
 	      && (sym->attr.dummy
 		  || sym->attr.function
 		  || sym->attr.result
@@ -3620,10 +3741,15 @@ gfc_conv_procedure_call (gfc_se * se, gfc_symbol * sym,
 		parmse.string_length = build_int_cst (gfc_charlen_type_node, 0);
 	    }
 	}
-      else if (arg->expr->expr_type == EXPR_NULL && fsym && !fsym->attr.pointer)
+      else if (arg->expr->expr_type == EXPR_NULL
+	       && fsym && !fsym->attr.pointer
+	       && (fsym->ts.type != BT_CLASS
+		   || !CLASS_DATA (fsym)->attr.class_pointer))
 	{
 	  /* Pass a NULL pointer to denote an absent arg.  */
-	  gcc_assert (fsym->attr.optional && !fsym->attr.allocatable);
+	  gcc_assert (fsym->attr.optional && !fsym->attr.allocatable
+		      && (fsym->ts.type != BT_CLASS
+			  || !CLASS_DATA (fsym)->attr.allocatable));
 	  gfc_init_se (&parmse, NULL);
 	  parmse.expr = null_pointer_node;
 	  if (arg->missing_arg_type == BT_CHARACTER)
@@ -3764,7 +3890,9 @@ gfc_conv_procedure_call (gfc_se * se, gfc_symbol * sym,
 		     class object, if the formal argument is a class object.  */
 		  if (fsym && fsym->ts.type == BT_CLASS
 			&& e->ts.type == BT_CLASS
-			&& CLASS_DATA (e)->attr.dimension)
+			&& ((CLASS_DATA (fsym)->as
+			     && CLASS_DATA (fsym)->as->type == AS_ASSUMED_RANK)
+			    || CLASS_DATA (e)->attr.dimension))
 		    gfc_conv_class_to_class (&parmse, e, fsym->ts, false);
 
 		  if (fsym && (fsym->ts.type == BT_DERIVED
@@ -3808,7 +3936,23 @@ gfc_conv_procedure_call (gfc_se * se, gfc_symbol * sym,
 		      gfc_add_expr_to_block (&se->pre, tmp);
 		    }
 
-		  if (fsym && e->expr_type != EXPR_NULL
+		  /* Wrap scalar variable in a descriptor. We need to convert
+		     the address of a pointer back to the pointer itself before,
+		     we can assign it to the data field.  */
+		     
+		  if (fsym && fsym->as && fsym->as->type == AS_ASSUMED_RANK
+		      && fsym->ts.type != BT_CLASS && e->expr_type != EXPR_NULL)
+		    {
+		      tmp = parmse.expr;
+		      if (TREE_CODE (tmp) == ADDR_EXPR
+			  && POINTER_TYPE_P (TREE_TYPE (TREE_OPERAND (tmp, 0))))
+			tmp = TREE_OPERAND (tmp, 0);
+		      parmse.expr = conv_scalar_to_descriptor (se, tmp,
+							       fsym->attr);
+		      parmse.expr = gfc_build_addr_expr (NULL_TREE,
+							 parmse.expr);
+		    }
+		  else if (fsym && e->expr_type != EXPR_NULL
 		      && ((fsym->attr.pointer
 			   && fsym->attr.flavor != FL_PROCEDURE)
 			  || (fsym->attr.proc_pointer
@@ -3850,7 +3994,8 @@ gfc_conv_procedure_call (gfc_se * se, gfc_symbol * sym,
 	      bool f;
 	      f = (fsym != NULL)
 		  && !(fsym->attr.pointer || fsym->attr.allocatable)
-		  && fsym->as && fsym->as->type != AS_ASSUMED_SHAPE;
+		  && fsym->as && fsym->as->type != AS_ASSUMED_SHAPE
+		  && fsym->as->type != AS_ASSUMED_RANK;
 	      if (comp)
 		f = f || !comp->attr.always_explicit;
 	      else
@@ -3959,12 +4104,13 @@ gfc_conv_procedure_call (gfc_se * se, gfc_symbol * sym,
 	     but do not always set fsym.  */
 	  if (e->expr_type == EXPR_VARIABLE
 	      && e->symtree->n.sym->attr.optional
-	      && ((e->rank > 0 && sym->attr.elemental)
+	      && ((e->rank != 0 && sym->attr.elemental)
 		  || e->representation.length || e->ts.type == BT_CHARACTER
-		  || (e->rank > 0
+		  || (e->rank != 0
 		      && (fsym == NULL 
 			  || (fsym-> as
 			      && (fsym->as->type == AS_ASSUMED_SHAPE
+				  || fsym->as->type == AS_ASSUMED_RANK
 			      	  || fsym->as->type == AS_DEFERRED))))))
 	    gfc_conv_missing_dummy (&parmse, e, fsym ? fsym->ts : e->ts,
 				    e->representation.length);
@@ -4210,7 +4356,9 @@ gfc_conv_procedure_call (gfc_se * se, gfc_symbol * sym,
 	      tmp = caf_decl;
 	    }
 
-          if (fsym->as->type == AS_ASSUMED_SHAPE)
+          if (fsym->as->type == AS_ASSUMED_SHAPE
+	      || (fsym->as->type == AS_ASSUMED_RANK && !fsym->attr.pointer
+		  && !fsym->attr.allocatable))
 	    {
 	      gcc_assert (POINTER_TYPE_P (TREE_TYPE (parmse.expr)));
 	      gcc_assert (GFC_DESCRIPTOR_TYPE_P (TREE_TYPE
diff --git a/gcc/fortran/trans-intrinsic.c b/gcc/fortran/trans-intrinsic.c
index e4905ff..be94219 100644
--- a/gcc/fortran/trans-intrinsic.c
+++ b/gcc/fortran/trans-intrinsic.c
@@ -1315,29 +1315,37 @@ trans_num_images (gfc_se * se)
 }
 
 
+static tree
+get_rank_from_desc (tree desc)
+{
+  tree tmp;
+  tree dtype;
+
+  dtype = gfc_conv_descriptor_dtype (desc);
+  tmp = build_int_cst (TREE_TYPE (dtype), GFC_DTYPE_RANK_MASK);
+  tmp = fold_build2_loc (input_location, BIT_AND_EXPR, TREE_TYPE (dtype),
+			 dtype, tmp);
+  return fold_convert (gfc_get_int_type (gfc_default_integer_kind), tmp);
+}
+
+
 static void
 gfc_conv_intrinsic_rank (gfc_se *se, gfc_expr *expr)
 {
   gfc_se argse;
   gfc_ss *ss;
-  tree dtype, tmp;
 
   ss = gfc_walk_expr (expr->value.function.actual->expr);
   gcc_assert (ss != gfc_ss_terminator);
   gfc_init_se (&argse, NULL);
   argse.data_not_needed = 1;
-  argse.want_pointer = 1;
+  argse.descriptor_only = 1;
 
   gfc_conv_expr_descriptor (&argse, expr->value.function.actual->expr, ss);
   gfc_add_block_to_block (&se->pre, &argse.pre);
   gfc_add_block_to_block (&se->post, &argse.post);
-  argse.expr = build_fold_indirect_ref_loc (input_location, argse.expr);
-  argse.expr = build_fold_indirect_ref_loc (input_location, argse.expr);
-  dtype = gfc_conv_descriptor_dtype (argse.expr);
-  tmp = build_int_cst (TREE_TYPE (dtype), GFC_DTYPE_RANK_MASK);
-  tmp = fold_build2_loc (input_location, BIT_AND_EXPR, TREE_TYPE (dtype),
-			 dtype, tmp);
-  se->expr = fold_convert (gfc_get_int_type (gfc_default_integer_kind), tmp);
+
+  se->expr = get_rank_from_desc (argse.expr);
 }
 
 
@@ -5855,8 +5863,15 @@ gfc_conv_associated (gfc_se *se, gfc_expr *expr)
 	     present.  */
 	  arg1se.descriptor_only = 1;
 	  gfc_conv_expr_lhs (&arg1se, arg1->expr);
-	  tmp = gfc_conv_descriptor_stride_get (arg1se.expr,
-					    gfc_rank_cst[arg1->expr->rank - 1]);
+	  if (arg1->expr->rank == -1)
+	    {
+	      tmp = get_rank_from_desc (arg1se.expr);
+	      tmp = fold_build2_loc (input_location, MINUS_EXPR,
+				     TREE_TYPE (tmp), tmp, gfc_index_one_node);
+	    }
+	  else
+	    tmp = gfc_rank_cst[arg1->expr->rank - 1];
+	  tmp = gfc_conv_descriptor_stride_get (arg1se.expr, tmp);
 	  nonzero_arraylen = fold_build2_loc (input_location, NE_EXPR,
 					      boolean_type_node, tmp,
 					      build_int_cst (TREE_TYPE (tmp), 0));
diff --git a/gcc/fortran/trans-types.c b/gcc/fortran/trans-types.c
index aa50e3d..d96f5e6 100644
--- a/gcc/fortran/trans-types.c
+++ b/gcc/fortran/trans-types.c
@@ -80,8 +80,8 @@ bool gfc_real16_is_float128 = false;
 
 static GTY(()) tree gfc_desc_dim_type;
 static GTY(()) tree gfc_max_array_element_size;
-static GTY(()) tree gfc_array_descriptor_base[2 * GFC_MAX_DIMENSIONS];
-static GTY(()) tree gfc_array_descriptor_base_caf[2 * GFC_MAX_DIMENSIONS];
+static GTY(()) tree gfc_array_descriptor_base[2 * (GFC_MAX_DIMENSIONS+1)];
+static GTY(()) tree gfc_array_descriptor_base_caf[2 * (GFC_MAX_DIMENSIONS+1)];
 
 /* 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.  */
@@ -1277,7 +1277,8 @@ gfc_is_nodesc_array (gfc_symbol * sym)
     return 0;
 
   if (sym->attr.dummy)
-    return sym->as->type != AS_ASSUMED_SHAPE;
+    return sym->as->type != AS_ASSUMED_SHAPE
+	   && sym->as->type != AS_ASSUMED_RANK;
 
   if (sym->attr.result || sym->attr.function)
     return 0;
@@ -1299,6 +1300,13 @@ gfc_build_array_type (tree type, gfc_array_spec * as,
   tree ubound[GFC_MAX_DIMENSIONS];
   int n;
 
+  if (as->type == AS_ASSUMED_RANK)
+    for (n = 0; n < GFC_MAX_DIMENSIONS; n++)
+      {
+	lbound[n] = NULL_TREE;
+	ubound[n] = NULL_TREE;
+      }
+
   for (n = 0; n < as->rank; n++)
     {
       /* Create expressions for the known bounds of the array.  */
@@ -1323,7 +1331,12 @@ gfc_build_array_type (tree type, gfc_array_spec * as,
   if (as->type == AS_ASSUMED_SHAPE)
     akind = contiguous ? GFC_ARRAY_ASSUMED_SHAPE_CONT
 		       : GFC_ARRAY_ASSUMED_SHAPE;
-  return gfc_get_array_type_bounds (type, as->rank, as->corank, lbound,
+  else if (as->type == AS_ASSUMED_RANK)
+    akind = contiguous ? GFC_ARRAY_ASSUMED_RANK_CONT
+		       : GFC_ARRAY_ASSUMED_RANK;
+  return gfc_get_array_type_bounds (type, as->rank == -1
+					  ? GFC_MAX_DIMENSIONS : as->rank,
+				    as->corank, lbound,
 				    ubound, 0, akind, restricted);
 }
 
@@ -1682,9 +1695,15 @@ gfc_get_array_descriptor_base (int dimen, int codimen, bool restricted,
 {
   tree fat_type, decl, arraytype, *chain = NULL;
   char name[16 + 2*GFC_RANK_DIGITS + 1 + 1];
-  int idx = 2 * (codimen + dimen - 1) + restricted;
+  int idx;
+
+  /* Assumed-rank array.  */
+  if (dimen == -1)
+    dimen = GFC_MAX_DIMENSIONS;
+
+  idx = 2 * (codimen + dimen) + restricted;
 
-  gcc_assert (codimen + dimen >= 1 && codimen + dimen <= GFC_MAX_DIMENSIONS);
+  gcc_assert (codimen + dimen >= 0 && codimen + dimen <= GFC_MAX_DIMENSIONS);
 
   if (gfc_option.coarray == GFC_FCOARRAY_LIB && codimen)
     {
@@ -1721,16 +1740,18 @@ gfc_get_array_descriptor_base (int dimen, int codimen, bool restricted,
   TREE_NO_WARNING (decl) = 1;
 
   /* Build the array type for the stride and bound components.  */
-  arraytype =
-    build_array_type (gfc_get_desc_dim_type (),
-		      build_range_type (gfc_array_index_type,
-					gfc_index_zero_node,
-					gfc_rank_cst[codimen + dimen - 1]));
+  if (dimen + codimen > 0)
+    {
+      arraytype =
+	build_array_type (gfc_get_desc_dim_type (),
+			  build_range_type (gfc_array_index_type,
+					    gfc_index_zero_node,
+					    gfc_rank_cst[codimen + dimen - 1]));
 
-  decl = gfc_add_field_to_struct_1 (fat_type,
-				    get_identifier ("dim"),
-				    arraytype, &chain);
-  TREE_NO_WARNING (decl) = 1;
+      decl = gfc_add_field_to_struct_1 (fat_type, get_identifier ("dim"),
+					arraytype, &chain);
+      TREE_NO_WARNING (decl) = 1;
+    }
 
   if (gfc_option.coarray == GFC_FCOARRAY_LIB && codimen
       && akind == GFC_ARRAY_ALLOCATABLE)
diff --git a/gcc/fortran/trans.h b/gcc/fortran/trans.h
index 3b77281..d4092f7 100644
--- a/gcc/fortran/trans.h
+++ b/gcc/fortran/trans.h
@@ -765,6 +765,8 @@ enum gfc_array_kind
   GFC_ARRAY_UNKNOWN,
   GFC_ARRAY_ASSUMED_SHAPE,
   GFC_ARRAY_ASSUMED_SHAPE_CONT,
+  GFC_ARRAY_ASSUMED_RANK,
+  GFC_ARRAY_ASSUMED_RANK_CONT,
   GFC_ARRAY_ALLOCATABLE,
   GFC_ARRAY_POINTER,
   GFC_ARRAY_POINTER_CONT
--- /dev/null	2012-07-14 08:59:06.947592273 +0200
+++ gcc/gcc/testsuite/gfortran.dg/assumed_rank_1.f90	2012-07-13 16:36:03.000000000 +0200
@@ -0,0 +1,147 @@
+! { dg-do run }
+! { dg-additional-sources assumed_rank_1_c.c }
+!
+! PR fortran/48820
+!
+! Assumed-rank tests
+!
+! FIXME: The ubound/lbound checks have to be re-enabled when
+! after they are supported
+
+implicit none
+
+interface
+  subroutine check_value(b, n, val)
+    integer :: b(..)
+    integer, value :: n
+    integer :: val(n)
+  end subroutine
+end interface
+
+integer, target :: x(2:5,4:7), y(-4:4)
+integer, allocatable, target :: z(:,:,:,:)
+integer, allocatable :: val(:)
+integer :: i
+
+allocate(z(1:4, -2:5, 4, 10:11))
+
+if (rank(x) /= 2) call abort ()
+val = [(2*i+3, i = 1, size(x))]
+x = reshape (val, shape(x))
+call foo(x, rank(x), lbound(x), ubound(x), val)
+call foo2(x, rank(x), lbound(x), ubound(x), val)
+call bar(x,x,.true.)
+call bar(x,prsnt=.false.)
+
+if (rank(y) /= 1) call abort ()
+val = [(2*i+7, i = 1, size(y))]
+y = reshape (val, shape(y))
+call foo(y, rank(y), lbound(y), ubound(y), val)
+call foo2(y, rank(y), lbound(y), ubound(y), val)
+call bar(y,y,.true.)
+call bar(y,prsnt=.false.)
+
+if (rank(z) /= 4) call abort ()
+val = [(2*i+5, i = 1, size(z))]
+z(:,:,:,:) = reshape (val, shape(z))
+call foo(z, rank(z), lbound(z), ubound(z), val)
+call foo(z, rank(z), lbound(z), ubound(z), val)
+call foo2(z, rank(z), lbound(z), ubound(z), val)
+call bar(z,z,.true.)
+call bar(z,prsnt=.false.)
+
+contains
+  subroutine bar(a,b, prsnt)
+    integer, pointer, optional, intent(in) :: a(..),b(..)
+    logical, value :: prsnt
+    ! The following is not valid, but it goes past the constraint check
+    ! Technically, it could be allowed and might be in Fortran 2015:
+    if (.not. associated(a)) call abort()
+    if (present(b)) then
+      if (.not. associated(a,b)) call abort()
+    else
+      if (.not. associated(a)) call abort()
+    end if
+    if (.not. present(a)) call abort()
+    if (prsnt .neqv. present(b)) call abort()
+  end subroutine
+
+  ! POINTER argument - bounds as specified before
+  subroutine foo(a, rnk, low, high, val)
+    integer,pointer, intent(in) :: a(..)
+    integer, value :: rnk
+    integer, intent(in) :: low(:), high(:), val(:)
+    integer :: i
+
+
+
+    if (rank(a) /= rnk) call abort()
+    if (size(low) /= rnk .or. size(high) /= rnk) call abort()
+    if (size(a) /= product (high - low +1)) call abort()
+
+    if (rnk > 0) then
+      if (low(1) /= lbound(a,1)) call abort()
+      if (high(1) /= ubound(a,1)) call abort()
+      if (size (a,1) /= high(1)-low(1)+1) call abort()
+    end if
+
+    do i = 1, rnk
+      if (low(i) /= lbound(a,i)) call abort()
+      if (high(i) /= ubound(a,i)) call abort()
+      if (size (a,i) /= high(i)-low(i)+1) call abort()
+    end do
+    call check_value (a, rnk, val)
+    call foo2(a, rnk, low, high, val)
+  end subroutine
+
+  ! Non-pointer, non-allocatable bounds. lbound == 1
+  subroutine foo2(a, rnk, low, high, val)
+    integer, intent(in) :: a(..)
+    integer, value :: rnk
+    integer, intent(in) :: low(:), high(:), val(:)
+    integer :: i
+
+    if (rank(a) /= rnk) call abort()
+    if (size(low) /= rnk .or. size(high) /= rnk) call abort()
+    if (size(a) /= product (high - low +1)) call abort()
+
+    if (rnk > 0) then
+!      if (1 /= lbound(a,1)) call abort()
+!      if (high(1)-low(1)+1 /= ubound(a,1)) call abort()
+      if (size (a,1) /= high(1)-low(1)+1) call abort()
+    end if
+
+    do i = 1, rnk
+!      if (1 /= lbound(a,i)) call abort()
+!      if (high(i)-low(i)+1 /= ubound(a,i)) call abort()
+      if (size (a,i) /= high(i)-low(i)+1) call abort()
+    end do
+    call check_value (a, rnk, val)
+  end subroutine foo2
+
+  ! ALLOCATABLE argument - bounds as specified before
+  subroutine foo3 (a, rnk, low, high, val)
+    integer, allocatable, intent(in), target :: a(..)
+    integer, value :: rnk
+    integer, intent(in) :: low(:), high(:), val(:)
+    integer :: i
+
+    if (rank(a) /= rnk) call abort()
+    if (size(low) /= rnk .or. size(high) /= rnk) call abort()
+    if (size(a) /= product (high - low +1)) call abort()
+
+    if (rnk > 0) then
+!      if (low(1) /= lbound(a,1)) call abort()
+!      if (high(1) /= ubound(a,1)) call abort()
+      if (size (a,1) /= high(1)-low(1)+1) call abort()
+    end if
+
+    do i = 1, rnk
+!      if (low(i) /= lbound(a,i)) call abort()
+!      if (high(i) /= ubound(a,i)) call abort()
+      if (size (a,i) /= high(i)-low(i)+1) call abort()
+    end do
+    call check_value (a, rnk, val)
+    call foo(a, rnk, low, high, val)
+  end subroutine
+end
--- /dev/null	2012-07-14 08:59:06.947592273 +0200
+++ gcc/gcc/testsuite/gfortran.dg/assumed_rank_1_c.c	2012-06-24 12:58:44.000000000 +0200
@@ -0,0 +1,16 @@
+/* Called by assumed_rank_1.f90.  */
+
+#include <stdlib.h>  /* For abort().  */
+
+struct array {
+  int *data;
+};
+
+void check_value_ (struct array *b, int n, int val[])
+{
+  int i;
+
+  for (i = 0; i < n; i++)
+    if (b->data[i] != val[i])
+      abort ();
+}
--- /dev/null	2012-07-14 08:59:06.947592273 +0200
+++ gcc/gcc/testsuite/gfortran.dg/assumed_rank_2.f90	2012-07-13 16:37:19.000000000 +0200
@@ -0,0 +1,137 @@
+! { dg-do run }
+! { dg-options "-fcheck=all" }
+!
+! PR fortran/48820
+!
+! Assumed-rank tests - same as assumed_rank_1.f90,
+! but with bounds checks and w/o call to C function
+!
+! FIXME: The ubound/lbound checks have to be re-enabled when
+! after they are supported
+
+implicit none
+
+integer, target :: x(2:5,4:7), y(-4:4)
+integer, allocatable, target :: z(:,:,:,:)
+integer, allocatable :: val(:)
+integer :: i
+
+allocate(z(1:4, -2:5, 4, 10:11))
+
+if (rank(x) /= 2) call abort ()
+val = [(2*i+3, i = 1, size(x))]
+x = reshape (val, shape(x))
+call foo(x, rank(x), lbound(x), ubound(x), val)
+call foo2(x, rank(x), lbound(x), ubound(x), val)
+call bar(x,x,.true.)
+call bar(x,prsnt=.false.)
+
+if (rank(y) /= 1) call abort ()
+val = [(2*i+7, i = 1, size(y))]
+y = reshape (val, shape(y))
+call foo(y, rank(y), lbound(y), ubound(y), val)
+call foo2(y, rank(y), lbound(y), ubound(y), val)
+call bar(y,y,.true.)
+call bar(y,prsnt=.false.)
+
+if (rank(z) /= 4) call abort ()
+val = [(2*i+5, i = 1, size(z))]
+z(:,:,:,:) = reshape (val, shape(z))
+call foo(z, rank(z), lbound(z), ubound(z), val)
+call foo(z, rank(z), lbound(z), ubound(z), val)
+call foo2(z, rank(z), lbound(z), ubound(z), val)
+call bar(z,z,.true.)
+call bar(z,prsnt=.false.)
+
+contains
+  subroutine bar(a,b, prsnt)
+    integer, pointer, optional, intent(in) :: a(..),b(..)
+    logical, value :: prsnt
+    ! The following is not valid, but it goes past the constraint check
+    ! Technically, it could be allowed and might be in Fortran 2015:
+    if (.not. associated(a)) call abort()
+    if (present(b)) then
+      if (.not. associated(a,b)) call abort()
+    else
+      if (.not. associated(a)) call abort()
+    end if
+    if (.not. present(a)) call abort()
+    if (prsnt .neqv. present(b)) call abort()
+  end subroutine
+
+  ! POINTER argument - bounds as specified before
+  subroutine foo(a, rnk, low, high, val)
+    integer,pointer, intent(in) :: a(..)
+    integer, value :: rnk
+    integer, intent(in) :: low(:), high(:), val(:)
+    integer :: i
+
+
+
+    if (rank(a) /= rnk) call abort()
+    if (size(low) /= rnk .or. size(high) /= rnk) call abort()
+    if (size(a) /= product (high - low +1)) call abort()
+
+    if (rnk > 0) then
+!      if (low(1) /= lbound(a,1)) call abort()
+!      if (high(1) /= ubound(a,1)) call abort()
+      if (size (a,1) /= high(1)-low(1)+1) call abort()
+    end if
+
+    do i = 1, rnk
+!      if (low(i) /= lbound(a,i)) call abort()
+!      if (high(i) /= ubound(a,i)) call abort()
+      if (size (a,i) /= high(i)-low(i)+1) call abort()
+    end do
+    call foo2(a, rnk, low, high, val)
+  end subroutine
+
+  ! Non-pointer, non-allocatable bounds. lbound == 1
+  subroutine foo2(a, rnk, low, high, val)
+    integer, intent(in) :: a(..)
+    integer, value :: rnk
+    integer, intent(in) :: low(:), high(:), val(:)
+    integer :: i
+
+    if (rank(a) /= rnk) call abort()
+    if (size(low) /= rnk .or. size(high) /= rnk) call abort()
+    if (size(a) /= product (high - low +1)) call abort()
+
+    if (rnk > 0) then
+!      if (1 /= lbound(a,1)) call abort()
+!      if (high(1)-low(1)+1 /= ubound(a,1)) call abort()
+      if (size (a,1) /= high(1)-low(1)+1) call abort()
+    end if
+
+    do i = 1, rnk
+!      if (1 /= lbound(a,i)) call abort()
+!      if (high(i)-low(i)+1 /= ubound(a,i)) call abort()
+      if (size (a,i) /= high(i)-low(i)+1) call abort()
+    end do
+  end subroutine foo2
+
+  ! ALLOCATABLE argument - bounds as specified before
+  subroutine foo3 (a, rnk, low, high, val)
+    integer, allocatable, intent(in), target :: a(..)
+    integer, value :: rnk
+    integer, intent(in) :: low(:), high(:), val(:)
+    integer :: i
+
+    if (rank(a) /= rnk) call abort()
+    if (size(low) /= rnk .or. size(high) /= rnk) call abort()
+    if (size(a) /= product (high - low +1)) call abort()
+
+    if (rnk > 0) then
+!      if (low(1) /= lbound(a,1)) call abort()
+!      if (high(1) /= ubound(a,1)) call abort()
+      if (size (a,1) /= high(1)-low(1)+1) call abort()
+    end if
+
+    do i = 1, rnk
+!      if (low(i) /= lbound(a,i)) call abort()
+!      if (high(i) /= ubound(a,i)) call abort()
+      if (size (a,i) /= high(i)-low(i)+1) call abort()
+    end do
+    call foo(a, rnk, low, high, val)
+  end subroutine
+end
--- /dev/null	2012-07-14 08:59:06.947592273 +0200
+++ gcc/gcc/testsuite/gfortran.dg/assumed_rank_4.f90	2012-07-15 19:30:19.000000000 +0200
@@ -0,0 +1,50 @@
+! { dg-do compile }
+! { dg-options "-std=f2008ts" }
+!
+! PR fortran/48820
+!
+! Assumed-rank constraint checks and other diagnostics
+!
+
+subroutine valid1a(x)
+  integer, intent(in), pointer, contiguous :: x(..)
+end subroutine valid1a
+
+subroutine valid1(x)
+  integer, intent(in) :: x(..)
+end subroutine valid1
+
+subroutine valid2(x)
+ type(*) :: x
+end subroutine valid2
+
+subroutine foo99(x)
+  integer  x(99)
+  call valid1(x) ! { dg-error "Procedure 'valid1' at .1. with assumed-rank dummy argument 'x' must have an explicit interface" }
+  call valid2(x(1)) ! { dg-error "Procedure 'valid2' at .1. with assumed-type dummy argument 'x' must have an explicit interface" }
+end subroutine foo99
+
+subroutine foo(x)
+  integer :: x(..)
+  print *, ubound(x,dim=2000) ! { dg-error "is not a valid dimension index" }
+  call bar(x) ! { dg-error "Assumed-rank argument requires an explicit interface" }
+  call intnl(x) ! { dg-error "requires that the dummy argument 'x' has assumed-rank" }
+contains
+  subroutine intnl(x)
+    integer :: x(:)
+  end subroutine intnl
+end subroutine foo
+
+subroutine foo2(x)
+  integer :: x(..)
+  call valid3(x(:)) ! { dg-error "Assumed-rank variable x at .1. shall not have a subobject reference" }
+  call valid3(x+1)  ! { dg-error "Assumed-rank variable x at .1. may only be used as actual argument" }
+contains
+  subroutine valid3(y)
+    integer :: y(..)
+  end subroutine
+end subroutine
+
+subroutine foo3()
+  integer :: x(..) ! { dg-error "Assumed-rank array at .1. must be a dummy argument" }
+end subroutine
--- /dev/null	2012-07-14 08:59:06.947592273 +0200
+++ gcc/gcc/testsuite/gfortran.dg/assumed_rank_5.f90	2012-06-24 15:17:51.000000000 +0200
@@ -0,0 +1,9 @@
+! { dg-do compile }
+! { dg-options "-std=f2008" }
+!
+! PR fortran/48820
+!
+!
+subroutine foo(x)
+  integer :: x(..)  ! { dg-error "TS 29113: Assumed-rank array" }
+end subroutine foo
--- /dev/null	2012-07-14 08:59:06.947592273 +0200
+++ gcc/gcc/testsuite/gfortran.dg/assumed_rank_6.f90	2012-07-15 19:29:22.000000000 +0200
@@ -0,0 +1,39 @@
+! { dg-do compile }
+! { dg-options "-fcoarray=single" }
+!
+! PR fortran/48820
+!
+! Assumed-rank constraint checks and other diagnostics
+!
+
+subroutine foo(x) ! { dg-error "Assumed-type variable x at .1. may not have the INTENT.OUT. attribute" }
+  type(*), intent(out) :: x
+end subroutine
+
+subroutine bar(x)
+  integer, intent(out) :: x(..)
+end subroutine bar
+
+subroutine foo3(y)
+  integer :: y(..)
+  y = 7           ! { dg-error "Assumed-rank variable y at .1. may only be used as actual argument" }
+  print *, y + 10 ! { dg-error "Assumed-rank variable y at .1. may only be used as actual argument" }
+  print *, y      ! { dg-error "Assumed-rank variable y at .1. may only be used as actual argument" }
+end subroutine
+
+subroutine foo2(x, y)
+  integer :: x(..), y(..)
+  call valid3(x(:)) ! { dg-error "Assumed-rank variable x at .1. shall not have a subobject reference" }
+contains
+  subroutine valid3(y)
+    integer :: y(..)
+  end subroutine
+end subroutine
+
+subroutine foo4(x) ! { dg-error "may not have the VALUE or CODIMENSION attribute" }
+  integer, codimension[*] :: x(..)
+end subroutine
+
+subroutine foo5(y) ! { dg-error "may not have the VALUE or CODIMENSION attribute" }
+  integer :: y(..)[*]
+end subroutine
--- /dev/null	2012-07-14 08:59:06.947592273 +0200
+++ gcc/gcc/testsuite/gfortran.dg/assumed_rank_7.f90	2012-07-13 16:38:43.000000000 +0200
@@ -0,0 +1,66 @@
+! { dg-do run }
+!
+! PR fortran/48820
+!
+! Handle type/class for assumed-rank arrays
+!
+! FIXME: The ubound/lbound checks have to be re-enabled when
+! after they are supported.
+! FIXME: Passing a CLASS to a CLASS has to be re-enabled.
+implicit none
+type t
+  integer :: i
+end type
+
+class(T), allocatable :: ac(:,:)
+type(T), allocatable :: at(:,:)
+integer :: i
+
+allocate(ac(2:3,2:4))
+allocate(at(2:3,2:4))
+
+i = 0
+call foo(ac)
+call foo(at)
+call bar(ac)
+call bar(at)
+if (i /= 12) call abort()
+
+contains
+  subroutine bar(x)
+    type(t) :: x(..)
+!    if (lbound(x,1) /= 1 .or. lbound(x,2) /= 1) call abort()
+    if (size(x) /= 6) call abort()
+    if (size(x,1) /= 2 .or. size(x,2) /= 3) call abort()
+!    if (ubound(x,1) /= 2 .or. ubound(x,2) /= 3) call abort()
+    i = i + 1
+    call foo(x)
+    call bar2(x)
+  end subroutine
+  subroutine bar2(x)
+    type(t) :: x(..)
+!    if (lbound(x,1) /= 1 .or. lbound(x,2) /= 1) call abort()
+    if (size(x) /= 6) call abort()
+    if (size(x,1) /= 2 .or. size(x,2) /= 3) call abort()
+!    if (ubound(x,1) /= 2 .or. ubound(x,2) /= 3) call abort()
+    i = i + 1
+  end subroutine
+  subroutine foo(x)
+    class(t) :: x(..)
+!    if (lbound(x,1) /= 1 .or. lbound(x,2) /= 1) call abort()
+    if (size(x) /= 6) call abort()
+    if (size(x,1) /= 2 .or. size(x,2) /= 3) call abort()
+!    if (ubound(x,1) /= 2 .or. ubound(x,2) /= 3) call abort()
+    i = i + 1
+    call foo2(x)
+!    call bar2(x) ! Passing a CLASS to a TYPE does not yet work
+  end subroutine
+  subroutine foo2(x)
+    class(t) :: x(..)
+!    if (lbound(x,1) /= 1 .or. lbound(x,2) /= 1) call abort()
+    if (size(x) /= 6) call abort()
+    if (size(x,1) /= 2 .or. size(x,2) /= 3) call abort()
+!    if (ubound(x,1) /= 2 .or. ubound(x,2) /= 3) call abort()
+    i = i + 1
+  end subroutine
+end 
--- /dev/null	2012-07-14 08:59:06.947592273 +0200
+++ gcc/gcc/testsuite/gfortran.dg/assumed_rank_8.f90	2012-07-15 19:35:32.000000000 +0200
@@ -0,0 +1,71 @@
+! { dg-do run }
+! { dg-additional-sources assumed_rank_8_c.c }
+!
+! PR fortran/48820
+!
+! Scalars to assumed-rank tests
+!
+program main
+  implicit none
+
+  interface
+    subroutine check (x)
+      integer :: x(..)
+    end subroutine check
+  end interface
+
+  integer, target :: ii, j
+  integer, allocatable :: kk
+  integer, pointer :: ll
+  ii = 489
+  j = 0
+  call f (ii)
+  call f (489)
+  call f ()
+  call f (null())
+  call f (kk)
+  if (j /= 2) call abort()
+
+  j = 0
+  nullify (ll)
+  call g (null())
+  call g (ll)
+  call g (ii)
+  if (j /= 1) call abort()
+
+  j = 0
+  call h (kk)
+  kk = 489
+  call h (kk)
+  if (j /= 1) call abort()
+
+contains
+
+  subroutine f (x)
+    integer, optional :: x(..)
+
+    if (.not. present (x)) return
+    if (rank (x) /= 0) call abort
+    call check (x)
+    j = j + 1
+  end subroutine
+
+  subroutine g (x)
+    integer, pointer, intent(in) :: x(..)
+
+    if (.not. associated (x)) return
+    if (rank (x) /= 0) call abort ()
+    call check (x)
+    j = j + 1
+  end subroutine
+
+  subroutine h (x)
+    integer, allocatable :: x(..)
+
+    if (.not. allocated (x)) return
+    if (rank (x) /= 0) call abort
+    call check (x)
+    j = j + 1
+  end subroutine
+
+end program main
--- /dev/null	2012-07-14 08:59:06.947592273 +0200
+++ gcc/gcc/testsuite/gfortran.dg/assumed_rank_8_c.c	2012-07-15 19:34:46.000000000 +0200
@@ -0,0 +1,25 @@
+/* Called by assumed_rank_8.f90 and assumed_rank_9.f90.  */
+
+#include <stdlib.h>  /* For abort().  */
+
+struct a {
+  int *dat;
+};
+
+struct b {
+  struct a _data;
+};
+
+
+void check_ (struct a *x)
+{
+  if (*x->dat != 489)
+    abort ();
+}
+
+
+void check2_ (struct b *x)
+{
+  if (*x->_data.dat != 489)
+    abort ();
+}
--- /dev/null	2012-07-14 08:59:06.947592273 +0200
+++ gcc/gcc/testsuite/gfortran.dg/assumed_rank_9.f90	2012-07-15 19:35:37.000000000 +0200
@@ -0,0 +1,139 @@
+! { dg-do run }
+! { dg-additional-sources assumed_rank_8_c.c }
+!
+! PR fortran/48820
+!
+! Scalars to assumed-rank tests
+!
+program main
+  implicit none
+
+  type t
+    integer :: i
+  end type t
+
+  interface
+    subroutine check (x)
+      integer :: x(..)
+    end subroutine check
+    subroutine check2 (x)
+      import t
+      class(t) :: x(..)
+    end subroutine check2
+  end interface
+
+  integer :: j
+
+  type(t), target :: y
+  class(t), allocatable, target :: yac
+  
+  y%i = 489
+  allocate (yac)
+  yac%i = 489
+  j = 0
+  call fc()
+  call fc(null())
+  call fc(y)
+  call fc(yac)
+  if (j /= 2) call abort ()
+
+  j = 0
+  call gc(null())
+  call gc(y)
+  call gc(yac)
+  deallocate (yac)
+  call gc(yac)
+  if (j /= 2) call abort ()
+
+  j = 0
+  call hc(yac)
+  allocate (yac)
+  yac%i = 489
+  call hc(yac)
+  if (j /= 1) call abort ()
+
+  j = 0
+  call ft()
+  call ft(null())
+  call ft(y)
+  call ft(yac)
+  if (j /= 2) call abort ()
+
+  j = 0
+  call gt(null())
+  call gt(y)
+  call gt(yac)
+  deallocate (yac)
+  call gt(yac)
+  if (j /= 2) call abort ()
+
+  j = 0
+  call ht(yac)
+  allocate (yac)
+  yac%i = 489
+  call ht(yac)
+  if (j /= 1) call abort ()
+
+contains
+
+  subroutine fc (x)
+    class(t), optional :: x(..)
+
+    if (.not. present (x)) return
+    if (.not. SAME_TYPE_AS (x, yac)) call abort ()
+    if (rank (x) /= 0) call abort
+    call check2 (x)
+    j = j + 1
+  end subroutine
+
+  subroutine gc (x)
+    class(t), pointer, intent(in) :: x(..)
+
+    if (.not. associated (x)) return
+    if (.not. SAME_TYPE_AS (x, yac)) call abort ()
+    if (rank (x) /= 0) call abort ()
+    call check2 (x)
+    j = j + 1
+  end subroutine
+
+  subroutine hc (x)
+    class(t), allocatable :: x(..)
+
+    if (.not. allocated (x)) return
+    if (.not. SAME_TYPE_AS (x, yac)) call abort ()
+    if (rank (x) /= 0) call abort
+    call check2 (x)
+    j = j + 1
+  end subroutine
+
+  subroutine ft (x)
+    type(t), optional :: x(..)
+
+    if (.not. present (x)) return
+    if (.not. SAME_TYPE_AS (x, yac)) call abort ()
+    if (rank (x) /= 0) call abort
+    call check2 (x)
+    j = j + 1
+  end subroutine
+
+  subroutine gt (x)
+    type(t), pointer, intent(in) :: x(..)
+
+    if (.not. associated (x)) return
+    if (.not. SAME_TYPE_AS (x, yac)) call abort ()
+    if (rank (x) /= 0) call abort ()
+    call check2 (x)
+    j = j + 1
+  end subroutine
+
+  subroutine ht (x)
+    type(t), allocatable :: x(..)
+
+    if (.not. allocated (x)) return
+    if (.not. SAME_TYPE_AS (x, yac)) call abort ()
+    if (rank (x) /= 0) call abort
+    call check2 (x)
+    j = j + 1
+  end subroutine
+
+end program main
--- /dev/null	2012-07-14 08:59:06.947592273 +0200
+++ gcc/gcc/testsuite/gfortran.dg/assumed_rank_10.f90	2012-07-15 20:34:21.000000000 +0200
@@ -0,0 +1,106 @@
+! { dg-do run }
+! { dg-options "-fdump-tree-original" }
+!
+! PR fortran/48820
+!
+! Ensure that the value of scalars to assumed-rank arrays is
+! copied back, if and only its pointer address could have changed.
+!
+program test
+ implicit none
+ type t
+   integer :: aa
+ end type t
+
+ integer, allocatable :: iia
+ integer, pointer     :: iip
+
+ type(t), allocatable :: jja
+ type(t), pointer     :: jjp
+
+ logical :: is_present
+
+ is_present = .true.
+
+ allocate (iip, jjp)
+
+ iia = 7
+ iip = 7
+ jja = t(88)
+ jjp = t(88)
+
+ call faa(iia, jja) ! Copy back
+ if (iia /= 7 .and. jja%aa /= 88) call abort ()
+ call fai(iia, jja) ! No copy back
+ if (iia /= 7 .and. jja%aa /= 88) call abort ()
+
+ call fpa(iip, jjp) ! Copy back
+ if (iip /= 7 .and. jjp%aa /= 88) call abort ()
+ call fpi(iip, jjp) ! No copy back
+ if (iip /= 7 .and. jjp%aa /= 88) call abort ()
+
+ call fnn(iia, jja) ! No copy back
+ if (iia /= 7 .and. jja%aa /= 88) call abort ()
+ call fno(iia, jja) ! No copy back
+ if (iia /= 7 .and. jja%aa /= 88) call abort ()
+ call fnn(iip, jjp) ! No copy back
+ if (iip /= 7 .and. jjp%aa /= 88) call abort ()
+ call fno(iip, jjp) ! No copy back
+ if (iip /= 7 .and. jjp%aa /= 88) call abort ()
+
+ is_present = .false.
+
+ call fpa(null(), null()) ! No copy back
+ call fpi(null(), null()) ! No copy back
+ call fno(null(), null()) ! No copy back
+
+ call fno() ! No copy back
+
+contains
+
+  subroutine faa (xx1, yy1)
+    integer, allocatable :: xx1(..)
+    type(t), allocatable :: yy1(..)
+    if (.not. allocated (xx1)) call abort ()
+    if (.not. allocated (yy1)) call abort ()
+  end subroutine faa
+  subroutine fai (xx1, yy1)
+    integer, allocatable, intent(in) :: xx1(..)
+    type(t), allocatable, intent(in) :: yy1(..)
+    if (.not. allocated (xx1)) call abort ()
+    if (.not. allocated (yy1)) call abort ()
+  end subroutine fai
+  subroutine fpa (xx1, yy1)
+    integer, pointer :: xx1(..)
+    type(t), pointer :: yy1(..)
+    if (is_present .neqv. associated (xx1)) call abort ()
+    if (is_present .neqv. associated (yy1)) call abort ()
+  end subroutine fpa
+
+  subroutine fpi (xx1, yy1)
+    integer, pointer, intent(in) :: xx1(..)
+    type(t), pointer, intent(in) :: yy1(..)
+    if (is_present .neqv. associated (xx1)) call abort ()
+    if (is_present .neqv. associated (yy1)) call abort ()
+  end subroutine fpi
+
+  subroutine fnn(xx2,yy2)
+    integer  :: xx2(..)
+    type(t)  :: yy2(..)
+  end subroutine fnn
+
+  subroutine fno(xx2,yy2)
+    integer, optional  :: xx2(..)
+    type(t), optional  :: yy2(..)
+    if (is_present .neqv. present (xx2)) call abort ()
+    if (is_present .neqv. present (yy2)) call abort ()
+  end subroutine fno
+end program test
+
+! We should have exactly one copy back per variable
+!
+! { dg-final { scan-tree-dump-times "iip = .integer.kind=4. .. desc.\[0-9\]+.data;" 1 "original" } }
+! { dg-final { scan-tree-dump-times "iia = .integer.kind=4. .. desc.\[0-9\]+.data;" 1 "original" } }
+! { dg-final { scan-tree-dump-times "jjp = .struct t .. desc.\[0-9\]+.data;" 1 "original" } }
+! { dg-final { scan-tree-dump-times "jja = .struct t .. desc.\[0-9\]+.data;" 1 "original" } }
+! { dg-final { cleanup-tree-dump "original" } }
