Index: flang/lib/Semantics/check-call.cpp =================================================================== --- flang/lib/Semantics/check-call.cpp +++ flang/lib/Semantics/check-call.cpp @@ -471,6 +471,7 @@ "POINTER or ALLOCATABLE dummy and actual arguments must have the same declared type and kind"_err_en_US); } } + // 15.5.2.5(4) if (const auto *derived{ evaluate::GetDerivedTypeSpec(actualType.type())}) { if (!DefersSameTypeParameters( @@ -478,6 +479,10 @@ messages.Say( "Dummy and actual arguments must defer the same type parameters when POINTER or ALLOCATABLE"_err_en_US); } + } else if (dummy.type.type().HasDeferredTypeParameter() != + actualType.type().HasDeferredTypeParameter()) { + messages.Say( + "Dummy and actual arguments must defer the same type parameters when POINTER or ALLOCATABLE"_err_en_US); } } } Index: flang/test/Lower/allocatable-caller.f90 =================================================================== --- flang/test/Lower/allocatable-caller.f90 +++ flang/test/Lower/allocatable-caller.f90 @@ -36,25 +36,21 @@ end subroutine end interface character(:), allocatable :: x - character(10), allocatable :: x2 - ! CHECK-DAG: %[[box:.*]] = fir.alloca !fir.box>> {{{.*}}uniq_name = "_QFtest_char_scalar_deferred_callEx"} - ! CHECK-DAG: %[[box2:.*]] = fir.alloca !fir.box>> {{{.*}}uniq_name = "_QFtest_char_scalar_deferred_callEx2"} + ! CHECK: %[[box:.*]] = fir.alloca !fir.box>> {{{.*}}uniq_name = "_QFtest_char_scalar_deferred_callEx"} call test_char_scalar_deferred(x) ! CHECK: fir.call @_QPtest_char_scalar_deferred(%[[box]]) : (!fir.ref>>>) -> () - call test_char_scalar_deferred(x2) - ! CHECK: %[[box2cast:.*]] = fir.convert %[[box2]] : (!fir.ref>>>) -> !fir.ref>>> - ! CHECK: fir.call @_QPtest_char_scalar_deferred(%[[box2cast]]) : (!fir.ref>>>) -> () end subroutine ! CHECK-LABEL: func @_QPtest_char_scalar_explicit_call( -subroutine test_char_scalar_explicit_call() +subroutine test_char_scalar_explicit_call(n) + integer :: n interface subroutine test_char_scalar_explicit(x) character(10), allocatable :: x end subroutine end interface character(10), allocatable :: x - character(:), allocatable :: x2 + character(n), allocatable :: x2 ! CHECK-DAG: %[[box:.*]] = fir.alloca !fir.box>> {{{.*}}uniq_name = "_QFtest_char_scalar_explicit_callEx"} ! CHECK-DAG: %[[box2:.*]] = fir.alloca !fir.box>> {{{.*}}uniq_name = "_QFtest_char_scalar_explicit_callEx2"} call test_char_scalar_explicit(x) @@ -72,25 +68,21 @@ end subroutine end interface character(:), allocatable :: x(:) - character(10), allocatable :: x2(:) - ! CHECK-DAG: %[[box:.*]] = fir.alloca !fir.box>>> {{{.*}}uniq_name = "_QFtest_char_array_deferred_callEx"} - ! CHECK-DAG: %[[box2:.*]] = fir.alloca !fir.box>>> {{{.*}}uniq_name = "_QFtest_char_array_deferred_callEx2"} + ! CHECK: %[[box:.*]] = fir.alloca !fir.box>>> {{{.*}}uniq_name = "_QFtest_char_array_deferred_callEx"} call test_char_array_deferred(x) ! CHECK: fir.call @_QPtest_char_array_deferred(%[[box]]) : (!fir.ref>>>>) -> () - call test_char_array_deferred(x2) - ! CHECK: %[[box2cast:.*]] = fir.convert %[[box2]] : (!fir.ref>>>>) -> !fir.ref>>>> - ! CHECK: fir.call @_QPtest_char_array_deferred(%[[box2cast]]) : (!fir.ref>>>>) -> () end subroutine ! CHECK-LABEL: func @_QPtest_char_array_explicit_call( -subroutine test_char_array_explicit_call() +subroutine test_char_array_explicit_call(n) + integer :: n interface subroutine test_char_array_explicit(x) character(10), allocatable :: x(:) end subroutine end interface character(10), allocatable :: x(:) - character(:), allocatable :: x2(:) + character(n), allocatable :: x2(:) ! CHECK-DAG: %[[box:.*]] = fir.alloca !fir.box>>> {{{.*}}uniq_name = "_QFtest_char_array_explicit_callEx"} ! CHECK-DAG: %[[box2:.*]] = fir.alloca !fir.box>>> {{{.*}}uniq_name = "_QFtest_char_array_explicit_callEx2"} call test_char_array_explicit(x) Index: flang/test/Lower/pointer-args-caller.f90 =================================================================== --- flang/test/Lower/pointer-args-caller.f90 +++ flang/test/Lower/pointer-args-caller.f90 @@ -46,9 +46,10 @@ end subroutine ! CHECK-LABEL: func @_QMcall_defsPtest_ptr_to_non_deferred_char_array_ptr( -! CHECK-SAME: %[[VAL_0:.*]]: !fir.ref>>>> {fir.bindc_name = "p"}) { -subroutine test_ptr_to_non_deferred_char_array_ptr(p) - character(:), pointer :: p(:) +! CHECK-SAME: %[[VAL_0:.*]]: !fir.ref>>>> {fir.bindc_name = "p"} +subroutine test_ptr_to_non_deferred_char_array_ptr(p, n) + integer :: n + character(n), pointer :: p(:) ! CHECK: %[[VAL_1:.*]] = fir.convert %[[VAL_0]] : (!fir.ref>>>>) -> !fir.ref>>>> ! CHECK: fir.call @_QPnon_deferred_char_array_ptr(%[[VAL_1]]) : (!fir.ref>>>>) -> () call non_deferred_char_array_ptr(p) Index: flang/test/Semantics/call05.f90 =================================================================== --- flang/test/Semantics/call05.f90 +++ flang/test/Semantics/call05.f90 @@ -153,8 +153,14 @@ subroutine test() + !ERROR: Dummy and actual arguments must defer the same type parameters when POINTER or ALLOCATABLE + call sma(t1) + call sma2(t1) ! ok + !ERROR: Dummy and actual arguments must defer the same type parameters when POINTER or ALLOCATABLE + call smp(p1) + call smp2(p1) ! ok !ERROR: ALLOCATABLE dummy argument 'a=' must be associated with an ALLOCATABLE actual argument @@ -168,8 +174,14 @@ call sma(t5) ! ok + !ERROR: Dummy and actual arguments must defer the same type parameters when POINTER or ALLOCATABLE + call sma2(t5) + call smp(p2) ! ok + !ERROR: Dummy and actual arguments must defer the same type parameters when POINTER or ALLOCATABLE + call smp2(p2) + !ERROR: ALLOCATABLE dummy argument 'a=' must be associated with an ALLOCATABLE actual argument call sma(t5(:)) @@ -194,3 +206,25 @@ end subroutine end module + +module test + type t(l) + integer, len :: l + character(l) :: c + end type + + contains + + subroutine bar(p) + type(t(:)), allocatable :: p(:) + end subroutine + + subroutine foo + type(t(10)), allocatable :: p(:) + + !ERROR: Dummy and actual arguments must defer the same type parameters when POINTER or ALLOCATABLE + call bar(p) + + end subroutine + +end module