2011-05-23 Tom de Vries <tom@codesourcery.com>
[official-gcc.git] / gcc / testsuite / gfortran.dg / finalize_7.f03
blobdb6b4bea948a8f867c14347f680a10915a730da4
1 ! { dg-do compile }
2 ! { dg-options "-Wsurprising" }
4 ! Implementation of finalizer procedures.
5 ! Check for expected warnings on dubious FINAL constructs.
7 MODULE final_type
8   IMPLICIT NONE
10   TYPE :: type_1
11     INTEGER, ALLOCATABLE :: fooarr(:)
12     REAL :: foobar
13   CONTAINS
14     ! Non-scalar procedures should be assumed shape
15     FINAL :: fin1_scalar
16     FINAL :: fin1_shape_1
17     FINAL :: fin1_shape_2
18   END TYPE type_1
20   TYPE :: type_2 ! { dg-warning "Only array FINAL procedures" }
21     REAL :: x
22   CONTAINS
23     ! No scalar finalizer, only array ones
24     FINAL :: fin2_vector
25   END TYPE type_2
27 CONTAINS
29   SUBROUTINE fin1_scalar (el)
30     IMPLICIT NONE
31     TYPE(type_1) :: el
32   END SUBROUTINE fin1_scalar
34   SUBROUTINE fin1_shape_1 (v) ! { dg-warning "assumed shape" }
35     IMPLICIT NONE
36     TYPE(type_1) :: v(*)
37   END SUBROUTINE fin1_shape_1
39   SUBROUTINE fin1_shape_2 (v) ! { dg-warning "assumed shape" }
40     IMPLICIT NONE
41     TYPE(type_1) :: v(42, 5)
42   END SUBROUTINE fin1_shape_2
44   SUBROUTINE fin2_vector (v)
45     IMPLICIT NONE
46     TYPE(type_2) :: v(:)
47   END SUBROUTINE fin2_vector
49 END MODULE final_type
51 PROGRAM finalizer
52   IMPLICIT NONE
53   ! Nothing here
54 END PROGRAM finalizer
56 ! TODO: Remove this once finalization is implemented.
57 ! { dg-excess-errors "not yet implemented" }
59 ! { dg-final { cleanup-modules "final_type" } }