1! RUN: %S/test_folding.sh %s %t %f18
2! Test transformational intrinsic function folding
3
4module m
5
6  ! Testing ASSOCATED
7  integer, pointer :: int_pointer
8  integer, allocatable :: int_allocatable
9  logical, parameter :: test_Assoc1 = .not.(associated(null()))
10  logical, parameter :: test_Assoc2 = .not.(associated(null(), null()))
11  logical, parameter :: test_Assoc3 = .not.(associated(null(int_pointer)))
12  logical, parameter :: test_Assoc4 = .not.(associated(null(int_allocatable)))
13  logical, parameter :: test_Assoc5 = .not.(associated(null(), null(int_pointer)))
14  logical, parameter :: test_Assoc6 = .not.(associated(null(), null(int_allocatable)))
15
16  type A
17    real(4) x
18    integer(8) i
19  end type
20
21  integer(8), parameter :: new_shape(*) = [2, 4]
22  integer(4), parameter :: order(2) = [2, 1]
23
24
25  ! Testing integers (similar to real and complex)
26  integer(4), parameter :: int_source(*) = [1, 2, 3, 4, 5, 6]
27  integer(4), parameter :: int_pad(2) = [7, 8]
28  integer(4), parameter :: int_expected_result(*, *) = reshape([1, 5, 2, 6, 3, 7, 4, 8], new_shape)
29  integer(4), parameter :: int_result(*, *) = reshape(int_source, new_shape, int_pad, order)
30  integer(4), parameter :: int_result_long_source(*, *) = reshape([1, 5, 2, 6, 3, 7, 4, 8, 9], new_shape)
31  logical, parameter :: test_reshape_integer_1 = all(int_expected_result == int_result)
32  logical, parameter :: test_reshape_integer_2 = all(shape(int_result, 8).EQ.new_shape)
33  logical, parameter :: test_reshape_integer_3 = all(int_expected_result == int_result_long_source)
34
35
36  ! Testing characters
37  character(kind=1, len=3), parameter ::char_source(*) = ["abc", "def", "ghi", "jkl", "mno", "pqr"]
38  character(kind=1,len=3), parameter :: char_pad(2) = ["stu", "vxy"]
39
40  character(kind=1, len=3), parameter :: char_expected_result(*, *) = &
41    reshape(["abc", "mno", "def", "pqr", "ghi", "stu", "jkl", "vxy"], new_shape)
42
43  character(kind=1, len=3), parameter :: char_result(*, *) = &
44    reshape(char_source, new_shape, char_pad, order)
45
46  logical, parameter :: test_reshape_char_1 = all(char_result == char_expected_result)
47  logical, parameter :: test_reshape_char_2 = all(shape(char_result, 8).EQ.new_shape)
48
49
50  ! Testing derived types
51  type(A), parameter :: derived_source(*) = &
52    [A(x=1.5, i=1), A(x=2.5, i=2), A(x=3.5, i=3), A(x=4.5, i=4), A(x=5.5, i=5), A(x=6.5, i=6)]
53
54  type(A), parameter :: derived_pad(2) = [A(x=7.5, i=7), A(x=8.5, i=8)]
55
56  type(A), parameter :: derived_expected_result(*, *) = &
57    reshape([a::a(x=1.5_4,i=1_8),a(x=5.5_4,i=5_8),a(x=2.5_4,i=2_8), a(x=6.5_4,i=6_8), &
58      a(x=3.5_4,i=3_8),a(x=7.5_4,i=7_8),a(x=4.5_4,i=4_8),a(x=8.5_4,i=8_8)], new_shape)
59
60  type(A), parameter :: derived_result(*, *) = reshape(derived_source, new_shape, derived_pad, order)
61
62  logical, parameter :: test_reshape_derived_1 = all((derived_result%x.EQ.derived_expected_result%x) &
63      .AND.(derived_result%i.EQ.derived_expected_result%i))
64
65  logical, parameter :: test_reshape_derived_2 = all(shape(derived_result).EQ.new_shape)
66end module
67