[Fortran] PR57338 - add more missing constraint checks for assumed-rank

2013-05-21  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-21  Tobias Burnus  <burnus@net-b.de>

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

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))
diff --git a/gcc/testsuite/gfortran.dg/assumed_type_6.f90 b/gcc/testsuite/gfortran.dg/assumed_type_6.f90
new file mode 100644
index 0000000..78ff849
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/assumed_type_6.f90
@@ -0,0 +1,12 @@ 
+! { 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