[patch,ping] Namelist IOSTAT behaviour - PR22010

[THOMAS Paul Richard 169137]

As of this morning, I am back in business with cvs and so can do the honours
here.  Remember that this was a port from g95 that required a couple of bugs
fixing -http://gcc.gnu.org/ml/fortran/2005-06/msg00297.html

OK to commit on mainline (and 4.0)?

Paul T

2005-06-15  Tobias Schlueter  <tobias.schlueter@physik.uni-muenchen.de>

	PR fortran/22010
	Port from g95.
	* module.c (mio_namelist): New function. Correct to set
	namelist_tail and to give error on renaming namelist by use
	association.
	(mio_symbol): Call mio_namelist.

2005-06-15  Paul Thomas  <pault@gcc.gnu.org>

	PR fortran/22010
	* gfortran.dg/namelist_use.f90: New.
	* gfortran.dg/namelist_use_only.f90: New.

*** module.c.old	Mon Jun 13 16:48:16 2005
--- gcc-4.1-20050515/gcc/fortran/module.c	Wed Jun 15 17:33:26 2005
*************** mio_expr (gfc_expr ** ep)
*** 2564,2569 ****
--- 2564,2618 ----
  }
  
  
+ /* Read and write namelists */
+ 
+ static void
+ mio_namelist (gfc_symbol * sym)
+ {
+   gfc_namelist *n, *m;
+   const char *check_name;
+ 
+   mio_lparen ();
+ 
+   if (iomode == IO_OUTPUT)
+     {
+       for (n = sym->namelist; n; n = n->next)
+ 	mio_symbol_ref (&n->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);
+ 	  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)
+ 	{
+ 	  n = gfc_get_namelist ();
+ 	  mio_symbol_ref (&n->sym);
+ 
+ 	  if (sym->namelist == NULL)
+ 	    sym->namelist = n;
+ 	  else
+ 	    m->next = n;
+ 
+ 	  m = n;
+ 	}
+       sym->namelist_tail = m;
+     }
+ 
+   mio_rparen ();
+ }
+ 
+ 
  /* Save/restore lists of gfc_interface stuctures.  When loading an
     interface, we are really appending to the existing list of
     interfaces.  Checking for duplicate and ambiguous interfaces has to
*************** mio_symbol (gfc_symbol * sym)
*** 2724,2729 ****
--- 2773,2779 ----
      sym->component_access =
        MIO_NAME(gfc_access) (sym->component_access, access_types);
  
+   mio_namelist (sym);
    mio_rparen ();
  }
  

! { dg-do run }
! This tests the fix for PR22010, where namelists were not being written to
! and read back from modules.  It has two namelists: one that is USE
! associated and another that is concatenated by USE and host association.
!
! Contributed by Paul Thomas  pault@gcc.gnu.org
!
module global
  character*4 :: aa
  integer :: ii
  real    :: rr
  namelist /nml1/ aa, ii, rr
  namelist /nml2/ aa
end module global
program namelist_use
  use global
  real    :: rrr
  namelist /nml2/ ii, rrr    ! Concatenate use and host associated
variables.
  open (10, status="scratch")
  write (10,*) "&NML1 aa=lmno ii=1 rr=2.5 /"
  write (10,*) "&NML2 aa=pqrs ii=2 rrr=3.5 /"
  rewind (10)
  read (10,nml=nml1,iostat=i)
  if ((i.ne.0).or.(aa.ne."lmno").or.(ii.ne.1).or.(rr.ne.2.5)) call abort ()

  read (10,nml=nml2,iostat=i) 
  if ((i.ne.0).or.(aa.ne."pqrs").or.(ii.ne.2).or.(rrr.ne.3.5)) call abort ()

  close (10)
end program namelist_use


! { dg-do run }
! This tests the fix for PR22010, where namelists were not being written to
! and read back from modules.  It checks that namelists from modules that
are
! selected by an ONLY declaration work correctly, even when the variables in
! the namelist are not host associated. Note that renaming a namelist by USE
! association is not allowed by the standard and this is trapped in
module.c.
!
! Contributed by Paul Thomas  pault@gcc.gnu.org
!
module global
  character*4 :: aa, aaa
  integer :: ii, iii
  real    :: rr, rrr
  namelist /nml1/ aa, ii, rr
  namelist /nml2/ aaa, iii, rrr
contains
  logical function foo()
    foo = (aaa.ne."pqrs").or.(iii.ne.2).or.(rrr.ne.3.5)
  end function foo
end module global
program namelist_use_only
  use global, only : nml1, aa, ii, rr
  use global, only : nml2, rrrr=>rrr, foo
  open (10, status="scratch")
  write (10,*) "&NML1 aa=lmno ii=1 rr=2.5 /"
  write (10,*) "&NML2 aaa=pqrs iii=2 rrr=3.5 /"
  rewind (10)
  read (10,nml=nml1,iostat=i)
  if ((i.ne.0).or.(aa.ne."lmno").or.(ii.ne.1).or.(rr.ne.2.5)) call abort ()

  read (10,nml=nml2,iostat=i) 
  if ((i.ne.0).or.(rrrr.ne.3.5).or.foo()) call abort ()
  close (10)
end program namelist_use_only