re PR fortran/54223 (Statement function statement with dummy arguments that are also...

2018-02-12  Steven G. Kargl  <kargl@gcc.gnu.org>

	PR fortran/54223
	PR fortran/84276
	* interface.c (compare_actual_formal): Add in_statement_function
	bool parameter.  Skip check of INTENT attribute for statement
	functions.  Arguments to a statement function cannot be optional,
	issue error for missing argument.
	(gfc_procedure_use, gfc_ppc_use, gfc_arglist_matches_symbol): Use
	in_statement_function.

2018-02-12  Steven G. Kargl  <kargl@gcc.gnu.org>

	PR fortran/54223
	PR fortran/84276
	* gfortran.dg/statement_function_1.f90: New test.
	* gfortran.dg/statement_function_2.f90: New test.

From-SVN: r257596

diff --git a/gcc/fortran/ChangeLog b/gcc/fortran/ChangeLog
index c3a2b628d8abf0c7227387545c9a17ecd3c5f966..8d0e84a053596d11b42d62da437222e9324f2818 100644 (file)
--- a/gcc/fortran/ChangeLog
+++ b/gcc/fortran/ChangeLog
@@ -1,3 +1,14 @@
+2018-02-12  Steven G. Kargl  <kargl@gcc.gnu.org>
+
+       PR fortran/54223
+       PR fortran/84276
+       * interface.c (compare_actual_formal): Add in_statement_function
+       bool parameter.  Skip check of INTENT attribute for statement
+       functions.  Arguments to a statement function cannot be optional,
+       issue error for missing argument.
+       (gfc_procedure_use, gfc_ppc_use, gfc_arglist_matches_symbol): Use
+       in_statement_function.
+
 2018-02-07  Steven G. Kargl  <kargl@gcc.gnu.org>
 
        PR fortran/82994

diff --git a/gcc/fortran/interface.c b/gcc/fortran/interface.c
index 6dac80195bd25e34baff071e0a3cfe5c38f8d2f7..09ed5ee8161def22bf690b461eaf85927c3a07bb 100644 (file)
--- a/gcc/fortran/interface.c
+++ b/gcc/fortran/interface.c
@@ -2710,7 +2710,8 @@ is_procptr_result (gfc_expr *expr)
 
 static int
 compare_actual_formal (gfc_actual_arglist **ap, gfc_formal_arglist *formal,
-                      int ranks_must_agree, int is_elemental, locus *where)
+                      int ranks_must_agree, int is_elemental,
+                      bool in_statement_function, locus *where)
 {
   gfc_actual_arglist **new_arg, *a, *actual;
   gfc_formal_arglist *f;
@@ -3058,8 +3059,9 @@ compare_actual_formal (gfc_actual_arglist **ap, gfc_formal_arglist *formal,
        }
 
       /* Check intent = OUT/INOUT for definable actual argument.  */
-      if ((f->sym->attr.intent == INTENT_OUT
-         || f->sym->attr.intent == INTENT_INOUT))
+      if (!in_statement_function
+         && (f->sym->attr.intent == INTENT_OUT
+             || f->sym->attr.intent == INTENT_INOUT))
        {
          const char* context = (where
                                 ? _("actual argument to INTENT = OUT/INOUT")
@@ -3157,7 +3159,8 @@ compare_actual_formal (gfc_actual_arglist **ap, gfc_formal_arglist *formal,
                       "at %L", where);
          return 0;
        }
-      if (!f->sym->attr.optional)
+      if (!f->sym->attr.optional
+         || (in_statement_function && f->sym->attr.optional))
        {
          if (where)
            gfc_error ("Missing actual argument for argument %qs at %L",
@@ -3443,6 +3446,7 @@ check_intents (gfc_formal_arglist *f, gfc_actual_arglist *a)
 bool
 gfc_procedure_use (gfc_symbol *sym, gfc_actual_arglist **ap, locus *where)
 {
+  gfc_actual_arglist *a;
   gfc_formal_arglist *dummy_args;
 
   /* Warn about calls with an implicit interface.  Special case
@@ -3469,8 +3473,6 @@ gfc_procedure_use (gfc_symbol *sym, gfc_actual_arglist **ap, locus *where)
 
   if (sym->attr.if_source == IFSRC_UNKNOWN)
     {
-      gfc_actual_arglist *a;
-
       if (sym->attr.pointer)
        {
          gfc_error ("The pointer object %qs at %L must have an explicit "
@@ -3562,9 +3564,12 @@ gfc_procedure_use (gfc_symbol *sym, gfc_actual_arglist **ap, locus *where)
 
   dummy_args = gfc_sym_get_dummy_args (sym);
 
-  if (!compare_actual_formal (ap, dummy_args, 0, sym->attr.elemental, where))
+  /* For a statement function, check that types and type parameters of actual
+     arguments and dummy arguments match.  */
+  if (!compare_actual_formal (ap, dummy_args, 0, sym->attr.elemental,
+                             sym->attr.proc == PROC_ST_FUNCTION, where))
     return false;
-
+ 
   if (!check_intents (dummy_args, *ap))
     return false;
 
@@ -3611,7 +3616,7 @@ gfc_ppc_use (gfc_component *comp, gfc_actual_arglist **ap, locus *where)
     }
 
   if (!compare_actual_formal (ap, comp->ts.interface->formal, 0,
-                             comp->attr.elemental, where))
+                             comp->attr.elemental, false, where))
     return;
 
   check_intents (comp->ts.interface->formal, *ap);
@@ -3636,7 +3641,7 @@ gfc_arglist_matches_symbol (gfc_actual_arglist** args, gfc_symbol* sym)
   dummy_args = gfc_sym_get_dummy_args (sym);
 
   r = !sym->attr.elemental;
-  if (compare_actual_formal (args, dummy_args, r, !r, NULL))
+  if (compare_actual_formal (args, dummy_args, r, !r, false, NULL))
     {
       check_intents (dummy_args, *args);
       if (warn_aliasing)

diff --git a/gcc/testsuite/ChangeLog b/gcc/testsuite/ChangeLog
index 09a8056109cf1fe51cf853ff1e7420387d19e690..c07d8797dace2069712f706e721eadb3c329d7ae 100644 (file)
--- a/gcc/testsuite/ChangeLog
+++ b/gcc/testsuite/ChangeLog
@@ -1,3 +1,10 @@
+2018-02-12  Steven G. Kargl  <kargl@gcc.gnu.org>
+
+       PR fortran/54223
+       PR fortran/84276
+       * gfortran.dg/statement_function_1.f90: New test.
+       * gfortran.dg/statement_function_2.f90: New test.
+
 2018-02-07  Steven G. Kargl  <kargl@gcc.gnu.org>
 
        PR fortran/82994

diff --git a/gcc/testsuite/gfortran.dg/statement_function_1.f90 b/gcc/testsuite/gfortran.dg/statement_function_1.f90
new file mode 100644 (file)
index 0000000..f26f25c
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/statement_function_1.f90
@@ -0,0 +1,28 @@
+! { dg-do compile }
+! PR fortran/84276
+      subroutine stepns(hh, h, s, w)
+      real, intent(inout) :: h, hh, s
+      real, intent(out) :: w
+      real :: qofs
+      integer i
+      qofs(s) = s
+      w = qofs(hh + h)
+      i = 42
+      w = qofs(i)       ! { dg-error "Type mismatch in argument" }
+      end subroutine stepns
+
+      subroutine step(hh, h, s, w)
+      real, intent(inout) :: h, hh, s
+      real, intent(out) :: w
+      real :: qofs
+      integer i
+      qofs(s, i) = i * s
+      i = 42
+      w = qofs(hh, i)
+!
+! The following line should cause an error, because keywords are not
+! allowed in a function with an implicit interface.
+!
+      w = qofs(i = i, s = hh)
+      end subroutine step
+! { dg-prune-output " Obsolescent feature" }

diff --git a/gcc/testsuite/gfortran.dg/statement_function_2.f90 b/gcc/testsuite/gfortran.dg/statement_function_2.f90
new file mode 100644 (file)
index 0000000..703ca17
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/statement_function_2.f90
@@ -0,0 +1,26 @@
+! { dg-do compile }
+! PR fortran/54223
+subroutine r(d)
+    implicit none
+    integer, optional :: d
+    integer :: h, q
+    q(d) = d + 1     ! statement function statement
+    h = q(d)
+end subroutine r
+
+subroutine s(x)
+    implicit none
+    integer, optional :: x
+    integer :: g, z
+    g(x) = x + 1     ! statement function statement
+    z = g()          ! { dg-error "Missing actual argument" }
+end subroutine s
+
+subroutine t(a)
+    implicit none
+    integer :: a
+    integer :: f, y
+    f(a) = a + 1     ! statement function statement
+    y = f()          ! { dg-error "Missing actual argument" }
+end subroutine t
+! { dg-prune-output " Obsolescent feature" }