1! { dg-do run }
2! { dg-additional-options "-fdump-tree-original" }
3! PR 95366 - this did not work due the wrong hashes
4! being generated for CHARACTER variables.
5MODULE mod1
6  implicit none
7  integer :: tst(3)
8CONTAINS
9  subroutine showpoly(poly)
10    CLASS(*), INTENT(IN) :: poly(:)
11    SELECT TYPE (poly)
12    TYPE IS(INTEGER)
13       tst(1) = tst(1) + 1
14    TYPE IS(character(*))
15       tst(2) = tst(2) + 1
16    class default
17       tst(3) = tst(3) + 1
18    end select
19  end subroutine showpoly
20END MODULE mod1
21MODULE mod2
22  implicit none
23CONTAINS
24subroutine polytest2()
25   use mod1
26   integer :: a(1)
27   character(len=42) :: c(1)
28   call showpoly(a)
29   if (any(tst /= [1,0,0])) stop 1
30   call showpoly(c)
31   if (any(tst /= [1,1,0])) stop 2
32end subroutine polytest2
33END MODULE mod2
34PROGRAM testpoly
35  use mod2
36  CALL polytest2()
37END PROGRAM testpoly
38! The value of the hashes are also checked.  If you get
39! a failure here, be aware that changing that value is
40! an ABI change.
41
42! { dg-final { scan-tree-dump-times "== 17759" 1 "original" } }
43! { dg-final { scan-tree-dump-times "== 85893463" 1 "original" } }
44