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

gcc/fortran/ChangeLog

+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.

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))

gcc/testsuite/ChangeLog

+2013-05-22  Tobias Burnus  <burnus@net-b.de>
+
+	PR fortran/57338
+	* gfortran.dg/assumed_type_6.f90: New.
+
 2013-05-22  Paolo Carlini  <paolo.carlini@oracle.com>
 
 	PR c++/57211

gcc/testsuite/gfortran.dg/assumed_type_6.f90

+! { dg-do compile }
+!
+! PR fortran/
+!
+! Contributed by Vladimír Fuka
+!
+function avg(a)
+  integer :: avg
+  integer,intent(in) :: a(..)
+  
+  avg = sum(a)/size(a) ! { dg-error "Assumed-rank argument at .1. is only permitted as actual argument to intrinsic inquiry functions" }
+end function