diff --git a/flang/include/flang/Evaluate/real.h b/flang/include/flang/Evaluate/real.h --- a/flang/include/flang/Evaluate/real.h +++ b/flang/include/flang/Evaluate/real.h @@ -63,10 +63,6 @@ return word_ == that.word_; } - // TODO: DIM, MAX, MIN, DPROD, FRACTION, - // INT/NINT, NEAREST, OUT_OF_RANGE, - // RRSPACING/SPACING, SCALE, SET_EXPONENT - constexpr bool IsSignBitSet() const { return word_.BTEST(bits - 1); } constexpr bool IsNegative() const { return !IsNotANumber() && IsSignBitSet(); @@ -118,7 +114,7 @@ const Real &, Rounding rounding = defaultRounding) const; // SQRT(x**2 + y**2) but computed so as to avoid spurious overflow - // TODO: needed for CABS + // TODO: not yet implemented; needed for CABS ValueWithRealFlags HYPOT( const Real &, Rounding rounding = defaultRounding) const; diff --git a/flang/include/flang/Parser/dump-parse-tree.h b/flang/include/flang/Parser/dump-parse-tree.h --- a/flang/include/flang/Parser/dump-parse-tree.h +++ b/flang/include/flang/Parser/dump-parse-tree.h @@ -200,7 +200,6 @@ NODE_ENUM(ConnectSpec::CharExpr, Kind) NODE(ConnectSpec, Newunit) NODE(ConnectSpec, Recl) - NODE(parser, ConstantValue) NODE(parser, ContainsStmt) NODE(parser, Contiguous) NODE(parser, ContiguousStmt) diff --git a/flang/include/flang/Parser/parse-state.h b/flang/include/flang/Parser/parse-state.h --- a/flang/include/flang/Parser/parse-state.h +++ b/flang/include/flang/Parser/parse-state.h @@ -34,7 +34,6 @@ class ParseState { public: - // TODO: Add a constructor for parsing a normalized module file. ParseState(const CookedSource &cooked) : p_{cooked.AsCharBlock().begin()}, limit_{cooked.AsCharBlock().end()} {} ParseState(const ParseState &that) diff --git a/flang/include/flang/Parser/parse-tree.h b/flang/include/flang/Parser/parse-tree.h --- a/flang/include/flang/Parser/parse-tree.h +++ b/flang/include/flang/Parser/parse-tree.h @@ -426,8 +426,9 @@ // R504 specification-part -> [use-stmt]... [import-stmt]... [implicit-part] // [declaration-construct]... -// TODO: transfer any statements after the last IMPLICIT (if any) -// from the implicit part to the declaration constructs +// PARAMETER, FORMAT, and ENTRY statements that appear before any other +// kind of declaration-construct will be parsed into the implicit-part, +// even if there are no IMPLICIT statements. struct SpecificationPart { TUPLE_CLASS_BOILERPLATE(SpecificationPart); std::tuple, @@ -861,13 +862,6 @@ u; }; -// R604 constant -> literal-constant | named-constant -// Renamed to dodge a clash with Constant<> template class. -struct ConstantValue { - UNION_CLASS_BOILERPLATE(ConstantValue); - std::variant u; -}; - // R807 access-spec -> PUBLIC | PRIVATE struct AccessSpec { ENUM_CLASS(Kind, Public, Private) @@ -1412,14 +1406,15 @@ // signed-int-literal-constant | signed-real-literal-constant | // null-init | initial-data-target | // structure-constructor +// N.B. Parsing ambiguities abound here without recourse to symbols +// (see comments on R845's parser). struct DataStmtConstant { UNION_CLASS_BOILERPLATE(DataStmtConstant); CharBlock source; mutable TypedExpr typedExpr; - std::variant, Scalar, - SignedIntLiteralConstant, SignedRealLiteralConstant, - SignedComplexLiteralConstant, NullInit, InitialDataTarget, - StructureConstructor> + std::variant, StructureConstructor> u; }; @@ -2100,11 +2095,11 @@ // R1109 block-specification-part -> // [use-stmt]... [import-stmt]... // [[declaration-construct]... specification-construct] -WRAPPER_CLASS(BlockSpecificationPart, SpecificationPart); -// TODO: Because BlockSpecificationPart just wraps the more general +// N.B. Because BlockSpecificationPart just wraps the more general // SpecificationPart, it can misrecognize an ImplicitPart as part of // the BlockSpecificationPart during parsing, and we have to detect and // flag such usage in semantics. +WRAPPER_CLASS(BlockSpecificationPart, SpecificationPart); // R1107 block-construct -> // block-stmt [block-specification-part] block end-block-stmt @@ -2227,8 +2222,9 @@ // R1119 do-construct -> do-stmt block end-do // R1120 do-stmt -> nonlabel-do-stmt | label-do-stmt -// TODO: deprecated: DO loop ending on statement types other than END DO and -// CONTINUE; multiple "label DO" loops ending on the same label +// Deprecated, but supported: "label DO" loops ending on statements other +// than END DO and CONTINUE, and multiple "label DO" loops ending on the +// same label. struct DoConstruct { TUPLE_CLASS_BOILERPLATE(DoConstruct); const std::optional &GetLoopControl() const; diff --git a/flang/lib/Evaluate/check-expression.cpp b/flang/lib/Evaluate/check-expression.cpp --- a/flang/lib/Evaluate/check-expression.cpp +++ b/flang/lib/Evaluate/check-expression.cpp @@ -411,8 +411,6 @@ } } else if (const auto *object{ ultimate.detailsIf()}) { - // TODO: what about EQUIVALENCE with data in COMMON? - // TODO: does this work for blank COMMON? if (object->commonBlock()) { return std::nullopt; } diff --git a/flang/lib/Evaluate/type.cpp b/flang/lib/Evaluate/type.cpp --- a/flang/lib/Evaluate/type.cpp +++ b/flang/lib/Evaluate/type.cpp @@ -37,7 +37,6 @@ if (IsDescriptor(details.type())) { return true; } - // TODO: Automatic (adjustable) arrays - are they descriptors? for (const ShapeSpec &shapeSpec : details.shape()) { const auto &lb{shapeSpec.lbound().GetExplicit()}; const auto &ub{shapeSpec.ubound().GetExplicit()}; diff --git a/flang/lib/Parser/Fortran-parsers.cpp b/flang/lib/Parser/Fortran-parsers.cpp --- a/flang/lib/Parser/Fortran-parsers.cpp +++ b/flang/lib/Parser/Fortran-parsers.cpp @@ -47,13 +47,6 @@ constexpr auto rawName{nonDigitIdChar >> many(nonDigitIdChar || digit)}; TYPE_PARSER(space >> sourced(rawName >> construct())) -// R604 constant -> literal-constant | named-constant -// Used only via R607 int-constant and R845 data-stmt-constant. -// The look-ahead check prevents occlusion of constant-subobject in -// data-stmt-constant. -TYPE_PARSER(construct(literalConstant) || - construct(namedConstant / !"%"_tok / !"("_tok)) - // R608 intrinsic-operator -> // power-op | mult-op | add-op | concat-op | rel-op | // not-op | and-op | or-op | equiv-op @@ -103,9 +96,9 @@ construct(definedOpName)) // R505 implicit-part -> [implicit-part-stmt]... implicit-stmt -// TODO: Can overshoot; any trailing PARAMETER, FORMAT, & ENTRY -// statements after the last IMPLICIT should be transferred to the -// list of declaration-constructs. +// N.B. PARAMETER, FORMAT, & ENTRY statements that appear before any +// other kind of declaration-construct will be parsed into the +// implicit-part. TYPE_CONTEXT_PARSER("implicit part"_en_US, construct(many(Parser{}))) @@ -828,21 +821,21 @@ // signed-int-literal-constant | signed-real-literal-constant | // null-init | initial-data-target | // constant-structure-constructor -// null-init and a structure-constructor without parameters or components -// are syntactically ambiguous in DATA, so "x()" is misparsed into a -// null-init then fixed up later in expression semantics. -// TODO: Some structure constructors can be misrecognized as array -// references into constant subobjects. -TYPE_PARSER(sourced(first( - construct(scalar(Parser{})), - construct(nullInit), - construct(scalar(constantSubobject)) / !"("_tok, - construct(Parser{}), +// N.B. scalar-constant and scalar-constant-subobject are ambiguous with +// initial-data-target; null-init and structure-constructor are ambiguous +// in the absence of parameters and components; structure-constructor with +// components can be ambiguous with a scalar-constant-subobject. +// So we parse literal constants, designator, null-init, and +// structure-constructor, so that semantics can figure things out later +// with the symbol table. +TYPE_PARSER(sourced(first(construct(literalConstant), construct(signedRealLiteralConstant), construct(signedIntLiteralConstant), extension( construct(Parser{})), - construct(initialDataTarget)))) + construct(nullInit), + construct(indirect(designator) / !"("_tok), + construct(Parser{})))) // R848 dimension-stmt -> // DIMENSION [::] array-name ( array-spec ) @@ -1067,6 +1060,7 @@ maybe(Parser{}))) // R913 structure-component -> data-ref +// The final part-ref in the data-ref is not allowed to have subscripts. TYPE_PARSER(construct( construct(some(Parser{} / percentOrDot)), name)) @@ -1125,8 +1119,6 @@ // R932 allocation -> // allocate-object [( allocate-shape-spec-list )] // [lbracket allocate-coarray-spec rbracket] -// TODO: allocate-shape-spec-list might be misrecognized as -// the final list of subscripts in allocate-object. TYPE_PARSER(construct(Parser{}, defaulted(parenthesized(nonemptyList(Parser{}))), maybe(bracketed(Parser{})))) diff --git a/flang/lib/Parser/program-parsers.cpp b/flang/lib/Parser/program-parsers.cpp --- a/flang/lib/Parser/program-parsers.cpp +++ b/flang/lib/Parser/program-parsers.cpp @@ -269,9 +269,9 @@ // R1412 only -> generic-spec | only-use-name | rename // R1413 only-use-name -> use-name +// N.B. generic-spec and only-use-name are ambiguous; resolved with symbols TYPE_PARSER(construct(Parser{}) || - construct(indirect(genericSpec)) || - construct(name)) // TODO: ambiguous, accepted by genericSpec + construct(indirect(genericSpec)) || construct(name)) // R1416 submodule -> // submodule-stmt [specification-part] [module-subprogram-part] diff --git a/flang/lib/Semantics/data-to-inits.cpp b/flang/lib/Semantics/data-to-inits.cpp --- a/flang/lib/Semantics/data-to-inits.cpp +++ b/flang/lib/Semantics/data-to-inits.cpp @@ -329,7 +329,14 @@ exprAnalyzer_.Say("Initializer for '%s' must not be a procedure"_err_en_US, DescribeElement()); } else if (auto designatorType{designator.GetType()}) { - if (auto converted{ConvertElement(*expr, *designatorType)}) { + if (expr->Rank() > 0) { + // Because initial-data-target is ambiguous with scalar-constant and + // scalar-constant-subobject at parse time, enforcement of scalar-* + // must be deferred to here. + exprAnalyzer_.Say( + "DATA statement value initializes '%s' with an array"_err_en_US, + DescribeElement()); + } else if (auto converted{ConvertElement(*expr, *designatorType)}) { // value non-pointer initialization if (std::holds_alternative(expr->u) && designatorType->category() != TypeCategory::Integer) { // 8.6.7(11) diff --git a/flang/lib/Semantics/rewrite-parse-tree.cpp b/flang/lib/Semantics/rewrite-parse-tree.cpp --- a/flang/lib/Semantics/rewrite-parse-tree.cpp +++ b/flang/lib/Semantics/rewrite-parse-tree.cpp @@ -43,7 +43,6 @@ void Post(parser::IoUnit &); void Post(parser::ReadStmt &); void Post(parser::WriteStmt &); - void Post(parser::DataStmtConstant &); // Name resolution yet implemented: // TODO: Can some/all of these now be enabled? @@ -176,19 +175,6 @@ FixMisparsedUntaggedNamelistName(x); } -void RewriteMutator::Post(parser::DataStmtConstant &x) { - if (auto *scalar{std::get_if>(&x.u)}) { - if (auto *named{std::get_if(&scalar->thing.u)}) { - if (const Symbol * symbol{named->v.symbol}) { - if (!IsNamedConstant(*symbol) && symbol->attrs().test(Attr::TARGET)) { - x.u = parser::InitialDataTarget{ - parser::Designator{parser::DataRef{parser::Name{named->v}}}}; - } - } - } - } -} - bool RewriteParseTree(SemanticsContext &context, parser::Program &program) { RewriteMutator mutator{context}; parser::Walk(program, mutator); diff --git a/flang/test/Semantics/data01.f90 b/flang/test/Semantics/data01.f90 --- a/flang/test/Semantics/data01.f90 +++ b/flang/test/Semantics/data01.f90 @@ -59,8 +59,8 @@ !OK: constant array element data x / a(1) / !C886, C887 - !ERROR: Must be a constant value + !ERROR: DATA statement value 'a(int(i,kind=8))' for 'y' is not a constant data y / a(i) / - !ERROR: Must be a constant value + !ERROR: DATA statement value 'b(1_8)' for 'z' is not a constant data z / b(1) / end diff --git a/flang/test/Semantics/data06.f90 b/flang/test/Semantics/data06.f90 --- a/flang/test/Semantics/data06.f90 +++ b/flang/test/Semantics/data06.f90 @@ -45,6 +45,6 @@ data jx/t1()/ !ERROR: DATA statement value could not be converted to the type 'INTEGER(4)' of the object 'jx' data jx/.false./ - !ERROR: must be a constant + !ERROR: DATA statement value 'jy' for 'jx' is not a constant data jx/jy/ end subroutine diff --git a/flang/test/Semantics/data10.f90 b/flang/test/Semantics/data10.f90 new file mode 100644 --- /dev/null +++ b/flang/test/Semantics/data10.f90 @@ -0,0 +1,14 @@ +! RUN: %S/test_errors.sh %s %t %f18 +type :: t + integer :: n +end type +type(t) :: x +real, target, save :: a(1) +real, parameter :: arrparm(1) = [3.14159] +real, pointer :: p +real :: y +data x/t(1)/ +data p/a(1)/ +!ERROR: DATA statement value initializes 'y' with an array +data y/arrparm/ +end