* cfgloopmanip.c (duplicate_loop_to_header_edge): Cleanup profile
[official-gcc.git] / gcc / testsuite / gfortran.dg / structure_constructor_8.f03
blob1c0ecd1c1a46a5faf146586781d5526ac178817f
1 ! { dg-do compile }
2 ! Test for errors when setting private components inside a structure constructor
3 ! or when constructing a private structure.
5 MODULE privmod
6   IMPLICIT NONE
8   TYPE :: haspriv_t
9     INTEGER :: a
10     INTEGER, PRIVATE :: b = 42
11   END TYPE haspriv_t
13   TYPE :: allpriv_t
14     PRIVATE
15     INTEGER :: a = 25
16   END TYPE allpriv_t
18   TYPE, PRIVATE :: ispriv_t
19     INTEGER :: x
20   END TYPE ispriv_t
22 CONTAINS
23   
24   SUBROUTINE testfunc ()
25     IMPLICIT NONE
26     TYPE(haspriv_t) :: struct1
27     TYPE(allpriv_t) :: struct2
28     TYPE(ispriv_t) :: struct3
30     ! This should succeed from within the module, no error.
31     struct1 = haspriv_t (1, 2)
32     struct2 = allpriv_t (42)
33     struct3 = ispriv_t (42)
34   END SUBROUTINE testfunc
36 END MODULE privmod
38 PROGRAM test
39   USE privmod
40   IMPLICIT NONE
42   TYPE(haspriv_t) :: struct1
43   TYPE(allpriv_t) :: struct2
45   ! This should succeed, not giving value to private component
46   struct1 = haspriv_t (5)
47   struct2 = allpriv_t ()
49   ! These should fail
50   struct1 = haspriv_t (1, 2) ! { dg-error "is a PRIVATE component" }
51   struct1 = haspriv_t (b = 2, a = 1) ! { dg-error "is a PRIVATE component" }
53   ! This should fail as all components are private
54   struct2 = allpriv_t (5) ! { dg-error "is a PRIVATE component" }
56   ! This should fail as the type itself is private, and the expression should
57   ! be deduced as call to an undefined function.
58   WRITE (*,*) ispriv_t (5) ! { dg-error "has no IMPLICIT type" }
60 END PROGRAM test