@@ -44,8 +44,7 @@ bool IODEF(OutputNamelist)(Cookie cookie, const NamelistGroup &group) {
4444 if ((connection.NeedAdvance (prefixLen) &&
4545 !(io.AdvanceRecord () && EmitAscii (io, " " , 1 ))) ||
4646 !EmitAscii (io, prefix, prefixLen) ||
47- (connection.NeedAdvance (
48- Fortran::runtime::strlen (str) + (suffix != ' ' )) &&
47+ (connection.NeedAdvance (runtime::strlen (str) + (suffix != ' ' )) &&
4948 !(io.AdvanceRecord () && EmitAscii (io, " " , 1 )))) {
5049 return false ;
5150 }
@@ -102,8 +101,8 @@ static constexpr RT_API_ATTRS char NormalizeIdChar(char32_t ch) {
102101 return static_cast <char >(ch >= ' A' && ch <= ' Z' ? ch - ' A' + ' a' : ch);
103102}
104103
105- static RT_API_ATTRS bool GetLowerCaseName (
106- IoStatementState &io, char buffer[], std::size_t maxLength) {
104+ static RT_API_ATTRS bool GetLowerCaseName (IoStatementState &io, char buffer[],
105+ std::size_t maxLength, bool crashIfTooLong = true ) {
107106 std::size_t byteLength{0 };
108107 if (auto ch{io.GetNextNonBlank (byteLength)}) {
109108 if (IsLegalIdStart (*ch)) {
@@ -117,8 +116,10 @@ static RT_API_ATTRS bool GetLowerCaseName(
117116 if (j <= maxLength) {
118117 return true ;
119118 }
120- io.GetIoErrorHandler ().SignalError (
121- " Identifier '%s...' in NAMELIST input group is too long" , buffer);
119+ if (crashIfTooLong) {
120+ io.GetIoErrorHandler ().SignalError (
121+ " Identifier '%s...' in NAMELIST input group is too long" , buffer);
122+ }
122123 }
123124 }
124125 return false ;
@@ -356,9 +357,8 @@ static RT_API_ATTRS bool HandleComponent(IoStatementState &io, Descriptor &desc,
356357 const DescriptorAddendum *addendum{source.Addendum ()};
357358 if (const typeInfo::DerivedType *
358359 type{addendum ? addendum->derivedType () : nullptr }) {
359- if (const typeInfo::Component *
360- comp{type->FindDataComponent (
361- compName, Fortran::runtime::strlen (compName))}) {
360+ if (const typeInfo::Component *comp{
361+ type->FindDataComponent (compName, runtime::strlen (compName))}) {
362362 bool createdDesc{false };
363363 if (comp->rank () > 0 && source.rank () > 0 ) {
364364 // If base and component are both arrays, the component name
@@ -484,7 +484,7 @@ bool IODEF(InputNamelist)(Cookie cookie, const NamelistGroup &group) {
484484 handler.SignalError (" NAMELIST input group has no name" );
485485 return false ;
486486 }
487- if (Fortran:: runtime::strcmp (group.groupName , name) == 0 ) {
487+ if (runtime::strcmp (group.groupName , name) == 0 ) {
488488 break ; // found it
489489 }
490490 SkipNamelistGroup (io);
@@ -503,7 +503,7 @@ bool IODEF(InputNamelist)(Cookie cookie, const NamelistGroup &group) {
503503 }
504504 std::size_t itemIndex{0 };
505505 for (; itemIndex < group.items ; ++itemIndex) {
506- if (Fortran:: runtime::strcmp (name, group.item [itemIndex].name ) == 0 ) {
506+ if (runtime::strcmp (name, group.item [itemIndex].name ) == 0 ) {
507507 break ;
508508 }
509509 }
@@ -577,13 +577,14 @@ bool IODEF(InputNamelist)(Cookie cookie, const NamelistGroup &group) {
577577 if (const auto *addendum{useDescriptor->Addendum ()};
578578 addendum && addendum->derivedType ()) {
579579 const NonTbpDefinedIoTable *table{group.nonTbpDefinedIo };
580- listInput->ResetForNextNamelistItem (/* inNamelistSequence= */ true );
580+ listInput->ResetForNextNamelistItem (&group );
581581 if (!IONAME (InputDerivedType)(cookie, *useDescriptor, table) &&
582582 handler.InError ()) {
583583 return false ;
584584 }
585585 } else {
586- listInput->ResetForNextNamelistItem (useDescriptor->rank () > 0 );
586+ listInput->ResetForNextNamelistItem (
587+ useDescriptor->rank () > 0 ? &group : nullptr );
587588 if (!descr::DescriptorIO<Direction::Input>(io, *useDescriptor) &&
588589 handler.InError ()) {
589590 return false ;
@@ -607,27 +608,51 @@ bool IODEF(InputNamelist)(Cookie cookie, const NamelistGroup &group) {
607608}
608609
609610RT_API_ATTRS bool IsNamelistNameOrSlash (IoStatementState &io) {
610- if (auto *listInput{
611- io.get_if <ListDirectedStatementState<Direction::Input>>()}) {
612- if (listInput->inNamelistSequence ()) {
613- SavedPosition savedPosition{io};
614- std::size_t byteCount{0 };
615- if (auto ch{io.GetNextNonBlank (byteCount)}) {
616- if (IsLegalIdStart (*ch)) {
617- do {
618- io.HandleRelativePosition (byteCount);
619- ch = io.GetCurrentChar (byteCount);
620- } while (ch && IsLegalIdChar (*ch));
621- ch = io.GetNextNonBlank (byteCount);
622- // TODO: how to deal with NaN(...) ambiguity?
623- return ch && (*ch == ' =' || *ch == ' (' || *ch == ' %' );
624- } else {
625- return *ch == ' /' || *ch == ' &' || *ch == ' $' ;
626- }
627- }
611+ auto *listInput{io.get_if <ListDirectedStatementState<Direction::Input>>()};
612+ if (!listInput || !listInput->namelistGroup ()) {
613+ return false ; // not namelist
614+ }
615+ SavedPosition savedPosition{io};
616+ std::size_t byteCount{0 };
617+ auto ch{io.GetNextNonBlank (byteCount)};
618+ if (!ch) {
619+ return false ;
620+ } else if (!IsLegalIdStart (*ch)) {
621+ return *ch == ' /' || *ch == ' &' || *ch == ' $' ;
622+ }
623+ char id[nameBufferSize];
624+ if (!GetLowerCaseName (io, id, sizeof id, /* crashIfTooLong=*/ false )) {
625+ return true ; // long name
626+ }
627+ // It looks like a name, but might be "inf" or "nan". Check what
628+ // follows.
629+ ch = io.GetNextNonBlank (byteCount);
630+ if (!ch) {
631+ return false ;
632+ } else if (*ch == ' =' || *ch == ' %' ) {
633+ return true ;
634+ } else if (*ch != ' (' ) {
635+ return false ;
636+ } else if (runtime::strcmp (id, " nan" ) != 0 ) {
637+ return true ;
638+ }
639+ // "nan(" ambiguity
640+ int depth{1 };
641+ while (true ) {
642+ io.HandleRelativePosition (byteCount);
643+ ch = io.GetNextNonBlank (byteCount);
644+ if (depth == 0 ) {
645+ // nan(...) followed by '=', '%', or '('?
646+ break ;
647+ } else if (!ch) {
648+ return true ; // not a valid NaN(...)
649+ } else if (*ch == ' (' ) {
650+ ++depth;
651+ } else if (*ch == ' )' ) {
652+ --depth;
628653 }
629654 }
630- return false ;
655+ return ch && (*ch == ' = ' || *ch == ' % ' || *ch == ' ( ' ) ;
631656}
632657
633658RT_OFFLOAD_API_GROUP_END
0 commit comments