1! RUN: %S/test_errors.sh %s %t %f18
2! C703 (R702) The derived-type-spec shall not specify an abstract type (7.5.7).
3! This constraint refers to the derived-type-spec in a type-spec.  A type-spec
4! can appear in an ALLOCATE statement, an ac-spec for an array constructor, and
5! in the type specifier of a TYPE GUARD statement
6!
7! C706 TYPE(derived-type-spec) shall not specify an abstract type (7.5.7).
8!   This is for a declaration-type-spec
9!
10! C796 (R756) The derived-type-spec shall not specify an abstract type (7.5.7).
11!
12! C705 (R703) In a declaration-type-spec that uses the CLASS keyword,
13! derived-type-spec shall specify an extensible type (7.5.7).
14subroutine s()
15  type, abstract :: abstractType
16  end type abstractType
17
18  type, extends(abstractType) :: concreteType
19  end type concreteType
20
21  ! declaration-type-spec
22  !ERROR: ABSTRACT derived type may not be used here
23  type (abstractType), allocatable :: abstractVar
24
25  ! ac-spec for an array constructor
26  !ERROR: ABSTRACT derived type may not be used here
27  !ERROR: ABSTRACT derived type may not be used here
28  type (abstractType), parameter :: abstractArray(*) = (/ abstractType :: /)
29
30  class(*), allocatable :: selector
31
32  ! Structure constructor
33  !ERROR: ABSTRACT derived type may not be used here
34  !ERROR: ABSTRACT derived type 'abstracttype' may not be used in a structure constructor
35  type (abstractType) :: abstractVar1 = abstractType()
36
37  ! Allocate statement
38  !ERROR: ABSTRACT derived type may not be used here
39  allocate(abstractType :: abstractVar)
40
41  select type(selector)
42    ! Type specifier for a type guard statement
43    !ERROR: ABSTRACT derived type may not be used here
44    type is (abstractType)
45  end select
46end subroutine s
47
48subroutine s1()
49  type :: extensible
50  end type
51  type, bind(c) :: inextensible
52  end type
53
54  ! This one's OK
55  class(extensible), allocatable :: y
56
57  !ERROR: Non-extensible derived type 'inextensible' may not be used with CLASS keyword
58  class(inextensible), allocatable :: x
59end subroutine s1
60
61subroutine s2()
62  type t
63    integer i
64  end type t
65  type, extends(t) :: t2
66    real x
67  end type t2
68contains
69  function f1(dummy)
70    class(*) dummy
71    type(t) f1(1)
72    !ERROR: Cannot have an unlimited polymorphic value in an array constructor
73    f1 = [ (dummy) ]
74  end function f1
75end subroutine s2
76