procyberian/gcc
1
0
Fork 0
Code Issues Pull requests Projects Releases Packages Wiki Activity Actions

re PR fortran/51825 (Fortran runtime error: Cannot match namelist object name)

Browse source 
2013-03-20  Tilo Schwarz  <tilo@tilo-schwarz.de>

        PR libfortran/51825
        * io/list_read.c (nml_read_obj): Don't end the component loop on
        a nested derived type, but continue with the next loop iteration.
        (nml_get_obj_data): Don't move the first_nl pointer further in
        the list if a qualifier was found.

2013-03-20  Tilo Schwarz  <tilo@tilo-schwarz.de>

        PR libfortran/51825
        * gcc/testsuite/gfortran.dg/namelist_77.f90: New.
        * gcc/testsuite/gfortran.dg/namelist_78.f90: New.

From-SVN: r196806
This commit is contained in:
Tilo Schwarz 2013-03-20 07:56:02 +00:00 • committed by Tobias Burnus
parent 09c7dc636d
commit a0b67fe26f
5 changed files with 105 additions and 7 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

6
gcc/testsuite/ChangeLog
View file

@ -1,3 +1,9 @@
2013-03-20 Tilo Schwarz <tilo@tilo-schwarz.de>
PR libfortran/51825
* gfortran.dg/namelist_77.f90: New.
* gfortran.dg/namelist_78.f90: New.
2013-03-20 Tilo Schwarz <tilo@tilo-schwarz.de>
PR libfortran/48618

49
gcc/testsuite/gfortran.dg/namelist_77.f90 Normal file
View file

@ -0,0 +1,49 @@
! { dg-do run }
!
! PR libfortran/51825 - Fortran runtime error: Cannot match namelist object name
! Test case derived from PR.
module local_mod
type mytype1
integer :: int1
end type
type mytype2
integer :: n_x
integer :: n_px
end type
type beam_init_struct
character(16) :: chars(1) = ''
type (mytype1) dummy
type (mytype2) grid(1)
end type
end module
program error_namelist
use local_mod
implicit none
type (beam_init_struct) beam_init
namelist / error_params / beam_init
open (10, status='scratch')
write (10, '(a)') "&error_params"
write (10, '(a)') " beam_init%chars(1)='JUNK'"
write (10, '(a)') " beam_init%grid(1)%n_x=3"
write (10, '(a)') " beam_init%grid(1)%n_px=2"
write (10, '(a)') "/"
rewind(10)
read(10, nml=error_params)
close (10)
if (beam_init%chars(1) /= 'JUNK') call abort
if (beam_init%grid(1)%n_x /= 3) call abort
if (beam_init%grid(1)%n_px /= 2) call abort
end program

34
gcc/testsuite/gfortran.dg/namelist_78.f90 Normal file
View file

@ -0,0 +1,34 @@
! { dg-do run }
!
! PR libfortran/51825
! Test case regarding namelist problems with derived types
program namelist
type d1
integer :: j = 0
end type d1
type d2
type(d1) k
end type d2
type d3
type(d2) d(2)
end type d3
type(d3) der
namelist /nmlst/ der
open (10, status='scratch')
write (10, '(a)') "&NMLST"
write (10, '(a)') " DER%D(1)%K%J = 1,"
write (10, '(a)') " DER%D(2)%K%J = 2,"
write (10, '(a)') "/"
rewind(10)
read(10, nml=nmlst)
close (10)
if (der%d(1)%k%j /= 1) call abort
if (der%d(2)%k%j /= 2) call abort
end program namelist

8
libgfortran/ChangeLog
View file

@ -1,3 +1,11 @@
2013-03-20 Tilo Schwarz <tilo@tilo-schwarz.de>
PR libfortran/51825
* io/list_read.c (nml_read_obj): Don't end the component loop on a
nested derived type, but continue with the next loop iteration.
(nml_get_obj_data): Don't move the first_nl pointer further in the
list if a qualifier was found.
2013-03-20 Tilo Schwarz <tilo@tilo-schwarz.de>
PR libfortran/48618

15
libgfortran/io/list_read.c
View file

@ -2578,17 +2578,17 @@ nml_read_obj (st_parameter_dt *dtp, namelist_info * nl, index_type offset,
since a single object can have multiple reads. */
dtp->u.p.expanded_read = 0;
/* Now loop over the components. Update the component pointer
with the return value from nml_write_obj. This loop jumps
past nested derived types by testing if the potential
component name contains '%'. */
/* Now loop over the components. */
for (cmp = nl->next;
cmp &&
!strncmp (cmp->var_name, obj_name, obj_name_len) &&
!strchr (cmp->var_name + obj_name_len, '%');
!strncmp (cmp->var_name, obj_name, obj_name_len);
cmp = cmp->next)
{
/* Jump over nested derived type by testing if the potential
component name contains '%'. */
if (strchr (cmp->var_name + obj_name_len, '%'))
continue;
if (!nml_read_obj (dtp, cmp, (index_type)(pdata - nl->mem_pos),
pprev_nl, nml_err_msg, nml_err_msg_size,
@ -2901,7 +2901,8 @@ get_name:
goto nml_err_ret;
}
if (*pprev_nl == NULL || !component_flag)
/* Don't move first_nl further in the list if a qualifier was found. */
if ((*pprev_nl == NULL && !qualifier_flag) || !component_flag)
first_nl = nl;
root_nl = nl;