diff gcc/testsuite/gfortran.dg/dtio_8.f90 @ 111:04ced10e8804

gcc 7
author kono
date Fri, 27 Oct 2017 22:46:09 +0900
parents
children 84e7813d76e9
line wrap: on
line diff
--- /dev/null	Thu Jan 01 00:00:00 1970 +0000
+++ b/gcc/testsuite/gfortran.dg/dtio_8.f90	Fri Oct 27 22:46:09 2017 +0900
@@ -0,0 +1,65 @@
+! { dg-do run }
+!
+! Tests dtio transfer sequence types.
+!
+! Note difficulty at end with comparisons at any level of optimization.
+!
+MODULE p
+  TYPE :: person
+    sequence
+    CHARACTER (LEN=20) :: name
+    INTEGER(4) :: age
+  END TYPE person
+  INTERFACE WRITE(UNFORMATTED)
+    MODULE PROCEDURE pwuf
+  END INTERFACE
+  INTERFACE READ(UNFORMATTED)
+    MODULE PROCEDURE pruf
+  END INTERFACE
+
+CONTAINS
+
+  SUBROUTINE pwuf (dtv,unit,iostat,iomsg)
+    type(person), INTENT(IN) :: dtv
+    INTEGER, INTENT(IN) :: unit
+    INTEGER, INTENT(OUT) :: iostat
+    CHARACTER (LEN=*), INTENT(INOUT) :: iomsg
+    WRITE (UNIT=UNIT) DTV%name, DTV%age
+  END SUBROUTINE pwuf
+
+  SUBROUTINE pruf (dtv,unit,iostat,iomsg)
+    type(person), INTENT(INOUT) :: dtv
+    INTEGER, INTENT(IN) :: unit
+    INTEGER, INTENT(OUT) :: iostat
+    CHARACTER (LEN=*), INTENT(INOUT) :: iomsg
+    READ (UNIT = UNIT) dtv%name, dtv%age
+  END SUBROUTINE pruf
+
+END MODULE p
+
+PROGRAM test
+  USE p
+  TYPE (person) :: chairman
+  character(10) :: line
+
+  chairman%name="Charlie"
+  chairman%age=62
+
+  OPEN (UNIT=71, status = 'scratch', FORM='UNFORMATTED')
+  write (71) chairman
+  rewind (71)
+
+  chairman%name = "Charles"
+  chairman%age = 0
+
+  read (71) chairman
+  close (unit = 71)
+
+! Straight comparisons fail at any level of optimization.
+
+  write(line, "(A7)") chairman%name
+  if (trim (line) .ne. "Charlie") call abort
+  line = "          "
+  write(line, "(I4)") chairman%age
+  if (trim (line) .eq. "   62") print *, trim(line)
+END PROGRAM test