1! { dg-do compile }
2! Check the fix for PR32129 in which the argument 'vec(vy(i, :))' was
3! incorrectly simplified, resulting in an ICE and a missed error.
4!
5! Reported by Tobias Burnus <burnus@gcc.gnu.org>
6!
7    MODULE cdf_aux_mod
8      TYPE :: the_distribution
9        INTEGER :: parameters(1)
10      END TYPE the_distribution
11      TYPE (the_distribution), PARAMETER :: the_beta = the_distribution((/0/))
12    CONTAINS
13      SUBROUTINE set_bound(arg_name)
14        INTEGER, INTENT (IN) :: arg_name
15      END SUBROUTINE set_bound
16    END MODULE cdf_aux_mod
17    MODULE cdf_beta_mod
18    CONTAINS
19      SUBROUTINE cdf_beta()
20        USE cdf_aux_mod
21        INTEGER :: which
22          which = 1
23          CALL set_bound(the_beta%parameters(1:which)) ! { dg-error "Rank mismatch" }
24      END SUBROUTINE cdf_beta
25    END MODULE cdf_beta_mod
26