56 lines · plain
1! RUN: %python %S/test_errors.py %s %flang_fc12! Test comparisons that use the intrinsic SHAPE() as an operand3program testShape4contains5 subroutine sub1(arrayDummy, assumedRank)6 integer :: arrayDummy(:), assumedRank(..)7 integer, allocatable :: arrayDeferred(:)8 integer :: arrayLocal(2) = [88, 99]9 integer, parameter :: aRrs = rank(shape(assumedRank))10 integer(kind=merge(kind(1),-1,aRrs == 1)) :: test_aRrs11 !ERROR: Dimension 1 of left operand has extent 1, but right operand has extent 012 !ERROR: Dimension 1 of left operand has extent 1, but right operand has extent 013 if (all(shape(arrayDummy)==shape(8))) then14 print *, "hello"15 end if16 !ERROR: Dimension 1 of left operand has extent 0, but right operand has extent 117 !ERROR: Dimension 1 of left operand has extent 0, but right operand has extent 118 if (all(shape(27)==shape(arrayDummy))) then19 print *, "hello"20 end if21 if (all(64==shape(arrayDummy))) then22 print *, "hello"23 end if24 !ERROR: Dimension 1 of left operand has extent 1, but right operand has extent 025 !ERROR: Dimension 1 of left operand has extent 1, but right operand has extent 026 if (all(shape(arrayDeferred)==shape(8))) then27 print *, "hello"28 end if29 !ERROR: Dimension 1 of left operand has extent 0, but right operand has extent 130 !ERROR: Dimension 1 of left operand has extent 0, but right operand has extent 131 if (all(shape(27)==shape(arrayDeferred))) then32 print *, "hello"33 end if34 if (all(64==shape(arrayDeferred))) then35 print *, "hello"36 end if37 !ERROR: Dimension 1 of left operand has extent 1, but right operand has extent 038 !ERROR: Dimension 1 of left operand has extent 1, but right operand has extent 039 if (all(shape(arrayLocal)==shape(8))) then40 print *, "hello"41 end if42 !ERROR: Dimension 1 of left operand has extent 0, but right operand has extent 143 !ERROR: Dimension 1 of left operand has extent 0, but right operand has extent 144 if (all(shape(27)==shape(arrayLocal))) then45 print *, "hello"46 end if47 if (all(64==shape(arrayLocal))) then48 print *, "hello"49 end if50 ! These can't be checked at compilation time51 if (any(shape(assumedRank) == [1])) stop52 if (any(lbound(assumedRank) == [1,2])) stop53 if (any(ubound(assumedRank) == [1,2,3])) stop54 end subroutine sub155end program testShape56