OpenE2K/gcc
2
0
Fork 0
Code Issues Pull Requests Projects Releases Wiki Activity

re PR fortran/88169 (Rejects USE rename of namelist group)

Browse Source 
2018-12-21  Steven G. Kargl  <kargl@gcc.gnu.org>

	PR fortran/88169
	* module.c (mio_namelist): Remove an error condition/message that
	is contrary to the Fortran standard.

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

	PR fortran/88169
	* gfortran.dg/pr88169_1.f90: new test.
	* gfortran.dg/pr88169_2.f90: Ditto.
	* gfortran.dg/pr88169_3.f90: Ditto.

From-SVN: r267351
This commit is contained in:
Steven G. Kargl 2018-12-22 17:26:12 +00:00
parent a00165b466
commit 73f5d219bb
6 changed files with 80 additions and 12 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

6
gcc/fortran/ChangeLog
View File

@ -1,3 +1,9 @@
2018-12-22 Steven G. Kargl <kargl@gcc.gnu.org>
PR fortran/88169
* module.c (mio_namelist): Remove an error condition/message that
is contrary to the Fortran standard.
2018-12-22 Thomas Koenig <tkoenig@gcc.gnu.org>
PR fortran/85544

12
gcc/fortran/module.c
View File

@ -3711,7 +3711,6 @@ static void
mio_namelist (gfc_symbol *sym)
{
gfc_namelist *n, *m;
const char *check_name;
mio_lparen ();
@ -3722,17 +3721,6 @@ mio_namelist (gfc_symbol *sym)
}
else
{
/* This departure from the standard is flagged as an error.
It does, in fact, work correctly. TODO: Allow it
conditionally? */
if (sym->attr.flavor == FL_NAMELIST)
{
check_name = find_use_name (sym->name, false);
if (check_name && strcmp (check_name, sym->name) != 0)
gfc_error ("Namelist %s cannot be renamed by USE "
"association to %s", sym->name, check_name);
}
m = NULL;
while (peek_atom () != ATOM_RPAREN)
{

7
gcc/testsuite/ChangeLog
View File

@ -1,3 +1,10 @@
2018-12-21 Steven G. Kargl <kargl@gcc.gnu.org>
PR fortran/88169
* gfortran.dg/pr88169_1.f90: new test.
* gfortran.dg/pr88169_2.f90: Ditto.
* gfortran.dg/pr88169_3.f90: Ditto.
2018-12-21 Steven G. Kargl <kargl@gcc.gnu.org>
PR fortran/69121

21
gcc/testsuite/gfortran.dg/pr88169_1.f90 Normal file
View File

@ -0,0 +1,21 @@
! { dg-do run }
module foo_nml
implicit none
real :: x = -1
namelist /foo/ x
end module
program main
use foo_nml, only: bar => foo, x
implicit none
integer fd
x = 42
open(newunit=fd, file='tmp.dat', status='replace')
write(fd,nml=bar)
close(fd)
open(newunit=fd, file='tmp.dat', status='old')
read(fd,nml=bar)
if (x /= 42) stop 1
close(fd)
end program
! { dg-final { cleanup-modules "foo_nml" } }

31
gcc/testsuite/gfortran.dg/pr88169_2.f90 Normal file
View File

@ -0,0 +1,31 @@
! { dg-do run }
module foo_nml
implicit none
real :: x = -1
namelist /foo/ x
end module
!
! Yes, implicit typing of local variable 'x'.
!
program main
use foo_nml, only: bar => foo
integer fd
x = 42
open(newunit=fd, file='tmp.dat', status='replace')
write(fd,nml=bar)
close(fd)
open(newunit=fd, file='tmp.dat', status='old')
read(fd,nml=bar)
close(fd)
call bah
if (x /= 42) stop 1
end program
subroutine bah
use foo_nml
integer fd
open(newunit=fd, file='tmp.dat', status='old')
read(fd,nml=foo)
if (x /= -1) stop 2
close(fd, status='delete')
end subroutine bah

15
gcc/testsuite/gfortran.dg/pr88169_3.f90 Normal file
View File

@ -0,0 +1,15 @@
! { dg-do compile }
! { dg-options "-std=f95" }
module foo_nml
implicit none
real :: x = -1
namelist /foo/ x
end module
program main
use foo_nml, only: bar => foo, x
implicit none
real a
namelist /bar/a ! { dg-error "already is USE associated" }
end program
! { dg-final { cleanup-modules "foo_nml" } }