139 lines · plain
1! RUN: bbc -emit-hlfir %s -o - | %python %S/gen_mod_ref_test.py | \2! RUN: fir-opt -pass-pipeline='builtin.module(func.func(test-fir-alias-analysis-modref))' \3! RUN: --mlir-disable-threading -o /dev/null 2>&1 | FileCheck %s4 5! Test fir.call modref with internal procedures6 7subroutine simple_modref_test(test_var_x)8 implicit none9 real :: test_var_x10 call test_effect_internal()11contains12 subroutine test_effect_internal()13 test_var_x = 0.14 end subroutine15end subroutine16! CHECK-LABEL: Testing : "_QPsimple_modref_test"17! CHECK: test_effect_internal -> test_var_x#0: ModRef18 19subroutine simple_nomodref_test(test_var_x)20 implicit none21 real :: test_var_x22 call test_effect_internal()23contains24 subroutine test_effect_internal()25 call some_external()26 end subroutine27end subroutine28! CHECK-LABEL: Testing : "_QPsimple_nomodref_test"29! CHECK: test_effect_internal -> test_var_x#0: NoModRef30 31! Test that effects on captured variable are propagated to associated variables32! in associate construct.33 34subroutine test_associate()35 implicit none36 real :: test_var_x(10), test_var_a(10)37 associate (test_var_y=>test_var_x)38 test_var_a = test_effect_internal()39 end associate40contains41 function test_effect_internal() result(res)42 real :: res(10)43 res = test_var_x(10:1:-1)44 end function45end subroutine46! CHECK-LABEL: Testing : "_QPtest_associate"47! CHECK: test_effect_internal -> test_var_a#0: NoModRef48! CHECK: test_effect_internal -> test_var_x#0: ModRef49! CHECK: test_effect_internal -> test_var_y#0: ModRef50 51! Test that captured variables are considered to be affected when calling52! another internal function.53subroutine effect_inside_internal()54 implicit none55 real :: test_var_x(10)56 call internal_sub()57contains58 subroutine internal_sub59 real :: test_var_y(10)60 test_var_y = test_effect_internal_func()61 end subroutine62 function test_effect_internal_func() result(res)63 real :: res(10)64 res = test_var_x(10:1:-1)65 end function66end subroutine67! CHECK-LABEL: Testing : "_QFeffect_inside_internalPinternal_sub"68! CHECK: test_effect_internal_func -> test_var_x#0: ModRef69! CHECK: test_effect_internal_func -> test_var_y#0: NoModRef70 71! Test that captured variables are considered to be affected when calling72! any procedure73subroutine effect_inside_internal_2()74 implicit none75 real :: test_var_x(10)76 call some_external_that_may_capture_procedure_pointer(capturing_internal_func)77 call internal_sub()78contains79 subroutine internal_sub80 test_var_x(1) = 081 call test_effect_external_func_may_use_captured_proc_pointer()82 end subroutine83 function capturing_internal_func() result(res)84 real :: res(10)85 res = test_var_x(10:1:-1)86 end function87end subroutine88! CHECK-LABEL: Testing : "_QFeffect_inside_internal_2Pinternal_sub"89! CHECK: test_effect_external_func_may_use_captured_proc_pointer -> test_var_x#0: ModRef90 91module ifaces92 interface93 subroutine modify_pointer(p)94 real, pointer :: p95 end subroutine96 subroutine modify_allocatable(p)97 real, allocatable :: p98 end subroutine99 end interface100end module101 102! Test that descriptor address of captured pointer are considered modified103! in internal call.104subroutine test_pointer()105 real, pointer :: test_var_pointer106 call capture_internal(modify_pointer)107 associate (test_var_pointer_target => test_var_pointer)108 ! external may call internal via procedure pointer109 call test_effect_external()110 end associate111contains112 subroutine internal()113 use ifaces, only : modify_pointer114 call modify_pointer(test_var_pointer)115 end subroutine116end subroutine117! CHECK-LABEL: Testing : "_QPtest_pointer"118! CHECK: test_effect_external -> test_var_pointer#0: ModRef119! CHECK: test_effect_external -> test_var_pointer_target#0: ModRef120 121! Test that descriptor address of captured allocatable are considered modified122! in internal calls.123subroutine test_allocatable()124 real, allocatable :: test_var_allocatable125 call capture_internal(modify_allocatable)126 associate (test_var_allocatable_target => test_var_allocatable)127 ! external may call internal via procedure pointer128 call test_effect_external()129 end associate130contains131 subroutine internal()132 use ifaces, only : modify_allocatable133 call modify_allocatable(test_var_allocatable)134 end subroutine135end subroutine136! CHECK-LABEL: Testing : "_QPtest_allocatable"137! CHECK: test_effect_external -> test_var_allocatable#0: ModRef138! CHECK: test_effect_external -> test_var_allocatable_target#0: ModRef139