1! RUN: %S/test_errors.sh %s %t %f18
2! Error tests for structure constructors.
3! Errors caught by name resolution are tested elsewhere; these are the
4! errors meant to be caught by expression semantic analysis, as well as
5! acceptable use cases.
6! Type parameters are used here to make the parses unambiguous.
7! C796 (R756) The derived-type-spec shall not specify an abstract type (7.5.7).
8!   This refers to a derived-type-spec used in a structure constructor
9
10module module1
11  type :: type1(j)
12    integer, kind :: j
13    integer :: n = 1
14  end type type1
15  type, extends(type1) :: type2(k)
16    integer, kind :: k
17    integer :: m
18  end type type2
19  type, abstract :: abstract(j)
20    integer, kind :: j
21    integer :: n
22  end type abstract
23  type :: privaten(j)
24    integer, kind :: j
25    integer, private :: n
26  end type privaten
27 contains
28  subroutine type1arg(x)
29    type(type1(0)), intent(in) :: x
30  end subroutine type1arg
31  subroutine type2arg(x)
32    type(type2(0,0)), intent(in) :: x
33  end subroutine type2arg
34  subroutine abstractarg(x)
35    class(abstract(0)), intent(in) :: x
36  end subroutine abstractarg
37  subroutine errors
38    call type1arg(type1(0)())
39    call type1arg(type1(0)(1))
40    call type1arg(type1(0)(n=1))
41    !ERROR: Type parameter 'j' may not appear as a component of a structure constructor
42    call type1arg(type1(0)(j=1))
43    !ERROR: Component 'n' conflicts with another component earlier in this structure constructor
44    call type1arg(type1(0)(1,n=2))
45    !ERROR: Value in structure constructor lacks a component name
46    call type1arg(type1(0)(n=1,2))
47    !ERROR: Component 'n' conflicts with another component earlier in this structure constructor
48    call type1arg(type1(0)(n=1,n=2))
49    !ERROR: Unexpected value in structure constructor
50    call type1arg(type1(0)(1,2))
51    call type2arg(type2(0,0)(n=1,m=2))
52    call type2arg(type2(0,0)(m=2))
53    !ERROR: Structure constructor lacks a value for component 'm'
54    call type2arg(type2(0,0)())
55    call type2arg(type2(0,0)(type1=type1(0)(n=1),m=2))
56    call type2arg(type2(0,0)(type1=type1(0)(),m=2))
57    !ERROR: Component 'type1' conflicts with another component earlier in this structure constructor
58    call type2arg(type2(0,0)(n=1,type1=type1(0)(n=2),m=3))
59    !ERROR: Component 'n' conflicts with another component earlier in this structure constructor
60    call type2arg(type2(0,0)(type1=type1(0)(n=1),n=2,m=3))
61    !ERROR: Component 'n' conflicts with another component earlier in this structure constructor
62    call type2arg(type2(0,0)(type1=type1(0)(1),n=2,m=3))
63    !ERROR: Type parameter 'j' may not appear as a component of a structure constructor
64    call type2arg(type2(0,0)(j=1, &
65    !ERROR: Type parameter 'k' may not appear as a component of a structure constructor
66      k=2,m=3))
67    !ERROR: ABSTRACT derived type 'abstract' may not be used in a structure constructor
68    call abstractarg(abstract(0)(n=1))
69  end subroutine errors
70end module module1
71