flang/test/Semantics/shape.f90

   1 ! RUN: %python %S/test_errors.py %s %flang_fc1
   2 ! Test comparisons that use the intrinsic SHAPE() as an operand
   3 program testShape
   4 contains
   5   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_aRrs
  11     !ERROR: Dimension 1 of left operand has extent 1, but right operand has extent 0
  12     !ERROR: Dimension 1 of left operand has extent 1, but right operand has extent 0
  13     if (all(shape(arrayDummy)==shape(8))) then
  14       print *, "hello"
  15     end if
  16     !ERROR: Dimension 1 of left operand has extent 0, but right operand has extent 1
  17     !ERROR: Dimension 1 of left operand has extent 0, but right operand has extent 1
  18     if (all(shape(27)==shape(arrayDummy))) then
  19       print *, "hello"
  20     end if
  21     if (all(64==shape(arrayDummy))) then
  22       print *, "hello"
  23     end if
  24     !ERROR: Dimension 1 of left operand has extent 1, but right operand has extent 0
  25     !ERROR: Dimension 1 of left operand has extent 1, but right operand has extent 0
  26     if (all(shape(arrayDeferred)==shape(8))) then
  27       print *, "hello"
  28     end if
  29     !ERROR: Dimension 1 of left operand has extent 0, but right operand has extent 1
  30     !ERROR: Dimension 1 of left operand has extent 0, but right operand has extent 1
  31     if (all(shape(27)==shape(arrayDeferred))) then
  32       print *, "hello"
  33     end if
  34     if (all(64==shape(arrayDeferred))) then
  35       print *, "hello"
  36     end if
  37     !ERROR: Dimension 1 of left operand has extent 1, but right operand has extent 0
  38     !ERROR: Dimension 1 of left operand has extent 1, but right operand has extent 0
  39     if (all(shape(arrayLocal)==shape(8))) then
  40       print *, "hello"
  41     end if
  42     !ERROR: Dimension 1 of left operand has extent 0, but right operand has extent 1
  43     !ERROR: Dimension 1 of left operand has extent 0, but right operand has extent 1
  44     if (all(shape(27)==shape(arrayLocal))) then
  45       print *, "hello"
  46     end if
  47     if (all(64==shape(arrayLocal))) then
  48       print *, "hello"
  49     end if
  50     ! These can't be checked at compilation time
  51     if (any(shape(assumedRank) == [1])) stop
  52     if (any(lbound(assumedRank) == [1,2])) stop
  53     if (any(ubound(assumedRank) == [1,2,3])) stop
  54   end subroutine sub1
  55 end program testShape