1! { dg-do run }
2!
3! Testing fix for PR fortran/60255
4!
5! Author: Andre Vehreschild <vehre@gmx.de>
6!
7MODULE m
8
9contains
10  subroutine bar (arg, res)
11    class(*) :: arg
12    character(100) :: res
13    select type (w => arg)
14      type is (character(*))
15        write (res, '(I2)') len(w)
16    end select
17  end subroutine
18
19END MODULE
20
21program test
22    use m;
23    implicit none
24    character(LEN=:), allocatable, target :: S
25    character(LEN=100) :: res
26    class(*), pointer :: ucp, ucp2
27    call sub1 ("long test string", 16)
28    call sub2 ()
29    S = "test"
30    ucp => S
31    call sub3 (ucp)
32    allocate (ucp2, source=ucp)
33    call sub3 (ucp2)
34    call sub4 (S, 4)
35    call sub4 ("This is a longer string.", 24)
36    call bar (S, res)
37    if (trim (res) .NE. " 4") call abort ()
38    call bar(ucp, res)
39    if (trim (res) .NE. " 4") call abort ()
40
41contains
42
43    subroutine sub1(dcl, ilen)
44        character(len=*), target :: dcl
45        integer(4) :: ilen
46        character(len=:), allocatable :: hlp
47        class(*), pointer :: ucp
48
49        ucp => dcl
50
51        select type (ucp)
52        type is (character(len=*))
53            if (len(dcl) .NE. ilen) call abort ()
54            if (len(ucp) .NE. ilen) call abort ()
55            hlp = ucp
56            if (len(hlp) .NE. ilen) call abort ()
57        class default
58            call abort()
59        end select
60    end subroutine
61
62    subroutine sub2
63        character(len=:), allocatable, target :: dcl
64        class(*), pointer :: ucp
65
66        dcl = "ttt"
67        ucp => dcl
68
69        select type (ucp)
70        type is (character(len=*))
71            if (len(ucp) .ne. 3) call abort ()
72        class default
73            call abort()
74        end select
75    end subroutine
76
77    subroutine sub3(ucp)
78        character(len=:), allocatable :: hlp
79        class(*), pointer :: ucp
80
81        select type (ucp)
82        type is (character(len=*))
83            if (len(ucp) .ne. 4) call abort ()
84            hlp = ucp
85            if (len(hlp) .ne. 4) call abort ()
86        class default
87            call abort()
88        end select
89    end subroutine
90
91    subroutine sub4(ucp, ilen)
92        character(len=:), allocatable :: hlp
93        integer(4) :: ilen
94        class(*) :: ucp
95
96        select type (ucp)
97        type is (character(len=*))
98            if (len(ucp) .ne. ilen) call abort ()
99            hlp = ucp
100            if (len(hlp) .ne. ilen) call abort ()
101        class default
102            call abort()
103        end select
104    end subroutine
105end program
106
107