From eefb204c6f3512703c5c45ce8b74729933f90129 Mon Sep 17 00:00:00 2001 From: Masatake YAMATO Date: Thu, 2 Jan 2025 01:19:45 +0900 Subject: [PATCH] Tcl: extract null tags for procedures The test case is taken from #4157 submitted by Javier Mora. Co-authored-by: Javier Mora Signed-off-by: Masatake YAMATO --- Units/parser-tcl.r/nulltags.d/args.ctags | 3 + Units/parser-tcl.r/nulltags.d/expected.tags-x | 12 ++++ Units/parser-tcl.r/nulltags.d/input.tcl | 17 +++++ parsers/tcl.c | 62 ++++++++++++++++--- 4 files changed, 84 insertions(+), 10 deletions(-) create mode 100644 Units/parser-tcl.r/nulltags.d/args.ctags create mode 100644 Units/parser-tcl.r/nulltags.d/expected.tags-x create mode 100644 Units/parser-tcl.r/nulltags.d/input.tcl diff --git a/Units/parser-tcl.r/nulltags.d/args.ctags b/Units/parser-tcl.r/nulltags.d/args.ctags new file mode 100644 index 0000000000..405dddc90f --- /dev/null +++ b/Units/parser-tcl.r/nulltags.d/args.ctags @@ -0,0 +1,3 @@ +--sort=no +--extras=+{nulltag} +--_xformat=%-16N %-10K %4n %-16F %C %{scopeKind}:%{scope} diff --git a/Units/parser-tcl.r/nulltags.d/expected.tags-x b/Units/parser-tcl.r/nulltags.d/expected.tags-x new file mode 100644 index 0000000000..298140f3bd --- /dev/null +++ b/Units/parser-tcl.r/nulltags.d/expected.tags-x @@ -0,0 +1,12 @@ + procedure 1 input.tcl proc {} {} {return Empty } : +aaa procedure 2 input.tcl proc aaa {} {return Normal} : +a procedure 4 input.tcl proc {a} {} {return Braced} : +ns1 namespace 6 input.tcl namespace eval ns1 { : + procedure 7 input.tcl proc {} {} {return Empty } namespace:::ns1 +bbb procedure 8 input.tcl proc bbb {} {return Normal} namespace:::ns1 +b procedure 9 input.tcl proc {b} {} {return Braced} namespace:::ns1 +ns2 namespace 12 input.tcl namespace eval ns2 : + procedure 13 input.tcl proc ns2:: {} {return Empty } namespace:ns2 +ccc procedure 14 input.tcl proc ns2::ccc {} {return Normal} namespace:ns2 +c procedure 15 input.tcl proc {ns2::c} {} {return Braced} namespace:ns2 + procedure 17 input.tcl proc :: {} {return "Empty at Root NS"} : diff --git a/Units/parser-tcl.r/nulltags.d/input.tcl b/Units/parser-tcl.r/nulltags.d/input.tcl new file mode 100644 index 0000000000..c1418d7c9e --- /dev/null +++ b/Units/parser-tcl.r/nulltags.d/input.tcl @@ -0,0 +1,17 @@ +proc {} {} {return Empty } +proc aaa {} {return Normal} + +proc {a} {} {return Braced} + +namespace eval ns1 { + proc {} {} {return Empty } + proc bbb {} {return Normal} + proc {b} {} {return Braced} +} + +namespace eval ns2 +proc ns2:: {} {return Empty } +proc ns2::ccc {} {return Normal} +proc {ns2::c} {} {return Braced} + +proc :: {} {return "Empty at Root NS"} diff --git a/parsers/tcl.c b/parsers/tcl.c index 3ee427ef75..f48dc8deec 100644 --- a/parsers/tcl.c +++ b/parsers/tcl.c @@ -450,13 +450,42 @@ static void collectSignature (const tokenInfo *const token, collector * col) vStringCat (col->str, token->string); } +static void tokenReadQuotedIdentifier (tokenInfo *const token) +{ + token->type = TOKEN_TCL_IDENTIFIER; + vStringClear (token->string); + unsigned int depth = 1; + while (depth > 0) + { + int c = getcFromInputFile (); + switch (c) + { + case EOF: + return; + case '{': + depth++; + tokenPutc (token, c); + break; + case '}': + if (depth != 1) + tokenPutc (token, c); + depth--; + break; + default: + vStringPut (token->string, c); + } + } +} + static void parseProc (tokenInfo *const token, - int parent) + int parent, bool quoted) { int index = CORK_NIL; int index_fq = CORK_NIL; - - tokenRead (token); + if (quoted) + tokenReadQuotedIdentifier (token); + else + tokenRead (token); if (tokenIsType(token, TCL_IDENTIFIER)) { @@ -494,6 +523,8 @@ static void parseProc (tokenInfo *const token, e.extensionFields.scopeName = vStringValue (ns); } + if (*e.name == '\0') + e.allowNullTag = 1; e.skipAutoFQEmission = 1; index = makeTagEntry (&e); @@ -517,13 +548,24 @@ static void parseProc (tokenInfo *const token, } else { - tagEntryInfo *ep; - index = makeSimpleTag (token->string, K_PROCEDURE); - ep = getEntryInCorkQueue (index); - if (ep) - ep->extensionFields.scopeIndex = parent; + tagEntryInfo e; + initTagEntry (&e, tokenString (token), K_PROCEDURE); + if (quoted) + { + e.lineNumber = token->lineNumber; + e.filePosition = token->filePosition; + if (vStringIsEmpty (token->string)) + e.allowNullTag = 1; + } + e.extensionFields.scopeIndex = parent; + index = makeTagEntry (&e); } } + else if (!quoted && token->type == '{') + { + parseProc(token, parent, true); + return; + } vString *signature = NULL; if (!tokenIsEOL (token)) @@ -628,7 +670,7 @@ static void parseNamespace (tokenInfo *const token, if (tokenIsKeyword (token, NAMESPACE)) parseNamespace (token, index); else if (tokenIsKeyword (token, PROC)) - parseProc (token, index); + parseProc (token, index, false); else if (tokenIsType (token, TCL_IDENTIFIER)) { int r = notifyCommand (token, index); @@ -677,7 +719,7 @@ static void findTclTags (void) if (tokenIsKeyword (token, NAMESPACE)) parseNamespace (token, CORK_NIL); else if (tokenIsKeyword (token, PROC)) - parseProc (token, CORK_NIL); + parseProc (token, CORK_NIL, false); else if (tokenIsKeyword (token, PACKAGE)) parsePackage (token); else if (tokenIsType (token, TCL_IDENTIFIER))