[patch,ping] Namelist IOSTAT behaviour - PR22010

classic Classic list List threaded Threaded
2 messages Options
Reply | Threaded
Open this post in threaded view
|

[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  <[hidden email]>

        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  <[hidden email]>

        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  [hidden email]
!
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  [hidden email]
!
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

Reply | Threaded
Open this post in threaded view
|

Re: [patch,ping] Namelist IOSTAT behaviour - PR22010

Steven Bosscher
On Tuesday 21 June 2005 13:30, THOMAS Paul Richard 169137 wrote:

> 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  <[hidden email]>
>
> 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  <[hidden email]>
>
> PR fortran/22010
> * gfortran.dg/namelist_use.f90: New.
> * gfortran.dg/namelist_use_only.f90: New.

This is OK for mainline, and also for 4.0 when it unfreezes.
Thanks!

Gr.
Steven