Index: flang/lib/Lower/Bridge.cpp =================================================================== --- flang/lib/Lower/Bridge.cpp +++ flang/lib/Lower/Bridge.cpp @@ -1840,6 +1840,34 @@ : implicitIterSpace.stmtContext()); } + /// Generate a substring assignment. + /// This is an assignment expression with memory conflict in a FORALL context. + void genForallSubstringAssignment(const Fortran::evaluate::Assignment &assign, + Fortran::lower::StatementContext &stmtCtx) { + assert(explicitIterationSpace() && "not in a Forall body construct"); + TODO(toLocation(), "assignment to substring in forall body"); + } + + /// Check if there is memory conflict in the assignment statement. Return true + /// if the symbol in variable \p var is referenced in the experssion \p expr. + template + bool assignmentHasMemConflict(const A &var, const A &expr) { + for (const auto &sym : Fortran::evaluate::CollectSymbols(expr)) { + const Fortran::semantics::Symbol *varSym{ + Fortran::evaluate::GetLastSymbol(var)}; + if (&varSym->GetUltimate() == &sym.get().GetUltimate()) + return true; + if (const Fortran::semantics::EquivalenceSet * + set{Fortran::semantics::FindEquivalenceSet(*varSym)}) { + for (const Fortran::semantics::EquivalenceObject &object : *set) { + if (&object.symbol.GetUltimate() == &sym.get().GetUltimate()) + return true; + } + } + } + return false; + } + static bool isArraySectionWithoutVectorSubscript(const Fortran::lower::SomeExpr &expr) { return expr.Rank() > 0 && Fortran::evaluate::IsVariable(expr) && @@ -1893,10 +1921,16 @@ // the pointer variable. if (assign.lhs.Rank() > 0 || explicitIterationSpace()) { - // Array assignment - // See Fortran 2018 10.2.1.3 p5, p6, and p7 - genArrayAssignment(assign, stmtCtx); - return; + if (assign.lhs.Rank() == 0 && + isCharacterCategory(lhsType->category())) { + if (assignmentHasMemConflict(assign.lhs, assign.rhs)) + genForallSubstringAssignment(assign, stmtCtx); + } else { + // Array assignment + // See Fortran 2018 10.2.1.3 p5, p6, and p7 + genArrayAssignment(assign, stmtCtx); + return; + } } // Scalar assignment Index: flang/test/Lower/forall/forall-character.f90 =================================================================== --- /dev/null +++ flang/test/Lower/forall/forall-character.f90 @@ -0,0 +1,152 @@ +! Test forall lowering + +! RUN: bbc -emit-fir %s -o - | FileCheck %s + +! CHECK-LABEL: func @_QPtest_forall_with_string_assignment() { +! CHECK: %[[VAL_0:.*]] = fir.alloca i32 {adapt.valuebyref, bindc_name = "i"} +! CHECK: %[[VAL_1:.*]] = fir.address_of(@_QFtest_forall_with_string_assignmentEx) : !fir.ref> +! CHECK: %[[VAL_c6:.*]] = arith.constant 6 : index +! CHECK: %[[VAL_2:.*]] = fir.alloca !fir.char<1,6> {bindc_name = "y", uniq_name = "_QFtest_forall_with_string_assignmentEy"} +! CHECK: %[[VAL_c1_i32:.*]] = arith.constant 1 : i32 +! CHECK: %[[VAL_3:.*]] = fir.convert %[[VAL_c1_i32]] : (i32) -> index +! CHECK: %[[VAL_c4_i32:.*]] = arith.constant 4 : i32 +! CHECK: %[[VAL_4:.*]] = fir.convert %[[VAL_c4_i32]] : (i32) -> index +! CHECK: %[[VAL_c1:.*]] = arith.constant 1 : index +! CHECK: fir.do_loop %[[VAL_arg0:.*]] = %[[VAL_3]] to %[[VAL_4]] step %[[VAL_c1]] unordered { +! CHECK: %[[VAL_5:.*]] = fir.convert %[[VAL_arg0]] : (index) -> i32 +! CHECK: fir.store %[[VAL_5]] to %[[VAL_0]] : !fir.ref +! CHECK: %[[VAL_6:.*]] = fir.load %[[VAL_0]] : !fir.ref +! CHECK: %[[VAL_c1_i32_0:.*]] = arith.constant 1 : i32 +! CHECK: %[[VAL_7:.*]] = arith.addi %[[VAL_6]], %[[VAL_c1_i32_0]] : i32 +! CHECK: %[[VAL_8:.*]] = fir.convert %[[VAL_7]] : (i32) -> i64 +! CHECK: %[[VAL_9:.*]] = fir.load %[[VAL_0]] : !fir.ref +! CHECK: %[[VAL_c1_i32_1:.*]] = arith.constant 1 : i32 +! CHECK: %[[VAL_10:.*]] = arith.addi %[[VAL_9]], %[[VAL_c1_i32_1]] : i32 +! CHECK: %[[VAL_11:.*]] = fir.convert %[[VAL_10]] : (i32) -> i64 +! CHECK: %[[VAL_12:.*]] = fir.convert %[[VAL_8]] : (i64) -> index +! CHECK: %[[VAL_13:.*]] = fir.convert %[[VAL_11]] : (i64) -> index +! CHECK: %[[VAL_c1_2:.*]] = arith.constant 1 : index +! CHECK: %[[VAL_14:.*]] = arith.subi %[[VAL_12]], %[[VAL_c1_2]] : index +! CHECK: %[[VAL_15:.*]] = fir.convert %[[VAL_1]] : (!fir.ref>) -> !fir.ref>> +! CHECK: %[[VAL_16:.*]] = fir.coordinate_of %[[VAL_15]], %[[VAL_14]] : (!fir.ref>>, index) -> !fir.ref> +! CHECK: %[[VAL_17:.*]] = fir.convert %[[VAL_16]] : (!fir.ref>) -> !fir.ref> +! CHECK: %[[VAL_18:.*]] = arith.subi %[[VAL_13]], %[[VAL_12]] : index +! CHECK: %[[VAL_19:.*]] = arith.addi %[[VAL_18]], %[[VAL_c1_2]] : index +! CHECK: %[[VAL_c0:.*]] = arith.constant 0 : index +! CHECK: %[[VAL_20:.*]] = arith.cmpi slt, %[[VAL_19]], %[[VAL_c0]] : index +! CHECK: %[[VAL_21:.*]] = arith.select %[[VAL_20]], %[[VAL_c0]], %[[VAL_19]] : index +! CHECK: %[[VAL_22:.*]] = arith.cmpi slt, %[[VAL_c6]], %[[VAL_21]] : index +! CHECK: %[[VAL_23:.*]] = arith.select %[[VAL_22]], %[[VAL_c6]], %[[VAL_21]] : index +! CHECK: %[[VAL_c1_i64:.*]] = arith.constant 1 : i64 +! CHECK: %[[VAL_24:.*]] = fir.convert %[[VAL_23]] : (index) -> i64 +! CHECK: %[[VAL_25:.*]] = arith.muli %[[VAL_c1_i64]], %[[VAL_24]] : i64 +! CHECK: %[[VAL_false:.*]] = arith.constant false +! CHECK: %[[VAL_26:.*]] = fir.convert %[[VAL_2]] : (!fir.ref>) -> !fir.ref +! CHECK: %[[VAL_27:.*]] = fir.convert %[[VAL_17]] : (!fir.ref>) -> !fir.ref +! CHECK: fir.call @llvm.memmove.p0i8.p0i8.i64(%[[VAL_26]], %[[VAL_27]], %[[VAL_25]], %[[VAL_false]]) : (!fir.ref, !fir.ref, i64, i1) -> () +! CHECK: %[[VAL_c1_3:.*]] = arith.constant 1 : index +! CHECK: %[[VAL_28:.*]] = arith.subi %[[VAL_c6]], %[[VAL_c1_3]] : index +! CHECK: %[[VAL_c32_i8:.*]] = arith.constant 32 : i8 +! CHECK: %[[VAL_29:.*]] = fir.undefined !fir.char<1> +! CHECK: %[[VAL_30:.*]] = fir.insert_value %[[VAL_29]], %[[VAL_c32_i8]], [0 : index] : (!fir.char<1>, i8) -> !fir.char<1> +! CHECK: %[[VAL_c1_4:.*]] = arith.constant 1 : index +! CHECK: fir.do_loop %[[VAL_arg1:.*]] = %[[VAL_23]] to %[[VAL_28]] step %[[VAL_c1_4]] { +! CHECK: %[[VAL_31:.*]] = fir.convert %[[VAL_2]] : (!fir.ref>) -> !fir.ref>> +! CHECK: %[[VAL_32:.*]] = fir.coordinate_of %[[VAL_31]], %[[VAL_arg1]] : (!fir.ref>>, index) -> !fir.ref> +! CHECK: fir.store %[[VAL_30]] to %[[VAL_32]] : !fir.ref> +! CHECK: } +! CHECK: } +! CHECK: return +! CHECK: } + +subroutine test_forall_with_string_assignment() + character(6) :: y, x = '123456' + + forall (i=1:4) + y = x(i+1:i+1) + end forall +end subroutine test_forall_with_string_assignment + +! CHECK-LABEL: func @_QPtest_forall_with_substring_assignment() { +! CHECK: %[[VAL_0:.*]] = fir.alloca i32 {adapt.valuebyref, bindc_name = "i"} +! CHECK: %[[VAL_1:.*]] = fir.address_of(@_QFtest_forall_with_substring_assignmentEx) : !fir.ref> +! CHECK: %[[VAL_2:.*]] = fir.address_of(@_QFtest_forall_with_substring_assignmentEy) : !fir.ref> +! CHECK: %[[VAL_c1_i32:.*]] = arith.constant 1 : i32 +! CHECK: %[[VAL_3:.*]] = fir.convert %[[VAL_c1_i32]] : (i32) -> index +! CHECK: %[[VAL_c4_i32:.*]] = arith.constant 4 : i32 +! CHECK: %[[VAL_4:.*]] = fir.convert %[[VAL_c4_i32]] : (i32) -> index +! CHECK: %[[VAL_c1:.*]] = arith.constant 1 : index +! CHECK: fir.do_loop %[[VAL_arg0:.*]] = %[[VAL_3]] to %[[VAL_4]] step %[[VAL_c1]] unordered { +! CHECK: %[[VAL_5:.*]] = fir.convert %[[VAL_arg0]] : (index) -> i32 +! CHECK: fir.store %[[VAL_5]] to %[[VAL_0]] : !fir.ref +! CHECK: %[[VAL_6:.*]] = fir.load %[[VAL_0]] : !fir.ref +! CHECK: %[[VAL_c1_i32_0:.*]] = arith.constant 1 : i32 +! CHECK: %[[VAL_7:.*]] = arith.addi %[[VAL_6]], %[[VAL_c1_i32_0]] : i32 +! CHECK: %[[VAL_8:.*]] = fir.convert %[[VAL_7]] : (i32) -> i64 +! CHECK: %[[VAL_9:.*]] = fir.load %[[VAL_0]] : !fir.ref +! CHECK: %[[VAL_c1_i32_1:.*]] = arith.constant 1 : i32 +! CHECK: %[[VAL_10:.*]] = arith.addi %[[VAL_9]], %[[VAL_c1_i32_1]] : i32 +! CHECK: %[[VAL_11:.*]] = fir.convert %[[VAL_10]] : (i32) -> i64 +! CHECK: %[[VAL_12:.*]] = fir.convert %[[VAL_8]] : (i64) -> index +! CHECK: %[[VAL_13:.*]] = fir.convert %[[VAL_11]] : (i64) -> index +! CHECK: %[[VAL_c1_2:.*]] = arith.constant 1 : index +! CHECK: %[[VAL_14:.*]] = arith.subi %[[VAL_12]], %[[VAL_c1_2]] : index +! CHECK: %[[VAL_15:.*]] = fir.convert %[[VAL_1]] : (!fir.ref>) -> !fir.ref>> +! CHECK: %[[VAL_16:.*]] = fir.coordinate_of %[[VAL_15]], %[[VAL_14]] : (!fir.ref>>, index) -> !fir.ref> +! CHECK: %[[VAL_17:.*]] = fir.convert %[[VAL_16]] : (!fir.ref>) -> !fir.ref> +! CHECK: %[[VAL_18:.*]] = arith.subi %[[VAL_13]], %[[VAL_12]] : index +! CHECK: %[[VAL_19:.*]] = arith.addi %[[VAL_18]], %[[VAL_c1_2]] : index +! CHECK: %[[VAL_c0:.*]] = arith.constant 0 : index +! CHECK: %[[VAL_20:.*]] = arith.cmpi slt, %[[VAL_19]], %[[VAL_c0]] : index +! CHECK: %[[VAL_21:.*]] = arith.select %[[VAL_20]], %[[VAL_c0]], %[[VAL_19]] : index +! CHECK: %[[VAL_22:.*]] = fir.load %[[VAL_0]] : !fir.ref +! CHECK: %[[VAL_c2_i32:.*]] = arith.constant 2 : i32 +! CHECK: %[[VAL_23:.*]] = arith.addi %[[VAL_22]], %[[VAL_c2_i32]] : i32 +! CHECK: %[[VAL_24:.*]] = fir.convert %[[VAL_23]] : (i32) -> i64 +! CHECK: %[[VAL_25:.*]] = fir.load %[[VAL_0]] : !fir.ref +! CHECK: %[[VAL_c2_i32_3:.*]] = arith.constant 2 : i32 +! CHECK: %[[VAL_26:.*]] = arith.addi %[[VAL_25]], %[[VAL_c2_i32_3]] : i32 +! CHECK: %[[VAL_27:.*]] = fir.convert %[[VAL_26]] : (i32) -> i64 +! CHECK: %[[VAL_28:.*]] = fir.convert %[[VAL_24]] : (i64) -> index +! CHECK: %[[VAL_29:.*]] = fir.convert %[[VAL_27]] : (i64) -> index +! CHECK: %[[VAL_c1_4:.*]] = arith.constant 1 : index +! CHECK: %[[VAL_30:.*]] = arith.subi %[[VAL_28]], %[[VAL_c1_4]] : index +! CHECK: %[[VAL_31:.*]] = fir.convert %[[VAL_2]] : (!fir.ref>) -> !fir.ref>> +! CHECK: %[[VAL_32:.*]] = fir.coordinate_of %[[VAL_31]], %[[VAL_30]] : (!fir.ref>>, index) -> !fir.ref> +! CHECK: %[[VAL_33:.*]] = fir.convert %[[VAL_32]] : (!fir.ref>) -> !fir.ref> +! CHECK: %[[VAL_34:.*]] = arith.subi %[[VAL_29]], %[[VAL_28]] : index +! CHECK: %[[VAL_35:.*]] = arith.addi %[[VAL_34]], %[[VAL_c1_4]] : index +! CHECK: %[[VAL_c0_5:.*]] = arith.constant 0 : index +! CHECK: %[[VAL_36:.*]] = arith.cmpi slt, %[[VAL_35]], %[[VAL_c0_5]] : index +! CHECK: %[[VAL_37:.*]] = arith.select %[[VAL_36]], %[[VAL_c0_5]], %[[VAL_35]] : index +! CHECK: %[[VAL_38:.*]] = arith.cmpi slt, %[[VAL_37]], %[[VAL_21]] : index +! CHECK: %[[VAL_39:.*]] = arith.select %[[VAL_38]], %[[VAL_37]], %[[VAL_21]] : index +! CHECK: %[[VAL_c1_i64:.*]] = arith.constant 1 : i64 +! CHECK: %[[VAL_40:.*]] = fir.convert %[[VAL_39]] : (index) -> i64 +! CHECK: %[[VAL_41:.*]] = arith.muli %[[VAL_c1_i64]], %[[VAL_40]] : i64 +! CHECK: %[[VAL_false:.*]] = arith.constant false +! CHECK: %[[VAL_42:.*]] = fir.convert %[[VAL_33]] : (!fir.ref>) -> !fir.ref +! CHECK: %[[VAL_43:.*]] = fir.convert %[[VAL_17]] : (!fir.ref>) -> !fir.ref +! CHECK: fir.call @llvm.memmove.p0i8.p0i8.i64(%[[VAL_42]], %[[VAL_43]], %[[VAL_41]], %[[VAL_false]]) : (!fir.ref, !fir.ref, i64, i1) -> () +! CHECK: %[[VAL_c1_6:.*]] = arith.constant 1 : index +! CHECK: %[[VAL_44:.*]] = arith.subi %[[VAL_37]], %[[VAL_c1_6]] : index +! CHECK: %[[VAL_c32_i8:.*]] = arith.constant 32 : i8 +! CHECK: %[[VAL_45:.*]] = fir.undefined !fir.char<1> +! CHECK: %[[VAL_46:.*]] = fir.insert_value %[[VAL_45]], %[[VAL_c32_i8]], [0 : index] : (!fir.char<1>, i8) -> !fir.char<1> +! CHECK: %[[VAL_c1_7:.*]] = arith.constant 1 : index +! CHECK: fir.do_loop %[[VAL_arg1:.*]] = %[[VAL_39]] to %[[VAL_44]] step %[[VAL_c1_7]] { +! CHECK: %[[VAL_47:.*]] = fir.convert %[[VAL_33]] : (!fir.ref>) -> !fir.ref>> +! CHECK: %[[VAL_48:.*]] = fir.coordinate_of %[[VAL_47]], %[[VAL_arg1]] : (!fir.ref>>, index) -> !fir.ref> +! CHECK: fir.store %[[VAL_46]] to %[[VAL_48]] : !fir.ref> +! CHECK: } +! CHECK: } +! CHECK: return +! CHECK: } + +subroutine test_forall_with_substring_assignment() + character(6) :: y = '000000', x = '123456' + + forall (i=1:4) + y(i+2:i+2) = x(i+1:i+1) + end forall +end subroutine test_forall_with_substring_assignment