OSDN Git Service

2010-04-24 Kai Tietz <kai.tietz@onevision.com>
[pf3gnuchains/gcc-fork.git] / gcc / testsuite / gfortran.dg / structure_constructor_1.f03
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