Mercurial > hg > CbC > CbC_gcc

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

Find changesets by keywords (author, files, the commit message), revision number or hash, or revset expression.
gcc 7
author kono
date Fri, 27 Oct 2017 22:46:09 +0900
parents
children 84e7813d76e9
comparison
equal deleted inserted replaced
68:561a7518be6b 111:04ced10e8804
1 ! { dg-do run }
2 !
3 ! Tests dtio transfer sequence types.
4 !
5 ! Note difficulty at end with comparisons at any level of optimization.
6 !
7 MODULE p
8 TYPE :: person
9 sequence
10 CHARACTER (LEN=20) :: name
11 INTEGER(4) :: age
12 END TYPE person
13 INTERFACE WRITE(UNFORMATTED)
14 MODULE PROCEDURE pwuf
15 END INTERFACE
16 INTERFACE READ(UNFORMATTED)
17 MODULE PROCEDURE pruf
18 END INTERFACE
19
20 CONTAINS
21
22 SUBROUTINE pwuf (dtv,unit,iostat,iomsg)
23 type(person), INTENT(IN) :: dtv
24 INTEGER, INTENT(IN) :: unit
25 INTEGER, INTENT(OUT) :: iostat
26 CHARACTER (LEN=*), INTENT(INOUT) :: iomsg
27 WRITE (UNIT=UNIT) DTV%name, DTV%age
28 END SUBROUTINE pwuf
29
30 SUBROUTINE pruf (dtv,unit,iostat,iomsg)
31 type(person), INTENT(INOUT) :: dtv
32 INTEGER, INTENT(IN) :: unit
33 INTEGER, INTENT(OUT) :: iostat
34 CHARACTER (LEN=*), INTENT(INOUT) :: iomsg
35 READ (UNIT = UNIT) dtv%name, dtv%age
36 END SUBROUTINE pruf
37
38 END MODULE p
39
40 PROGRAM test
41 USE p
42 TYPE (person) :: chairman
43 character(10) :: line
44
45 chairman%name="Charlie"
46 chairman%age=62
47
48 OPEN (UNIT=71, status = 'scratch', FORM='UNFORMATTED')
49 write (71) chairman
50 rewind (71)
51
52 chairman%name = "Charles"
53 chairman%age = 0
54
55 read (71) chairman
56 close (unit = 71)
57
58 ! Straight comparisons fail at any level of optimization.
59
60 write(line, "(A7)") chairman%name
61 if (trim (line) .ne. "Charlie") call abort
62 line = " "
63 write(line, "(I4)") chairman%age
64 if (trim (line) .eq. " 62") print *, trim(line)
65 END PROGRAM test