brintos

brintos / llvm-project-archived public Read only

0
0
Text · 4.6 KiB · 18cc0ec Raw
159 lines · plain
1! RUN: %python %S/test_errors.py %s %flang_fc1 -pedantic2! 15.5.1 procedure reference constraints and restrictions3 4subroutine s01(elem, subr)5  interface6    !ERROR: A dummy procedure may not be ELEMENTAL7    elemental real function elem(x)8      real, intent(in), value :: x9    end function10    subroutine subr(dummy)11      !PORTABILITY: A dummy procedure should not have an ELEMENTAL intrinsic as its interface [-Wportability]12      procedure(sin) :: dummy13    end subroutine14    subroutine badsubr(dummy)15      import :: elem16      !ERROR: A dummy procedure may not be ELEMENTAL17      procedure(elem) :: dummy18    end subroutine19    subroutine optionalsubr(dummy)20      !PORTABILITY: A dummy procedure should not have an ELEMENTAL intrinsic as its interface [-Wportability]21      procedure(sin), optional :: dummy22    end subroutine23    subroutine ptrsubr(dummy)24      !PORTABILITY: A dummy procedure should not have an ELEMENTAL intrinsic as its interface [-Wportability]25      procedure(sin), pointer, intent(in) :: dummy26    end subroutine27  end interface28  intrinsic :: cos29  call subr(cos) ! not an error30  !ERROR: Non-intrinsic ELEMENTAL procedure 'elem' may not be passed as an actual argument31  call subr(elem) ! C153332  !ERROR: Actual argument associated with procedure dummy argument 'dummy=' is a null pointer33  call subr(null())34  call optionalsubr(null()) ! ok35  call ptrsubr(null()) ! ok36  !ERROR: Actual argument associated with procedure dummy argument 'dummy=' is typeless37  call subr(B"1010")38end subroutine39 40subroutine s0241  !ERROR: Non-intrinsic ELEMENTAL procedure 'elem' may not be passed as an actual argument42  call sub(elem)43 contains44  elemental integer function elem()45    elem = 146  end function47end48 49subroutine s0350  interface51    subroutine sub1(p)52      procedure(real) :: p53    end subroutine54  end interface55  sf(x) = x + 1.56  !ERROR: Statement function 'sf' may not be passed as an actual argument57  call sub1(sf)58  !ERROR: Statement function 'sf' may not be passed as an actual argument59  call sub2(sf)60end61 62module m0163  procedure(sin) :: elem0164  interface65    elemental real function elem02(x)66      real, value :: x67    end function68    subroutine callme(f)69      external f70    end subroutine71  end interface72 contains73  elemental real function elem03(x)74    real, value :: x75    elem03 = 0.76  end function77  subroutine test78    intrinsic :: cos79    call callme(cos) ! not an error80    !ERROR: Non-intrinsic ELEMENTAL procedure 'elem01' may not be passed as an actual argument81    call callme(elem01) ! C153382    !ERROR: Non-intrinsic ELEMENTAL procedure 'elem02' may not be passed as an actual argument83    call callme(elem02) ! C153384    !ERROR: Non-intrinsic ELEMENTAL procedure 'elem03' may not be passed as an actual argument85    call callme(elem03) ! C153386    !ERROR: Non-intrinsic ELEMENTAL procedure 'elem04' may not be passed as an actual argument87    call callme(elem04) ! C153388   contains89    elemental real function elem04(x)90      real, value :: x91      elem04 = 0.92    end function93  end subroutine94end module95 96module m0297  type :: t98    integer, pointer :: ptr99  end type100  type(t) :: coarray[*]101 contains102  subroutine callee(x)103    type(t), intent(in) :: x104  end subroutine105  subroutine test106    !ERROR: Coindexed object 'coarray' with POINTER ultimate component '%ptr' cannot be associated with dummy argument 'x='107    call callee(coarray[1]) ! C1537108  end subroutine109end module110 111module m03112 contains113  subroutine test114    !ERROR: Non-intrinsic ELEMENTAL procedure 'elem' may not be passed as an actual argument115    call sub(elem)116   contains117    elemental integer function elem()118      elem = 1119    end function120  end121end122 123program p03124  logical :: l125  call s1(index)126  l = index .eq. 0  ! index is an object entity, not an intrinsic127  call s2(sin)128  !ERROR: Actual argument associated with procedure dummy argument 'p=' is not a procedure129  call s3(cos)130contains131  subroutine s2(x)132    real :: x133  end134  subroutine s3(p)135    procedure(real) :: p136  end137end138 139subroutine p04140  implicit none141  !ERROR: No explicit type declared for 'index'142  call s1(index)143end144 145subroutine p05146  integer :: a1(2), a2, a3147  !ERROR: In an elemental procedure reference with at least one array argument, actual argument a2 that corresponds to an INTENT(OUT) or INTENT(INOUT) dummy argument must be an array148  !ERROR: In an elemental procedure reference with at least one array argument, actual argument a3 that corresponds to an INTENT(OUT) or INTENT(INOUT) dummy argument must be an array149  call s1(a1, a2, a3)150contains151  elemental subroutine s1(a, b, c)152    integer, intent(in) :: a153    integer, intent(out) :: b154    integer, intent(inout) :: c155    b = a156    c = a157  end158end159