1! { dg-do compile }
2! Tests the fix for PR30660 in which gfortran insisted that g_dest
3! should have the SAVE attribute because the hidden default
4! initializer for the allocatable component was being detected.
5!
6! Contributed by Toon Moene <toon@moene.indiv.nluug.nl>
7!
8MODULE types_m
9  TYPE coord_t
10    INTEGER ncord
11    REAL,ALLOCATABLE,DIMENSION(:) :: x, y
12  END TYPE
13
14  TYPE grib_t
15    REAL,DIMENSION(:),ALLOCATABLE :: vdata
16   TYPE(coord_t) coords
17  END TYPE
18END MODULE
19
20MODULE globals_m
21  USE types_m
22  TYPE(grib_t) g_dest           ! output field
23END MODULE
24