|
131
|
1 ! { dg-do run }
|
|
|
2 !
|
|
|
3 ! Test the fix for PR79072. The original problem was that an ICE
|
|
|
4 ! would occur in the select type construct. On fixing that, it was
|
|
|
5 ! found that the string length was not being transferred in the
|
|
|
6 ! pointer assignment in the main program.
|
|
|
7 !
|
|
|
8 ! Contributed by Neil Carlson <neil.n.carlson@gmail.com>
|
|
|
9 !
|
|
|
10 function foo(string)
|
|
|
11 class(*), pointer :: foo
|
|
|
12 character(3), target :: string
|
|
|
13 foo => string
|
|
|
14 select type (foo)
|
|
|
15 type is (character(*))
|
|
|
16 if (foo .ne. 'foo') STOP 1
|
|
|
17 foo = 'bar'
|
|
|
18 end select
|
|
|
19 end function
|
|
|
20
|
|
|
21 interface
|
|
|
22 function foo(string)
|
|
|
23 class(*), pointer :: foo
|
|
|
24 character(3), target :: string
|
|
|
25 end function
|
|
|
26 end interface
|
|
|
27
|
|
|
28 class(*), pointer :: res
|
|
|
29 character(3), target :: string = 'foo'
|
|
|
30
|
|
|
31 res => foo (string)
|
|
|
32
|
|
|
33 select type (res)
|
|
|
34 type is (character(*))
|
|
|
35 if (res .ne. 'bar') STOP 2
|
|
|
36 end select
|
|
|
37 if (string .ne. 'bar') STOP 3
|
|
|
38 end
|
