1! { dg-do compile }
2
3! PR fortran/38883
4! This ICE'd because the temporary-creation in the MVBITS call was wrong.
5! This is the original test from the PR, the complicated version.
6
7! Contributed by Dick Hendrickson <dick.hendrickson@gmail.com>
8
9     module yg0009_stuff
10
11      type unseq
12         integer I
13      end type
14
15      contains
16
17      SUBROUTINE YG0009(TDA2L,NF4,NF3,NF1,MF1,MF4,MF3)
18        TYPE(UNSEQ) TDA2L(NF4,NF3)
19
20        CALL MVBITS (TDA2L(NF4:NF1:MF1,NF1:NF3)%I,2, &
21          4, TDA2L(-MF4:-MF1:-NF1,-MF1:-MF3)%I, 3)
22
23      END SUBROUTINE
24
25      end module yg0009_stuff
26
27      program try_yg0009
28      use yg0009_stuff
29      type(unseq)  tda2l(4,3)
30
31      call yg0009(tda2l,4,3,1,-1,-4,-3)
32
33      end
34