The attached patch addresses an issue submitted by Neil
Carlson. He and I have an exchange in the PR's audit
trail hashing out the validity of his code example. I
also asked on the J3 mailing about the his code. It seems
that language of the Fortran standard may have been
misinterpreted when the gfortran code was committed. See
the PR for more information.
The patch has been tested on x86_64-*-freebsd. OK to commit?
2018-12-21 Steven G. Kargl <ka...@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 <ka...@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.
--
Steve
Index: gcc/fortran/module.c
===================================================================
--- gcc/fortran/module.c (revision 267342)
+++ gcc/fortran/module.c (working copy)
@@ -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)
{
Index: gcc/testsuite/gfortran.dg/pr88169_1.f90
===================================================================
--- gcc/testsuite/gfortran.dg/pr88169_1.f90 (nonexistent)
+++ gcc/testsuite/gfortran.dg/pr88169_1.f90 (working copy)
@@ -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" } }
Index: gcc/testsuite/gfortran.dg/pr88169_2.f90
===================================================================
--- gcc/testsuite/gfortran.dg/pr88169_2.f90 (nonexistent)
+++ gcc/testsuite/gfortran.dg/pr88169_2.f90 (working copy)
@@ -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
Index: gcc/testsuite/gfortran.dg/pr88169_3.f90
===================================================================
--- gcc/testsuite/gfortran.dg/pr88169_3.f90 (nonexistent)
+++ gcc/testsuite/gfortran.dg/pr88169_3.f90 (working copy)
@@ -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" } }
