Re: [PATCH] Fix handling of arguments in statement functions

[Steve Kargl]

On Sun, Feb 11, 2018 at 08:34:05AM -0800, Steve Kargl wrote:
> On Sun, Feb 11, 2018 at 01:48:10PM +0100, Dominique d'Humières wrote:
> > Hi Steve,
> > 
> > With your patch applied to revision r257559, I get the following failures
> > 
> > /opt/gcc/p_work/gcc/testsuite/gfortran.dg/statement_function_3.f:5:72: 
> > Warning: Obsolescent feature: Statement function at (1)
> > /opt/gcc/p_work/gcc/testsuite/gfortran.dg/statement_function_3.f:3:24: 
> > Error: Argument 'e' of statement function at (1) must be scalar
> > compiler exited with status 1
> > FAIL: gfortran.dg/statement_function_3.f   -O   (test for errors, line 5)
> > FAIL: gfortran.dg/statement_function_3.f   -O  (test for excess errors)
> > 
> 
> I may have posted the wrong patch or forgot to include the
> diff of the file that deals with this error.
> 

Yep, I forgot to include the diff for resolve.c.
See the new attachment for the complete patch.

-- 
Steve
Index: gcc/fortran/interface.c
===
--- gcc/fortran/interface.c	(revision 257464)
+++ gcc/fortran/interface.c	(working copy)
@@ -2835,7 +2835,8 @@ lookup_arg_fuzzy (const char *arg, gfc_formal_arglist 
 
 static bool
 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;
@@ -3204,8 +3205,9 @@ compare_actual_formal (gfc_actual_arglist **ap, gfc_fo
 	}
 
   /* 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")
@@ -3310,7 +3312,8 @@ compare_actual_formal (gfc_actual_arglist **ap, gfc_fo
 		   "at %L", where);
 	  return false;
 	}
-  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",
@@ -3598,6 +3601,7 @@ check_intents (gfc_formal_arglist *f, gfc_actual_argli
 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
@@ -3631,8 +3635,6 @@ gfc_procedure_use (gfc_symbol *sym, gfc_actual_arglist
 
   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 "
@@ -3724,9 +3726,12 @@ gfc_procedure_use (gfc_symbol *sym, gfc_actual_arglist
 
   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;
 
@@ -3773,7 +3778,7 @@ gfc_ppc_use (gfc_component *comp, gfc_actual_arglist *
 }
 
   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);
@@ -3798,7 +3803,7 @@ gfc_arglist_matches_symbol (gfc_actual_arglist** args,
   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)
Index: gcc/fortran/resolve.c
===
--- gcc/fortran/resolve.c	(revision 257464)
+++ gcc/fortran/resolve.c	(working copy)
@@ -512,8 +512,11 @@ resolve_formal_arglist (gfc_symbol *proc)
 	{
 	  if (sym->as != NULL)
 	{
-	  gfc_error ("Argument %qs of statement function at %L must "
-			 "be scalar", sym->name, >declared_at);
+	  /* F03:C1263 (R1238) The function-name and each dummy-arg-name
+		 shall be specified, explicitly or implicitly, to be scalar.  */
+	  gfc_error ("Argument '%s' of statement function '%s' at %L "
+			 "must be scalar", sym->name, proc->name,
+			 >declared_at);
 	  continue;
 	}
 
Index: gcc/testsuite/gfortran.dg/statement_function_1.f90
===
--- gcc/testsuite/gfortran.dg/statement_function_1.f90	(nonexistent)
+++ 

Re: [PATCH] Fix handling of arguments in statement functions

[Steve Kargl]

On Sun, Feb 11, 2018 at 01:48:10PM +0100, Dominique d'Humières wrote:
> Hi Steve,
> 
> With your patch applied to revision r257559, I get the following failures
> 
> /opt/gcc/p_work/gcc/testsuite/gfortran.dg/statement_function_3.f:5:72: 
> Warning: Obsolescent feature: Statement function at (1)
> /opt/gcc/p_work/gcc/testsuite/gfortran.dg/statement_function_3.f:3:24: Error: 
> Argument 'e' of statement function at (1) must be scalar
> compiler exited with status 1
> FAIL: gfortran.dg/statement_function_3.f   -O   (test for errors, line 5)
> FAIL: gfortran.dg/statement_function_3.f   -O  (test for excess errors)
> 

I may have posted the wrong patch or forgot to include the
diff of the file that deals with this error.

-- 
Steve

Re: [PATCH] Fix handling of arguments in statement functions

[Dominique d'Humières]

Hi Steve,

With your patch applied to revision r257559, I get the following failures

/opt/gcc/p_work/gcc/testsuite/gfortran.dg/statement_function_3.f:5:72: Warning: 
Obsolescent feature: Statement function at (1)
/opt/gcc/p_work/gcc/testsuite/gfortran.dg/statement_function_3.f:3:24: Error: 
Argument 'e' of statement function at (1) must be scalar
compiler exited with status 1
FAIL: gfortran.dg/statement_function_3.f   -O   (test for errors, line 5)
FAIL: gfortran.dg/statement_function_3.f   -O  (test for excess errors)

The error still occurs at line 3

/opt/gcc/work/gcc/testsuite/gfortran.dg/statement_function_3.f:3:24:

   subroutine phtod(e,n,i,h)
1
Error: Argument 'e' of statement function at (1) must be scalar

and not at line 5.

IMO there should be no error with the test since e(i-1) is a scalar in 

h = hstar(e(i-1), a)

but 

h = hstar(e, a)

should give an error.

Thanks for working on this issue.

Dominique

Re: [PATCH] Fix handling of arguments in statement functions

[Steve Kargl]

On Sat, Feb 10, 2018 at 09:46:57AM -0800, Steve Kargl wrote:
> 
>   PR fortran/35299
>   * gfortran.dg/statement_function_3.f: New test.

This patch should be credited to FX.  I've added

2018-02-10  Francois-Xavier Coudert  

to the ChangeLog entry.

-- 
Steve
20170425 https://www.youtube.com/watch?v=VWUpyCsUKR4
20161221 https://www.youtube.com/watch?v=IbCHE-hONow

[PATCH] Fix handling of arguments in statement functions

[Steve Kargl]

All,

The attach patch address 3 issues with statement functions.
First, a dummy argument in a statement function declarations
acquires only its type and type parameters from the containing
scope.  All attributes should be ignores.  The first fix for
PR fortran/84276 disables a check for the INTENT(INOUT,OUT) 
attribute.  The second fix for PR fortran/54223 disables a 
check for missing OPTIONAL arguments as an argument to a 
statement function cannot be optional.

In reviewing the bugs for statement functions, I came across
PR fortran/35229.  There is a long audit trail, but I have come
to agree with comment #3 from FX.  I have taken his suggested
patch for updating the error message.  Note, this issue is 
10 years old, and AFAIK, no one has sent a duplicate PR or an
email to fortran@gnu complaining about the current error 
message.  The new error message simply gives a better locus.
OK to commit?

Release Manager, I can hold the patch until after 8.0/1 is
released, but it is highly unlikely that this patch will 
cause a regression and it does fix two ICE.

2018-02-10  Steven G. Kargl  

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-10  Steven G. Kargl  

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

PR fortran/35299
* gfortran.dg/statement_function_3.f: New test.

-- 
Steve
Index: gcc/fortran/interface.c
===
--- gcc/fortran/interface.c	(revision 257464)
+++ gcc/fortran/interface.c	(working copy)
@@ -2835,7 +2835,8 @@ lookup_arg_fuzzy (const char *arg, gfc_formal_arglist 
 
 static bool
 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;
@@ -3204,8 +3205,9 @@ compare_actual_formal (gfc_actual_arglist **ap, gfc_fo
 	}
 
   /* 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")
@@ -3310,7 +3312,8 @@ compare_actual_formal (gfc_actual_arglist **ap, gfc_fo
 		   "at %L", where);
 	  return false;
 	}
-  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",
@@ -3598,6 +3601,7 @@ check_intents (gfc_formal_arglist *f, gfc_actual_argli
 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
@@ -3631,8 +3635,6 @@ gfc_procedure_use (gfc_symbol *sym, gfc_actual_arglist
 
   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 "
@@ -3724,9 +3726,12 @@ gfc_procedure_use (gfc_symbol *sym, gfc_actual_arglist
 
   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;
 
@@ -3773,7 +3778,7 @@ gfc_ppc_use (gfc_component *comp, gfc_actual_arglist *
 }
 
   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);
@@ -3798,7 +3803,7 @@ gfc_arglist_matches_symbol (gfc_actual_arglist** args,
   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