diff options
| author | janus <janus@138bc75d-0d04-0410-961f-82ee72b054a4> | 2017-03-28 17:01:05 +0000 |
|---|---|---|
| committer | janus <janus@138bc75d-0d04-0410-961f-82ee72b054a4> | 2017-03-28 17:01:05 +0000 |
| commit | 259bcf21ddd684301c83190a9ce3c86e7b3debf3 (patch) | |
| tree | 6beb828d036294eea66384e7a4eb740ad9421682 /libgfortran | |
| parent | e8ae43242eddc806b002eff4d2bd69f1bee24d46 (diff) | |
| download | gcc-259bcf21ddd684301c83190a9ce3c86e7b3debf3.tar.gz | |
2017-03-28 Janus Weil <janus@gcc.gnu.org>
PR fortran/78661
* trans-io.c (transfer_namelist_element): Perform a polymorphic call
to a DTIO procedure if necessary.
2017-03-28 Janus Weil <janus@gcc.gnu.org>
PR fortran/78661
* gfortran.dg/dtio_25.f90: Modified test case.
* gfortran.dg/dtio_27.f90: New test case.
2017-03-28 Janus Weil <janus@gcc.gnu.org>
PR fortran/78661
* io/write.c (nml_write_obj): Build a class container only if necessary.
git-svn-id: svn+ssh://gcc.gnu.org/svn/gcc/trunk@246546 138bc75d-0d04-0410-961f-82ee72b054a4
Diffstat (limited to 'libgfortran')
| -rw-r--r-- | libgfortran/ChangeLog | 5 | ||||
| -rw-r--r-- | libgfortran/io/write.c | 28 |
2 files changed, 23 insertions, 10 deletions
diff --git a/libgfortran/ChangeLog b/libgfortran/ChangeLog index d585b214833..13fe6bbeb44 100644 --- a/libgfortran/ChangeLog +++ b/libgfortran/ChangeLog @@ -1,3 +1,8 @@ +2017-03-28 Janus Weil <janus@gcc.gnu.org> + + PR fortran/78661 + * io/write.c (nml_write_obj): Build a class container only if necessary. + 2017-03-27 Dominique d'Humieres <dominiq@lps.ens.fr> * io/list_read.c: Insert /* Fall through. */ in the macro diff --git a/libgfortran/io/write.c b/libgfortran/io/write.c index f03929e49f8..af46fe8e623 100644 --- a/libgfortran/io/write.c +++ b/libgfortran/io/write.c @@ -2075,7 +2075,7 @@ nml_write_obj (st_parameter_dt *dtp, namelist_info * obj, index_type offset, /* Write namelist variable names in upper case. If a derived type, nothing is output. If a component, base and base_name are set. */ - if (obj->type != BT_DERIVED) + if (obj->type != BT_DERIVED || obj->dtio_sub != NULL) { namelist_write_newline (dtp); write_character (dtp, " ", 1, 1, NODELIM); @@ -2227,15 +2227,10 @@ nml_write_obj (st_parameter_dt *dtp, namelist_info * obj, index_type offset, int noiostat; int *child_iostat = NULL; gfc_array_i4 vlist; - gfc_class list_obj; formatted_dtio dtio_ptr = (formatted_dtio)obj->dtio_sub; GFC_DIMENSION_SET(vlist.dim[0],1, 0, 0); - list_obj.data = p; - list_obj.vptr = obj->vtable; - list_obj.len = 0; - /* Set iostat, intent(out). */ noiostat = 0; child_iostat = (dtp->common.flags & IOPARM_HAS_IOSTAT) ? @@ -2252,7 +2247,6 @@ nml_write_obj (st_parameter_dt *dtp, namelist_info * obj, index_type offset, child_iomsg = tmp_iomsg; child_iomsg_len = IOMSG_LEN; } - namelist_write_newline (dtp); /* If writing to an internal unit, stash it to allow the child procedure to access it. */ @@ -2261,9 +2255,23 @@ nml_write_obj (st_parameter_dt *dtp, namelist_info * obj, index_type offset, /* Call the user defined formatted WRITE procedure. */ dtp->u.p.current_unit->child_dtio++; - dtio_ptr ((void *)&list_obj, &unit, iotype, &vlist, - child_iostat, child_iomsg, - iotype_len, child_iomsg_len); + if (obj->type == BT_DERIVED) + { + // build a class container + gfc_class list_obj; + list_obj.data = p; + list_obj.vptr = obj->vtable; + list_obj.len = 0; + dtio_ptr ((void *)&list_obj, &unit, iotype, &vlist, + child_iostat, child_iomsg, + iotype_len, child_iomsg_len); + } + else + { + dtio_ptr (p, &unit, iotype, &vlist, + child_iostat, child_iomsg, + iotype_len, child_iomsg_len); + } dtp->u.p.current_unit->child_dtio--; goto obj_loop; |