Mercurial > hg > CbC > CbC_gcc

comparison gcc/testsuite/gfortran.dg/structure_constructor_1.f03 @ 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 ! Simple structure constructors, without naming arguments, default values
3 ! or inheritance and the like.
4
5 PROGRAM test
6 IMPLICIT NONE
7
8 ! Empty structuer
9 TYPE :: empty_t
10 END TYPE empty_t
11
12 ! Structure of basic data types
13 TYPE :: basics_t
14 INTEGER :: i
15 REAL :: r
16 COMPLEX :: c
17 LOGICAL :: l
18 END TYPE basics_t
19
20 ! Structure with strings
21 TYPE :: strings_t
22 CHARACTER(len=5) :: str1, str2
23 CHARACTER(len=10) :: long
24 END TYPE strings_t
25
26 ! Structure with arrays
27 TYPE :: array_t
28 INTEGER :: ints(2:5)
29 REAL :: matrix(2, 2)
30 END TYPE array_t
31
32 ! Structure containing structures
33 TYPE :: nestedStruct_t
34 TYPE(basics_t) :: basics
35 TYPE(array_t) :: arrays
36 END TYPE nestedStruct_t
37
38 TYPE(empty_t) :: empty
39 TYPE(basics_t) :: basics
40 TYPE(strings_t) :: strings
41 TYPE(array_t) :: arrays
42 TYPE(nestedStruct_t) :: nestedStruct
43
44 empty = empty_t ()
45
46 basics = basics_t (42, -1.5, (.5, .5), .FALSE.)
47 IF (basics%i /= 42 .OR. basics%r /= -1.5 &
48 .OR. basics%c /= (.5, .5) .OR. basics%l) THEN
49 CALL abort()
50 END IF
51
52 strings = strings_t ("hello", "abc", "this one is long")
53 IF (strings%str1 /= "hello" .OR. strings%str2 /= "abc" &
54 .OR. strings%long /= "this one i") THEN
55 CALL abort()
56 END IF
57
58 arrays = array_t ( (/ 1, 2, 3, 4 /), RESHAPE((/ 5, 6, 7, 8 /), (/ 2, 2 /)) )
59 IF (arrays%ints(2) /= 1 .OR. arrays%ints(3) /= 2 &
60 .OR. arrays%ints(4) /= 3 .OR. arrays%ints(5) /= 4 &
61 .OR. arrays%matrix(1, 1) /= 5. .OR. arrays%matrix(2, 1) /= 6. &
62 .OR. arrays%matrix(1, 2) /= 7. .OR. arrays%matrix(2, 2) /= 8.) THEN
63 CALL abort()
64 END IF
65
66 nestedStruct = nestedStruct_t (basics_t (42, -1.5, (.5, .5), .FALSE.), arrays)
67 IF (nestedStruct%basics%i /= 42 .OR. nestedStruct%basics%r /= -1.5 &
68 .OR. nestedStruct%basics%c /= (.5, .5) .OR. nestedStruct%basics%l &
69 .OR. ANY(nestedStruct%arrays%ints /= arrays%ints) &
70 .OR. ANY(nestedStruct%arrays%matrix /= arrays%matrix)) THEN
71 CALL abort()
72 END IF
73
74 END PROGRAM test