diff --git a/flang/include/flang/Lower/BoxAnalyzer.h b/flang/include/flang/Lower/BoxAnalyzer.h --- a/flang/include/flang/Lower/BoxAnalyzer.h +++ b/flang/include/flang/Lower/BoxAnalyzer.h @@ -236,6 +236,10 @@ return det && det->IsArray() && det->shape().IsExplicitShape(); } +inline bool isAssumedSize(const Fortran::semantics::Symbol &sym) { + return Fortran::semantics::IsAssumedSizeArray(sym.GetUltimate()); +} + //===----------------------------------------------------------------------===// // Perform analysis to determine a box's parameter values //===----------------------------------------------------------------------===// @@ -378,7 +382,7 @@ /// Run the analysis on `sym`. void analyze(const Fortran::semantics::Symbol &sym) { if (symIsArray(sym)) { - bool isConstant = true; + bool isConstant = !isAssumedSize(sym); llvm::SmallVector lbounds; llvm::SmallVector shapes; llvm::SmallVector bounds; @@ -396,6 +400,8 @@ continue; } } else if (subs.ubound().isStar()) { + assert(Fortran::semantics::IsNamedConstant(sym) && + "expect implied shape constant"); shapes.push_back(fir::SequenceType::getUnknownExtent()); continue; } diff --git a/flang/include/flang/Lower/PFTBuilder.h b/flang/include/flang/Lower/PFTBuilder.h --- a/flang/include/flang/Lower/PFTBuilder.h +++ b/flang/include/flang/Lower/PFTBuilder.h @@ -668,8 +668,6 @@ entryPointList{std::pair{nullptr, nullptr}}; /// Current index into entryPointList. Index 0 is the primary entry point. int activeEntry = 0; - /// Dummy arguments that are not universal across entry points. - llvm::SmallVector nonUniversalDummyArguments; /// Primary result for function subprograms with alternate entries. This /// is one of the largest result values, not necessarily the first one. const semantics::Symbol *primaryResult{nullptr}; diff --git a/flang/lib/Lower/Bridge.cpp b/flang/lib/Lower/Bridge.cpp --- a/flang/lib/Lower/Bridge.cpp +++ b/flang/lib/Lower/Bridge.cpp @@ -2392,19 +2392,6 @@ for (const Fortran::lower::CalleeInterface::PassedEntity &arg : callee.getPassedArguments()) mapPassedEntity(arg); - - // Allocate local skeleton instances of dummies from other entry points. - // Most of these locals will not survive into final generated code, but - // some will. It is illegal to reference them at run time if they do. - for (const Fortran::semantics::Symbol *arg : - funit.nonUniversalDummyArguments) { - if (lookupSymbol(*arg)) - continue; - mlir::Type type = genType(*arg); - // TODO: Account for VALUE arguments (and possibly other variants). - type = builder->getRefType(type); - addSymbol(*arg, builder->create(toLocation(), type)); - } if (std::optional passedResult = callee.getPassedResult()) { mapPassedEntity(*passedResult); @@ -2491,15 +2478,10 @@ } } - // If this is a host procedure with host associations, then create the tuple - // of pointers for passing to the internal procedures. - if (!funit.getHostAssoc().empty()) - funit.getHostAssoc().hostProcedureBindings(*this, localSymbols); - - /// TODO: should use same mechanism as equivalence? - /// One blocking point is character entry returns that need special handling - /// since they are not locally allocated but come as argument. CHARACTER(*) - /// is not something that fit wells with equivalence lowering. + // TODO: should use same mechanism as equivalence? + // One blocking point is character entry returns that need special handling + // since they are not locally allocated but come as argument. CHARACTER(*) + // is not something that fits well with equivalence lowering. for (const Fortran::lower::pft::Variable &altResult : deferredFuncResultList) { if (std::optional @@ -2510,6 +2492,11 @@ stmtCtx, primaryFuncResultStorage); } + // If this is a host procedure with host associations, then create the tuple + // of pointers for passing to the internal procedures. + if (!funit.getHostAssoc().empty()) + funit.getHostAssoc().hostProcedureBindings(*this, localSymbols); + // Create most function blocks in advance. createEmptyBlocks(funit.evaluationList); diff --git a/flang/lib/Lower/ConvertType.cpp b/flang/lib/Lower/ConvertType.cpp --- a/flang/lib/Lower/ConvertType.cpp +++ b/flang/lib/Lower/ConvertType.cpp @@ -225,6 +225,8 @@ // links, the fir type is built based on the ultimate symbol. This relies // on the fact volatile and asynchronous are not reflected in fir types. const Fortran::semantics::Symbol &ultimate = symbol.GetUltimate(); + if (Fortran::semantics::IsProcedurePointer(ultimate)) + TODO(loc, "procedure pointers"); if (const Fortran::semantics::DeclTypeSpec *type = ultimate.GetType()) { if (const Fortran::semantics::IntrinsicTypeSpec *tySpec = type->AsIntrinsic()) { diff --git a/flang/lib/Lower/ConvertVariable.cpp b/flang/lib/Lower/ConvertVariable.cpp --- a/flang/lib/Lower/ConvertVariable.cpp +++ b/flang/lib/Lower/ConvertVariable.cpp @@ -122,7 +122,7 @@ // symbol is an object of a function pointer. const Fortran::semantics::Symbol &ultimate = sym.GetUltimate(); if (!ultimate.has() && - !ultimate.has()) + !Fortran::semantics::IsProcedurePointer(ultimate)) mlir::emitError(loc, "lowering global declaration: symbol '") << toStringRef(sym.name()) << "' has unexpected details\n"; return builder.createGlobal(loc, converter.genType(var), globalName, linkage, @@ -378,6 +378,10 @@ if (global && globalIsInitialized(global)) return global; + + if (Fortran::semantics::IsProcedurePointer(sym)) + TODO(loc, "procedure pointer globals"); + // If this is an array, check to see if we can use a dense attribute // with a tensor mlir type. This optimization currently only supports // rank-1 Fortran arrays of integer, real, or logical. The tensor @@ -1187,11 +1191,10 @@ } /// Lower specification expressions and attributes of variable \p var and -/// add it to the symbol map. -/// For global and aliases, the address must be pre-computed and provided -/// in \p preAlloc. -/// Dummy arguments must have already been mapped to mlir block arguments -/// their mapping may be updated here. +/// add it to the symbol map. For a global or an alias, the address must be +/// pre-computed and provided in \p preAlloc. A dummy argument for the current +/// entry point has already been mapped to an mlir block argument in +/// mapDummiesAndResults. Its mapping may be updated here. void Fortran::lower::mapSymbolAttributes( AbstractConverter &converter, const Fortran::lower::pft::Variable &var, Fortran::lower::SymMap &symMap, Fortran::lower::StatementContext &stmtCtx, @@ -1200,14 +1203,32 @@ const Fortran::semantics::Symbol &sym = var.getSymbol(); const mlir::Location loc = converter.genLocation(sym.name()); mlir::IndexType idxTy = builder.getIndexType(); - const bool isDummy = Fortran::semantics::IsDummy(sym); + const bool isDeclaredDummy = Fortran::semantics::IsDummy(sym); + // An active dummy from the current entry point. + const bool isDummy = isDeclaredDummy && symMap.lookupSymbol(sym).getAddr(); + // An unused dummy from another entry point. + const bool isUnusedEntryDummy = isDeclaredDummy && !isDummy; const bool isResult = Fortran::semantics::IsFunctionResult(sym); const bool replace = isDummy || isResult; fir::factory::CharacterExprHelper charHelp{builder, loc}; + + if (Fortran::semantics::IsProcedure(sym)) { + if (isUnusedEntryDummy) { + // Additional discussion below. + mlir::Type dummyProcType = + Fortran::lower::getDummyProcedureType(sym, converter); + mlir::Value undefOp = builder.create(loc, dummyProcType); + symMap.addSymbol(sym, undefOp); + } + if (Fortran::semantics::IsPointer(sym)) + TODO(loc, "procedure pointers"); + return; + } + Fortran::lower::BoxAnalyzer ba; ba.analyze(sym); - // First deal with pointers an allocatables, because their handling here + // First deal with pointers and allocatables, because their handling here // is the same regardless of their rank. if (Fortran::semantics::IsAllocatableOrPointer(sym)) { // Get address of fir.box describing the entity. @@ -1263,6 +1284,42 @@ } } + // A dummy from another entry point that is not declared in the current + // entry point requires a skeleton definition. Most such "unused" dummies + // will not survive into final generated code, but some will. It is illegal + // to reference one at run time if it does. Such a dummy is mapped to a + // value in one of three ways: + // + // - Generate a fir::UndefOp value. This is lightweight, easy to clean up, + // and often valid, but it may fail for a dummy with dynamic bounds, + // or a dummy used to define another dummy. Information to distinguish + // valid cases is not generally available here, with the exception of + // dummy procedures. See the first function exit above. + // + // - Allocate an uninitialized stack slot. This is an intermediate-weight + // solution that is harder to clean up. It is often valid, but may fail + // for an object with dynamic bounds. This option is "automatically" + // used by default for cases that do not use one of the other options. + // + // - Allocate a heap box/descriptor, initialized to zero. This always + // works, but is more heavyweight and harder to clean up. It is used + // for dynamic objects via calls to genUnusedEntryPointBox. + + auto genUnusedEntryPointBox = [&]() { + if (isUnusedEntryDummy) { + assert(!Fortran::semantics::IsAllocatableOrPointer(sym) && + "handled above"); + // The box is read right away because lowering code does not expect + // a non pointer/allocatable symbol to be mapped to a MutableBox. + symMap.addSymbol(sym, fir::factory::genMutableBoxRead( + builder, loc, + fir::factory::createTempMutableBox( + builder, loc, converter.genType(var)))); + return true; + } + return false; + }; + // Helper to generate scalars for the symbol properties. auto genValue = [&](const Fortran::lower::SomeExpr &expr) { return genScalarValue(converter, loc, expr, symMap, stmtCtx); @@ -1412,6 +1469,8 @@ //===--------------------------------------------------------------===// [&](const Fortran::lower::details::ScalarDynamicChar &x) { + if (genUnusedEntryPointBox()) + return; // type is a CHARACTER, determine the LEN value auto charLen = x.charLen(); if (replace) { @@ -1419,17 +1478,8 @@ mlir::Value boxAddr = symBox.getAddr(); mlir::Value len; mlir::Type addrTy = boxAddr.getType(); - if (addrTy.isa() || addrTy.isa()) { + if (addrTy.isa() || addrTy.isa()) std::tie(boxAddr, len) = charHelp.createUnboxChar(symBox.getAddr()); - } else { - // dummy from an other entry case: we cannot get a dynamic length - // for it, it's illegal for the user program to use it. However, - // since we are lowering all function unit statements regardless - // of whether the execution will reach them or not, we need to - // fill a value for the length here. - len = builder.createIntegerConstant( - loc, builder.getCharacterLengthType(), 1); - } // Override LEN with an expression if (charLen) len = genExplicitCharLen(charLen); @@ -1484,6 +1534,8 @@ //===--------------------------------------------------------------===// [&](const Fortran::lower::details::DynamicArray &x) { + if (genUnusedEntryPointBox()) + return; // cast to the known constant parts from the declaration mlir::Type varType = converter.genType(var); mlir::Value addr = symMap.lookupSymbol(sym).getAddr(); @@ -1587,6 +1639,8 @@ //===--------------------------------------------------------------===// [&](const Fortran::lower::details::StaticArrayDynamicChar &x) { + if (genUnusedEntryPointBox()) + return; mlir::Value addr; mlir::Value len; [[maybe_unused]] bool mustBeDummy = false; @@ -1656,6 +1710,8 @@ //===--------------------------------------------------------------===// [&](const Fortran::lower::details::DynamicArrayStaticChar &x) { + if (genUnusedEntryPointBox()) + return; mlir::Value addr; mlir::Value len; mlir::Value argBox; @@ -1714,6 +1770,8 @@ //===--------------------------------------------------------------===// [&](const Fortran::lower::details::DynamicArrayDynamicChar &x) { + if (genUnusedEntryPointBox()) + return; mlir::Value addr; mlir::Value len; mlir::Value argBox; diff --git a/flang/lib/Lower/PFTBuilder.cpp b/flang/lib/Lower/PFTBuilder.cpp --- a/flang/lib/Lower/PFTBuilder.cpp +++ b/flang/lib/Lower/PFTBuilder.cpp @@ -975,30 +975,28 @@ } } - /// For multiple entry subprograms, build a list of the dummy arguments that - /// appear in some, but not all entry points. For those that are functions, - /// also find one of the largest function results, since a single result - /// container holds the result for all entries. + /// Do processing specific to subprograms with multiple entry points. void processEntryPoints() { lower::pft::Evaluation *initialEval = &evaluationListStack.back()->front(); lower::pft::FunctionLikeUnit *unit = initialEval->getOwningProcedure(); int entryCount = unit->entryPointList.size(); if (entryCount == 1) return; - llvm::DenseMap dummyCountMap; + + // The first executable statement in the subprogram is preceded by a + // branch to the entry point, so it starts a new block. + if (initialEval->hasNestedEvaluations()) + initialEval = &initialEval->getFirstNestedEvaluation(); + else if (initialEval->isA()) + initialEval = initialEval->lexicalSuccessor; + initialEval->isNewBlock = true; + + // All function entry points share a single result container. + // Find one of the largest results. for (int entryIndex = 0; entryIndex < entryCount; ++entryIndex) { unit->setActiveEntry(entryIndex); const auto &details = unit->getSubprogramSymbol().get(); - for (semantics::Symbol *arg : details.dummyArgs()) { - if (!arg) - continue; // alternate return specifier (no actual argument) - const auto iter = dummyCountMap.find(arg); - if (iter == dummyCountMap.end()) - dummyCountMap.try_emplace(arg, 1); - else - ++iter->second; - } if (details.isFunction()) { const semantics::Symbol *resultSym = &details.result(); assert(resultSym && "missing result symbol"); @@ -1008,16 +1006,6 @@ } } unit->setActiveEntry(0); - for (auto arg : dummyCountMap) - if (arg.second < entryCount) - unit->nonUniversalDummyArguments.push_back(arg.first); - // The first executable statement in the subprogram is preceded by a - // branch to the entry point, so it starts a new block. - if (initialEval->hasNestedEvaluations()) - initialEval = &initialEval->getFirstNestedEvaluation(); - else if (initialEval->isA()) - initialEval = initialEval->lexicalSuccessor; - initialEval->isNewBlock = true; } std::unique_ptr pgm; @@ -1401,10 +1389,14 @@ LLVM_DEBUG(llvm::dbgs() << "analyze symbol: " << sym << '\n'); if (!done.second) return 0; - if (semantics::IsProcedure(sym)) { - // TODO: add declaration? + const bool isProcedurePointerOrDummy = + semantics::IsProcedurePointer(sym) || + (semantics::IsProcedure(sym) && IsDummy(sym)); + // A procedure argument in a subprogram with multiple entry points might + // need a vars list entry to trigger creation of a symbol map entry in + // some cases. Non-dummy procedures don't. + if (semantics::IsProcedure(sym) && !isProcedurePointerOrDummy) return 0; - } semantics::Symbol ultimate = sym.GetUltimate(); if (const auto *details = ultimate.detailsIf()) { @@ -1414,7 +1406,7 @@ return 0; } if (!ultimate.has() && - !ultimate.has()) + !isProcedurePointerOrDummy) return 0; if (sym.has()) @@ -1422,15 +1414,14 @@ // Symbol must be something lowering will have to allocate. int depth = 0; - const semantics::DeclTypeSpec *symTy = sym.GetType(); - assert(symTy && "symbol must have a type"); - // Analyze symbols appearing in object entity specification expression. This // ensures these symbols will be instantiated before the current one. // This is not done for object entities that are host associated because // they must be instantiated from the value of the host symbols (the // specification expressions should not be re-evaluated). if (const auto *details = sym.detailsIf()) { + const semantics::DeclTypeSpec *symTy = sym.GetType(); + assert(symTy && "symbol must have a type"); // check CHARACTER's length if (symTy->category() == semantics::DeclTypeSpec::Character) if (auto e = symTy->characterTypeSpec().length().GetExplicit()) @@ -1471,9 +1462,8 @@ // If there are alias sets, then link the participating variables to their // aggregate stores when constructing the new variable on the list. - if (lower::pft::Variable::AggregateStore *store = findStoreIfAlias(sym)) { + if (lower::pft::Variable::AggregateStore *store = findStoreIfAlias(sym)) vars[depth].back().setAlias(store->getOffset()); - } return depth; } diff --git a/flang/test/Lower/dummy-procedure-in-entry.f90 b/flang/test/Lower/dummy-procedure-in-entry.f90 new file mode 100644 --- /dev/null +++ b/flang/test/Lower/dummy-procedure-in-entry.f90 @@ -0,0 +1,90 @@ +! Test dummy procedures that are not an argument in every entry. +! This requires creating a mock value in the entries where it is +! not an argument. +! RUN: bbc -emit-fir %s -o - | FileCheck %s + +subroutine dummy_with_iface() + interface + real function x() + end function + end interface + entry dummy_with_iface_entry(x) + call takes_real(x()) +end subroutine +! CHECK-LABEL: func @_QPdummy_with_iface() { +! CHECK: %[[VAL_0:.*]] = fir.alloca f32 {adapt.valuebyref} +! CHECK: %[[VAL_1:.*]] = fir.undefined !fir.boxproc<() -> ()> +! CHECK: br ^bb1 +! CHECK: ^bb1: +! CHECK: %[[VAL_2:.*]] = fir.box_addr %[[VAL_1]] : (!fir.boxproc<() -> ()>) -> (() -> f32) +! CHECK: %[[VAL_3:.*]] = fir.call %[[VAL_2]]() : () -> f32 +! CHECK: fir.store %[[VAL_3]] to %[[VAL_0]] : !fir.ref +! CHECK: fir.call @_QPtakes_real(%[[VAL_0]]) : (!fir.ref) -> () + +! CHECK-LABEL: func @_QPdummy_with_iface_entry( +! CHECK-SAME: %[[VAL_0:.*]]: !fir.boxproc<() -> ()>) { +! CHECK: %[[VAL_1:.*]] = fir.alloca f32 {adapt.valuebyref} +! CHECK: br ^bb1 +! CHECK: ^bb1: +! CHECK: %[[VAL_2:.*]] = fir.box_addr %[[VAL_0]] : (!fir.boxproc<() -> ()>) -> (() -> f32) +! CHECK: %[[VAL_3:.*]] = fir.call %[[VAL_2]]() : () -> f32 +! CHECK: fir.store %[[VAL_3]] to %[[VAL_1]] : !fir.ref +! CHECK: fir.call @_QPtakes_real(%[[VAL_1]]) : (!fir.ref) -> () + +subroutine subroutine_dummy() + entry subroutine_dummy_entry(x) + call x() +end subroutine +! CHECK-LABEL: func @_QPsubroutine_dummy() { +! CHECK: %[[VAL_0:.*]] = fir.undefined !fir.boxproc<() -> ()> +! CHECK: br ^bb1 +! CHECK: ^bb1: +! CHECK: %[[VAL_1:.*]] = fir.box_addr %[[VAL_0]] : (!fir.boxproc<() -> ()>) -> (() -> ()) +! CHECK: fir.call %[[VAL_1]]() : () -> () + +! CHECK-LABEL: func @_QPsubroutine_dummy_entry( +! CHECK-SAME: %[[VAL_0:.*]]: !fir.boxproc<() -> ()>) { +! CHECK: br ^bb1 +! CHECK: ^bb1: +! CHECK: %[[VAL_1:.*]] = fir.box_addr %[[VAL_0]] : (!fir.boxproc<() -> ()>) -> (() -> ()) +! CHECK: fir.call %[[VAL_1]]() : () -> () + +subroutine character_dummy() + external :: c + character(*) :: c + entry character_dummy_entry(c) + call takes_char(c()) +end subroutine +! CHECK-LABEL: func @_QPcharacter_dummy() { +! CHECK: %[[VAL_0:.*]] = fir.undefined tuple ()>, i64> +! CHECK: br ^bb1 +! CHECK: ^bb1: +! CHECK: %[[VAL_1:.*]] = fir.extract_value %[[VAL_0]], [0 : index] : (tuple ()>, i64>) -> !fir.boxproc<() -> ()> +! CHECK: %[[VAL_2:.*]] = fir.box_addr %[[VAL_1]] : (!fir.boxproc<() -> ()>) -> (() -> ()) +! CHECK: %[[VAL_3:.*]] = fir.extract_value %[[VAL_0]], [1 : index] : (tuple ()>, i64>) -> i64 +! CHECK: %[[VAL_4:.*]] = fir.call @llvm.stacksave() : () -> !fir.ref +! CHECK: %[[VAL_5:.*]] = fir.alloca !fir.char<1,?>(%[[VAL_3]] : i64) {bindc_name = ".result"} +! CHECK: %[[VAL_6:.*]] = fir.convert %[[VAL_2]] : (() -> ()) -> ((!fir.ref>, index) -> !fir.boxchar<1>) +! CHECK: %[[VAL_7:.*]] = fir.convert %[[VAL_3]] : (i64) -> index +! CHECK: %[[VAL_8:.*]] = fir.call %[[VAL_6]](%[[VAL_5]], %[[VAL_7]]) : (!fir.ref>, index) -> !fir.boxchar<1> +! CHECK: %[[VAL_9:.*]] = fir.convert %[[VAL_3]] : (i64) -> index +! CHECK: %[[VAL_10:.*]] = fir.emboxchar %[[VAL_5]], %[[VAL_9]] : (!fir.ref>, index) -> !fir.boxchar<1> +! CHECK: fir.call @_QPtakes_char(%[[VAL_10]]) : (!fir.boxchar<1>) -> () +! CHECK: fir.call @llvm.stackrestore(%[[VAL_4]]) : (!fir.ref) -> () + +! CHECK-LABEL: func @_QPcharacter_dummy_entry( +! CHECK-SAME: %[[VAL_0:.*]]: tuple ()>, i64> {fir.char_proc}) { +! CHECK: br ^bb1 +! CHECK: ^bb1: +! CHECK: %[[VAL_1:.*]] = fir.extract_value %[[VAL_0]], [0 : index] : (tuple ()>, i64>) -> !fir.boxproc<() -> ()> +! CHECK: %[[VAL_2:.*]] = fir.box_addr %[[VAL_1]] : (!fir.boxproc<() -> ()>) -> (() -> ()) +! CHECK: %[[VAL_3:.*]] = fir.extract_value %[[VAL_0]], [1 : index] : (tuple ()>, i64>) -> i64 +! CHECK: %[[VAL_4:.*]] = fir.call @llvm.stacksave() : () -> !fir.ref +! CHECK: %[[VAL_5:.*]] = fir.alloca !fir.char<1,?>(%[[VAL_3]] : i64) {bindc_name = ".result"} +! CHECK: %[[VAL_6:.*]] = fir.convert %[[VAL_2]] : (() -> ()) -> ((!fir.ref>, index) -> !fir.boxchar<1>) +! CHECK: %[[VAL_7:.*]] = fir.convert %[[VAL_3]] : (i64) -> index +! CHECK: %[[VAL_8:.*]] = fir.call %[[VAL_6]](%[[VAL_5]], %[[VAL_7]]) : (!fir.ref>, index) -> !fir.boxchar<1> +! CHECK: %[[VAL_9:.*]] = fir.convert %[[VAL_3]] : (i64) -> index +! CHECK: %[[VAL_10:.*]] = fir.emboxchar %[[VAL_5]], %[[VAL_9]] : (!fir.ref>, index) -> !fir.boxchar<1> +! CHECK: fir.call @_QPtakes_char(%[[VAL_10]]) : (!fir.boxchar<1>) -> () +! CHECK: fir.call @llvm.stackrestore(%[[VAL_4]]) : (!fir.ref) -> () diff --git a/flang/test/Lower/entry-statement.f90 b/flang/test/Lower/entry-statement.f90 --- a/flang/test/Lower/entry-statement.f90 +++ b/flang/test/Lower/entry-statement.f90 @@ -16,10 +16,26 @@ end program entries + character c(3) character(10) hh, qq, m character(len=4) s1, s2 - integer mm + integer mm, x(3), y(5) logical r + complex xx(3) + character(5), external :: f1, f2, f3 + + interface + subroutine ashapec(asc) + character asc(:) + end subroutine + subroutine ashapei(asi) + integer asi(:) + end subroutine + subroutine ashapex(asx) + complex asx(:) + end subroutine + end interface + s1 = 'a111' s2 = 'a222' call compare1(r, s1, s2); print*, r @@ -37,6 +53,16 @@ call dd2 call dd3(6) 6 continue + x = 5 + y = 7 + call level3a(x, y, 3) + call level3b(x, y, 3) + call ashapec(c); print*, c + call ashapei(x); print*, x + call ashapex(xx); print*, xx + print *, f1(1) + print *, f2(2) + print *, f3() end ! CHECK-LABEL: func @_QPss( @@ -110,8 +136,7 @@ ! CHECK-LABEL: func @_QPdd1() subroutine dd1 - ! CHECK: %[[kk:[0-9]*]] = fir.alloca i32 {bindc_name = "kk", uniq_name = - ! "_QFdd1Ekk"} + ! CHECK: %[[kk:[0-9]*]] = fir.alloca i32 {bindc_name = "kk", uniq_name = "_QFdd1Ekk"} ! CHECK: br ^bb1 ! CHECK: ^bb1: // pred: ^bb0 ! CHECK: %[[ten:.*]] = arith.constant 10 : i32 @@ -126,8 +151,7 @@ kk = 10 ! CHECK-LABEL: func @_QPdd2() - ! CHECK: %[[kk:[0-9]*]] = fir.alloca i32 {bindc_name = "kk", uniq_name = - ! "_QFdd1Ekk"} + ! CHECK: %[[kk:[0-9]*]] = fir.alloca i32 {bindc_name = "kk", uniq_name = "_QFdd1Ekk"} ! CHECK: br ^bb1 ! CHECK: ^bb1: // pred: ^bb0 ! CHECK: %[[twenty:.*]] = arith.constant 20 : i32 @@ -141,8 +165,7 @@ ! CHECK-LABEL: func @_QPdd3 ! CHECK: %[[dd3:[0-9]*]] = fir.alloca index {bindc_name = "dd3"} - ! CHECK: %[[kk:[0-9]*]] = fir.alloca i32 {bindc_name = "kk", uniq_name = - ! "_QFdd1Ekk"} + ! CHECK: %[[kk:[0-9]*]] = fir.alloca i32 {bindc_name = "kk", uniq_name = "_QFdd1Ekk"} ! CHECK: %[[zero:.*]] = arith.constant 0 : index ! CHECK: fir.store %[[zero:.*]] to %[[dd3]] : !fir.ref ! CHECK: br ^bb1 @@ -156,3 +179,297 @@ entry dd3(*) kk = 30 end + +! CHECK-LABEL: func @_QPashapec( +subroutine ashapec(asc) + ! CHECK: %[[asx:[0-9]*]] = fir.alloca !fir.box>>> + ! CHECK: %[[asi:[0-9]*]] = fir.alloca !fir.box>> + ! CHECK: %[[zeroi:[0-9]*]] = fir.zero_bits !fir.heap> + ! CHECK: %[[shapei:[0-9]*]] = fir.shape %c0{{.*}} : (index) -> !fir.shape<1> + ! CHECK: %[[boxi:[0-9]*]] = fir.embox %[[zeroi]](%[[shapei]]) : (!fir.heap>, !fir.shape<1>) -> !fir.box>> + ! CHECK: fir.store %[[boxi]] to %[[asi]] : !fir.ref>>> + ! CHECK: %[[zerox:[0-9]*]] = fir.zero_bits !fir.heap>> + ! CHECK: %[[shapex:[0-9]*]] = fir.shape %c0{{.*}} : (index) -> !fir.shape<1> + ! CHECK: %[[boxx:[0-9].*]] = fir.embox %[[zerox]](%[[shapex]]) : (!fir.heap>>, !fir.shape<1>) -> !fir.box>>> + ! CHECK: fir.store %[[boxx]] to %[[asx]] : !fir.ref>>>> + character asc(:) + integer asi(:) + complex asx(:) + asc = '?' + return +! CHECK-LABEL: func @_QPashapei( +entry ashapei(asi) + ! CHECK: %[[asx:[0-9]*]] = fir.alloca !fir.box>>> + ! CHECK: %[[asc:[0-9]*]] = fir.alloca !fir.box>>> + ! CHECK: %[[zeroc:[0-9]*]] = fir.zero_bits !fir.heap>> + ! CHECK: %[[shapec:[0-9]*]] = fir.shape %c0{{.*}} : (index) -> !fir.shape<1> + ! CHECK: %[[boxc:[0-9]*]] = fir.embox %[[zeroc]](%[[shapec]]) : (!fir.heap>>, !fir.shape<1>) -> !fir.box>>> + ! CHECK: fir.store %[[boxc]] to %[[asc]] : !fir.ref>>>> + ! CHECK: %[[zerox:[0-9]*]] = fir.zero_bits !fir.heap>> + ! CHECK: %[[shapex:[0-9]*]] = fir.shape %c0{{.*}} : (index) -> !fir.shape<1> + ! CHECK: %[[boxx:[0-9].*]] = fir.embox %[[zerox]](%[[shapex]]) : (!fir.heap>>, !fir.shape<1>) -> !fir.box>>> + ! CHECK: fir.store %[[boxx]] to %[[asx]] : !fir.ref>>>> + asi = 3 + return +! CHECK-LABEL: func @_QPashapex( +entry ashapex(asx) + ! CHECK: %[[asi:[0-9]*]] = fir.alloca !fir.box>> + ! CHECK: %[[asc:[0-9]*]] = fir.alloca !fir.box>>> + ! CHECK: %[[zeroc:[0-9]*]] = fir.zero_bits !fir.heap>> + ! CHECK: %[[shapec:[0-9]*]] = fir.shape %c0{{.*}} : (index) -> !fir.shape<1> + ! CHECK: %[[boxc:[0-9]*]] = fir.embox %[[zeroc]](%[[shapec]]) : (!fir.heap>>, !fir.shape<1>) -> !fir.box>>> + ! CHECK: fir.store %[[boxc]] to %[[asc]] : !fir.ref>>>> + ! CHECK: %[[zeroi:[0-9]*]] = fir.zero_bits !fir.heap> + ! CHECK: %[[shapei:[0-9]*]] = fir.shape %c0{{.*}} : (index) -> !fir.shape<1> + ! CHECK: %[[boxi:[0-9].*]] = fir.embox %[[zeroi]](%[[shapei]]) : (!fir.heap>, !fir.shape<1>) -> !fir.box>> + ! CHECK: fir.store %[[boxi]] to %[[asi]] : !fir.ref>>> + asx = (2.0,-2.0) +end + +! CHECK-LABEL: func @_QPlevel3a( +subroutine level3a(a, b, m) + ! CHECK: fir.alloca !fir.box>> + ! CHECK: fir.alloca !fir.box>> + ! CHECK: fir.alloca i32 {bindc_name = "n", uniq_name = "_QFlevel3aEn"} + integer :: a(m), b(a(m)), m + integer :: x(n), y(x(n)), n +1 print*, m + print*, a + print*, b + if (m == 3) return +! CHECK-LABEL: func @_QPlevel3b( +entry level3b(x, y, n) + ! CHECK: fir.alloca !fir.box>> + ! CHECK: fir.alloca !fir.box>> + ! CHECK: fir.alloca i32 {bindc_name = "m", uniq_name = "_QFlevel3aEm"} + print*, n + print*, x + print*, y + if (n /= 3) goto 1 +end + +! CHECK-LABEL: @_QPf1 +function f1(n1) result(res1) + ! CHECK: %[[V_0:[0-9]+]] = fir.convert %arg0 : (!fir.ref>) -> !fir.ref> + ! CHECK: %[[V_1:[0-9]+]] = fir.alloca i32 {bindc_name = "n2", uniq_name = "_QFf1En2"} + ! CHECK: %[[V_2:[0-9]+]] = fir.alloca tuple, !fir.boxchar<1>> + ! CHECK: %[[V_3:[0-9]+]] = fir.coordinate_of %[[V_2]], %c0{{.*}}_i32 : (!fir.ref, !fir.boxchar<1>>>, i32) -> !fir.ref> + ! CHECK: %[[V_4:[0-9]+]] = fir.emboxchar %[[V_0]], %c5{{.*}} : (!fir.ref>, index) -> !fir.boxchar<1> + ! CHECK: fir.store %[[V_4]] to %[[V_3]] : !fir.ref> + ! CHECK: %[[V_5:[0-9]+]] = fir.coordinate_of %[[V_2]], %c1{{.*}}_i32 : (!fir.ref, !fir.boxchar<1>>>, i32) -> !fir.ref> + ! CHECK: %[[V_6:[0-9]+]] = fir.emboxchar %[[V_0]], %c5{{.*}} : (!fir.ref>, index) -> !fir.boxchar<1> + ! CHECK: fir.store %[[V_6]] to %[[V_5]] : !fir.ref> + ! CHECK: br ^bb1 + ! CHECK: ^bb1: // pred: ^bb0 + ! CHECK: %[[V_7:[0-9]+]] = fir.address_of(@_QQcl.6120612061) : !fir.ref> + ! CHECK: %[[V_8:[0-9]+]] = arith.cmpi slt, %c5{{.*}}, %c5{{.*}} : index + ! CHECK: %[[V_9:[0-9]+]] = arith.select %[[V_8]], %c5{{.*}}, %c5{{.*}} : index + ! CHECK: %[[V_10:[0-9]+]] = fir.convert %[[V_9]] : (index) -> i64 + ! CHECK: %[[V_11:[0-9]+]] = arith.muli %c1{{.*}}_i64, %[[V_10]] : i64 + ! CHECK: %[[V_12:[0-9]+]] = fir.convert %[[V_0]] : (!fir.ref>) -> !fir.ref + ! CHECK: %[[V_13:[0-9]+]] = fir.convert %[[V_7]] : (!fir.ref>) -> !fir.ref + ! CHECK: fir.call @llvm.memmove.p0i8.p0i8.i64(%[[V_12]], %[[V_13]], %[[V_11]], %false{{.*}}) : (!fir.ref, !fir.ref, i64, i1) -> () + ! CHECK: %[[V_14:[0-9]+]] = arith.subi %c5{{.*}}, %c1{{.*}} : index + ! CHECK: %[[V_15:[0-9]+]] = fir.undefined !fir.char<1> + ! CHECK: %[[V_16:[0-9]+]] = fir.insert_value %[[V_15]], %c32{{.*}}_i8, [0 : index] : (!fir.char<1>, i8) -> !fir.char<1> + ! CHECK: fir.do_loop %arg3 = %[[V_9]] to %[[V_14]] step %c1{{.*}} { + ! CHECK: %[[V_32:[0-9]+]] = fir.convert %[[V_0]] : (!fir.ref>) -> !fir.ref>> + ! CHECK: %[[V_33:[0-9]+]] = fir.coordinate_of %[[V_32]], %arg3 : (!fir.ref>>, index) -> !fir.ref> + ! CHECK: fir.store %[[V_16]] to %[[V_33]] : !fir.ref> + ! CHECK: } + ! CHECK: %[[V_17:[0-9]+]] = fir.load %arg2 : !fir.ref + ! CHECK: %[[V_18:[0-9]+]] = arith.cmpi eq, %[[V_17]], %c1{{.*}}_i32_4 : i32 + ! CHECK: cond_br %[[V_18]], ^bb2, ^bb3 + ! CHECK: ^bb2: // 2 preds: ^bb1, ^bb3 + ! CHECK: br ^bb5 + ! CHECK: ^bb3: // pred: ^bb1 + ! CHECK: fir.call @_QFf1Ps2(%[[V_2]]) : (!fir.ref, !fir.boxchar<1>>>) -> () + ! CHECK: %[[V_19:[0-9]+]] = fir.load %[[V_1]] : !fir.ref + ! CHECK: %[[V_20:[0-9]+]] = arith.cmpi eq, %[[V_19]], %c2{{.*}}_i32 : i32 + ! CHECK: cond_br %[[V_20]], ^bb2, ^bb4 + ! CHECK: ^bb4: // pred: ^bb3 + ! CHECK: %[[V_21:[0-9]+]] = fir.address_of(@_QQcl.4320432043) : !fir.ref> + ! CHECK: %[[V_22:[0-9]+]] = arith.cmpi slt, %c5{{.*}}, %c5{{.*}} : index + ! CHECK: %[[V_23:[0-9]+]] = arith.select %[[V_22]], %c5{{.*}}, %c5{{.*}} : index + ! CHECK: %[[V_24:[0-9]+]] = fir.convert %[[V_23]] : (index) -> i64 + ! CHECK: %[[V_25:[0-9]+]] = arith.muli %c1{{.*}}_i64_6, %[[V_24]] : i64 + ! CHECK: %[[V_26:[0-9]+]] = fir.convert %[[V_0]] : (!fir.ref>) -> !fir.ref + ! CHECK: %[[V_27:[0-9]+]] = fir.convert %[[V_21]] : (!fir.ref>) -> !fir.ref + ! CHECK: fir.call @llvm.memmove.p0i8.p0i8.i64(%[[V_26]], %[[V_27]], %[[V_25]], %false{{.*}}) : (!fir.ref, !fir.ref, i64, i1) -> () + ! CHECK: %[[V_28:[0-9]+]] = arith.subi %c5{{.*}}, %c1{{.*}} : index + ! CHECK: %[[V_29:[0-9]+]] = fir.undefined !fir.char<1> + ! CHECK: %[[V_30:[0-9]+]] = fir.insert_value %[[V_29]], %c32{{.*}}_i8_9, [0 : index] : (!fir.char<1>, i8) -> !fir.char<1> + ! CHECK: fir.do_loop %arg3 = %[[V_23]] to %[[V_28]] step %c1{{.*}} { + ! CHECK: %[[V_32]] = fir.convert %[[V_0]] : (!fir.ref>) -> !fir.ref>> + ! CHECK: %[[V_33]] = fir.coordinate_of %[[V_32]], %arg3 : (!fir.ref>>, index) -> !fir.ref> + ! CHECK: fir.store %[[V_30]] to %[[V_33]] : !fir.ref> + ! CHECK: } + ! CHECK: fir.call @_QFf1Ps3(%[[V_2]]) : (!fir.ref, !fir.boxchar<1>>>) -> () + ! CHECK: br ^bb5 + ! CHECK: ^bb5: // 2 preds: ^bb2, ^bb4 + ! CHECK: %[[V_31:[0-9]+]] = fir.emboxchar %[[V_0]], %c5{{.*}} : (!fir.ref>, index) -> !fir.boxchar<1> + ! CHECK: return %[[V_31]] : !fir.boxchar<1> + ! CHECK: } + character(5) res1, f2, f3 + res1 = 'a a a' + if (n1 == 1) return + +! CHECK-LABEL: @_QPf2 +entry f2(n2) + ! CHECK: %[[V_0:[0-9]+]] = fir.convert %arg0 : (!fir.ref>) -> !fir.ref> + ! CHECK: %[[V_1:[0-9]+]] = fir.alloca i32 {bindc_name = "n1", uniq_name = "_QFf1En1"} + ! CHECK: %[[V_2:[0-9]+]] = fir.alloca tuple, !fir.boxchar<1>> + ! CHECK: %[[V_3:[0-9]+]] = fir.coordinate_of %[[V_2]], %c0{{.*}}_i32 : (!fir.ref, !fir.boxchar<1>>>, i32) -> !fir.ref> + ! CHECK: %[[V_4:[0-9]+]] = fir.emboxchar %[[V_0]], %c5{{.*}} : (!fir.ref>, index) -> !fir.boxchar<1> + ! CHECK: fir.store %[[V_4]] to %[[V_3]] : !fir.ref> + ! CHECK: %[[V_5:[0-9]+]] = fir.coordinate_of %[[V_2]], %c1{{.*}}_i32 : (!fir.ref, !fir.boxchar<1>>>, i32) -> !fir.ref> + ! CHECK: %[[V_6:[0-9]+]] = fir.emboxchar %[[V_0]], %c5{{.*}} : (!fir.ref>, index) -> !fir.boxchar<1> + ! CHECK: fir.store %[[V_6]] to %[[V_5]] : !fir.ref> + ! CHECK: br ^bb1 + ! CHECK: ^bb1: // pred: ^bb0 + ! CHECK: fir.call @_QFf1Ps2(%[[V_2]]) : (!fir.ref, !fir.boxchar<1>>>) -> () + ! CHECK: %[[V_7:[0-9]+]] = fir.load %arg2 : !fir.ref + ! CHECK: %[[V_8:[0-9]+]] = arith.cmpi eq, %[[V_7]], %c2{{.*}}_i32 : i32 + ! CHECK: cond_br %[[V_8]], ^bb2, ^bb3 + ! CHECK: ^bb2: // pred: ^bb1 + ! CHECK: br ^bb4 + ! CHECK: ^bb3: // pred: ^bb1 + ! CHECK: %[[V_9:[0-9]+]] = fir.address_of(@_QQcl.4320432043) : !fir.ref> + ! CHECK: %[[V_10:[0-9]+]] = arith.cmpi slt, %c5{{.*}}, %c5{{.*}} : index + ! CHECK: %[[V_11:[0-9]+]] = arith.select %[[V_10]], %c5{{.*}}, %c5{{.*}} : index + ! CHECK: %[[V_12:[0-9]+]] = fir.convert %[[V_11]] : (index) -> i64 + ! CHECK: %[[V_13:[0-9]+]] = arith.muli %c1{{.*}}_i64, %[[V_12]] : i64 + ! CHECK: %[[V_14:[0-9]+]] = fir.convert %[[V_0]] : (!fir.ref>) -> !fir.ref + ! CHECK: %[[V_15:[0-9]+]] = fir.convert %[[V_9]] : (!fir.ref>) -> !fir.ref + ! CHECK: fir.call @llvm.memmove.p0i8.p0i8.i64(%[[V_14]], %[[V_15]], %[[V_13]], %false{{.*}}) : (!fir.ref, !fir.ref, i64, i1) -> () + ! CHECK: %[[V_16:[0-9]+]] = arith.subi %c5{{.*}}, %c1{{.*}} : index + ! CHECK: %[[V_17:[0-9]+]] = fir.undefined !fir.char<1> + ! CHECK: %[[V_18:[0-9]+]] = fir.insert_value %[[V_17]], %c32{{.*}}_i8, [0 : index] : (!fir.char<1>, i8) -> !fir.char<1> + ! CHECK: fir.do_loop %arg3 = %[[V_11]] to %[[V_16]] step %c1{{.*}} { + ! CHECK: %[[V_20:[0-9]+]] = fir.convert %[[V_0]] : (!fir.ref>) -> !fir.ref>> + ! CHECK: %[[V_21:[0-9]+]] = fir.coordinate_of %[[V_20]], %arg3 : (!fir.ref>>, index) -> !fir.ref> + ! CHECK: fir.store %[[V_18]] to %[[V_21]] : !fir.ref> + ! CHECK: } + ! CHECK: fir.call @_QFf1Ps3(%[[V_2]]) : (!fir.ref, !fir.boxchar<1>>>) -> () + ! CHECK: br ^bb4 + ! CHECK: ^bb4: // 2 preds: ^bb2, ^bb3 + ! CHECK: %[[V_19:[0-9]+]] = fir.emboxchar %[[V_0]], %c5{{.*}} : (!fir.ref>, index) -> !fir.boxchar<1> + ! CHECK: return %[[V_19]] : !fir.boxchar<1> + ! CHECK: } + call s2 + if (n2 == 2) return + +! CHECK-LABEL: @_QPf3 +entry f3 + ! CHECK: %[[V_0:[0-9]+]] = fir.convert %arg0 : (!fir.ref>) -> !fir.ref> + ! CHECK: %[[V_1:[0-9]+]] = fir.alloca i32 {bindc_name = "n1", uniq_name = "_QFf1En1"} + ! CHECK: %[[V_2:[0-9]+]] = fir.alloca i32 {bindc_name = "n2", uniq_name = "_QFf1En2"} + ! CHECK: %[[V_3:[0-9]+]] = fir.alloca tuple, !fir.boxchar<1>> + ! CHECK: %[[V_4:[0-9]+]] = fir.coordinate_of %[[V_3]], %c0{{.*}}_i32 : (!fir.ref, !fir.boxchar<1>>>, i32) -> !fir.ref> + ! CHECK: %[[V_5:[0-9]+]] = fir.emboxchar %[[V_0]], %c5{{.*}} : (!fir.ref>, index) -> !fir.boxchar<1> + ! CHECK: fir.store %[[V_5]] to %[[V_4]] : !fir.ref> + ! CHECK: %[[V_6:[0-9]+]] = fir.coordinate_of %[[V_3]], %c1{{.*}}_i32 : (!fir.ref, !fir.boxchar<1>>>, i32) -> !fir.ref> + ! CHECK: %[[V_7:[0-9]+]] = fir.emboxchar %[[V_0]], %c5{{.*}} : (!fir.ref>, index) -> !fir.boxchar<1> + ! CHECK: fir.store %[[V_7]] to %[[V_6]] : !fir.ref> + ! CHECK: br ^bb1 + ! CHECK: ^bb1: // pred: ^bb0 + ! CHECK: %[[V_8:[0-9]+]] = fir.address_of(@_QQcl.4320432043) : !fir.ref> + ! CHECK: %[[V_9:[0-9]+]] = arith.cmpi slt, %c5{{.*}}, %c5{{.*}} : index + ! CHECK: %[[V_10:[0-9]+]] = arith.select %[[V_9]], %c5{{.*}}, %c5{{.*}} : index + ! CHECK: %[[V_11:[0-9]+]] = fir.convert %[[V_10]] : (index) -> i64 + ! CHECK: %[[V_12:[0-9]+]] = arith.muli %c1{{.*}}_i64, %[[V_11]] : i64 + ! CHECK: %[[V_13:[0-9]+]] = fir.convert %[[V_0]] : (!fir.ref>) -> !fir.ref + ! CHECK: %[[V_14:[0-9]+]] = fir.convert %[[V_8]] : (!fir.ref>) -> !fir.ref + ! CHECK: fir.call @llvm.memmove.p0i8.p0i8.i64(%[[V_13]], %[[V_14]], %[[V_12]], %false{{.*}}) : (!fir.ref, !fir.ref, i64, i1) -> () + ! CHECK: %[[V_15:[0-9]+]] = arith.subi %c5{{.*}}, %c1{{.*}} : index + ! CHECK: %[[V_16:[0-9]+]] = fir.undefined !fir.char<1> + ! CHECK: %[[V_17:[0-9]+]] = fir.insert_value %[[V_16]], %c32{{.*}}_i8, [0 : index] : (!fir.char<1>, i8) -> !fir.char<1> + ! CHECK: fir.do_loop %arg2 = %[[V_10]] to %[[V_15]] step %c1{{.*}} { + ! CHECK: %[[V_19:[0-9]+]] = fir.convert %[[V_0]] : (!fir.ref>) -> !fir.ref>> + ! CHECK: %[[V_20:[0-9]+]] = fir.coordinate_of %[[V_19]], %arg2 : (!fir.ref>>, index) -> !fir.ref> + ! CHECK: fir.store %[[V_17]] to %[[V_20]] : !fir.ref> + ! CHECK: } + ! CHECK: fir.call @_QFf1Ps3(%[[V_3]]) : (!fir.ref, !fir.boxchar<1>>>) -> () + ! CHECK: br ^bb2 + ! CHECK: ^bb2: // pred: ^bb1 + ! CHECK: %[[V_18:[0-9]+]] = fir.emboxchar %[[V_0]], %c5{{.*}} : (!fir.ref>, index) -> !fir.boxchar<1> + ! CHECK: return %[[V_18]] : !fir.boxchar<1> + ! CHECK: } + f3 = "C C C" + call s3 +contains + ! CHECK-LABEL: @_QFf1Ps2 + subroutine s2 + ! CHECK: %[[V_0:[0-9]+]] = fir.coordinate_of %arg0, %c0{{.*}}_i32 : (!fir.ref, !fir.boxchar<1>>>, i32) -> !fir.ref> + ! CHECK: %[[V_1:[0-9]+]] = fir.load %[[V_0]] : !fir.ref> + ! CHECK: %[[V_2:[0-9]+]]:2 = fir.unboxchar %[[V_1]] : (!fir.boxchar<1>) -> (!fir.ref>, index) + ! CHECK: %[[V_3:[0-9]+]] = fir.address_of(@_QQcl.6220622062) : !fir.ref> + ! CHECK: %[[V_4:[0-9]+]] = arith.cmpi slt, %[[V_2]]#1, %c5{{.*}} : index + ! CHECK: %[[V_5:[0-9]+]] = arith.select %[[V_4]], %[[V_2]]#1, %c5{{.*}} : index + ! CHECK: %[[V_6:[0-9]+]] = fir.convert %[[V_5]] : (index) -> i64 + ! CHECK: %[[V_7:[0-9]+]] = arith.muli %c1{{.*}}_i64, %[[V_6]] : i64 + ! CHECK: %[[V_8:[0-9]+]] = fir.convert %[[V_2]]#0 : (!fir.ref>) -> !fir.ref + ! CHECK: %[[V_9:[0-9]+]] = fir.convert %[[V_3]] : (!fir.ref>) -> !fir.ref + ! CHECK: fir.call @llvm.memmove.p0i8.p0i8.i64(%[[V_8]], %[[V_9]], %[[V_7]], %false{{.*}}) : (!fir.ref, !fir.ref, i64, i1) -> () + ! CHECK: %[[V_10:[0-9]+]] = arith.subi %[[V_2]]#1, %c1{{.*}} : index + ! CHECK: %[[V_11:[0-9]+]] = fir.undefined !fir.char<1> + ! CHECK: %[[V_12:[0-9]+]] = fir.insert_value %[[V_11]], %c32{{.*}}_i8, [0 : index] : (!fir.char<1>, i8) -> !fir.char<1> + ! CHECK: fir.do_loop %arg1 = %[[V_5]] to %[[V_10]] step %c1{{.*}} { + ! CHECK: %[[V_13:[0-9]+]] = fir.convert %[[V_2]]#0 : (!fir.ref>) -> !fir.ref>> + ! CHECK: %[[V_14:[0-9]+]] = fir.coordinate_of %[[V_13]], %arg1 : (!fir.ref>>, index) -> !fir.ref> + ! CHECK: fir.store %[[V_12]] to %[[V_14]] : !fir.ref> + ! CHECK: } + ! CHECK: return + ! CHECK: } + f2 = 'b b b' + end + + ! CHECK-LABEL: @_QFf1Ps3 + subroutine s3 + ! CHECK: %[[V_0:[0-9]+]] = fir.coordinate_of %arg0, %c1{{.*}}_i32 : (!fir.ref, !fir.boxchar<1>>>, i32) -> !fir.ref> + ! CHECK: %[[V_1:[0-9]+]] = fir.load %[[V_0]] : !fir.ref> + ! CHECK: %[[V_2:[0-9]+]]:2 = fir.unboxchar %[[V_1]] : (!fir.boxchar<1>) -> (!fir.ref>, index) + ! CHECK: %[[V_3:[0-9]+]] = fir.address_of(@_QQcl.6320632063) : !fir.ref> + ! CHECK: %[[V_4:[0-9]+]] = arith.cmpi slt, %[[V_2]]#1, %c5{{.*}} : index + ! CHECK: %[[V_5:[0-9]+]] = arith.select %[[V_4]], %[[V_2]]#1, %c5{{.*}} : index + ! CHECK: %[[V_6:[0-9]+]] = fir.convert %[[V_5]] : (index) -> i64 + ! CHECK: %[[V_7:[0-9]+]] = arith.muli %c1{{.*}}_i64, %[[V_6]] : i64 + ! CHECK: %[[V_8:[0-9]+]] = fir.convert %[[V_2]]#0 : (!fir.ref>) -> !fir.ref + ! CHECK: %[[V_9:[0-9]+]] = fir.convert %[[V_3]] : (!fir.ref>) -> !fir.ref + ! CHECK: fir.call @llvm.memmove.p0i8.p0i8.i64(%[[V_8]], %[[V_9]], %[[V_7]], %false{{.*}}) : (!fir.ref, !fir.ref, i64, i1) -> () + ! CHECK: %[[V_10:[0-9]+]] = arith.subi %[[V_2]]#1, %c1{{.*}} : index + ! CHECK: %[[V_11:[0-9]+]] = fir.undefined !fir.char<1> + ! CHECK: %[[V_12:[0-9]+]] = fir.insert_value %[[V_11]], %c32{{.*}}_i8, [0 : index] : (!fir.char<1>, i8) -> !fir.char<1> + ! CHECK: fir.do_loop %arg1 = %[[V_5]] to %[[V_10]] step %c1{{.*}} { + ! CHECK: %[[V_13:[0-9]+]] = fir.convert %[[V_2]]#0 : (!fir.ref>) -> !fir.ref>> + ! CHECK: %[[V_14:[0-9]+]] = fir.coordinate_of %[[V_13]], %arg1 : (!fir.ref>>, index) -> !fir.ref> + ! CHECK: fir.store %[[V_12]] to %[[V_14]] : !fir.ref> + ! CHECK: } + ! CHECK: return + ! CHECK: } + f3 = 'c c c' + end +end + +! CHECK-LABEL: func @_QPassumed_size() { +subroutine assumed_size() + real :: x(*) +! CHECK: %[[VAL_0:.*]] = fir.alloca !fir.box>> +! CHECK: %[[VAL_1:.*]] = fir.zero_bits !fir.heap> +! CHECK: %[[VAL_2:.*]] = arith.constant 0 : index +! CHECK: %[[VAL_3:.*]] = fir.shape %[[VAL_2]] : (index) -> !fir.shape<1> +! CHECK: %[[VAL_4:.*]] = fir.embox %[[VAL_1]](%[[VAL_3]]) : (!fir.heap>, !fir.shape<1>) -> !fir.box>> +! CHECK: fir.store %[[VAL_4]] to %[[VAL_0]] : !fir.ref>>> +! CHECK: br ^bb1 +! CHECK: ^bb1: +! CHECK: return +! CHECK: } + +! CHECK-LABEL: func @_QPentry_with_assumed_size( + entry entry_with_assumed_size(x) +! CHECK-SAME: %[[VAL_0:.*]]: !fir.ref> {fir.bindc_name = "x"}) { +! CHECK: br ^bb1 +! CHECK: ^bb1: +! CHECK: return +! CHECK: } +end subroutine