3 ! Test dummy and result arrays in module procedures
5 ! Contributed by Paul Thomas <pault@gcc.gnu.org>
10 character(len
=16) :: greeting
= "Hello, world! "
11 character(len
=16), private
:: byebye
= "adieu, world! "
15 module function array1(this
) result (that
)
16 type(foo
), intent(in
), dimension(:) :: this
17 type(foo
), allocatable
, dimension(:) :: that
19 character(16) module function array2(this
, that
)
20 type(foo
), intent(in
), dimension(:) :: this
21 type(foo
), allocatable
, dimension(:) :: that
23 module subroutine array3(this
, that
)
24 type(foo
), intent(in
), dimension(:) :: this
25 type(foo
), intent(inOUT
), allocatable
, dimension(:) :: that
27 module subroutine array4(this
, that
)
28 type(foo
), intent(in
), dimension(:) :: this
29 type(foo
), intent(inOUT
), allocatable
, dimension(:) :: that
35 SUBMODULE (foo_interface
) foo_interface_son
39 ! Test array characteristics for dummy and result are OK
40 module function array1 (this
) result(that
)
41 type(foo
), intent(in
), dimension(:) :: this
42 type(foo
), allocatable
, dimension(:) :: that
43 allocate (that(size(this
)), source
= this
)
44 that
%greeting
= that
%byebye
47 ! Test array characteristics for dummy and result are OK for
48 ! abbreviated module procedure declaration.
49 module procedure array2
50 allocate (that(size(this
)), source
= this
)
51 that
%greeting
= that
%byebye
52 array2
= trim (that(size (that
))%greeting(1:5))//", people!"
55 end SUBMODULE foo_interface_son
58 SUBMODULE (foo_interface
) foo_interface_daughter
62 ! Test array characteristics for dummies are OK
63 module subroutine array3(this
, that
)
64 type(foo
), intent(in
), dimension(:) :: this
65 type(foo
), intent(inOUT
), allocatable
, dimension(:) :: that
66 allocate (that(size(this
)), source
= this
)
67 that
%greeting
= that
%byebye
70 ! Test array characteristics for dummies are OK for
71 ! abbreviated module procedure declaration.
72 module procedure array4
74 allocate (that(size(this
)), source
= this
)
75 that
%greeting
= that
%byebye
77 that(i
)%greeting
= trim (that(i
)%greeting(1:5))//", people!"
80 end SUBMODULE foo_interface_daughter
86 type(foo
), dimension(2) :: bar
87 type (foo
), dimension(:), allocatable
:: arg
89 arg
= array1(bar
) ! typebound call
90 if (any (arg
%greeting
.ne
. ["adieu, world! ", "adieu, world! "])) call abort
92 if (trim (array2 (bar
, arg
)) .ne
. "adieu, people!") call abort
94 call array3 (bar
, arg
) ! typebound call
95 if (any (arg
%greeting
.ne
. ["adieu, world! ", "adieu, world! "])) call abort
97 call array4 (bar
, arg
) ! typebound call
98 if (any (arg
%greeting
.ne
. ["adieu, people!", "adieu, people!"])) call abort