1! { dg-do compile }
2
3! Abstract Types.
4! Check for correct handling of abstract-typed base object references.
5
6MODULE m
7  IMPLICIT NONE
8
9  TYPE, ABSTRACT :: abstract_t
10    INTEGER :: i
11  CONTAINS
12    PROCEDURE, NOPASS :: proc
13    PROCEDURE, NOPASS :: func
14  END TYPE abstract_t
15
16  TYPE, EXTENDS(abstract_t) :: concrete_t
17  END TYPE concrete_t
18
19CONTAINS
20
21  SUBROUTINE proc ()
22    IMPLICIT NONE
23    ! Do nothing
24  END SUBROUTINE proc
25
26  INTEGER FUNCTION func ()
27    IMPLICIT NONE
28    func = 1234
29  END FUNCTION func
30
31  SUBROUTINE test ()
32    IMPLICIT NONE
33    TYPE(concrete_t) :: obj
34
35    ! These are ok.
36    obj%abstract_t%i = 42
37    CALL obj%proc ()
38    PRINT *, obj%func ()
39
40    ! These are errors (even though the procedures are not DEFERRED!).
41    CALL obj%abstract_t%proc () ! { dg-error "is of ABSTRACT type" }
42    PRINT *, obj%abstract_t%func () ! { dg-error "is of ABSTRACT type" }
43  END SUBROUTINE test
44
45END MODULE m
46