Skip to content

R
riscv-gcc-1
Commit 44facdb7 by Fritz Reese
Options

PR fortran/87923 -- fix ICE when resolving I/O tags and simplify io.c 

2020-04-06  Fritz Reese  <foreese@gcc.gnu.org>

This patch reorganizes I/O checking code. Checks which were done in the
matching phase which do not affect the match result are moved to the
resolution phase. Checks which were duplicated in both the matching phase
and resolution phase have been reduced to one check in the resolution phase.

Another section of code which used a global async_io_dt flag to check for
and assign the asynchronous attribute to variables used in asynchronous I/O
has been simplified.

Furthermore, this patch improves error reporting and expands test coverage
of I/O tags:

 - "TAG must be an initialization expression" reported by io.c
   (check_io_constraints) is replaced with an error from expr.c
   (gfc_reduce_init_expr) indicating _why_ the expression is not a valid
   initialization expression.

 - Several distinct error messages regarding the check for scalar
   + character + default kind have been unified to one message reported by
   resolve_tag or check_*_constraints.

gcc/fortran/ChangeLog:

2020-04-09  Fritz Reese  <foreese@gcc.gnu.org>

	PR fortran/87923
	* gfortran.h (gfc_resolve_open, gfc_resolve_close): Add
	locus parameter.
	(gfc_resolve_dt): Add code parameter.
	* io.c (async_io_dt, check_char_variable, is_char_type): Removed.
	(resolve_tag_format): Add locus to error message regarding
	zero-sized array in FORMAT tag.
	(check_open_constraints, check_close_constraints): New functions
	called at resolution time.
	(gfc_match_open, gfc_match_close, match_io): Move checks which don't
	affect the match result to new functions check_open_constraints,
	check_close_constraints, check_io_constraints.
	(gfc_resolve_open, gfc_resolve_close): Call new functions
	check_open_constraints, check_close_constraints after all tags have
	been independently resolved.  Remove duplicate constraints which are
	already verified by resolve_tag. Explicitly pass locus to all error
	reports.
	(compare_to_allowed_values): Add locus parameter and provide
	explicit locus all error reports.
	(match_open_element, match_close_element, match_file_element,
	match_dt_element, match_inquire_element): Remove redundant special
	cases for ASYNCHRONOUS and IOMSG tags.
	(gfc_resolve_dt): Remove redundant special case for format
	expression.  Call check_io_constraints, forwarding an I/O list as
	the io_code parameter if present.
	(check_io_constraints): Change return type to bool. Pass explicit
	locus to error reports. Move generic checks after tag-specific
	checks, since errors are no longer buffered.  Move simplification of
	format string to match_io.  Remove redundant checks which are
	verified by resolve_tag.  Remove usage of async_io_dt flag and
	explicitly mark symbols used in asynchronous I/O with the
	asynchronous attribute.
	* resolve.c (resolve_transfer, resolve_fl_namelist): Remove checks
	for async_io_dt flag. This is now done in io.c
	(check_io_constraints).
	(gfc_resolve_code): Pass code locus to gfc_resolve_open,
	gfc_resolve_close, gfc_resolve_dt.

gcc/testsuite/ChangeLog:

2020-04-09  Fritz Reese  <foreese@gcc.gnu.org>

	PR fortran/87923
	* gfortran.dg/f2003_io_8.f03: Fix expected error messages.
	* gfortran.dg/io_constraints_8.f90: Likewise.
	* gfortran.dg/iomsg_2.f90: Likewise.
	* gfortran.dg/pr66725.f90: Likewise.
	* gfortran.dg/pr88205.f90: Likewise.
	* gfortran.dg/write_check4.f90: Likewise.
	* gfortran.dg/asynchronous_5.f03: New test.
	* gfortran.dg/io_constraints_15.f90: Likewise.
	* gfortran.dg/io_constraints_16.f90: Likewise.
	* gfortran.dg/io_constraints_17.f90: Likewise.
	* gfortran.dg/io_constraints_18.f90: Likewise.
	* gfortran.dg/io_tags_1.f90: Likewise.
	* gfortran.dg/io_tags_10.f90: Likewise.
	* gfortran.dg/io_tags_2.f90: Likewise.
	* gfortran.dg/io_tags_3.f90: Likewise.
	* gfortran.dg/io_tags_4.f90: Likewise.
	* gfortran.dg/io_tags_5.f90: Likewise.
	* gfortran.dg/io_tags_6.f90: Likewise.
	* gfortran.dg/io_tags_7.f90: Likewise.
	* gfortran.dg/io_tags_8.f90: Likewise.
	* gfortran.dg/io_tags_9.f90: Likewise.
	* gfortran.dg/write_check5.f90: Likewise.
parent ef529765
Showing with 569 additions and 61 deletions
gcc/fortran/ChangeLog
2020-04-09 Fritz Reese <foreese@gcc.gnu.org>
PR fortran/87923
* gfortran.h (gfc_resolve_open, gfc_resolve_close): Add
locus parameter.
(gfc_resolve_dt): Add code parameter.
* io.c (async_io_dt, check_char_variable, is_char_type): Removed.
(resolve_tag_format): Add locus to error message regarding
zero-sized array in FORMAT tag.
(check_open_constraints, check_close_constraints): New functions
called at resolution time.
(gfc_match_open, gfc_match_close, match_io): Move checks which don't
affect the match result to new functions check_open_constraints,
check_close_constraints, check_io_constraints.
(gfc_resolve_open, gfc_resolve_close): Call new functions
check_open_constraints, check_close_constraints after all tags have
been independently resolved. Remove duplicate constraints which are
already verified by resolve_tag. Explicitly pass locus to all error
reports.
(compare_to_allowed_values): Add locus parameter and provide
explicit locus all error reports.
(match_open_element, match_close_element, match_file_element,
match_dt_element, match_inquire_element): Remove redundant special
cases for ASYNCHRONOUS and IOMSG tags.
(gfc_resolve_dt): Remove redundant special case for format
expression. Call check_io_constraints, forwarding an I/O list as
the io_code parameter if present.
(check_io_constraints): Change return type to bool. Pass explicit
locus to error reports. Move generic checks after tag-specific
checks, since errors are no longer buffered. Move simplification of
format string to match_io. Remove redundant checks which are
verified by resolve_tag. Remove usage of async_io_dt flag and
explicitly mark symbols used in asynchronous I/O with the
asynchronous attribute.
* resolve.c (resolve_transfer, resolve_fl_namelist): Remove checks
for async_io_dt flag. This is now done in io.c.
(check_io_constraints).
(gfc_resolve_code): Pass code locus to gfc_resolve_open,
gfc_resolve_close, gfc_resolve_dt.
2020-04-07 Fritz Reese <foreese@gcc.gnu.org> 2020-04-07 Fritz Reese <foreese@gcc.gnu.org>
Steven G. Kargl <kargl@gcc.gnu.org> Steven G. Kargl <kargl@gcc.gnu.org>
......
gcc/fortran/gfortran.h
...@@ -3476,18 +3476,17 @@ bool gfc_compare_actual_formal (gfc_actual_arglist **, gfc_formal_arglist *, ...@@ -3476,18 +3476,17 @@ bool gfc_compare_actual_formal (gfc_actual_arglist **, gfc_formal_arglist *,
extern gfc_st_label format_asterisk; extern gfc_st_label format_asterisk;
void gfc_free_open (gfc_open *); void gfc_free_open (gfc_open *);
bool gfc_resolve_open (gfc_open *); bool gfc_resolve_open (gfc_open *, locus *);
void gfc_free_close (gfc_close *); void gfc_free_close (gfc_close *);
bool gfc_resolve_close (gfc_close *); bool gfc_resolve_close (gfc_close *, locus *);
void gfc_free_filepos (gfc_filepos *); void gfc_free_filepos (gfc_filepos *);
bool gfc_resolve_filepos (gfc_filepos *, locus *); bool gfc_resolve_filepos (gfc_filepos *, locus *);
void gfc_free_inquire (gfc_inquire *); void gfc_free_inquire (gfc_inquire *);
bool gfc_resolve_inquire (gfc_inquire *); bool gfc_resolve_inquire (gfc_inquire *);
void gfc_free_dt (gfc_dt *); void gfc_free_dt (gfc_dt *);
bool gfc_resolve_dt (gfc_dt *, locus *); bool gfc_resolve_dt (gfc_code *, gfc_dt *, locus *);
void gfc_free_wait (gfc_wait *); void gfc_free_wait (gfc_wait *);
bool gfc_resolve_wait (gfc_wait *); bool gfc_resolve_wait (gfc_wait *);
extern bool async_io_dt;
/* module.c */ /* module.c */
void gfc_module_init_2 (void); void gfc_module_init_2 (void);
......
gcc/fortran/resolve.c
...@@ -9941,9 +9941,6 @@ resolve_transfer (gfc_code *code) ...@@ -9941,9 +9941,6 @@ resolve_transfer (gfc_code *code)
"an assumed-size array", &code->loc); "an assumed-size array", &code->loc);
return; return;
} }
if (async_io_dt && exp->expr_type == EXPR_VARIABLE)
exp->symtree->n.sym->attr.asynchronous = 1;
} }
...@@ -12003,14 +12000,14 @@ start: ...@@ -12003,14 +12000,14 @@ start:
break; break;
case EXEC_OPEN: case EXEC_OPEN:
if (!gfc_resolve_open (code->ext.open)) if (!gfc_resolve_open (code->ext.open, &code->loc))
break; break;
resolve_branch (code->ext.open->err, code); resolve_branch (code->ext.open->err, code);
break; break;
case EXEC_CLOSE: case EXEC_CLOSE:
if (!gfc_resolve_close (code->ext.close)) if (!gfc_resolve_close (code->ext.close, &code->loc))
break; break;
resolve_branch (code->ext.close->err, code); resolve_branch (code->ext.close->err, code);
...@@ -12052,7 +12049,7 @@ start: ...@@ -12052,7 +12049,7 @@ start:
case EXEC_READ: case EXEC_READ:
case EXEC_WRITE: case EXEC_WRITE:
if (!gfc_resolve_dt (code->ext.dt, &code->loc)) if (!gfc_resolve_dt (code, code->ext.dt, &code->loc))
break; break;
resolve_branch (code->ext.dt->err, code); resolve_branch (code->ext.dt->err, code);
...@@ -15009,11 +15006,6 @@ resolve_fl_namelist (gfc_symbol *sym) ...@@ -15009,11 +15006,6 @@ resolve_fl_namelist (gfc_symbol *sym)
} }
} }
if (async_io_dt)
{
for (nl = sym->namelist; nl; nl = nl->next)
nl->sym->attr.asynchronous = 1;
}
return true; return true;
} }
......
gcc/testsuite/ChangeLog
2020-04-09 Fritz Reese <foreese@gcc.gnu.org>
PR fortran/87923
* gfortran.dg/f2003_io_8.f03: Fix expected error messages.
* gfortran.dg/io_constraints_8.f90: Likewise.
* gfortran.dg/iomsg_2.f90: Likewise.
* gfortran.dg/pr66725.f90: Likewise.
* gfortran.dg/pr88205.f90: Likewise.
* gfortran.dg/write_check4.f90: Likewise.
* gfortran.dg/asynchronous_5.f03: New test.
* gfortran.dg/io_constraints_15.f90: Likewise.
* gfortran.dg/io_constraints_16.f90: Likewise.
* gfortran.dg/io_constraints_17.f90: Likewise.
* gfortran.dg/io_constraints_18.f90: Likewise.
* gfortran.dg/io_tags_1.f90: Likewise.
* gfortran.dg/io_tags_10.f90: Likewise.
* gfortran.dg/io_tags_2.f90: Likewise.
* gfortran.dg/io_tags_3.f90: Likewise.
* gfortran.dg/io_tags_4.f90: Likewise.
* gfortran.dg/io_tags_5.f90: Likewise.
* gfortran.dg/io_tags_6.f90: Likewise.
* gfortran.dg/io_tags_7.f90: Likewise.
* gfortran.dg/io_tags_8.f90: Likewise.
* gfortran.dg/io_tags_9.f90: Likewise.
* gfortran.dg/write_check5.f90: Likewise.
2020-04-09 Richard Sandiford <richard.sandiford@arm.com> 2020-04-09 Richard Sandiford <richard.sandiford@arm.com>
* gcc.target/aarch64/sve/acle/general/attributes_1.c: New test. * gcc.target/aarch64/sve/acle/general/attributes_1.c: New test.
......
gcc/testsuite/gfortran.dg/asynchronous_5.f03 0 → 100644
! { dg-do compile }
! { dg-options "-std=f2003" }
!
! Covers code introduced by the fix to PR fortran/87923.
! The idea is that the variables in a namelist or I/O list used for
! asynchronous I/O will be marked with the asynchronous attribute.
!
! At this time, "asynchronous" is treated as "volatile" (see trans-decl.c).
! Thus, every variable referenced in an "asynchronous=yes" I/O list
! should obtain the "volatile" specifier in its declaration.
!
type t
character(4) :: comp_async
end type
character(2) :: ccvar_async
type(t) :: dvar_async
integer :: ivar_async
real :: rvar_async
logical :: lvar_async
type(t), dimension(2) :: darrvar_async
integer :: ivar_noasync
namelist /names/ ivar_async, rvar_async, lvar_async
open(1, asynchronous="yes")
write(1, asynchronous="yes") dvar_async, ccvar_async
write(1, asynchronous="yes") dvar_async%comp_async, darrvar_async
read(1, asynchronous="yes", nml=names)
open(2, asynchronous="no")
read(2, asynchronous="no") ivar_noasync
end
! { dg-final { scan-tree-dump-times "volatile.*?ccvar_async" 1 "original" } }
! { dg-final { scan-tree-dump-times "volatile.*?dvar_async" 1 "original" } }
! { dg-final { scan-tree-dump-times "volatile.*?ivar_async" 1 "original" } }
! { dg-final { scan-tree-dump-times "volatile.*?rvar_async" 1 "original" } }
! { dg-final { scan-tree-dump-times "volatile.*?lvar_async" 1 "original" } }
! { dg-final { scan-tree-dump-times "volatile.*?darrvar_async" 1 "original" } }
! { dg-final { scan-tree-dump-not "volatile.*?ivar_noasync" "original" } }
gcc/testsuite/gfortran.dg/f2003_io_8.f03
...@@ -9,5 +9,5 @@ character(25) :: msg ...@@ -9,5 +9,5 @@ character(25) :: msg
open(10, file='mydata_f2003_io_8', asynchronous="yes", blank="null") open(10, file='mydata_f2003_io_8', asynchronous="yes", blank="null")
write(10,'(10f8.3)', asynchronous='no', decimal="comma", id=j) a ! { dg-error "must be with ASYNCHRONOUS=" } write(10,'(10f8.3)', asynchronous='no', decimal="comma", id=j) a ! { dg-error "must be with ASYNCHRONOUS=" }
read(10,'(10f8.3)', id=j, decimal="comma", blank="zero") b ! { dg-error "must be with ASYNCHRONOUS=" } read(10,'(10f8.3)', id=j, decimal="comma", blank="zero") b ! { dg-error "must be with ASYNCHRONOUS=" }
read(10,'(10f8.3)', asynchronous=msg, decimal="comma", blank="zero") b ! { dg-error "must be an initialization expression" } read(10,'(10f8.3)', asynchronous=msg, decimal="comma", blank="zero") b ! { dg-error "does not reduce to a constant expression" }
end end
gcc/testsuite/gfortran.dg/io_constraints_15.f90 0 → 100644
! { dg-do compile }
!
! PR fortran/87923
!
program p
open (1, blank=char(1000,4)) ! { dg-error "must be a character string of default kind" }
open (2, decimal=char(1000,4)) ! { dg-error "must be a character string of default kind" }
open (3, encoding=char(1000,4)) ! { dg-error "must be a character string of default kind" }
open (4, round=char(1000,4)) ! { dg-error "must be a character string of default kind" }
open (5, sign=char(1000,4)) ! { dg-error "must be a character string of default kind" }
end
gcc/testsuite/gfortran.dg/io_constraints_16.f90 0 → 100644
! { dg-do compile }
!
! PR fortran/87923
!
program p
read (1, blank=char(1000,4)) ! { dg-error "must be a character string of default kind" }
read (1, delim=char(1000,4)) ! { dg-error "must be a character string of default kind" }
read (1, pad=char(1000,4)) ! { dg-error "must be a character string of default kind" }
read (1, round=char(1000,4)) ! { dg-error "must be a character string of default kind" }
read (1, sign=char(1000,4)) ! { dg-error "must be a character string of default kind" }
end
gcc/testsuite/gfortran.dg/io_constraints_17.f90 0 → 100644
! { dg-do compile }
!
! PR fortran/87923
!
program p
write (1, blank=char(1000,4)) ! { dg-error "must be a character string of default kind" }
write (1, delim=char(1000,4)) ! { dg-error "must be a character string of default kind" }
write (1, pad=char(1000,4)) ! { dg-error "must be a character string of default kind" }
write (1, round=char(1000,4)) ! { dg-error "must be a character string of default kind" }
write (1, sign=char(1000,4)) ! { dg-error "must be a character string of default kind" }
end
gcc/testsuite/gfortran.dg/io_constraints_18.f90 0 → 100644
! { dg-options "-fdec" }
! { dg-do compile }
!
! PR fortran/87923
!
program p
open (1, carriagecontrol=char(1000,4)) ! { dg-error "must be a character string of default kind" }
open (2, share=char(1000,4)) ! { dg-error "must be a character string of default kind" }
end
gcc/testsuite/gfortran.dg/io_constraints_8.f90
...@@ -14,7 +14,7 @@ integer :: i ...@@ -14,7 +14,7 @@ integer :: i
OPEN(99, access=4_'direct') ! { dg-error "must be a character string of default kind" } OPEN(99, access=4_'direct') ! { dg-error "must be a character string of default kind" }
OPEN(99, action=4_'read') ! { dg-error "must be a character string of default kind" } OPEN(99, action=4_'read') ! { dg-error "must be a character string of default kind" }
OPEN(99, asynchronous=4_'no') ! { dg-error "must be of default CHARACTER kind" } OPEN(99, asynchronous=4_'no') ! { dg-error "must be a character string of default kind" }
OPEN(99, blank=4_'null') ! { dg-error "must be a character string of default kind" } OPEN(99, blank=4_'null') ! { dg-error "must be a character string of default kind" }
OPEN(99, decimal=4_'comma') ! { dg-error "must be a character string of default kind" } OPEN(99, decimal=4_'comma') ! { dg-error "must be a character string of default kind" }
OPEN(99, delim=4_'quote') ! { dg-error "must be a character string of default kind" } OPEN(99, delim=4_'quote') ! { dg-error "must be a character string of default kind" }
......
gcc/testsuite/gfortran.dg/io_tags_1.f90 0 → 100644
! { dg-do compile }
! { dg-options "-std=f2003" }
! Based on PR fortran/66724, also covers fortran/66725 and fortran/87923.
!
backspace (1, iomsg=1) ! { dg-error "IOMSG tag at ... must be of type CHARACTER" }
backspace (1, iomsg=1e1) ! { dg-error "IOMSG tag at ... must be of type CHARACTER" }
backspace (1, iomsg=1d1) ! { dg-error "IOMSG tag at ... must be of type CHARACTER" }
backspace (1, iomsg=.false.) ! { dg-error "IOMSG tag at ... must be of type CHARACTER" }
backspace (1, iomsg='') ! { dg-error "Non-variable expression" }
backspace (1, iomsg='no') ! { dg-error "Non-variable expression" }
backspace (1, iomsg=null()) ! { dg-error "IOMSG tag at ... must be of type CHARACTER" }
backspace (1, iomsg=(1)) ! { dg-error "IOMSG tag at ... must be of type CHARACTER" }
backspace (1, iomsg=(1., 0.)) ! { dg-error "IOMSG tag at ... must be of type CHARACTER" }
backspace (1, iomsg=[1]) ! { dg-error "IOMSG tag at ... must be of type CHARACTER" }
backspace (1, iomsg=['']) ! { dg-error "IOMSG tag at ... must be scalar" }
backspace (1, iomsg=['no']) ! { dg-error "IOMSG tag at ... must be scalar" }
end
gcc/testsuite/gfortran.dg/io_tags_10.f90 0 → 100644
! { dg-do compile }
! { dg-options "-std=f2003" }
! Based on PR fortran/66724, also covers fortran/66725 and fortran/87923.
!
write (1, blank='') ! { dg-error "BLANK specifier in WRITE statement at ... has invalid value" }
write (1, asynchronous=1) ! { dg-error "ASYNCHRONOUS tag at ... must be of type CHARACTER" }
write (1, asynchronous=1e1) ! { dg-error "ASYNCHRONOUS tag at ... must be of type CHARACTER" }
write (1, asynchronous=1d1) ! { dg-error "ASYNCHRONOUS tag at ... must be of type CHARACTER" }
write (1, asynchronous=.false.) ! { dg-error "ASYNCHRONOUS tag at ... must be of type CHARACTER" }
write (1, asynchronous='') ! { dg-error "ASYNCHRONOUS specifier in WRITE statement at ... has invalid value" }
write (1, asynchronous='no')
write (1, asynchronous=null()) ! { dg-error "ASYNCHRONOUS tag at ... must be of type CHARACTER" }
write (1, asynchronous=(1)) ! { dg-error "ASYNCHRONOUS tag at ... must be of type CHARACTER" }
write (1, asynchronous=(1., 0.)) ! { dg-error "ASYNCHRONOUS tag at ... must be of type CHARACTER" }
write (1, asynchronous=[1]) ! { dg-error "ASYNCHRONOUS tag at ... must be of type CHARACTER" }
write (1, asynchronous=['']) ! { dg-error "ASYNCHRONOUS tag at ... must be scalar" }
write (1, blank=1) ! { dg-error "BLANK tag at ... must be of type CHARACTER" }
write (1, blank=1e1) ! { dg-error "BLANK tag at ... must be of type CHARACTER" }
write (1, blank=1d1) ! { dg-error "BLANK tag at ... must be of type CHARACTER" }
write (1, blank=.false.) ! { dg-error "BLANK tag at ... must be of type CHARACTER" }
write (1, blank='no') ! { dg-error "BLANK specifier in WRITE statement at ... has invalid value" }
write (1, blank=null()) ! { dg-error "BLANK tag at ... must be of type CHARACTER" }
write (1, blank=(1)) ! { dg-error "BLANK tag at ... must be of type CHARACTER" }
write (1, blank=(1., 0.)) ! { dg-error "BLANK tag at ... must be of type CHARACTER" }
write (1, blank=[1]) ! { dg-error "BLANK tag at ... must be of type CHARACTER" }
write (1, blank=['']) ! { dg-error "BLANK tag at ... must be scalar" }
write (1, delim=1) ! { dg-error "DELIM tag at ... must be of type CHARACTER" }
write (1, delim=1e1) ! { dg-error "DELIM tag at ... must be of type CHARACTER" }
write (1, delim=1d1) ! { dg-error "DELIM tag at ... must be of type CHARACTER" }
write (1, delim=.false.) ! { dg-error "DELIM tag at ... must be of type CHARACTER" }
write (1, delim='') ! { dg-error "DELIM specifier in WRITE statement at ... has invalid value" }
write (1, delim='no') ! { dg-error "DELIM specifier in WRITE statement at ... has invalid value" }
write (1, delim=null()) ! { dg-error "DELIM tag at ... must be of type CHARACTER" }
write (1, delim=(1)) ! { dg-error "DELIM tag at ... must be of type CHARACTER" }
write (1, delim=(1., 0.)) ! { dg-error "DELIM tag at ... must be of type CHARACTER" }
write (1, delim=[1]) ! { dg-error "DELIM tag at ... must be of type CHARACTER" }
write (1, delim=['']) ! { dg-error "DELIM tag at ... must be scalar" }
write (1, decimal=1) ! { dg-error "DECIMAL tag at ... must be of type CHARACTER" }
write (1, decimal=1e1) ! { dg-error "DECIMAL tag at ... must be of type CHARACTER" }
write (1, decimal=1d1) ! { dg-error "DECIMAL tag at ... must be of type CHARACTER" }
write (1, decimal=.false.) ! { dg-error "DECIMAL tag at ... must be of type CHARACTER" }
write (1, decimal='') ! { dg-error "DECIMAL specifier in WRITE statement at ... has invalid value" }
write (1, decimal='no') ! { dg-error "DECIMAL specifier in WRITE statement at ... has invalid value" }
write (1, decimal=null()) ! { dg-error "DECIMAL tag at ... must be of type CHARACTER" }
write (1, decimal=(1)) ! { dg-error "DECIMAL tag at ... must be of type CHARACTER" }
write (1, decimal=(1., 0.)) ! { dg-error "DECIMAL tag at ... must be of type CHARACTER" }
write (1, decimal=[1]) ! { dg-error "DECIMAL tag at ... must be of type CHARACTER" }
write (1, decimal=['']) ! { dg-error "DECIMAL tag at ... must be scalar" }
write (1, iomsg=1) ! { dg-error "IOMSG tag at ... must be of type CHARACTER" }
write (1, iomsg=1e1) ! { dg-error "IOMSG tag at ... must be of type CHARACTER" }
write (1, iomsg=1d1) ! { dg-error "IOMSG tag at ... must be of type CHARACTER" }
write (1, iomsg=.false.) ! { dg-error "IOMSG tag at ... must be of type CHARACTER" }
write (1, iomsg='') ! { dg-error "Non-variable expression" }
write (1, iomsg='no') ! { dg-error "Non-variable expression" }
write (1, iomsg=null()) ! { dg-error "IOMSG tag at ... must be of type CHARACTER" }
write (1, iomsg=(1)) ! { dg-error "IOMSG tag at ... must be of type CHARACTER" }
write (1, iomsg=(1., 0.)) ! { dg-error "IOMSG tag at ... must be of type CHARACTER" }
write (1, iomsg=[1]) ! { dg-error "IOMSG tag at ... must be of type CHARACTER" }
write (1, iomsg=['']) ! { dg-error "IOMSG tag at ... must be scalar" }
write (1, pad=1) ! { dg-error "PAD tag at ... must be of type CHARACTER" }
write (1, pad=1e1) ! { dg-error "PAD tag at ... must be of type CHARACTER" }
write (1, pad=1d1) ! { dg-error "PAD tag at ... must be of type CHARACTER" }
write (1, pad=.false.) ! { dg-error "PAD tag at ... must be of type CHARACTER" }
write (1, pad='') ! { dg-error "PAD specifier in WRITE statement at ... has invalid value" }
write (1, pad='no') ! { dg-error "the PAD= specifier at ... must be with an explicit format expression" }
write (1, pad=null()) ! { dg-error "PAD tag at ... must be of type CHARACTER" }
write (1, pad=(1)) ! { dg-error "PAD tag at ... must be of type CHARACTER" }
write (1, pad=(1., 0.)) ! { dg-error "PAD tag at ... must be of type CHARACTER" }
write (1, pad=[1]) ! { dg-error "PAD tag at ... must be of type CHARACTER" }
write (1, pad=['']) ! { dg-error "PAD tag at ... must be scalar" }
write (1, round=1) ! { dg-error "ROUND tag at ... must be of type CHARACTER" }
write (1, round=1e1) ! { dg-error "ROUND tag at ... must be of type CHARACTER" }
write (1, round=1d1) ! { dg-error "ROUND tag at ... must be of type CHARACTER" }
write (1, round=.false.) ! { dg-error "ROUND tag at ... must be of type CHARACTER" }
write (1, round='') ! { dg-error "ROUND specifier in WRITE statement at ... has invalid value" }
write (1, round='no') ! { dg-error "ROUND specifier in WRITE statement at ... has invalid value" }
write (1, round=null()) ! { dg-error "ROUND tag at ... must be of type CHARACTER" }
write (1, round=(1)) ! { dg-error "ROUND tag at ... must be of type CHARACTER" }
write (1, round=(1., 0.)) ! { dg-error "ROUND tag at ... must be of type CHARACTER" }
write (1, round=[1]) ! { dg-error "ROUND tag at ... must be of type CHARACTER" }
write (1, round=['']) ! { dg-error "ROUND tag at ... must be scalar" }
write (1, sign=1) ! { dg-error "SIGN tag at ... must be of type CHARACTER" }
write (1, sign=1e1) ! { dg-error "SIGN tag at ... must be of type CHARACTER" }
write (1, sign=1d1) ! { dg-error "SIGN tag at ... must be of type CHARACTER" }
write (1, sign=.false.) ! { dg-error "SIGN tag at ... must be of type CHARACTER" }
write (1, sign='') ! { dg-error "SIGN specifier in WRITE statement at ... has invalid value" }
write (1, sign='no') ! { dg-error "SIGN specifier in WRITE statement at ... has invalid value" }
write (1, sign=null()) ! { dg-error "SIGN tag at ... must be of type CHARACTER" }
write (1, sign=(1)) ! { dg-error "SIGN tag at ... must be of type CHARACTER" }
write (1, sign=(1., 0.)) ! { dg-error "SIGN tag at ... must be of type CHARACTER" }
write (1, sign=[1]) ! { dg-error "SIGN tag at ... must be of type CHARACTER" }
write (1, sign=['']) ! { dg-error "SIGN tag at ... must be scalar" }
end
gcc/testsuite/gfortran.dg/io_tags_2.f90 0 → 100644
! { dg-do compile }
! { dg-options "-std=f2003" }
! Based on PR fortran/66724, also covers fortran/66725 and fortran/87923.
!
close (1, iomsg=1) ! { dg-error "IOMSG tag at ... must be of type CHARACTER" }
close (1, iomsg=1e1) ! { dg-error "IOMSG tag at ... must be of type CHARACTER" }
close (1, iomsg=1d1) ! { dg-error "IOMSG tag at ... must be of type CHARACTER" }
close (1, iomsg=.false.) ! { dg-error "IOMSG tag at ... must be of type CHARACTER" }
close (1, iomsg='') ! { dg-error "Non-variable expression" }
close (1, iomsg='no') ! { dg-error "Non-variable expression" }
close (1, iomsg=null()) ! { dg-error "IOMSG tag at ... must be of type CHARACTER" }
close (1, iomsg=(1)) ! { dg-error "IOMSG tag at ... must be of type CHARACTER" }
close (1, iomsg=(1., 0.)) ! { dg-error "IOMSG tag at ... must be of type CHARACTER" }
close (1, iomsg=[1]) ! { dg-error "IOMSG tag at ... must be of type CHARACTER" }
close (1, iomsg=['']) ! { dg-error "IOMSG tag at ... must be scalar" }
close (1, iomsg=['no']) ! { dg-error "IOMSG tag at ... must be scalar" }
close (1, status=1) ! { dg-error "STATUS tag at ... must be of type CHARACTER" }
close (1, status=1e1) ! { dg-error "STATUS tag at ... must be of type CHARACTER" }
close (1, status=1d1) ! { dg-error "STATUS tag at ... must be of type CHARACTER" }
close (1, status=.false.) ! { dg-error "STATUS tag at ... must be of type CHARACTER" }
close (1, status='') ! { dg-error "STATUS specifier in CLOSE statement at ... has invalid value" }
close (1, status='no') ! { dg-error "STATUS specifier in CLOSE statement at ... has invalid value" }
close (1, status=null()) ! { dg-error "STATUS tag at ... must be of type CHARACTER" }
close (1, status=(1)) ! { dg-error "STATUS tag at ... must be of type CHARACTER" }
close (1, status=(1., 0.)) ! { dg-error "STATUS tag at ... must be of type CHARACTER" }
close (1, status=[1]) ! { dg-error "STATUS tag at ... must be of type CHARACTER" }
close (1, status=['']) ! { dg-error "STATUS tag at ... must be scalar" }
end
gcc/testsuite/gfortran.dg/io_tags_3.f90 0 → 100644
! { dg-do compile }
! { dg-options "-std=f2003" }
! Based on PR fortran/66724, also covers fortran/66725 and fortran/87923.
!
endfile (1, iomsg=1) ! { dg-error "IOMSG tag at ... must be of type CHARACTER" }
endfile (1, iomsg=1e1) ! { dg-error "IOMSG tag at ... must be of type CHARACTER" }
endfile (1, iomsg=1d1) ! { dg-error "IOMSG tag at ... must be of type CHARACTER" }
endfile (1, iomsg=.false.) ! { dg-error "IOMSG tag at ... must be of type CHARACTER" }
endfile (1, iomsg='') ! { dg-error "Non-variable expression" }
endfile (1, iomsg='no') ! { dg-error "Non-variable expression" }
endfile (1, iomsg=null()) ! { dg-error "IOMSG tag at ... must be of type CHARACTER" }
endfile (1, iomsg=(1)) ! { dg-error "IOMSG tag at ... must be of type CHARACTER" }
endfile (1, iomsg=(1., 0.)) ! { dg-error "IOMSG tag at ... must be of type CHARACTER" }
endfile (1, iomsg=[1]) ! { dg-error "IOMSG tag at ... must be of type CHARACTER" }
endfile (1, iomsg=['']) ! { dg-error "IOMSG tag at ... must be scalar" }
end
gcc/testsuite/gfortran.dg/io_tags_4.f90 0 → 100644
! { dg-do compile }
! { dg-options "-std=f2003" }
! Based on PR fortran/66724, also covers fortran/66725 and fortran/87923.
!
flush (1, iomsg=1) ! { dg-error "IOMSG tag at ... must be of type CHARACTER" }
flush (1, iomsg=1e1) ! { dg-error "IOMSG tag at ... must be of type CHARACTER" }
flush (1, iomsg=1d1) ! { dg-error "IOMSG tag at ... must be of type CHARACTER" }
flush (1, iomsg=.false.) ! { dg-error "IOMSG tag at ... must be of type CHARACTER" }
flush (1, iomsg='') ! { dg-error "Non-variable expression" }
flush (1, iomsg='no') ! { dg-error "Non-variable expression" }
flush (1, iomsg=null()) ! { dg-error "IOMSG tag at ... must be of type CHARACTER" }
flush (1, iomsg=(1)) ! { dg-error "IOMSG tag at ... must be of type CHARACTER" }
flush (1, iomsg=(1., 0.)) ! { dg-error "IOMSG tag at ... must be of type CHARACTER" }
flush (1, iomsg=[1]) ! { dg-error "IOMSG tag at ... must be of type CHARACTER" }
flush (1, iomsg=['']) ! { dg-error "IOMSG tag at ... must be scalar" }
end
gcc/testsuite/gfortran.dg/io_tags_5.f90 0 → 100644
! { dg-do compile }
! { dg-options "-std=f2003" }
! Based on PR fortran/66724, also covers fortran/66725 and fortran/87923.
!
inquire (1, iomsg=1) ! { dg-error "IOMSG tag at ... must be of type CHARACTER" }
inquire (1, iomsg=1e1) ! { dg-error "IOMSG tag at ... must be of type CHARACTER" }
inquire (1, iomsg=1d1) ! { dg-error "IOMSG tag at ... must be of type CHARACTER" }
inquire (1, iomsg=.false.) ! { dg-error "IOMSG tag at ... must be of type CHARACTER" }
inquire (1, iomsg='') ! { dg-error "Non-variable expression" }
inquire (1, iomsg='no') ! { dg-error "Non-variable expression" }
inquire (1, iomsg=null()) ! { dg-error "IOMSG tag at ... must be of type CHARACTER" }
inquire (1, iomsg=(1)) ! { dg-error "IOMSG tag at ... must be of type CHARACTER" }
inquire (1, iomsg=(1., 0.)) ! { dg-error "IOMSG tag at ... must be of type CHARACTER" }
inquire (1, iomsg=[1]) ! { dg-error "IOMSG tag at ... must be of type CHARACTER" }
inquire (1, iomsg=['']) ! { dg-error "IOMSG tag at ... must be scalar" }
end
gcc/testsuite/gfortran.dg/io_tags_7.f90 0 → 100644
! { dg-do compile }
! { dg-options "-std=f2003" }
! Based on PR fortran/66724, also covers fortran/66725 and fortran/87923.
!
read (1, asynchronous=1) ! { dg-error "ASYNCHRONOUS tag at ... must be of type CHARACTER" }
read (1, asynchronous=1e1) ! { dg-error "ASYNCHRONOUS tag at ... must be of type CHARACTER" }
read (1, asynchronous=1d1) ! { dg-error "ASYNCHRONOUS tag at ... must be of type CHARACTER" }
read (1, asynchronous=.false.) ! { dg-error "ASYNCHRONOUS tag at ... must be of type CHARACTER" }
read (1, asynchronous='') ! { dg-error "ASYNCHRONOUS specifier in READ statement at ... has invalid value" }
read (1, asynchronous='no')
read (1, asynchronous=null()) ! { dg-error "ASYNCHRONOUS tag at ... must be of type CHARACTER" }
read (1, asynchronous=(1)) ! { dg-error "ASYNCHRONOUS tag at ... must be of type CHARACTER" }
read (1, asynchronous=(1., 0.)) ! { dg-error "ASYNCHRONOUS tag at ... must be of type CHARACTER" }
read (1, asynchronous=[1]) ! { dg-error "ASYNCHRONOUS tag at ... must be of type CHARACTER" }
read (1, asynchronous=['']) ! { dg-error "ASYNCHRONOUS tag at ... must be scalar" }
read (1, blank=1) ! { dg-error "BLANK tag at ... must be of type CHARACTER" }
read (1, blank=1e1) ! { dg-error "BLANK tag at ... must be of type CHARACTER" }
read (1, blank=1d1) ! { dg-error "BLANK tag at ... must be of type CHARACTER" }
read (1, blank=.false.) ! { dg-error "BLANK tag at ... must be of type CHARACTER" }
read (1, blank='') ! { dg-error "BLANK specifier in READ statement at ... has invalid value" }
read (1, blank='no') ! { dg-error "BLANK specifier in READ statement at ... has invalid value" }
read (1, blank=null()) ! { dg-error "BLANK tag at ... must be of type CHARACTER" }
read (1, blank=(1)) ! { dg-error "BLANK tag at ... must be of type CHARACTER" }
read (1, blank=(1., 0.)) ! { dg-error "BLANK tag at ... must be of type CHARACTER" }
read (1, blank=[1]) ! { dg-error "BLANK tag at ... must be of type CHARACTER" }
read (1, blank=['']) ! { dg-error "BLANK tag at ... must be scalar" }
read (1, delim=1) ! { dg-error "DELIM tag at ... must be of type CHARACTER" }
read (1, delim=1e1) ! { dg-error "DELIM tag at ... must be of type CHARACTER" }
read (1, delim=1d1) ! { dg-error "DELIM tag at ... must be of type CHARACTER" }
read (1, delim=.false.) ! { dg-error "DELIM tag at ... must be of type CHARACTER" }
read (1, delim='') ! { dg-error "DELIM specifier in READ statement at ... has invalid value" }
read (1, delim='no') ! { dg-error "DELIM specifier in READ statement at ... has invalid value" }
read (1, delim=null()) ! { dg-error "DELIM tag at ... must be of type CHARACTER" }
read (1, delim=(1)) ! { dg-error "DELIM tag at ... must be of type CHARACTER" }
read (1, delim=(1., 0.)) ! { dg-error "DELIM tag at ... must be of type CHARACTER" }
read (1, delim=[1]) ! { dg-error "DELIM tag at ... must be of type CHARACTER" }
read (1, delim=['']) ! { dg-error "DELIM tag at ... must be scalar" }
read (1, decimal=1) ! { dg-error "DECIMAL tag at ... must be of type CHARACTER" }
read (1, decimal=1e1) ! { dg-error "DECIMAL tag at ... must be of type CHARACTER" }
read (1, decimal=1d1) ! { dg-error "DECIMAL tag at ... must be of type CHARACTER" }
read (1, decimal=.false.) ! { dg-error "DECIMAL tag at ... must be of type CHARACTER" }
read (1, decimal='') ! { dg-error "DECIMAL specifier in READ statement at ... has invalid value" }
read (1, decimal='no') ! { dg-error "DECIMAL specifier in READ statement at ... has invalid value" }
read (1, decimal=null()) ! { dg-error "DECIMAL tag at ... must be of type CHARACTER" }
read (1, decimal=(1)) ! { dg-error "DECIMAL tag at ... must be of type CHARACTER" }
read (1, decimal=(1., 0.)) ! { dg-error "DECIMAL tag at ... must be of type CHARACTER" }
read (1, decimal=[1]) ! { dg-error "DECIMAL tag at ... must be of type CHARACTER" }
read (1, decimal=['']) ! { dg-error "DECIMAL tag at ... must be scalar" }
read (1, iomsg=1) ! { dg-error "IOMSG tag at ... must be of type CHARACTER" }
read (1, iomsg=1e1) ! { dg-error "IOMSG tag at ... must be of type CHARACTER" }
read (1, iomsg=1d1) ! { dg-error "IOMSG tag at ... must be of type CHARACTER" }
read (1, iomsg=.false.) ! { dg-error "IOMSG tag at ... must be of type CHARACTER" }
read (1, iomsg='') ! { dg-error "Non-variable expression" }
read (1, iomsg='no') ! { dg-error "Non-variable expression" }
read (1, iomsg=null()) ! { dg-error "IOMSG tag at ... must be of type CHARACTER" }
read (1, iomsg=(1)) ! { dg-error "IOMSG tag at ... must be of type CHARACTER" }
read (1, iomsg=(1., 0.)) ! { dg-error "IOMSG tag at ... must be of type CHARACTER" }
read (1, iomsg=[1]) ! { dg-error "IOMSG tag at ... must be of type CHARACTER" }
read (1, iomsg=['']) ! { dg-error "IOMSG tag at ... must be scalar" }
read (1, pad=1) ! { dg-error "PAD tag at ... must be of type CHARACTER" }
read (1, pad=1e1) ! { dg-error "PAD tag at ... must be of type CHARACTER" }
read (1, pad=1d1) ! { dg-error "PAD tag at ... must be of type CHARACTER" }
read (1, pad=.false.) ! { dg-error "PAD tag at ... must be of type CHARACTER" }
read (1, pad='') ! { dg-error "PAD specifier in READ statement at ... has invalid value" }
read (1, pad='no') ! { dg-error "the PAD= specifier at ... must be with an explicit format expression" }
read (1, pad=null()) ! { dg-error "PAD tag at ... must be of type CHARACTER" }
read (1, pad=(1)) ! { dg-error "PAD tag at ... must be of type CHARACTER" }
read (1, pad=(1., 0.)) ! { dg-error "PAD tag at ... must be of type CHARACTER" }
read (1, pad=[1]) ! { dg-error "PAD tag at ... must be of type CHARACTER" }
read (1, pad=['']) ! { dg-error "PAD tag at ... must be scalar" }
read (1, round=1) ! { dg-error "ROUND tag at ... must be of type CHARACTER" }
read (1, round=1e1) ! { dg-error "ROUND tag at ... must be of type CHARACTER" }
read (1, round=1d1) ! { dg-error "ROUND tag at ... must be of type CHARACTER" }
read (1, round=.false.) ! { dg-error "ROUND tag at ... must be of type CHARACTER" }
read (1, round='') ! { dg-error "ROUND specifier in READ statement at ... has invalid value" }
read (1, round='no') ! { dg-error "ROUND specifier in READ statement at ... has invalid value" }
read (1, round=null()) ! { dg-error "ROUND tag at ... must be of type CHARACTER" }
read (1, round=(1)) ! { dg-error "ROUND tag at ... must be of type CHARACTER" }
read (1, round=(1., 0.)) ! { dg-error "ROUND tag at ... must be of type CHARACTER" }
read (1, round=[1]) ! { dg-error "ROUND tag at ... must be of type CHARACTER" }
read (1, round=['']) ! { dg-error "ROUND tag at ... must be scalar" }
read (1, sign=1) ! { dg-error "SIGN tag at ... must be of type CHARACTER" }
read (1, sign=1e1) ! { dg-error "SIGN tag at ... must be of type CHARACTER" }
read (1, sign=1d1) ! { dg-error "SIGN tag at ... must be of type CHARACTER" }
read (1, sign=.false.) ! { dg-error "SIGN tag at ... must be of type CHARACTER" }
read (1, sign='') ! { dg-error "SIGN specifier in READ statement at ... has invalid value" }
read (1, sign='no') ! { dg-error "SIGN specifier in READ statement at ... has invalid value" }
read (1, sign=null()) ! { dg-error "SIGN tag at ... must be of type CHARACTER" }
read (1, sign=(1)) ! { dg-error "SIGN tag at ... must be of type CHARACTER" }
read (1, sign=(1., 0.)) ! { dg-error "SIGN tag at ... must be of type CHARACTER" }
read (1, sign=[1]) ! { dg-error "SIGN tag at ... must be of type CHARACTER" }
read (1, sign=['']) ! { dg-error "SIGN tag at ... must be scalar" }
end
gcc/testsuite/gfortran.dg/io_tags_8.f90 0 → 100644
! { dg-do compile }
! { dg-options "-std=f2003" }
! Based on PR fortran/66724, also covers fortran/66725 and fortran/87923.
!
rewind (1, iomsg=1) ! { dg-error "IOMSG tag at ... must be of type CHARACTER" }
rewind (1, iomsg=1e1) ! { dg-error "IOMSG tag at ... must be of type CHARACTER" }
rewind (1, iomsg=1d1) ! { dg-error "IOMSG tag at ... must be of type CHARACTER" }
rewind (1, iomsg=.false.) ! { dg-error "IOMSG tag at ... must be of type CHARACTER" }
rewind (1, iomsg='') ! { dg-error "Non-variable expression" }
rewind (1, iomsg='no') ! { dg-error "Non-variable expression" }
rewind (1, iomsg=null()) ! { dg-error "IOMSG tag at ... must be of type CHARACTER" }
rewind (1, iomsg=(1)) ! { dg-error "IOMSG tag at ... must be of type CHARACTER" }
rewind (1, iomsg=(1., 0.)) ! { dg-error "IOMSG tag at ... must be of type CHARACTER" }
rewind (1, iomsg=[1]) ! { dg-error "IOMSG tag at ... must be of type CHARACTER" }
rewind (1, iomsg=['']) ! { dg-error "IOMSG tag at ... must be scalar" }
end
gcc/testsuite/gfortran.dg/io_tags_9.f90 0 → 100644
! { dg-do compile }
! { dg-options "-std=f2003" }
! Based on PR fortran/66724, also covers fortran/66725 and fortran/87923.
!
wait (1, iomsg=1) ! { dg-error "IOMSG tag at ... must be of type CHARACTER" }
wait (1, iomsg=1e1) ! { dg-error "IOMSG tag at ... must be of type CHARACTER" }
wait (1, iomsg=1d1) ! { dg-error "IOMSG tag at ... must be of type CHARACTER" }
wait (1, iomsg=.false.) ! { dg-error "IOMSG tag at ... must be of type CHARACTER" }
wait (1, iomsg='') ! { dg-error "Non-variable expression" }
wait (1, iomsg='no') ! { dg-error "Non-variable expression" }
wait (1, iomsg=null()) ! { dg-error "IOMSG tag at ... must be of type CHARACTER" }
wait (1, iomsg=(1)) ! { dg-error "IOMSG tag at ... must be of type CHARACTER" }
wait (1, iomsg=(1., 0.)) ! { dg-error "IOMSG tag at ... must be of type CHARACTER" }
wait (1, iomsg=[1]) ! { dg-error "IOMSG tag at ... must be of type CHARACTER" }
wait (1, iomsg=['']) ! { dg-error "IOMSG tag at ... must be scalar" }
end
gcc/testsuite/gfortran.dg/iomsg_2.f90
...@@ -2,30 +2,30 @@ ...@@ -2,30 +2,30 @@
subroutine foo1 subroutine foo1
implicit none implicit none
integer i integer i
open(1, iomsg=666) ! { dg-error "IOMSG must be" } open(1, iomsg=666) ! { dg-error "must be of type CHARACTER" }
open(1, iomsg='sgk') ! { dg-error "IOMSG must be" } open(1, iomsg='sgk') ! { dg-error "Non-variable expression" }
open(1, iomsg=i) ! { dg-error "IOMSG must be" } open(1, iomsg=i) ! { dg-error "must be of type CHARACTER" }
close(1, iomsg=666) ! { dg-error "IOMSG must be" } close(1, iomsg=666) ! { dg-error "must be of type CHARACTER" }
close(1, iomsg='sgk') ! { dg-error "IOMSG must be" } close(1, iomsg='sgk') ! { dg-error "Non-variable expression" }
close(1, iomsg=i) ! { dg-error "IOMSG must be" } close(1, iomsg=i) ! { dg-error "must be of type CHARACTER" }
end subroutine foo1 end subroutine foo1
subroutine foo subroutine foo
implicit none implicit none
integer i integer i
real :: x = 1 real :: x = 1
write(1, *, iomsg='sgk') x ! { dg-error "IOMSG must be" } write(1, *, iomsg='sgk') x ! { dg-error "Non-variable expression" }
write(1, *, iomsg=i) x ! { dg-error "IOMSG must be" } write(1, *, iomsg=i) x ! { dg-error "must be of type CHARACTER" }
read(1, *, iomsg='sgk') x ! { dg-error "IOMSG must be" } read(1, *, iomsg='sgk') x ! { dg-error "Non-variable expression" }
read(1, *, iomsg=i) x ! { dg-error "IOMSG must be" } read(1, *, iomsg=i) x ! { dg-error "must be of type CHARACTER" }
flush(1, iomsg='sgk') ! { dg-error "IOMSG must be" } flush(1, iomsg='sgk') ! { dg-error "Non-variable expression" }
flush(1, iomsg=i) ! { dg-error "IOMSG must be" } flush(1, iomsg=i) ! { dg-error "must be of type CHARACTER" }
rewind(1, iomsg='sgk') ! { dg-error "IOMSG must be" } rewind(1, iomsg='sgk') ! { dg-error "Non-variable expression" }
rewind(1, iomsg=i) ! { dg-error "IOMSG must be" } rewind(1, iomsg=i) ! { dg-error "must be of type CHARACTER" }
backspace(1,iomsg='sgk') ! { dg-error "IOMSG must be" } backspace(1,iomsg='sgk') ! { dg-error "Non-variable expression" }
backspace(1,iomsg=i) ! { dg-error "IOMSG must be" } backspace(1,iomsg=i) ! { dg-error "must be of type CHARACTER" }
wait(1, iomsg='sgk') ! { dg-error "IOMSG must be" } wait(1, iomsg='sgk') ! { dg-error "Non-variable expression" }
wait(1, iomsg=i) ! { dg-error "IOMSG must be" } wait(1, iomsg=i) ! { dg-error "must be of type CHARACTER" }
end subroutine foo end subroutine foo
subroutine bar subroutine bar
......
gcc/testsuite/gfortran.dg/pr66725.f90
...@@ -3,29 +3,29 @@ ...@@ -3,29 +3,29 @@
! !
program foo program foo
open(unit=1,access = 999) ! { dg-error "ACCESS requires" } open(unit=1,access = 999) ! { dg-error "must be of type CHARACTER" }
open(unit=1,action = 999) ! { dg-error "ACTION requires" } open(unit=1,action = 999) ! { dg-error "must be of type CHARACTER" }
open(unit=1,asynchronous = 999) ! { dg-error "ASYNCHRONOUS requires" } open(unit=1,asynchronous = 999) ! { dg-error "must be of type CHARACTER" }
open(unit=1,blank = 999) ! { dg-error "BLANK requires" } open(unit=1,blank = 999) ! { dg-error "must be of type CHARACTER" }
open(unit=1,decimal = 999) ! { dg-error "DECIMAL requires" } open(unit=1,decimal = 999) ! { dg-error "must be of type CHARACTER" }
open(unit=1,delim = 999) ! { dg-error "DELIM requires" } open(unit=1,delim = 999) ! { dg-error "must be of type CHARACTER" }
open(unit=1,encoding = 999) ! { dg-error "ENCODING requires" } open(unit=1,encoding = 999) ! { dg-error "must be of type CHARACTER" }
open(unit=1,form = 999) ! { dg-error "FORM requires" } open(unit=1,form = 999) ! { dg-error "must be of type CHARACTER" }
open(unit=1,pad = 999) ! { dg-error "PAD requires" } open(unit=1,pad = 999) ! { dg-error "must be of type CHARACTER" }
open(unit=1,position = 999) ! { dg-error "POSITION requires" } open(unit=1,position = 999) ! { dg-error "must be of type CHARACTER" }
open(unit=1,round = 999) ! { dg-error "ROUND requires" } open(unit=1,round = 999) ! { dg-error "must be of type CHARACTER" }
open(unit=1,sign = 999) ! { dg-error "SIGN requires" } open(unit=1,sign = 999) ! { dg-error "must be of type CHARACTER" }
open(unit=1,status = 999) ! { dg-error "STATUS requires" } open(unit=1,status = 999) ! { dg-error "must be of type CHARACTER" }
close(unit=1, status=999) ! { dg-error "STATUS requires" } close(unit=1, status=999) ! { dg-error "must be of type CHARACTER" }
write (unit=1, asynchronous=257) ! { dg-error "ASYNCHRONOUS requires" } write (unit=1, asynchronous=257) ! { dg-error "must be of type CHARACTER" }
write (unit=1, delim=257) ! { dg-error "DELIM requires" } write (unit=1, delim=257) ! { dg-error "must be of type CHARACTER" }
write (unit=1, decimal=257) ! { dg-error "DECIMAL requires" } write (unit=1, decimal=257) ! { dg-error "must be of type CHARACTER" }
write (unit=1, round=257) ! { dg-error "ROUND requires" } write (unit=1, round=257) ! { dg-error "must be of type CHARACTER" }
write (unit=1, sign=257) ! { dg-error "SIGN requires" } write (unit=1, sign=257) ! { dg-error "must be of type CHARACTER" }
write (unit=1, blank=257) ! { dg-error "BLANK requires" } write (unit=1, blank=257) ! { dg-error "must be of type CHARACTER" }
write (unit=1, pad=257) ! { dg-error "PAD requires" } write (unit=1, pad=257) ! { dg-error "must be of type CHARACTER" }
end program foo end program foo
gcc/testsuite/gfortran.dg/pr88205.f90
...@@ -2,13 +2,13 @@ ...@@ -2,13 +2,13 @@
! PR fortran/88205 ! PR fortran/88205
subroutine s1 subroutine s1
real, parameter :: status = 0 real, parameter :: status = 0
open (newunit=n, status=status) ! { dg-error "STATUS requires" } open (newunit=n, status=status) ! { dg-error "must be of type CHARACTER" }
end end
subroutine s2 subroutine s2
complex, parameter :: status = 0 complex, parameter :: status = 0
open (newunit=n, status=status) ! { dg-error "STATUS requires" } open (newunit=n, status=status) ! { dg-error "must be of type CHARACTER" }
end end
program p program p
logical, parameter :: status = .false. logical, parameter :: status = .false.
open (newunit=a, status=status) ! { dg-error "STATUS requires" } open (newunit=a, status=status) ! { dg-error "must be of type CHARACTER" }
end end
gcc/testsuite/gfortran.dg/write_check4.f90
...@@ -11,7 +11,7 @@ ...@@ -11,7 +11,7 @@
no = "no" no = "no"
open (unit=10, asynchronous = no) ! Ok, it isn't a transfer stmt open (unit=10, asynchronous = no) ! Ok, it isn't a transfer stmt
write(*,*, asynchronous="Y"//"E"//trim("S ")) ! Ok, it is an init expr write(*,*, asynchronous="Y"//"E"//trim("S ")) ! Ok, it is an init expr
write(*,*, asynchronous=no) ! { dg-error "must be an initialization expression" } write(*,*, asynchronous=no) ! { dg-error "does not reduce to a constant expression" }
read (*,*, asynchronous="Y"//"e"//trim("S ")) read (*,*, asynchronous="Y"//"e"//trim("S "))
read (*,*, asynchronous=no) ! { dg-error "must be an initialization expression" } read (*,*, asynchronous=no) ! { dg-error "does not reduce to a constant expression" }
end end
gcc/testsuite/gfortran.dg/write_check5.f90 0 → 100644
! { dg-do compile }
!
! The asynchronous specifier for a data transfer statement shall be
! an initialization expression
!
module write_check5
contains
function no()
implicit none
character(3) :: no
no = "yes"
endfunction
end module
use write_check5
implicit none
open (unit=10, asynchronous=no()) ! Ok, it isn't a transfer stmt
write(*,*, asynchronous=no()) ! { dg-error "must be an intrinsic function" }
read (*,*, asynchronous=no()) ! { dg-error "must be an intrinsic function" }
end
Markdown is supported
0% or
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment