Mercurial > hg > CbC > CbC_gcc
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