|
111
|
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
|
