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.



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

2 files changed, 38 insertions, 12 deletions

diff --git a/gcc/fortran/ChangeLog b/gcc/fortran/ChangeLog
index 89d83cf5bca..6fb27dc0495 100644
--- a/gcc/fortran/ChangeLog
+++ b/gcc/fortran/ChangeLog
@@ -1,3 +1,10 @@
+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  Janne Blomqvist  <jb@gcc.gnu.org>
 
 	* intrinsic.texi (RANDOM_SEED): Improve example.
@@ -5,7 +12,7 @@
 2013-05-21  Tobias Burnus  <burnus@net-b.de>
 
 	PR fortran/57035
-	* intrinsic.c (do_check): Add contraint check for
+	* intrinsic.c (do_check): Add constraint check for
 	NO_ARG_CHECK, assumed rank and assumed type.
 	* gfortran.texi (NO_ARG_CHECK): Minor wording change,
 	allow PRESENT intrinsic.
diff --git a/gcc/fortran/intrinsic.c b/gcc/fortran/intrinsic.c
index ddf9d8010fd..3251ebb558d 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))