I attached the wrong test case.
use the one attached.
On 05/24/2014 07:14 PM, Jerry DeLisle wrote:
> Hi folks,
>
> This patch combines Tobias front-end patch with my libgfortran patch to
> resolve
> this PR.
>
> To denote extended derived types (classes) we use a '+' rather than '%' in
> certain parts of the namelist name internally to identify that an extended
> type
> is being dealt with. The runtime is modified to look for this '+' and when it
> is seen, scan ahead for the varname match.
>
> For inherited types, a match could be found in two different ways.
>
> parent%cousin%child
>
> parent%child
>
> This would be internally represented as:
>
> parent+cousin%child
>
> So the '+' sign is used to signal that we have to do a special matching check
> for both possible cases depending on how the user chose to represent it,
> usually
> as the shorter version of the name.
>
> Admittedly, I do not have very many examples of code that use this feature
> yet.
>
> Regression tested on x86-64. Test case attached with patch.
>
> OK for trunk?
>
> Regards,
>
> Jerry
>
> 2014-05-24 Tobias Burnus <bur...@net-b.de>
>
> PR fortran/55117
> * trans-io.c (nml_full_name, transfer_namelist_element): Insert
> a '+' rather then '%' to differentiate namelist variable names
> that are based on extended derived types.
>
> 2014-05-24 Jerry DeLisle <jvdeli...@gcc.gnu.org>
>
> PR libgfortran/55117
> * io/list_read.c (extended_look_ahead): New helper function to
> scan the namelist name and look for matches with the new '+'
> extended type parent indicator. (str_comp_extended): New
> helper function to compare the namelist name with the varname
> namelist. (find_nml_name): Use the new helper functions to match
> the extended type varnames.
>
! { dg-do run }
! { dg-options -std=gnu }
! PR55117 Programs fails namelist read (contains derived types objects)
program test_type_extension
type tk_t
real :: x
end type tk_t
type, extends(tk_t) :: tke_t
character(8) :: string
end type tke_t
type, extends(tke_t) :: deep
integer :: int1
real :: y
character(10) :: the_name
end type deep
type other
integer :: one_oh
integer :: two_oh
end type other
type plain_type
integer :: var1
type(other) :: var2
real :: var3
end type plain_type
type some_other
complex :: varx
type(tke_t) :: tke
type (plain_type) :: varpy
real :: vary
end type some_other
type(deep) :: trouble
type(some_other) :: somethinelse
type(tke_t) :: tke
integer :: answer
namelist /test_NML/ trouble, somethinelse, tke, answer
tke%x = 0.0
tke%string = "xxxxxxxx"
answer = 5
trouble%x = 5.34
trouble%y = 4.25
trouble%string = "yyyy"
trouble%the_name = "mischief"
open(10, status="scratch")
write(10,*) "&TEST_NML"
write(10,*) "TKE%X= 3.14 ,"
write(10,*) "TKE%STRING='kf7rcc',"
write(10,*) "ANSWER= 42,"
write(10,*) "/"
rewind(10)
read(10,NML=test_NML)
if (tke%x - 3.14000010 > .00001) call abort
if (tke%string /= "kf7rcc") call abort
if (answer /= 42) call abort ! hitchkikers guide to the galaxy
end program test_type_extension
