1! { dg-do run } 2! Simple structure constructors, without naming arguments, default values 3! or inheritance and the like. 4 5PROGRAM 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 STOP 1 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 STOP 2 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 STOP 3 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 STOP 4 72 END IF 73 74END PROGRAM test 75