flang/test/Semantics/misc-intrinsics.f90

   1 ! RUN: %python %S/test_errors.py %s %flang_fc1
   2 ! Miscellaneous constraint and requirement checking on intrinsics
   3 program test_size
   4   real :: scalar
   5   real, dimension(5, 5) :: array
   6   call test(array, array)
   7  contains
   8   subroutine test(arg, assumedRank)
   9     real, dimension(5, *) :: arg
  10     real, dimension(..) :: assumedRank
  11     !ERROR: A dim= argument is required for 'size' when the array is assumed-size
  12     print *, size(arg)
  13     !ERROR: A dim= argument is required for 'ubound' when the array is assumed-size
  14     print *, ubound(arg)
  15     !ERROR: The 'source=' argument to the intrinsic function 'shape' may not be assumed-size
  16     print *, shape(arg)
  17     !ERROR: The 'harvest=' argument to the intrinsic procedure 'random_number' may not be assumed-size
  18     call random_number(arg)
  19     !ERROR: 'array=' argument has unacceptable rank 0
  20     print *, lbound(scalar)
  21     !ERROR: 'array=' argument has unacceptable rank 0
  22     print *, size(scalar)
  23     !ERROR: 'array=' argument has unacceptable rank 0
  24     print *, ubound(scalar)
  25     !ERROR: DIM=0 dimension must be positive
  26     print *, lbound(arg, 0)
  27     !ERROR: DIM=0 dimension must be positive
  28     print *, lbound(assumedRank, 0)
  29     !ERROR: DIM=666 dimension is too large for any array (maximum rank 15)
  30     print *, lbound(assumedRank, 666)
  31     !ERROR: DIM=0 dimension must be positive
  32     print *, ubound(arg, 0)
  33     !ERROR: DIM=2 dimension is out of range for rank-2 assumed-size array
  34     print *, ubound(arg, 2)
  35     !ERROR: DIM=0 dimension must be positive
  36     print *, ubound(assumedRank, 0)
  37     !ERROR: DIM=666 dimension is too large for any array (maximum rank 15)
  38     print *, ubound(assumedRank, 666)
  39     select rank(assumedRank)
  40     rank(1)
  41       !ERROR: DIM=2 dimension is out of range for rank-1 array
  42       print *, lbound(assumedRank, dim=2)
  43       !ERROR: DIM=2 dimension is out of range for rank-1 array
  44       print *, ubound(assumedRank, dim=2)
  45     rank(*)
  46       !ERROR: A dim= argument is required for 'size' when the array is assumed-size
  47       print *, size(assumedRank)
  48       !ERROR: A dim= argument is required for 'ubound' when the array is assumed-size
  49       print *, ubound(assumedRank)
  50       !ERROR: The 'source=' argument to the intrinsic function 'shape' may not be assumed-size
  51       print *, shape(assumedRank)
  52       !ERROR: The 'harvest=' argument to the intrinsic procedure 'random_number' may not be assumed-size
  53       call random_number(assumedRank)
  54       !ERROR: DIM=0 dimension must be positive
  55       print *, lbound(assumedRank, 0)
  56       !ERROR: DIM=0 dimension must be positive
  57       print *, ubound(assumedRank, 0)
  58       !ERROR: DIM=1 dimension is out of range for rank-1 assumed-size array
  59       print *, ubound(assumedRank, 1)
  60       !ERROR: DIM=2 dimension is out of range for rank-1 array
  61       print *, lbound(assumedRank, dim=2)
  62       !ERROR: DIM=2 dimension is out of range for rank-1 array
  63       print *, ubound(assumedRank, dim=2)
  64     end select
  65     ! But these cases are fine:
  66     print *, size(arg, dim=1)
  67     print *, ubound(arg, dim=1)
  68     print *, lbound(arg)
  69     print *, size(array)
  70     print *, ubound(array)
  71     print *, lbound(array)
  72     print *, size(arg(:,1))
  73     print *, ubound(arg(:,1))
  74     print *, shape(scalar)
  75     print *, shape(arg(:,1))
  76     print *, lbound(assumedRank, dim=2) ! can't check until run time
  77     print *, ubound(assumedRank, dim=2)
  78     select rank(assumedRank)
  79     rank(3)
  80       print *, lbound(assumedRank, dim=2)
  81       print *, ubound(assumedRank, dim=2)
  82     rank(*)
  83       print *, lbound(assumedRank, dim=1)
  84     rank default
  85       print *, lbound(assumedRank, dim=2)
  86       print *, ubound(assumedRank, dim=2)
  87     end select
  88   end subroutine
  89 end