The attached patch has been tested on x86_64-*-freebsd.
OK to commit?
If an inquiry parameter cannot appear in a file IO statement
as a tag (see new testcase). The patch re-arranges the code
to prevent an ICE due to 'result->symtree = NULL;', checks
for a constant in a variable definition context, and takes
a different exit route to get better error messages.
2019-10-01 Steven G. Kargl <ka...@gcc.gnu.org>
PR fortran/91942
* io.c (match_vtag): Check for non-NULL result->symtree.
(match_out_tag): Check for invalid constant due to inquiry parameter.
(match_filepos): Instead of a syntax error, go to cleanup to get better
error messages.
2019-10-01 Steven G. Kargl <ka...@gcc.gnu.org>
PR fortran/91942
* gfortran.dg/pr91587.f90: Update dg-error regex.
* gfortran.dg/pr91942.f90: New test.
--
Steve
Index: gcc/fortran/io.c
===================================================================
--- gcc/fortran/io.c (revision 276426)
+++ gcc/fortran/io.c (working copy)
@@ -1482,25 +1482,30 @@ match_vtag (const io_tag *tag, gfc_expr **v)
return MATCH_ERROR;
}
- if (result->symtree->n.sym->attr.intent == INTENT_IN)
+ if (result->symtree)
{
- gfc_error ("Variable %s cannot be INTENT(IN) at %C", tag->name);
- gfc_free_expr (result);
- return MATCH_ERROR;
- }
+ bool impure;
- bool impure = gfc_impure_variable (result->symtree->n.sym);
- if (impure && gfc_pure (NULL))
- {
- gfc_error ("Variable %s cannot be assigned in PURE procedure at %C",
- tag->name);
- gfc_free_expr (result);
- return MATCH_ERROR;
- }
+ if (result->symtree->n.sym->attr.intent == INTENT_IN)
+ {
+ gfc_error ("Variable %s cannot be INTENT(IN) at %C", tag->name);
+ gfc_free_expr (result);
+ return MATCH_ERROR;
+ }
- if (impure)
- gfc_unset_implicit_pure (NULL);
+ impure = gfc_impure_variable (result->symtree->n.sym);
+ if (impure && gfc_pure (NULL))
+ {
+ gfc_error ("Variable %s cannot be assigned in PURE procedure at %C",
+ tag->name);
+ gfc_free_expr (result);
+ return MATCH_ERROR;
+ }
+ if (impure)
+ gfc_unset_implicit_pure (NULL);
+ }
+
*v = result;
return MATCH_YES;
}
@@ -1515,8 +1520,17 @@ match_out_tag (const io_tag *tag, gfc_expr **result)
m = match_vtag (tag, result);
if (m == MATCH_YES)
- gfc_check_do_variable ((*result)->symtree);
+ {
+ if ((*result)->symtree)
+ gfc_check_do_variable ((*result)->symtree);
+ if ((*result)->expr_type == EXPR_CONSTANT)
+ {
+ gfc_error ("Expecting a variable at %L", &(*result)->where);
+ return MATCH_ERROR;
+ }
+ }
+
return m;
}
@@ -2845,7 +2859,7 @@ match_filepos (gfc_statement st, gfc_exec_op op)
m = match_file_element (fp);
if (m == MATCH_ERROR)
- goto syntax;
+ goto cleanup;
if (m == MATCH_NO)
{
m = gfc_match_expr (&fp->unit);
Index: gcc/testsuite/gfortran.dg/pr91587.f90
===================================================================
--- gcc/testsuite/gfortran.dg/pr91587.f90 (revision 276426)
+++ gcc/testsuite/gfortran.dg/pr91587.f90 (working copy)
@@ -2,9 +2,9 @@
! PR fortran/91587
! Code contributed by Gerhard Steinmetz
program p
- backspace(err=!) ! { dg-error "Syntax error in" }
- flush(err=!) ! { dg-error "Syntax error in" }
- rewind(err=!) ! { dg-error "Syntax error in" }
+ backspace(err=!) ! { dg-error "Invalid value for" }
+ flush(err=!) ! { dg-error "Invalid value for" }
+ rewind(err=!) ! { dg-error "Invalid value for" }
end
subroutine bar ! An other matcher runs, and gives a different error.
Index: gcc/testsuite/gfortran.dg/pr91942.f90
===================================================================
--- gcc/testsuite/gfortran.dg/pr91942.f90 (nonexistent)
+++ gcc/testsuite/gfortran.dg/pr91942.f90 (working copy)
@@ -0,0 +1,10 @@
+! { dg-do compile }
+! PR fortran/91942
+! Code contributed by Gerhard Steinmetz
+program p
+ integer :: i
+ backspace (iostat=i%kind) ! { dg-error "Expecting a variable at" }
+ endfile (iostat=i%kind) ! { dg-error "Expecting END PROGRAM" }
+ flush (iostat=i%kind) ! { dg-error "Expecting a variable at" }
+ rewind (iostat=i%kind) ! { dg-error "Expecting a variable at" }
+end
