1! { dg-do compile }
2!
3! PR 41070: [4.5 Regression] Error: Components of structure constructor '' at (1) are PRIVATE
4!
5! Contributed by Michael Richmond <michael.a.richmond@nasa.gov>
6
7MODULE cdf_aux_mod
8IMPLICIT NONE
9
10TYPE :: one_parameter
11  CHARACTER (8) :: name
12END TYPE one_parameter
13
14TYPE :: the_distribution
15  CHARACTER (8) :: name
16END TYPE the_distribution
17
18TYPE (the_distribution), PARAMETER :: the_beta = the_distribution('cdf_beta')
19END MODULE cdf_aux_mod
20
21SUBROUTINE cdf_beta()
22  USE cdf_aux_mod
23  IMPLICIT NONE
24  CALL check_complements(the_beta%name)
25END SUBROUTINE cdf_beta
26