1! { dg-do compile }
2! Test the fixes for PR38917 and 38918, in which the NULL values caused errors.
3!
4! Contributed by Dick Hendrickson  <dick.hendrickson@gmail.com>
5!             and Tobias Burnus  <burnus@gcc.gnu.org>
6!
7      SUBROUTINE PF0009
8!  PR38918
9      TYPE  :: HAS_POINTER
10        INTEGER, POINTER            :: PTR_S
11      END TYPE HAS_POINTER
12      TYPE (HAS_POINTER)  ::  PTR_ARRAY(5)
13
14      DATA PTR_ARRAY(1)%PTR_S  /NULL()/
15
16      end subroutine pf0009
17
18      SUBROUTINE PF0005
19! PR38917
20      REAL, SAVE, POINTER :: PTR1
21      INTEGER, POINTER       :: PTR2(:,:,:)
22      CHARACTER(LEN=1), SAVE, POINTER :: PTR3(:)
23
24      DATA  PTR1 / NULL() /
25      DATA  PTR2 / NULL() /
26      DATA  PTR3 / NULL() /
27
28      end subroutine pf0005
29
30! Tobias pointed out that this would cause an ICE rather than an error.
31      subroutine tobias
32      integer, pointer :: ptr(:)
33      data ptr(1) /NULL()/  ! { dg-error "must be a full array" }
34      end subroutine tobias
35
36