1! RUN: %S/test_errors.sh %s %t %flang_fc1
2! REQUIRES: shell
3! Confirm enforcement of constraints and restrictions in 7.8
4! C7110, C7111, C7112, C7113, C7114, C7115
5
6subroutine arrayconstructorvalues()
7  integer :: intarray(5)
8  integer(KIND=8) :: k8 = 20
9
10  TYPE EMPLOYEE
11    INTEGER AGE
12    CHARACTER (LEN = 30) NAME
13  END TYPE EMPLOYEE
14  TYPE EMPLOYEER
15    CHARACTER (LEN = 30) NAME
16  END TYPE EMPLOYEER
17
18  TYPE(EMPLOYEE) :: emparray(3)
19  class(*), pointer :: unlim_polymorphic
20  TYPE, ABSTRACT :: base_type
21    INTEGER :: CARPRIZE
22  END TYPE
23  ! Different declared type
24  !ERROR: Values in array constructor must have the same declared type when no explicit type appears
25  intarray = (/ 1, 2, 3, 4., 5/)  ! C7110
26  ! Different kind type parameter
27  !ERROR: Values in array constructor must have the same declared type when no explicit type appears
28  intarray = (/ 1,2,3,4, k8 /)    ! C7110
29
30  ! C7111
31  !ERROR: Value in array constructor of type 'LOGICAL(4)' could not be converted to the type of the array 'INTEGER(4)'
32  intarray = [integer:: .true., 2, 3, 4, 5]
33  !ERROR: Value in array constructor of type 'CHARACTER(1)' could not be converted to the type of the array 'INTEGER(4)'
34  intarray = [integer:: "RAM stores information", 2, 3, 4, 5]
35  !ERROR: Value in array constructor of type 'employee' could not be converted to the type of the array 'INTEGER(4)'
36  intarray = [integer:: EMPLOYEE (19, "Jack"), 2, 3, 4, 5]
37
38  ! C7112
39  !ERROR: Value in array constructor of type 'INTEGER(4)' could not be converted to the type of the array 'employee'
40  emparray = (/ EMPLOYEE:: EMPLOYEE(19, "Ganesh"), EMPLOYEE(22, "Omkar"), 19 /)
41  !ERROR: Value in array constructor of type 'employeer' could not be converted to the type of the array 'employee'
42  emparray = (/ EMPLOYEE:: EMPLOYEE(19, "Ganesh"), EMPLOYEE(22, "Ram"),EMPLOYEER("ShriniwasPvtLtd") /)
43
44  ! C7113
45  !ERROR: Cannot have an unlimited polymorphic value in an array constructor
46  intarray = (/ unlim_polymorphic, 2, 3, 4, 5/)
47
48  ! C7114
49  !ERROR: No intrinsic or user-defined ASSIGNMENT(=) matches operand types INTEGER(4) and TYPE(base_type)
50  !ERROR: ABSTRACT derived type 'base_type' may not be used in a structure constructor
51  !ERROR: Values in array constructor must have the same declared type when no explicit type appears
52  intarray = (/ base_type(10), 2, 3, 4, 5 /)
53
54  !ERROR: Item is not suitable for use in an array constructor
55  intarray(1:1) = [ arrayconstructorvalues ]
56end subroutine arrayconstructorvalues
57subroutine checkC7115()
58  real, dimension(10), parameter :: good1 = [(99.9, i = 1, 10)]
59  real, dimension(100), parameter :: good2 = [((88.8, i = 1, 10), j = 1, 10)]
60  real, dimension(-1:0), parameter :: good3 = [77.7, 66.6]
61  !ERROR: Implied DO index is active in surrounding implied DO loop and may not have the same name
62  real, dimension(100), parameter :: bad = [((88.8, i = 1, 10), i = 1, 10)]
63
64  !ERROR: Value of named constant 'bad2' ([INTEGER(4)::(int(j,kind=4),INTEGER(8)::j=1_8,1_8,0_8)]) cannot be computed as a constant value
65  !ERROR: The stride of an implied DO loop must not be zero
66  integer, parameter :: bad2(*) = [(j, j=1,1,0)]
67  integer, parameter, dimension(-1:0) :: negLower = (/343,512/)
68  integer, parameter, dimension(-1:0) :: negLower1 = ((/343,512/))
69
70  real :: local
71
72  local = good3(0)
73  !ERROR: Subscript value (2) is out of range on dimension 1 in reference to a constant array value
74  local = good3(2)
75  call inner(negLower(:)) ! OK
76  call inner(negLower1(:)) ! OK
77
78  contains
79    subroutine inner(arg)
80      integer :: arg(:)
81    end subroutine inner
82end subroutine checkC7115
83subroutine checkOkDuplicates
84  real :: realArray(21) = &
85    [ ((1.0, iDuplicate = 1,j), &
86       (0.0, iDuplicate = j,3 ), &
87        j = 1,5 ) ]
88end subroutine
89subroutine charLengths(c, array)
90  character(3) :: c
91  character(3) :: array(2)
92  !No error should ensue for distinct but compatible DynamicTypes
93  array = ["abc", c]
94end subroutine
95