xref: /llvm-project/flang/test/Semantics/assign16.f90 (revision b8513e439351b11a90b8aa69311cf57572405826)
1! RUN: %python %S/test_errors.py %s %flang_fc1
2! The RHS of a pointer assignment can be unlimited polymorphic
3! if the LHS is a sequence type.
4program main
5  type nonSeqType
6    integer j
7  end type
8  type seqType
9    sequence
10    integer j
11  end type
12  type(nonSeqType), target :: xNonSeq = nonSeqType(1)
13  type(nonSeqType), pointer :: pNonSeq
14  type(seqType), target :: xSeq = seqType(1), aSeq(1)
15  type(seqType), pointer :: pSeq, paSeq(:)
16  !ERROR: function result type 'CLASS(*)' is not compatible with pointer type 'nonseqtype'
17  pNonSeq => polyPtr(xNonSeq)
18  pSeq => polyPtr(xSeq) ! ok
19  !ERROR: Pointer has rank 1 but target has rank 0
20  paSeq => polyPtr(xSeq)
21  !ERROR: Pointer has rank 0 but target has rank 1
22  pSeq => polyPtrArr(aSeq)
23 contains
24  function polyPtr(target)
25    class(*), intent(in), target :: target
26    class(*), pointer :: polyPtr
27    polyPtr => target
28  end
29  function polyPtrArr(target)
30    class(*), intent(in), target :: target(:)
31    class(*), pointer :: polyPtrArr(:)
32    polyPtrArr => target
33  end
34  function err1(target)
35    class(*), intent(in), target :: target(:)
36    class(*), pointer :: err1
37    !ERROR: Pointer has rank 0 but target has rank 1
38    err1 => target
39  end
40  function err2(target)
41    class(*), intent(in), target :: target
42    class(*), pointer :: err2(:)
43    !ERROR: Pointer has rank 1 but target has rank 0
44    err2 => target
45  end
46end
47