[flang-commits] [flang] 3d63d21 - [flang] Do not pass derived type by descriptor when not needed

Jean Perier via flang-commits flang-commits at lists.llvm.org
Wed Apr 20 01:01:20 PDT 2022


Author: Jean Perier
Date: 2022-04-20T10:00:34+02:00
New Revision: 3d63d2111c3e8ee2c897caa6d71429e3bf183e2d

URL: https://github.com/llvm/llvm-project/commit/3d63d2111c3e8ee2c897caa6d71429e3bf183e2d
DIFF: https://github.com/llvm/llvm-project/commit/3d63d2111c3e8ee2c897caa6d71429e3bf183e2d.diff

LOG: [flang] Do not pass derived type by descriptor when not needed

A missing "!" in the call interface lowering caused all derived type
arguments without length parameters that require and explicit interface
to be passed via fir.box (runtime descriptor).

This was not the intent: there is no point passing a simple derived type
scalars or explicit shapes by descriptor just because they have an attribute
like TARGET. This would actually be problematic with existing code that is
not always 100% compliant: some code implicitly calls procedures with
TARGET dummy attributes (this is not something a compiler can enforce
if the call and procedure definition are not in the same file).

Add a Scope::IsDerivedTypeWithLengthParameter to avoid passing derived
types with only kind parameters by descriptor. There is no point, the
callee knows about the kind parameter values.

Differential Revision: https://reviews.llvm.org/D123990

Added: 
    flang/test/Lower/dummy-argument-derived.f90

Modified: 
    flang/include/flang/Semantics/scope.h
    flang/lib/Lower/CallInterface.cpp
    flang/lib/Semantics/scope.cpp
    flang/test/Lower/default-initialization.f90

Removed: 
    


################################################################################
diff  --git a/flang/include/flang/Semantics/scope.h b/flang/include/flang/Semantics/scope.h
index e83f89405f74e..7c42e7ff14fa6 100644
--- a/flang/include/flang/Semantics/scope.h
+++ b/flang/include/flang/Semantics/scope.h
@@ -104,7 +104,10 @@ class Scope {
   bool IsParameterizedDerivedTypeInstantiation() const {
     return kind_ == Kind::DerivedType && !symbol_;
   }
+  /// Does this derived type have at least one kind parameter ?
   bool IsDerivedTypeWithKindParameter() const;
+  /// Does this derived type have at least one length parameter ?
+  bool IsDerivedTypeWithLengthParameter() const;
   Symbol *symbol() { return symbol_; }
   const Symbol *symbol() const { return symbol_; }
   SemanticsContext &context() const { return context_; }

diff  --git a/flang/lib/Lower/CallInterface.cpp b/flang/lib/Lower/CallInterface.cpp
index 071cda6880c50..9ff32315cd9a6 100644
--- a/flang/lib/Lower/CallInterface.cpp
+++ b/flang/lib/Lower/CallInterface.cpp
@@ -765,8 +765,9 @@ class Fortran::lower::CallInterfaceImpl {
       return true;
     if (const Fortran::semantics::DerivedTypeSpec *derived =
             Fortran::evaluate::GetDerivedTypeSpec(obj.type.type()))
-      // Need to pass type parameters in fir.box if any.
-      return derived->parameters().empty();
+      if (const Fortran::semantics::Scope *scope = derived->scope())
+        // Need to pass length type parameters in fir.box if any.
+        return scope->IsDerivedTypeWithLengthParameter();
     return false;
   }
 

diff  --git a/flang/lib/Semantics/scope.cpp b/flang/lib/Semantics/scope.cpp
index 5d483733b4419..e92a21b55768a 100644
--- a/flang/lib/Semantics/scope.cpp
+++ b/flang/lib/Semantics/scope.cpp
@@ -357,35 +357,32 @@ bool Scope::IsStmtFunction() const {
   return symbol_ && symbol_->test(Symbol::Flag::StmtFunction);
 }
 
-bool Scope::IsParameterizedDerivedType() const {
-  if (!IsDerivedType()) {
-    return false;
-  }
-  if (const Scope * parent{GetDerivedTypeParent()}) {
-    if (parent->IsParameterizedDerivedType()) {
-      return true;
-    }
-  }
-  for (const auto &pair : symbols_) {
-    if (pair.second->has<TypeParamDetails>()) {
-      return true;
-    }
+template <common::TypeParamAttr... ParamAttr> struct IsTypeParamHelper {
+  static_assert(sizeof...(ParamAttr) == 0, "must have one or zero template");
+  static bool IsParam(const Symbol &symbol) {
+    return symbol.has<TypeParamDetails>();
   }
-  return false;
-}
+};
 
-bool Scope::IsDerivedTypeWithKindParameter() const {
-  if (!IsDerivedType()) {
+template <common::TypeParamAttr ParamAttr> struct IsTypeParamHelper<ParamAttr> {
+  static bool IsParam(const Symbol &symbol) {
+    if (const auto *typeParam{symbol.detailsIf<TypeParamDetails>()}) {
+      return typeParam->attr() == ParamAttr;
+    }
     return false;
   }
-  if (const Scope * parent{GetDerivedTypeParent()}) {
-    if (parent->IsDerivedTypeWithKindParameter()) {
-      return true;
+};
+
+template <common::TypeParamAttr... ParamAttr>
+static bool IsParameterizedDerivedTypeHelper(const Scope &scope) {
+  if (scope.IsDerivedType()) {
+    if (const Scope * parent{scope.GetDerivedTypeParent()}) {
+      if (IsParameterizedDerivedTypeHelper<ParamAttr...>(*parent)) {
+        return true;
+      }
     }
-  }
-  for (const auto &pair : symbols_) {
-    if (const auto *typeParam{pair.second->detailsIf<TypeParamDetails>()}) {
-      if (typeParam->attr() == common::TypeParamAttr::Kind) {
+    for (const auto &nameAndSymbolPair : scope) {
+      if (IsTypeParamHelper<ParamAttr...>::IsParam(*nameAndSymbolPair.second)) {
         return true;
       }
     }
@@ -393,6 +390,16 @@ bool Scope::IsDerivedTypeWithKindParameter() const {
   return false;
 }
 
+bool Scope::IsParameterizedDerivedType() const {
+  return IsParameterizedDerivedTypeHelper<>(*this);
+}
+bool Scope::IsDerivedTypeWithLengthParameter() const {
+  return IsParameterizedDerivedTypeHelper<common::TypeParamAttr::Len>(*this);
+}
+bool Scope::IsDerivedTypeWithKindParameter() const {
+  return IsParameterizedDerivedTypeHelper<common::TypeParamAttr::Kind>(*this);
+}
+
 const DeclTypeSpec *Scope::FindInstantiatedDerivedType(
     const DerivedTypeSpec &spec, DeclTypeSpec::Category category) const {
   DeclTypeSpec type{category, spec};

diff  --git a/flang/test/Lower/default-initialization.f90 b/flang/test/Lower/default-initialization.f90
index 4f676fa794a6c..eb75021104e62 100644
--- a/flang/test/Lower/default-initialization.f90
+++ b/flang/test/Lower/default-initialization.f90
@@ -75,11 +75,12 @@ subroutine intent_out(x)
   ! Test that optional intent(out) are default initialized only when
   ! present.
   ! CHECK-LABEL: func @_QMtest_dinitPintent_out_optional(
-  ! CHECK-SAME: %[[x:.*]]: !fir.box<!fir.type<_QMtest_dinitTt{i:i32}>> {fir.bindc_name = "x", fir.optional})
+  ! CHECK-SAME: %[[x:.*]]: !fir.ref<!fir.type<_QMtest_dinitTt{i:i32}>> {fir.bindc_name = "x", fir.optional})
   subroutine intent_out_optional(x)
-    ! CHECK: %[[isPresent:.*]] = fir.is_present %[[x]] : (!fir.box<!fir.type<_QMtest_dinitTt{i:i32}>>) -> i1
+    ! CHECK: %[[isPresent:.*]] = fir.is_present %[[x]] : (!fir.ref<!fir.type<_QMtest_dinitTt{i:i32}>>) -> i1
     ! CHECK: fir.if %[[isPresent]] {
-      ! CHECK: %[[xboxNone:.*]] = fir.convert %[[x]]
+      ! CHECK: %[[xbox:.*]] = fir.embox %[[x]] : (!fir.ref<!fir.type<_QMtest_dinitTt{i:i32}>>) -> !fir.box<!fir.type<_QMtest_dinitTt{i:i32}>>
+      ! CHECK: %[[xboxNone:.*]] = fir.convert %[[xbox]]
       ! CHECK: fir.call @_FortranAInitialize(%[[xboxNone]], %{{.*}}, %{{.*}}) : (!fir.box<none>, !fir.ref<i8>, i32) -> none
     ! CHECK: }
     type(t), intent(out), optional :: x

diff  --git a/flang/test/Lower/dummy-argument-derived.f90 b/flang/test/Lower/dummy-argument-derived.f90
new file mode 100644
index 0000000000000..55093e1670995
--- /dev/null
+++ b/flang/test/Lower/dummy-argument-derived.f90
@@ -0,0 +1,116 @@
+! Test lowering of derived type dummy arguments
+! RUN: bbc -emit-fir %s -o - | FileCheck %s
+module type_defs
+  type simple_type
+    integer :: i
+  end type
+  type with_kind(k)
+    integer, kind :: k
+    real(k) :: x
+  end type
+end module
+
+! -----------------------------------------------------------------------------
+!     Test passing of derived type arguments that do not require a
+!     fir.box (runtime descriptor).
+! -----------------------------------------------------------------------------
+
+! Test simple type scalar with no attribute.
+! CHECK-LABEL: func @_QPtest1(
+! CHECK-SAME:  %[[VAL_0:.*]]: !fir.ref<!fir.type<_QMtype_defsTsimple_type{i:i32}>> {fir.bindc_name = "a"}) {
+subroutine test1(a)
+  use type_defs
+  type(simple_type) :: a
+end subroutine
+
+! Test simple type explicit array with no attribute.
+! CHECK-LABEL: func @_QPtest2(
+! CHECK-SAME:  %[[VAL_0:.*]]: !fir.ref<!fir.array<100x!fir.type<_QMtype_defsTsimple_type{i:i32}>>> {fir.bindc_name = "a"}) {
+subroutine test2(a)
+  use type_defs
+  type(simple_type) :: a(100)
+end subroutine
+
+! Test simple type scalar with TARGET attribute.
+! CHECK-LABEL: func @_QPtest3(
+! CHECK-SAME:  %[[VAL_0:.*]]: !fir.ref<!fir.type<_QMtype_defsTsimple_type{i:i32}>> {fir.bindc_name = "a", fir.target}) {
+subroutine test3(a)
+  use type_defs
+  type(simple_type), target :: a
+end subroutine
+
+! Test simple type explicit array with TARGET attribute.
+! CHECK-LABEL: func @_QPtest4(
+! CHECK-SAME:  %[[VAL_0:.*]]: !fir.ref<!fir.array<100x!fir.type<_QMtype_defsTsimple_type{i:i32}>>> {fir.bindc_name = "a", fir.target}) {
+subroutine test4(a)
+  use type_defs
+  type(simple_type), target :: a(100)
+end subroutine
+
+! Test kind parametrized derived type scalar with no attribute.
+! CHECK-LABEL: func @_QPtest1k(
+! CHECK-SAME:  %[[VAL_0:.*]]: !fir.ref<!fir.type<_QMtype_defsTwith_kindK4{x:f32}>> {fir.bindc_name = "a"}) {
+subroutine test1k(a)
+  use type_defs
+  type(with_kind(4)) :: a
+end subroutine
+
+! Test kind parametrized derived type explicit array with no attribute.
+! CHECK-LABEL: func @_QPtest2k(
+! CHECK-SAME:  %[[VAL_0:.*]]: !fir.ref<!fir.array<100x!fir.type<_QMtype_defsTwith_kindK4{x:f32}>>> {fir.bindc_name = "a"}) {
+subroutine test2k(a)
+  use type_defs
+  type(with_kind(4)) :: a(100)
+end subroutine
+
+! Test kind parametrized derived type scalar with TARGET attribute.
+! CHECK-LABEL: func @_QPtest3k(
+! CHECK-SAME:  %[[VAL_0:.*]]: !fir.ref<!fir.type<_QMtype_defsTwith_kindK4{x:f32}>> {fir.bindc_name = "a", fir.target}) {
+subroutine test3k(a)
+  use type_defs
+  type(with_kind(4)), target :: a
+end subroutine
+
+! Test kind parametrized derived type explicit array with TARGET attribute.
+! CHECK-LABEL: func @_QPtest4k(
+! CHECK-SAME:  %[[VAL_0:.*]]: !fir.ref<!fir.array<100x!fir.type<_QMtype_defsTwith_kindK4{x:f32}>>> {fir.bindc_name = "a", fir.target}) {
+subroutine test4k(a)
+  use type_defs
+  type(with_kind(4)), target :: a(100)
+end subroutine
+
+! -----------------------------------------------------------------------------
+!     Test passing of derived type arguments that require a fir.box (runtime descriptor).
+! -----------------------------------------------------------------------------
+
+! Test simple type assumed shape array with no attribute.
+! CHECK-LABEL: func @_QPtest5(
+! CHECK-SAME:  %[[VAL_0:.*]]: !fir.box<!fir.array<?x!fir.type<_QMtype_defsTsimple_type{i:i32}>>> {fir.bindc_name = "a"}) {
+subroutine test5(a)
+  use type_defs
+  type(simple_type) :: a(:)
+end subroutine
+
+! Test simple type assumed shape array with TARGET attribute.
+! CHECK-LABEL: func @_QPtest6(
+! CHECK-SAME:  %[[VAL_0:.*]]: !fir.box<!fir.array<?x!fir.type<_QMtype_defsTsimple_type{i:i32}>>> {fir.bindc_name = "a", fir.target}) {
+subroutine test6(a)
+  use type_defs
+  type(simple_type), target :: a(:)
+end subroutine
+
+! Test kind parametrized derived type assumed shape array with no attribute.
+! CHECK-LABEL: func @_QPtest5k(
+! CHECK-SAME:  %[[VAL_0:.*]]: !fir.box<!fir.array<?x!fir.type<_QMtype_defsTwith_kindK4{x:f32}>>> {fir.bindc_name = "a"}) {
+subroutine test5k(a)
+  use type_defs
+  type(with_kind(4)) :: a(:)
+end subroutine
+
+! Test kind parametrized derived type assumed shape array with TARGET attribute.
+! CHECK-LABEL: func @_QPtest6k(
+! CHECK-SAME:  %[[VAL_0:.*]]: !fir.box<!fir.array<?x!fir.type<_QMtype_defsTwith_kindK4{x:f32}>>> {fir.bindc_name = "a", fir.target}) {
+subroutine test6k(a)
+  use type_defs
+  type(with_kind(4)), target :: a(:)
+end subroutine


        


More information about the flang-commits mailing list