[flang-commits] [flang] fbdcb3c - [flang] Add one semantic check for allocatable/pointer argument association
via flang-commits
flang-commits at lists.llvm.org
Mon Apr 4 08:17:13 PDT 2022
Author: PeixinQiao
Date: 2022-04-04T23:16:30+08:00
New Revision: fbdcb3ce6b7b0bac45e06aeac0ca02607f54a0a7
URL: https://github.com/llvm/llvm-project/commit/fbdcb3ce6b7b0bac45e06aeac0ca02607f54a0a7
DIFF: https://github.com/llvm/llvm-project/commit/fbdcb3ce6b7b0bac45e06aeac0ca02607f54a0a7.diff
LOG: [flang] Add one semantic check for allocatable/pointer argument association
The actual argument shall have deferred the same type parameters as
the dummy argument if the argument is allocatable or pointer variable.
Currently programs not following this get one crash during execution.
Reviewed By: Jean Perier
Differential Revision: https://reviews.llvm.org/D122779
Added:
Modified:
flang/lib/Semantics/check-call.cpp
flang/test/Lower/allocatable-caller.f90
flang/test/Lower/pointer-args-caller.f90
flang/test/Semantics/call05.f90
Removed:
################################################################################
diff --git a/flang/lib/Semantics/check-call.cpp b/flang/lib/Semantics/check-call.cpp
index 7c5fb605567cb..ad3c5cb434d4f 100644
--- a/flang/lib/Semantics/check-call.cpp
+++ b/flang/lib/Semantics/check-call.cpp
@@ -471,6 +471,7 @@ static void CheckExplicitDataArg(const characteristics::DummyDataObject &dummy,
"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 @@ static void CheckExplicitDataArg(const characteristics::DummyDataObject &dummy,
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);
}
}
}
diff --git a/flang/test/Lower/allocatable-caller.f90 b/flang/test/Lower/allocatable-caller.f90
index 16d661b91d30d..0abd6b97f37d4 100644
--- a/flang/test/Lower/allocatable-caller.f90
+++ b/flang/test/Lower/allocatable-caller.f90
@@ -36,25 +36,21 @@ subroutine test_char_scalar_deferred(x)
end subroutine
end interface
character(:), allocatable :: x
- character(10), allocatable :: x2
- ! CHECK-DAG: %[[box:.*]] = fir.alloca !fir.box<!fir.heap<!fir.char<1,?>>> {{{.*}}uniq_name = "_QFtest_char_scalar_deferred_callEx"}
- ! CHECK-DAG: %[[box2:.*]] = fir.alloca !fir.box<!fir.heap<!fir.char<1,10>>> {{{.*}}uniq_name = "_QFtest_char_scalar_deferred_callEx2"}
+ ! CHECK: %[[box:.*]] = fir.alloca !fir.box<!fir.heap<!fir.char<1,?>>> {{{.*}}uniq_name = "_QFtest_char_scalar_deferred_callEx"}
call test_char_scalar_deferred(x)
! CHECK: fir.call @_QPtest_char_scalar_deferred(%[[box]]) : (!fir.ref<!fir.box<!fir.heap<!fir.char<1,?>>>>) -> ()
- call test_char_scalar_deferred(x2)
- ! CHECK: %[[box2cast:.*]] = fir.convert %[[box2]] : (!fir.ref<!fir.box<!fir.heap<!fir.char<1,10>>>>) -> !fir.ref<!fir.box<!fir.heap<!fir.char<1,?>>>>
- ! CHECK: fir.call @_QPtest_char_scalar_deferred(%[[box2cast]]) : (!fir.ref<!fir.box<!fir.heap<!fir.char<1,?>>>>) -> ()
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<!fir.heap<!fir.char<1,10>>> {{{.*}}uniq_name = "_QFtest_char_scalar_explicit_callEx"}
! CHECK-DAG: %[[box2:.*]] = fir.alloca !fir.box<!fir.heap<!fir.char<1,?>>> {{{.*}}uniq_name = "_QFtest_char_scalar_explicit_callEx2"}
call test_char_scalar_explicit(x)
@@ -72,25 +68,21 @@ subroutine test_char_array_deferred(x)
end subroutine
end interface
character(:), allocatable :: x(:)
- character(10), allocatable :: x2(:)
- ! CHECK-DAG: %[[box:.*]] = fir.alloca !fir.box<!fir.heap<!fir.array<?x!fir.char<1,?>>>> {{{.*}}uniq_name = "_QFtest_char_array_deferred_callEx"}
- ! CHECK-DAG: %[[box2:.*]] = fir.alloca !fir.box<!fir.heap<!fir.array<?x!fir.char<1,10>>>> {{{.*}}uniq_name = "_QFtest_char_array_deferred_callEx2"}
+ ! CHECK: %[[box:.*]] = fir.alloca !fir.box<!fir.heap<!fir.array<?x!fir.char<1,?>>>> {{{.*}}uniq_name = "_QFtest_char_array_deferred_callEx"}
call test_char_array_deferred(x)
! CHECK: fir.call @_QPtest_char_array_deferred(%[[box]]) : (!fir.ref<!fir.box<!fir.heap<!fir.array<?x!fir.char<1,?>>>>>) -> ()
- call test_char_array_deferred(x2)
- ! CHECK: %[[box2cast:.*]] = fir.convert %[[box2]] : (!fir.ref<!fir.box<!fir.heap<!fir.array<?x!fir.char<1,10>>>>>) -> !fir.ref<!fir.box<!fir.heap<!fir.array<?x!fir.char<1,?>>>>>
- ! CHECK: fir.call @_QPtest_char_array_deferred(%[[box2cast]]) : (!fir.ref<!fir.box<!fir.heap<!fir.array<?x!fir.char<1,?>>>>>) -> ()
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<!fir.heap<!fir.array<?x!fir.char<1,10>>>> {{{.*}}uniq_name = "_QFtest_char_array_explicit_callEx"}
! CHECK-DAG: %[[box2:.*]] = fir.alloca !fir.box<!fir.heap<!fir.array<?x!fir.char<1,?>>>> {{{.*}}uniq_name = "_QFtest_char_array_explicit_callEx2"}
call test_char_array_explicit(x)
diff --git a/flang/test/Lower/pointer-args-caller.f90 b/flang/test/Lower/pointer-args-caller.f90
index 89a8e5a06f8f9..d4f10571e4347 100644
--- a/flang/test/Lower/pointer-args-caller.f90
+++ b/flang/test/Lower/pointer-args-caller.f90
@@ -46,9 +46,10 @@ subroutine test_ptr_to_char_array_ptr(p)
end subroutine
! CHECK-LABEL: func @_QMcall_defsPtest_ptr_to_non_deferred_char_array_ptr(
-! CHECK-SAME: %[[VAL_0:.*]]: !fir.ref<!fir.box<!fir.ptr<!fir.array<?x!fir.char<1,?>>>>> {fir.bindc_name = "p"}) {
-subroutine test_ptr_to_non_deferred_char_array_ptr(p)
- character(:), pointer :: p(:)
+! CHECK-SAME: %[[VAL_0:.*]]: !fir.ref<!fir.box<!fir.ptr<!fir.array<?x!fir.char<1,?>>>>> {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.box<!fir.ptr<!fir.array<?x!fir.char<1,?>>>>>) -> !fir.ref<!fir.box<!fir.ptr<!fir.array<?x!fir.char<1,10>>>>>
! CHECK: fir.call @_QPnon_deferred_char_array_ptr(%[[VAL_1]]) : (!fir.ref<!fir.box<!fir.ptr<!fir.array<?x!fir.char<1,10>>>>>) -> ()
call non_deferred_char_array_ptr(p)
diff --git a/flang/test/Semantics/call05.f90 b/flang/test/Semantics/call05.f90
index c97dcd166495d..ab7b974527a91 100644
--- a/flang/test/Semantics/call05.f90
+++ b/flang/test/Semantics/call05.f90
@@ -153,8 +153,14 @@ subroutine smb(b)
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 @@ subroutine test()
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 @@ subroutine test()
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
More information about the flang-commits
mailing list