brintos

brintos / llvm-project-archived public Read only

0
0
Text · 4.3 KiB · 5af7e95 Raw
139 lines · plain
1! RUN: not %flang_fc1 -fsyntax-only %s 2>&1 | FileCheck %s2! Test WhyNotDefinable() explanations3 4module prot5  real, protected :: prot6  type :: ptype7    real, pointer :: ptr8    real :: x9  end type10  type(ptype), protected :: protptr11 contains12  subroutine ok13    prot = 0. ! ok14  end subroutine15end module16 17module m18  use iso_fortran_env19  use prot20  type :: t121    type(lock_type) :: lock22  end type23  type :: t224    type(t1) :: x125    real :: x226  end type27  type(t2) :: t2static28  type list29    real a30    type(list), pointer :: prev, next31  end type32  character(*), parameter :: internal = '0'33 contains34  subroutine test1(dummy)35    real :: arr(2)36    integer, parameter :: j3 = 66637    type(ptype), intent(in) :: dummy38    type(t2) :: t2var39    associate (a => 3+4)40      !CHECK: error: Input variable 'a' is not definable41      !CHECK: because: 'a' is construct associated with an expression42      read(internal,*) a43    end associate44    associate (a => arr([1])) ! vector subscript45      !CHECK: error: Input variable 'a' is not definable46      !CHECK: because: Construct association 'a' has a vector subscript47      read(internal,*) a48    end associate49    associate (a => arr(2:1:-1))50      read(internal,*) a ! ok51    end associate52    !CHECK: error: Input variable 'j3' is not definable53    !CHECK: because: '666_4' is not a variable54    read(internal,*) j355    !CHECK: error: Left-hand side of assignment is not definable56    !CHECK: because: 't2var' is an entity with either an EVENT_TYPE or LOCK_TYPE57    t2var = t2static58    t2var%x2 = 0. ! ok59    !CHECK: error: Left-hand side of assignment is not definable60    !CHECK: because: 'prot' is protected in this scope61    prot = 0.62    protptr%ptr = 0. ! ok63    !CHECK: error: Left-hand side of assignment is not definable64    !CHECK: because: 'dummy' is an INTENT(IN) dummy argument65    dummy%x = 0.66    dummy%ptr = 0. ! ok67  end subroutine68  pure subroutine test2(ptr)69    integer, pointer, intent(in) :: ptr70    !CHECK: error: Input variable 'ptr' is not definable71    !CHECK: because: 'ptr' is externally visible via 'ptr' and not definable in a pure subprogram72    read(internal,*) ptr73  end subroutine74  subroutine test3(objp, procp)75    real, intent(in), pointer :: objp76    procedure(sin), pointer, intent(in) :: procp77    !CHECK: error: Actual argument associated with INTENT(IN OUT) dummy argument 'op=' is not definable78    !CHECK: because: 'objp' is an INTENT(IN) dummy argument79    call test3a(objp)80    !CHECK: error: Actual argument associated with INTENT(IN OUT) procedure pointer dummy argument 'pp=' is not definable81    !CHECK: because: 'procp' is an INTENT(IN) dummy argument82    call test3b(procp)83  end subroutine84  subroutine test3a(op)85    real, intent(in out), pointer :: op86  end subroutine87  subroutine test3b(pp)88    procedure(sin), pointer, intent(in out) :: pp89  end subroutine90  subroutine test4(p)91    type(ptype), pointer, intent(in) :: p92    p%x = 1.93    p%ptr = 1. ! ok94    nullify(p%ptr) ! ok95    !CHECK: error: 'p' may not appear in NULLIFY96    !CHECK: because: 'p' is an INTENT(IN) dummy argument97    nullify(p)98  end99  subroutine test5(np)100    type(ptype), intent(in) :: np101    !CHECK: error: 'ptr' may not appear in NULLIFY102    !CHECK: because: 'np' is an INTENT(IN) dummy argument103    nullify(np%ptr)104  end105  pure function test6(lp)106    type(list), pointer :: lp107    !CHECK: error: The left-hand side of a pointer assignment is not definable108    !CHECK: because: 'lp' may not be defined in pure subprogram 'test6' because it is a POINTER dummy argument of a pure function109    lp%next%next => null()110  end111  pure subroutine test7(lp)112    type(list), pointer :: lp113    lp%next%next => null() ! ok114  end115end module116program main117  use iso_fortran_env, only: lock_type118  type(lock_type) lock119  interface120    subroutine inlock(lock)121      import lock_type122      type(lock_type), intent(in) :: lock123    end124    subroutine outlock(lock)125      import lock_type126      !CHECK: error: An INTENT(OUT) dummy argument may not be, or contain, EVENT_TYPE or LOCK_TYPE127      type(lock_type), intent(out) :: lock128    end129    subroutine inoutlock(lock)130      import lock_type131      type(lock_type), intent(in out) :: lock132    end133  end interface134  call inlock(lock) ! ok135  call inoutlock(lock) ! ok136  !CHECK: error: Actual argument associated with INTENT(OUT) dummy argument 'lock=' is not definable137  call outlock(lock)138end139