diff --git a/flang/include/flang/Evaluate/type.h b/flang/include/flang/Evaluate/type.h --- a/flang/include/flang/Evaluate/type.h +++ b/flang/include/flang/Evaluate/type.h @@ -91,8 +91,11 @@ CHECK(IsValidKindOfIntrinsicType(category_, kind_)); } DynamicType(int charKind, const semantics::ParamValue &len); + // When a known length is presented, resolve it to its effective + // length of zero if it is negative. constexpr DynamicType(int k, std::int64_t len) - : category_{TypeCategory::Character}, kind_{k}, knownLength_{len} { + : category_{TypeCategory::Character}, kind_{k}, knownLength_{ + len >= 0 ? len : 0} { CHECK(IsValidKindOfIntrinsicType(category_, kind_)); } explicit constexpr DynamicType( 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 @@ -96,7 +96,7 @@ : category_{TypeCategory::Character}, kind_{k} { CHECK(IsValidKindOfIntrinsicType(category_, kind_)); if (auto n{ToInt64(pv.GetExplicit())}) { - knownLength_ = *n; + knownLength_ = *n > 0 ? *n : 0; } else { charLengthParamValue_ = &pv; } diff --git a/flang/test/Semantics/separate-mp02.f90 b/flang/test/Semantics/separate-mp02.f90 --- a/flang/test/Semantics/separate-mp02.f90 +++ b/flang/test/Semantics/separate-mp02.f90 @@ -305,9 +305,32 @@ end subroutine end interface end module + submodule(m8) sm8 contains !Ensure no spurious error about mismatching attributes module procedure s1 end procedure end submodule + +module m9 + interface + module subroutine sub1(s) + character(len=0) s + end subroutine + module subroutine sub2(s) + character(len=0) s + end subroutine + end interface +end module + +submodule(m9) sm1 + contains + module subroutine sub1(s) + character(len=-1) s ! ok + end subroutine + module subroutine sub2(s) + !ERROR: Dummy argument 's' has type CHARACTER(KIND=1,LEN=1_8); the corresponding argument in the interface body has type CHARACTER(KIND=1,LEN=0_8) + character(len=1) s + end subroutine +end submodule