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

diff --git a/gcc/fortran/ChangeLog b/gcc/fortran/ChangeLog
index 89d83cf..6fb27dc 100644 (file)
--- 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 ddf9d80..3251ebb 100644 (file)
--- 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/ChangeLog b/gcc/testsuite/ChangeLog
index fc2a2f3..dcf16a4 100644 (file)
--- a/gcc/testsuite/ChangeLog
+++ b/gcc/testsuite/ChangeLog
@@ -1,3 +1,8 @@
+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

diff --git a/gcc/testsuite/gfortran.dg/assumed_type_6.f90 b/gcc/testsuite/gfortran.dg/assumed_type_6.f90
new file mode 100644 (file)
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