re PR fortran/57338 (ICE with assumed rank)

2013-05-22  Tobias Burnus  <burnus@net-b.de>

        PR fortran/57338
        * intrinsic.c (do_check): Move some checks to ...
        (do_ts29113_check): ... this new function.
        (check_specific, gfc_intrinsic_sub_interface): Call it.

2013-05-22  Tobias Burnus  <burnus@net-b.de>

        PR fortran/57338
        * gfortran.dg/assumed_type_6.f90: New.

From-SVN: r199192

1 files changed, 30 insertions, 11 deletions

diff --git a/gcc/fortran/intrinsic.c b/gcc/fortran/intrinsic.c
index ddf9d80..3251ebb 100644
--- a/gcc/fortran/intrinsic.c
+++ b/gcc/fortran/intrinsic.c
@@ -174,21 +174,14 @@ find_char_conv (gfc_typespec *from, gfc_typespec *to)
 }
 
 
-/* Interface to the check functions.  We break apart an argument list
-   and call the proper check function rather than forcing each
-   function to manipulate the argument list.  */
+/* Check TS29113, C407b for assumed type and C535b for assumed-rank,
+   and a likewise check for NO_ARG_CHECK.  */
 
 static bool
-do_check (gfc_intrinsic_sym *specific, gfc_actual_arglist *arg)
+do_ts29113_check (gfc_intrinsic_sym *specific, gfc_actual_arglist *arg)
 {
-  gfc_expr *a1, *a2, *a3, *a4, *a5;
   gfc_actual_arglist *a;
 
-  if (arg == NULL)
-    return (*specific->check.f0) ();
-
-  /* Check TS29113, C407b for assumed type and C535b for assumed-rank,
-     and a likewise check for NO_ARG_CHECK.  */
   for (a = arg; a; a = a->next)
     {
       if (!a->expr)
@@ -242,6 +235,22 @@ do_check (gfc_intrinsic_sym *specific, gfc_actual_arglist *arg)
 	}
     }
 
+  return true;
+}
+
+
+/* Interface to the check functions.  We break apart an argument list
+   and call the proper check function rather than forcing each
+   function to manipulate the argument list.  */
+
+static bool
+do_check (gfc_intrinsic_sym *specific, gfc_actual_arglist *arg)
+{
+  gfc_expr *a1, *a2, *a3, *a4, *a5;
+
+  if (arg == NULL)
+    return (*specific->check.f0) ();
+
   a1 = arg->expr;
   arg = arg->next;
   if (arg == NULL)
@@ -4038,11 +4047,18 @@ check_specific (gfc_intrinsic_sym *specific, gfc_expr *expr, int error_flag)
       || specific->check.f1m == gfc_check_min_max_integer
       || specific->check.f1m == gfc_check_min_max_real
       || specific->check.f1m == gfc_check_min_max_double)
-    return (*specific->check.f1m) (*ap);
+    {
+      if (!do_ts29113_check (specific, *ap))
+	return false;
+      return (*specific->check.f1m) (*ap);
+    }
 
   if (!sort_actual (specific->name, ap, specific->formal, &expr->where))
     return false;
 
+  if (!do_ts29113_check (specific, *ap))
+    return false;
+
   if (specific->check.f3ml == gfc_check_minloc_maxloc)
     /* This is special because we might have to reorder the argument list.  */
     t = gfc_check_minloc_maxloc (*ap);
@@ -4352,6 +4368,9 @@ gfc_intrinsic_sub_interface (gfc_code *c, int error_flag)
   if (!sort_actual (name, &c->ext.actual, isym->formal, &c->loc))
     goto fail;
 
+  if (!do_ts29113_check (isym, c->ext.actual))
+    goto fail;
+
   if (isym->check.f1 != NULL)
     {
       if (!do_check (isym, c->ext.actual))