2012-07-20 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 assert.
        * dump-parse-tree.c (show_array_spec): Add support for
        assumed-rank arrays.
        * 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, argument_rank_mismatch,
        compare_parameter, 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_actual_arglist,
        resolve_elemental_actual, resolve_global_procedure,
        expression_shape, resolve_variable, update_ppc_arglist,
        check_typebound_baseobject, gfc_resolve_expr,
        resolve_fl_var_and_proc, gfc_resolve_finalizers,
        resolve_typebound_procedure, resolve_symbol): Ditto.
        (assumed_type_expr_allowed): Remove static variable.
        (actual_arg, first_actual_arg): New static variables.
        * 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-20  Tobias Burnus  <burnus@net-b.de>

        PR fortran/48820
        * gfortran.dg/assumed_type_3.f90: Update dg-error.
        * 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.
        * gfortran.dg/assumed_rank_12.f90: New.



git-svn-id: svn+ssh://gcc.gnu.org/svn/gcc/trunk@189700 138bc75d-0d04-0410-961f-82ee72b054a4

1 files changed, 22 insertions, 3 deletions

diff --git a/gcc/fortran/interface.c b/gcc/fortran/interface.c
index 2e181c9be87..7dd4b834d7c 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);
@@ -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
@@ -3001,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;