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