brintos

brintos / llvm-project-archived public Read only

0
0
Text · 1.2 KiB · b4d55db Raw
52 lines · plain
1!RUN: %python %S/test_errors.py %s %flang_fc12module m3 contains4  subroutine s(x, y, mask)5    class(*), allocatable, intent(in out) :: x(:), y(:)6    logical, intent(in) :: mask(:)7    select type(x)8    type is(integer)9      print *, 'before, x is integer', x10    type is(real)11      print *, 'before, x is real', x12    class default13      print *, 'before, x has some other type'14    end select15    select type(y)16    type is(integer)17      print *, 'y is integer', y18    type is(real)19      print *, 'y is real', y20    end select21    print *, 'mask', mask22    !ERROR: Assignment to whole polymorphic allocatable 'x' may not be nested in a WHERE statement or construct23    where(mask) x = y24    select type(x)25    type is(integer)26      print *, 'after, x is integer', x27    type is(real)28      print *, 'after, x is real', x29    class default30      print *, 'before, x has some other type'31    end select32    print *33  end34end35 36program main37  use m38  class(*), allocatable :: x(:), y(:)39  x = [1, 2]40  y = [3., 4.]41  call s(x, y, [.false., .false.])42  x = [1, 2]43  y = [3., 4.]44  call s(x, y, [.false., .true.])45  x = [1, 2]46  y = [3., 4.]47  call s(x, y, [.true., .false.])48  x = [1, 2]49  y = [3., 4.]50  call s(x, y, [.true., .true.])51end program main52