re PR fortran/84387 (Defined output does not work for a derived type that has no...
authorJerry DeLisle <jvdelisle@gcc.gnu.org>
Sat, 23 Feb 2019 18:07:10 +0000 (18:07 +0000)
committerJerry DeLisle <jvdelisle@gcc.gnu.org>
Sat, 23 Feb 2019 18:07:10 +0000 (18:07 +0000)
2019-02-23  Jerry DeLisle <jvdelisle@gcc.gnu.org>

PR fortran/84387
* trans-io.c (transfer_expr): Do not return if there are no
components to the derived type or class.

* gfortran.dg/dtio_34.f90: New test.

From-SVN: r269161

gcc/fortran/ChangeLog
gcc/fortran/trans-io.c
gcc/testsuite/ChangeLog
gcc/testsuite/gfortran.dg/dtio_34.f90 [new file with mode: 0644]

index f03302e73a373e0f280f356287386661a438d105..580d4b7fb7a63da5a3506b92b1d89e0f913db1eb 100644 (file)
@@ -1,3 +1,9 @@
+2019-02-23  Jerry DeLisle <jvdelisle@gcc.gnu.org>
+
+       PR fortran/84387
+       * trans-io.c (transfer_expr): Do not return if there are no
+       components to the derived type or class.
+
 2019-02-23  Paul Thomas  <pault@gcc.gnu.org>
 
        PR fortran/88117
index 9a13af4a630cd5bccf8eaba9457fa3b2f0b1790a..9e7071dc12164f82f78e71e439e05caeb6addf56 100644 (file)
@@ -2407,8 +2407,6 @@ transfer_expr (gfc_se * se, gfc_typespec * ts, tree addr_expr,
 
     case_bt_struct:
     case BT_CLASS:
-      if (ts->u.derived->components == NULL)
-       return;
       if (gfc_bt_struct (ts->type) || ts->type == BT_CLASS)
        {
          gfc_symbol *derived;
index 3cd5d935edf2fe682d1ae22a165aca3fb568ff7c..958564ac8b002e98cb27c33207928346f5277b42 100644 (file)
@@ -1,3 +1,8 @@
+2019-02-23  Jerry DeLisle <jvdelisle@gcc.gnu.org>
+
+       PR fortran/84387
+       * gfortran.dg/dtio_34.f90: New test.
+
 2019-02-23  Marek Polacek  <polacek@redhat.com>
 
        PR c++/88294 - ICE with non-constant noexcept-specifier.
diff --git a/gcc/testsuite/gfortran.dg/dtio_34.f90 b/gcc/testsuite/gfortran.dg/dtio_34.f90
new file mode 100644 (file)
index 0000000..7cecc8b
--- /dev/null
@@ -0,0 +1,32 @@
+! { dg-do run }
+! PR84387 Defined output does not work for a derived type that
+! has no components 
+module m
+   type :: t
+      private
+      !integer :: m_i = 0  !<-- ***
+   contains
+      private
+      procedure, pass(this) :: write_t
+      generic, public :: write(formatted) => write_t
+   end type
+contains
+   subroutine write_t(this, lun, iotype, vlist, istat, imsg)
+      ! argument definitions
+      class(t), intent(in)            :: this
+      integer, intent(in)             :: lun
+      character(len=*), intent(in)    :: iotype
+      integer, intent(in)             :: vlist(:)
+      integer, intent(out)            :: istat
+      character(len=*), intent(inout) :: imsg
+      write(lun, fmt=*, iostat=istat, iomsg=imsg) "Hello World!"
+      return
+   end subroutine write_t
+
+end module
+
+program p
+   use m, only : t
+   type(t) :: foo
+   print "(dt)", foo ! { dg-output " Hello World!" }
+end program