Commit 8df59132 authored by Slava Zakharin's avatar Slava Zakharin
Browse files

[flang][hlfir] Fixed length-one assignment. 

Assignment from a character dummy argument to a length-one character
variable resulted in illegal fir.convert:
  %0 = fir.load %unboxed_dummy : !fir.ref<!fir.char<1,?>>
  %1 = fir.convert %0 : (!fir.char<1,?>) -> !fir.char<1>
  fir.store %1 to %local : !fir.ref<!fir.char<1>>

This change fixes the length-one assignment code to use proper casts.

For character dummy arguments with constant length we will now also
type cast the unboxed reference to the character type with constant length
during the lowering:
  fir.convert %x : (!fir.ref<!fir.char<1,?>>) -> !fir.ref<!fir.char<1,8>>

I also adjusted the length-one assignment recognition so that in case
of same-length assignment we recognize length-one from either LHS or RHS
data types.

Reviewed By: jeanPerier

Differential Revision: https://reviews.llvm.org/D149382
parent 6db45cc4

flang/lib/Lower/ConvertVariable.cpp

+7 −6
Original line number Diff line number Diff line
@@ -1840,14 +1840,15 @@ void Fortran::lower::mapSymbolAttributes( 
    }

  }



  // Compute array extents and lower bounds.

  if (ba.isArray()) {

  if (addr && addr.getDefiningOp<fir::UnboxCharOp>()) {

      // Ensure proper type is given to array that transited via fir.boxchar

      // arg.

    // Ensure proper type is given to array/scalar that transited via

    // fir.boxchar arg.

    mlir::Type castTy = builder.getRefType(converter.genType(var));

    addr = builder.createConvert(loc, castTy, addr);

  }



  // Compute array extents and lower bounds.

  if (ba.isArray()) {

    if (ba.isStaticArray()) {

      if (ba.lboundIsAllOnes()) {

        for (std::int64_t extent :

flang/lib/Optimizer/Builder/Character.cpp

+36 −9
Original line number Diff line number Diff line
@@ -400,10 +400,19 @@ void fir::factory::CharacterExprHelper::createLengthOneAssign( 
  auto addr = lhs.getBuffer();

  auto toTy = fir::unwrapRefType(addr.getType());

  mlir::Value val = rhs.getBuffer();

  if (fir::isa_ref_type(val.getType()))

    val = builder.create<fir::LoadOp>(loc, val);

  val = builder.createConvert(loc, toTy, val);

  builder.create<fir::StoreOp>(loc, val, addr);

  if (fir::isa_ref_type(val.getType())) {

    auto fromCharLen1RefTy = builder.getRefType(getSingletonCharType(

        builder.getContext(),

        getCharacterKind(fir::unwrapRefType(val.getType()))));

    val = builder.create<fir::LoadOp>(

        loc, builder.createConvert(loc, fromCharLen1RefTy, val));

  }

  auto toCharLen1Ty =

      getSingletonCharType(builder.getContext(), getCharacterKind(toTy));

  val = builder.createConvert(loc, toCharLen1Ty, val);

  builder.create<fir::StoreOp>(

      loc, val,

      builder.createConvert(loc, builder.getRefType(toCharLen1Ty), addr));

}



/// Returns the minimum of integer mlir::Value \p a and \b.
@@ -418,11 +427,29 @@ void fir::factory::CharacterExprHelper::createAssign( 
    const fir::CharBoxValue &lhs, const fir::CharBoxValue &rhs) {

  auto rhsCstLen = getCompileTimeLength(rhs);

  auto lhsCstLen = getCompileTimeLength(lhs);

  bool compileTimeSameLength =

      (lhsCstLen && rhsCstLen && *lhsCstLen == *rhsCstLen) ||

      (rhs.getLen() == lhs.getLen());



  if (compileTimeSameLength && lhsCstLen && *lhsCstLen == 1) {

  bool compileTimeSameLength = false;

  bool isLengthOneAssign = false;



  if (lhsCstLen && rhsCstLen && *lhsCstLen == *rhsCstLen) {

    compileTimeSameLength = true;

    if (*lhsCstLen == 1)

      isLengthOneAssign = true;

  } else if (rhs.getLen() == lhs.getLen()) {

    compileTimeSameLength = true;



    // If the length values are the same for LHS and RHS,

    // then we can rely on the constant length deduced from

    // any of the two types.

    if (lhsCstLen && *lhsCstLen == 1)

      isLengthOneAssign = true;

    if (rhsCstLen && *rhsCstLen == 1)

      isLengthOneAssign = true;



    // We could have recognized constant operations here (e.g.

    // two different arith.constant ops may produce the same value),

    // but for now leave it to CSE to get rid of the duplicates.

  }

  if (isLengthOneAssign) {

    createLengthOneAssign(lhs, rhs);

    return;

  }

flang/test/HLFIR/char_assign.fir

0 → 100644
+44 −0
Original line number Diff line number Diff line 
// RUN: fir-opt --split-input-file %s -convert-hlfir-to-fir | FileCheck %s



// Verify that the special case of length-one character assignment

// is using valid fir.converts.



// -----



// CHECK-LABEL: func.func @_QPtest1

// CHECK: [[C_DECL:%[0-9]*]] = fir.declare{{.*}}{uniq_name = "_QFtest1Ec"} : (!fir.ref<!fir.char<1,?>>, index) -> !fir.ref<!fir.char<1,?>>

// CHECK: [[LOCAL_DECL:%[0-9]*]] = fir.declare{{.*}}{uniq_name = "_QFtest1Elocal"} : (!fir.ref<!fir.char<1>>, index) -> !fir.ref<!fir.char<1>>

// CHECK: [[CVT:%[0-9]*]] = fir.convert [[C_DECL]] : (!fir.ref<!fir.char<1,?>>) -> !fir.ref<!fir.char<1>>

// CHECK: [[LD:%[0-9]*]] = fir.load [[CVT]] : !fir.ref<!fir.char<1>>

// CHECK: fir.store [[LD]] to [[LOCAL_DECL]] : !fir.ref<!fir.char<1>>

module {

  func.func @_QPtest1(%arg0: !fir.boxchar<1> {fir.bindc_name = "c"}) {

    %c1 = arith.constant 1 : index

    %0:2 = fir.unboxchar %arg0 : (!fir.boxchar<1>) -> (!fir.ref<!fir.char<1,?>>, index)

    %1:2 = hlfir.declare %0#0 typeparams %c1 {uniq_name = "_QFtest1Ec"} : (!fir.ref<!fir.char<1,?>>, index) -> (!fir.boxchar<1>, !fir.ref<!fir.char<1,?>>)

    %2 = fir.alloca !fir.char<1> {bindc_name = "local", uniq_name = "_QFtest1Elocal"}

    %3:2 = hlfir.declare %2 typeparams %c1 {uniq_name = "_QFtest1Elocal"} : (!fir.ref<!fir.char<1>>, index) -> (!fir.ref<!fir.char<1>>, !fir.ref<!fir.char<1>>)

    hlfir.assign %1#0 to %3#0 : !fir.boxchar<1>, !fir.ref<!fir.char<1>>

    return

  }

}



// -----



// CHECK-LABEL: func.func @_QPtest2

// CHECK: [[C_DECL:%[0-9]*]] = fir.declare{{.*}}{uniq_name = "_QFtest2Ec"} : (!fir.ref<!fir.char<1,?>>, index) -> !fir.ref<!fir.char<1,?>>

// CHECK: [[LOCAL_DECL:%[0-9]*]] = fir.declare{{.*}}{uniq_name = "_QFtest2Elocal"} : (!fir.ref<!fir.char<1>>, index) -> !fir.ref<!fir.char<1>>

// CHECK: [[LD:%[0-9]*]] = fir.load [[LOCAL_DECL]] : !fir.ref<!fir.char<1>>

// CHECK: [[CVT:%[0-9]*]] = fir.convert [[C_DECL]] : (!fir.ref<!fir.char<1,?>>) -> !fir.ref<!fir.char<1>>

// CHECK: fir.store [[LD]] to [[CVT]] : !fir.ref<!fir.char<1>>

module {

  func.func @_QPtest2(%arg0: !fir.boxchar<1> {fir.bindc_name = "c"}) {

    %c1 = arith.constant 1 : index

    %0:2 = fir.unboxchar %arg0 : (!fir.boxchar<1>) -> (!fir.ref<!fir.char<1,?>>, index)

    %1:2 = hlfir.declare %0#0 typeparams %c1 {uniq_name = "_QFtest2Ec"} : (!fir.ref<!fir.char<1,?>>, index) -> (!fir.boxchar<1>, !fir.ref<!fir.char<1,?>>)

    %2 = fir.alloca !fir.char<1> {bindc_name = "local", uniq_name = "_QFtest2Elocal"}

    %3:2 = hlfir.declare %2 typeparams %c1 {uniq_name = "_QFtest2Elocal"} : (!fir.ref<!fir.char<1>>, index) -> (!fir.ref<!fir.char<1>>, !fir.ref<!fir.char<1>>)

    hlfir.assign %3#0 to %1#0 : !fir.ref<!fir.char<1>>, !fir.boxchar<1>

    return

  }

}

flang/test/Lower/HLFIR/calls-character-singleton-result.f90

+6 −4
Original line number Diff line number Diff line
@@ -11,7 +11,8 @@ subroutine scalar_char(c, i) 
end subroutine

! CHECK-LABEL: func.func @_QPscalar_char(

! CHECK:  %[[VAL_2:.*]] = fir.alloca !fir.char<1>

! CHECK:  %[[VAL_5:.*]]:2 = hlfir.declare %{{.*}}#0 typeparams %{{.*}}  {{.*}}Ec

! CHECK:  %[[VAL_4:.*]] = fir.convert %{{.*}}#0 : (!fir.ref<!fir.char<1,?>>) -> !fir.ref<!fir.char<1>>

! CHECK:  %[[VAL_5:.*]]:2 = hlfir.declare %[[VAL_4]] typeparams %{{.*}}  {{.*}}Ec

! CHECK:  %[[VAL_6:.*]]:2 = hlfir.declare %{{.*}}  {{.*}}Ei

! CHECK:  %[[VAL_7:.*]] = fir.load %[[VAL_6]]#1 : !fir.ref<i64>

! CHECK:  %[[VAL_8:.*]] = fir.convert %[[VAL_7]] : (i64) -> i8
@@ -20,7 +21,7 @@ end subroutine 
! CHECK:  fir.store %[[VAL_10]] to %[[VAL_2]] : !fir.ref<!fir.char<1>>

! CHECK:  %[[VAL_11:.*]] = arith.constant false

! CHECK:  %[[VAL_12:.*]] = hlfir.as_expr %[[VAL_2]] move %[[VAL_11]] : (!fir.ref<!fir.char<1>>, i1) -> !hlfir.expr<!fir.char<1>>

! CHECK:  hlfir.assign %[[VAL_12]] to %[[VAL_5]]#0 : !hlfir.expr<!fir.char<1>>, !fir.boxchar<1>

! CHECK:  hlfir.assign %[[VAL_12]] to %[[VAL_5]]#0 : !hlfir.expr<!fir.char<1>>, !fir.ref<!fir.char<1>>



subroutine scalar_bindc(c)

  character(1) :: c
@@ -32,12 +33,13 @@ subroutine scalar_bindc(c) 
end subroutine

! CHECK-LABEL: func.func @_QPscalar_bindc(

! CHECK:  %[[VAL_1:.*]] = fir.alloca !fir.char<1>

! CHECK:  %[[VAL_4:.*]]:2 = hlfir.declare %{{.*}}#0 typeparams %{{.*}}  {{.*}}Ec

! CHECK:  %[[VAL_3:.*]] = fir.convert %{{.*}}#0 : (!fir.ref<!fir.char<1,?>>) -> !fir.ref<!fir.char<1>>

! CHECK:  %[[VAL_4:.*]]:2 = hlfir.declare %[[VAL_3]] typeparams %{{.*}}  {{.*}}Ec

! CHECK:  %[[VAL_5:.*]] = fir.call @bar() fastmath<contract> : () -> !fir.char<1>

! CHECK:  fir.store %[[VAL_5]] to %[[VAL_1]] : !fir.ref<!fir.char<1>>

! CHECK:  %[[VAL_6:.*]] = arith.constant false

! CHECK:  %[[VAL_7:.*]] = hlfir.as_expr %[[VAL_1]] move %[[VAL_6]] : (!fir.ref<!fir.char<1>>, i1) -> !hlfir.expr<!fir.char<1>>

! CHECK:  hlfir.assign %[[VAL_7]] to %[[VAL_4]]#0 : !hlfir.expr<!fir.char<1>>, !fir.boxchar<1>

! CHECK:  hlfir.assign %[[VAL_7]] to %[[VAL_4]]#0 : !hlfir.expr<!fir.char<1>>, !fir.ref<!fir.char<1>>



subroutine array_char(c, i)

  character(1) :: c(100)

flang/test/Lower/HLFIR/convert-variable.f90

+2 −1
Original line number Diff line number Diff line
@@ -23,7 +23,8 @@ end subroutine 
! CHECK-SAME:    %[[VAL_0:.*]]: !fir.boxchar<1>

! CHECK:  %[[VAL_1:.*]]:2 = fir.unboxchar %[[VAL_0]] : (!fir.boxchar<1>) -> (!fir.ref<!fir.char<1,?>>, index)

! CHECK:  %[[VAL_2:.*]] = arith.constant 10 : index

! CHECK:  %[[VAL_3:.*]] = hlfir.declare %[[VAL_1]]#0 typeparams %[[VAL_2]] {uniq_name = "_QFscalar_character_cst_lenEc"} : (!fir.ref<!fir.char<1,?>>, index) -> (!fir.boxchar<1>, !fir.ref<!fir.char<1,?>>)

! CHECK:  %[[VAL_3:.*]] = fir.convert %[[VAL_1]]#0 : (!fir.ref<!fir.char<1,?>>) -> !fir.ref<!fir.char<1,10>>

! CHECK:  %[[VAL_4:.*]] = hlfir.declare %[[VAL_3]] typeparams %[[VAL_2]] {uniq_name = "_QFscalar_character_cst_lenEc"} : (!fir.ref<!fir.char<1,10>>, index) -> (!fir.ref<!fir.char<1,10>>, !fir.ref<!fir.char<1,10>>)



subroutine array_numeric(x)

  integer :: x(10, 20)