1! { dg-do compile }
2! This tests the patch for PR29098, in which the presence of the default
3! initializer would cause allocate to fail because the latter uses
4! the interface assignment.  This, in its turn was failing because
5! no expressions were found for the other components; and a FAILURE
6! was returned from resolve_structure_cons.
7!
8! Contributed by Olav Vahtras  <vahtras@pdc.kth.se>
9!
10 MODULE MAT
11   TYPE BAS
12      INTEGER :: R = 0,C = 0
13   END TYPE BAS
14   TYPE BLOCK
15      INTEGER, DIMENSION(:), POINTER ::  R,C
16      TYPE(BAS), POINTER, DIMENSION(:) :: NO => NULL()
17   END TYPE BLOCK
18   INTERFACE ASSIGNMENT(=)
19      MODULE PROCEDURE BLASSIGN
20   END INTERFACE
21   CONTAINS
22      SUBROUTINE BLASSIGN(A,B)
23      TYPE(BLOCK), INTENT(IN) :: B
24      TYPE(BLOCK), INTENT(INOUT) :: A
25      INTEGER I,N
26      ! ...
27      END SUBROUTINE BLASSIGN
28 END MODULE MAT
29PROGRAM TEST
30USE MAT
31TYPE(BLOCK) MATRIX
32POINTER MATRIX
33ALLOCATE(MATRIX)
34END
35