bug#5624: 23.1; etags elisp and scheme "=" in names

[Alex <agrambot@gmail.com>]

[-- Attachment #1: Type: text/plain, Size: 1376 bytes --]

Eli Zaretskii <eliz@gnu.org> writes:

>> From: Alex <agrambot@gmail.com>
>> Cc: user42@zip.com.au,  5624@debbugs.gnu.org
>> Date: Mon, 12 Jun 2017 21:31:57 -0600
>> 
>> > I think it would be much cleaner not to use get_tag for these
>> > languages, but instead either call make_tag directly or write a
>> > get_lispy_tag function which will DTRT for Lisp-like languages.
>> >
>> > Thanks.
>> 
>> I wanted to reduce duplicated code, but I suppose it is cleaner that
>> way.
>> 
>> I've attached a patch below.
>
> Thanks.  This looks OK to me, but please also add a test for this
> problem, and make sure the previous tests still succeed.  (The etags
> test suite is in test/manual/etags/.)
>
>> +/* Similar to get_tag, but include '=' as part of the tag. */
>> +static void
>> +get_lispy_tag (register char *bp, char **namepp)
>> +{
>> +  register char *cp = bp;
>> +
>> +  if (*bp != '\0')
>> +    {
>> +      /* Go till you get to white space or a syntactic break */
>> +      for (cp = bp + 1; !notinname (*cp) || *cp == '='; cp++)
>> +	continue;
>> +      make_tag (bp, cp - bp, true,
>> +		lb.buffer, cp - lb.buffer + 1, lineno, linecharno);
>> +    }
>> +
>> +  if (namepp != NULL)
>> +    *namepp = savenstr (bp, cp - bp);
>> +}
>
> It looks like none of the callers uses a non-NULL 2nd arg, so perhaps
> just remove it, and its supporting code.

Alright, I did both.


[-- Warning: decoded text below may be mangled, UTF-8 assumed --]
[-- Attachment #2: etags --]
[-- Type: text/x-diff, Size: 15307 bytes --]

From 0b5ca3f4d395e3894e4e2098ca77af62549b88a5 Mon Sep 17 00:00:00 2001
From: Alexander Gramiak <agrambot@gmail.com>
Date: Mon, 12 Jun 2017 21:28:39 -0600
Subject: [PATCH] Include '=' in Scheme and Lisp tags in etags

* lib-src/etags.c (get_lispy_tag): New function.
(L_getit, Scheme_functions): Use get_lispy_tag (Bug#5624).
* test/manual/etags/CTAGS.good:
* test/manual/etags/ETAGS.good_1:
* test/manual/etags/ETAGS.good_2:
* test/manual/etags/ETAGS.good_3:
* test/manual/etags/ETAGS.good_4:
* test/manual/etags/ETAGS.good_5:
* test/manual/etags/ETAGS.good_6:
* test/manual/etags/Makefile:
* test/manual/etags/el-src/TAGTEST.EL: Update tests.
* test/manual/etags/scm-src/test.scm: Add tests for Scheme.
---
 lib-src/etags.c                     | 29 +++++++++++++++++++++++------
 test/manual/etags/CTAGS.good        |  8 ++++++++
 test/manual/etags/ETAGS.good_1      | 16 +++++++++++++---
 test/manual/etags/ETAGS.good_2      | 16 +++++++++++++---
 test/manual/etags/ETAGS.good_3      | 16 +++++++++++++---
 test/manual/etags/ETAGS.good_4      | 16 +++++++++++++---
 test/manual/etags/ETAGS.good_5      | 16 +++++++++++++---
 test/manual/etags/ETAGS.good_6      | 16 +++++++++++++---
 test/manual/etags/Makefile          |  3 ++-
 test/manual/etags/el-src/TAGTEST.EL |  1 +
 test/manual/etags/scm-src/test.scm  | 20 ++++++++++++++++++++
 11 files changed, 132 insertions(+), 25 deletions(-)
 create mode 100644 test/manual/etags/scm-src/test.scm

diff --git a/lib-src/etags.c b/lib-src/etags.c
index 6f280d8ab4..ef377b399d 100644
--- a/lib-src/etags.c
+++ b/lib-src/etags.c
@@ -372,6 +372,7 @@ static void readline (linebuffer *, FILE *);
 static long readline_internal (linebuffer *, FILE *, char const *);
 static bool nocase_tail (const char *);
 static void get_tag (char *, char **);
+static void get_lispy_tag (char *);
 
 static void analyze_regex (char *);
 static void free_regexps (void);
@@ -5346,7 +5347,7 @@ L_getit (void)
       /* Ok, then skip "(" before name in (defstruct (foo)) */
       dbp = skip_spaces (dbp);
   }
-  get_tag (dbp, NULL);
+  get_lispy_tag (dbp);
 }
 
 static void
@@ -5548,14 +5549,14 @@ Scheme_functions (FILE *inf)
       if (strneq (bp, "(def", 4) || strneq (bp, "(DEF", 4))
 	{
 	  bp = skip_non_spaces (bp+4);
-	  /* Skip over open parens and white space.  Don't continue past
-	     '\0'. */
-	  while (*bp && notinname (*bp))
+	  /* Skip over open parens and white space.
+	     Don't continue past '\0' or '='. */
+	  while (*bp && notinname (*bp) && *bp != '=')
 	    bp++;
-	  get_tag (bp, NULL);
+	  get_lispy_tag (bp);
 	}
       if (LOOKING_AT (bp, "(SET!") || LOOKING_AT (bp, "(set!"))
-	get_tag (bp, NULL);
+	get_lispy_tag (bp);
     }
 }
 
@@ -6590,6 +6591,22 @@ get_tag (register char *bp, char **namepp)
     *namepp = savenstr (bp, cp - bp);
 }
 
+/* Similar to get_tag, but include '=' as part of the tag. */
+static void
+get_lispy_tag (register char *bp)
+{
+  register char *cp = bp;
+
+  if (*bp != '\0')
+    {
+      /* Go till you get to white space or a syntactic break */
+      for (cp = bp + 1; !notinname (*cp) || *cp == '='; cp++)
+	continue;
+      make_tag (bp, cp - bp, true,
+		lb.buffer, cp - lb.buffer + 1, lineno, linecharno);
+    }
+}
+
 /*
  * Read a line of text from `stream' into `lbp', excluding the
  * newline or CR-NL, if any.  Return the number of characters read from
diff --git a/test/manual/etags/CTAGS.good b/test/manual/etags/CTAGS.good
index 13bb37c2e6..519315c6fd 100644
--- a/test/manual/etags/CTAGS.good
+++ b/test/manual/etags/CTAGS.good
@@ -202,6 +202,7 @@ ${CHECKOBJS}	make-src/Makefile	/^${CHECKOBJS}: CFLAGS=-g3 -DNULLFREECHECK=0$/
 =\relax	tex-src/texinfo.tex	/^\\let\\subsubsection=\\relax$/
 =\relax	tex-src/texinfo.tex	/^\\let\\appendix=\\relax$/
 =\smartitalic	tex-src/texinfo.tex	/^\\let\\cite=\\smartitalic$/
+=starts-with-equals!	scm-src/test.scm	/^(define =starts-with-equals! #t)$/
 >	tex-src/texinfo.tex	/^\\def>{{\\tt \\gtr}}$/
 >field1	forth-src/test-forth.fth	/^   9   field   >field1$/
 >field2	forth-src/test-forth.fth	/^   5   field   >field2$/
@@ -2750,6 +2751,7 @@ current-idle-time	c-src/emacs/src/keyboard.c	/^DEFUN ("current-idle-time", Fcurr
 current-input-mode	c-src/emacs/src/keyboard.c	/^DEFUN ("current-input-mode", Fcurrent_input_mode, /
 current_kboard	c-src/emacs/src/keyboard.c	85
 current_lb_is_new	c-src/etags.c	2926
+curry-test	scm-src/test.scm	/^(define (((((curry-test a) b) c) d) e)$/
 cursor_position	cp-src/screen.cpp	/^void cursor_position(void)$/
 cursor_x	cp-src/screen.cpp	15
 cursor_y	cp-src/screen.cpp	15
@@ -3037,6 +3039,7 @@ foo	ruby-src/test1.ru	/^    attr_reader :foo$/
 foo!	ruby-src/test1.ru	/^    def foo!$/
 foo1	ruby-src/test1.ru	/^    attr_reader(:foo1, :bar1, # comment$/
 foo2	ruby-src/test1.ru	/^    alias_method ( :foo2, #cmmt$/
+foo==bar	el-src/TAGTEST.EL	/^(defun foo==bar () (message "hi"))  ; Bug#5624$/
 foobar	c-src/c.c	/^int foobar() {;}$/
 foobar	c.c	/^extern void foobar (void) __attribute__ ((section /
 foobar2	c-src/h.h	20
@@ -3161,6 +3164,9 @@ header	c-src/emacs/src/lisp.h	1672
 header	c-src/emacs/src/lisp.h	1826
 header_size	c-src/emacs/src/lisp.h	1471
 heapsize	c-src/emacs/src/gmalloc.c	361
+hello	scm-src/test.scm	/^(define hello "Hello, Emacs!")$/
+hello	scm-src/test.scm	/^(set! hello "Hello, world!")$/
+hello-world	scm-src/test.scm	/^(define (hello-world)$/
 help	c-src/etags.c	193
 helpPanel	objcpp-src/SimpleCalc.M	/^- helpPanel:sender$/
 help_char_p	c-src/emacs/src/keyboard.c	/^help_char_p (Lisp_Object c)$/
@@ -4317,10 +4323,12 @@ test	erl-src/gs_dialog.erl	/^test() ->$/
 test	go-src/test1.go	/^func test(p plus) {$/
 test	make-src/Makefile	/^test:$/
 test	php-src/ptest.php	/^test $/
+test-begin	scm-src/test.scm	/^(define-syntax test-begin$/
 test.me22b	lua-src/test.lua	/^   local function test.me22b (one)$/
 test.me_22a	lua-src/test.lua	/^   function test.me_22a(one, two)$/
 test_undefined	c-src/emacs/src/keyboard.c	/^test_undefined (Lisp_Object binding)$/
 texttreelist	prol-src/natded.prolog	/^texttreelist([]).$/
+there-is-a-=-in-the-middle!	scm-src/test.scm	/^(define (there-is-a-=-in-the-middle!) #t)$/
 this	c-src/a/b/b.c	1
 this-command-keys	c-src/emacs/src/keyboard.c	/^DEFUN ("this-command-keys", Fthis_command_keys, St/
 this-command-keys-vector	c-src/emacs/src/keyboard.c	/^DEFUN ("this-command-keys-vector", Fthis_command_k/
diff --git a/test/manual/etags/ETAGS.good_1 b/test/manual/etags/ETAGS.good_1
index 6c4a02ae1c..1dd540cd66 100644
--- a/test/manual/etags/ETAGS.good_1
+++ b/test/manual/etags/ETAGS.good_1
@@ -2143,10 +2143,11 @@ main(\x7f37,571
 	class D \x7f41,622
 		D(\x7f43,659
 \f
-el-src/TAGTEST.EL,148
+el-src/TAGTEST.EL,179
 (foo::defmumble bletch \x7f1,0
-(defalias 'pending-delete-mode \x7fpending-delete-mode\x015,102
-(defalias (quote explicitly-quoted-pending-delete-mode)\x7f8,175
+(defun foo==bar \x7ffoo==bar\x012,33
+(defalias 'pending-delete-mode \x7fpending-delete-mode\x016,149
+(defalias (quote explicitly-quoted-pending-delete-mode)\x7f9,222
 \f
 el-src/emacs/lisp/progmodes/etags.el,5069
 (defvar tags-file-name \x7f34,1034
@@ -3135,6 +3136,15 @@ module A\x7f9,57
     alias_method ( :foo2,\x7ffoo2\x0137,586
 A::Constant \x7fConstant\x0142,655
 \f
+scm-src/test.scm,260
+(define hello \x7f1,0
+(set! hello \x7f3,32
+(define (hello-world)\x7f5,62
+(define (there-is-a-=-in-the-middle!)\x7fthere-is-a-=-in-the-middle!\x0110,128
+(define =starts-with-equals! \x7f=starts-with-equals!\x0112,171
+(define (((((curry-test \x7f14,205
+(define-syntax test-begin\x7f17,265
+\f
 tex-src/testenv.tex,52
 \newcommand{\nm}\x7f\nm\x014,77
 \section{blah}\x7fblah\x018,139
diff --git a/test/manual/etags/ETAGS.good_2 b/test/manual/etags/ETAGS.good_2
index fa784d2e7b..3563f4611a 100644
--- a/test/manual/etags/ETAGS.good_2
+++ b/test/manual/etags/ETAGS.good_2
@@ -2712,10 +2712,11 @@ main(\x7f37,571
 	class D \x7f41,622
 		D(\x7f43,659
 \f
-el-src/TAGTEST.EL,148
+el-src/TAGTEST.EL,179
 (foo::defmumble bletch \x7f1,0
-(defalias 'pending-delete-mode \x7fpending-delete-mode\x015,102
-(defalias (quote explicitly-quoted-pending-delete-mode)\x7f8,175
+(defun foo==bar \x7ffoo==bar\x012,33
+(defalias 'pending-delete-mode \x7fpending-delete-mode\x016,149
+(defalias (quote explicitly-quoted-pending-delete-mode)\x7f9,222
 \f
 el-src/emacs/lisp/progmodes/etags.el,5188
 (defvar tags-file-name \x7f34,1034
@@ -3708,6 +3709,15 @@ module A\x7f9,57
     alias_method ( :foo2,\x7ffoo2\x0137,586
 A::Constant \x7fConstant\x0142,655
 \f
+scm-src/test.scm,260
+(define hello \x7f1,0
+(set! hello \x7f3,32
+(define (hello-world)\x7f5,62
+(define (there-is-a-=-in-the-middle!)\x7fthere-is-a-=-in-the-middle!\x0110,128
+(define =starts-with-equals! \x7f=starts-with-equals!\x0112,171
+(define (((((curry-test \x7f14,205
+(define-syntax test-begin\x7f17,265
+\f
 tex-src/testenv.tex,52
 \newcommand{\nm}\x7f\nm\x014,77
 \section{blah}\x7fblah\x018,139
diff --git a/test/manual/etags/ETAGS.good_3 b/test/manual/etags/ETAGS.good_3
index 547dee2d43..e9356620dc 100644
--- a/test/manual/etags/ETAGS.good_3
+++ b/test/manual/etags/ETAGS.good_3
@@ -2520,10 +2520,11 @@ main(\x7f37,571
 		D(\x7f43,659
 		int x;\x7f44,694
 \f
-el-src/TAGTEST.EL,148
+el-src/TAGTEST.EL,179
 (foo::defmumble bletch \x7f1,0
-(defalias 'pending-delete-mode \x7fpending-delete-mode\x015,102
-(defalias (quote explicitly-quoted-pending-delete-mode)\x7f8,175
+(defun foo==bar \x7ffoo==bar\x012,33
+(defalias 'pending-delete-mode \x7fpending-delete-mode\x016,149
+(defalias (quote explicitly-quoted-pending-delete-mode)\x7f9,222
 \f
 el-src/emacs/lisp/progmodes/etags.el,5069
 (defvar tags-file-name \x7f34,1034
@@ -3542,6 +3543,15 @@ module A\x7f9,57
     alias_method ( :foo2,\x7ffoo2\x0137,586
 A::Constant \x7fConstant\x0142,655
 \f
+scm-src/test.scm,260
+(define hello \x7f1,0
+(set! hello \x7f3,32
+(define (hello-world)\x7f5,62
+(define (there-is-a-=-in-the-middle!)\x7fthere-is-a-=-in-the-middle!\x0110,128
+(define =starts-with-equals! \x7f=starts-with-equals!\x0112,171
+(define (((((curry-test \x7f14,205
+(define-syntax test-begin\x7f17,265
+\f
 tex-src/testenv.tex,52
 \newcommand{\nm}\x7f\nm\x014,77
 \section{blah}\x7fblah\x018,139
diff --git a/test/manual/etags/ETAGS.good_4 b/test/manual/etags/ETAGS.good_4
index 2c50ec1a74..318e3614a4 100644
--- a/test/manual/etags/ETAGS.good_4
+++ b/test/manual/etags/ETAGS.good_4
@@ -2307,10 +2307,11 @@ main(\x7f37,571
 	class D \x7f41,622
 		D(\x7f43,659
 \f
-el-src/TAGTEST.EL,148
+el-src/TAGTEST.EL,179
 (foo::defmumble bletch \x7f1,0
-(defalias 'pending-delete-mode \x7fpending-delete-mode\x015,102
-(defalias (quote explicitly-quoted-pending-delete-mode)\x7f8,175
+(defun foo==bar \x7ffoo==bar\x012,33
+(defalias 'pending-delete-mode \x7fpending-delete-mode\x016,149
+(defalias (quote explicitly-quoted-pending-delete-mode)\x7f9,222
 \f
 el-src/emacs/lisp/progmodes/etags.el,5069
 (defvar tags-file-name \x7f34,1034
@@ -3299,6 +3300,15 @@ module A\x7f9,57
     alias_method ( :foo2,\x7ffoo2\x0137,586
 A::Constant \x7fConstant\x0142,655
 \f
+scm-src/test.scm,260
+(define hello \x7f1,0
+(set! hello \x7f3,32
+(define (hello-world)\x7f5,62
+(define (there-is-a-=-in-the-middle!)\x7fthere-is-a-=-in-the-middle!\x0110,128
+(define =starts-with-equals! \x7f=starts-with-equals!\x0112,171
+(define (((((curry-test \x7f14,205
+(define-syntax test-begin\x7f17,265
+\f
 tex-src/testenv.tex,52
 \newcommand{\nm}\x7f\nm\x014,77
 \section{blah}\x7fblah\x018,139
diff --git a/test/manual/etags/ETAGS.good_5 b/test/manual/etags/ETAGS.good_5
index 2b431034f4..04912ecbfb 100644
--- a/test/manual/etags/ETAGS.good_5
+++ b/test/manual/etags/ETAGS.good_5
@@ -3253,10 +3253,11 @@ main(\x7f37,571
 		D(\x7f43,659
 		int x;\x7f44,694
 \f
-el-src/TAGTEST.EL,148
+el-src/TAGTEST.EL,179
 (foo::defmumble bletch \x7f1,0
-(defalias 'pending-delete-mode \x7fpending-delete-mode\x015,102
-(defalias (quote explicitly-quoted-pending-delete-mode)\x7f8,175
+(defun foo==bar \x7ffoo==bar\x012,33
+(defalias 'pending-delete-mode \x7fpending-delete-mode\x016,149
+(defalias (quote explicitly-quoted-pending-delete-mode)\x7f9,222
 \f
 el-src/emacs/lisp/progmodes/etags.el,5188
 (defvar tags-file-name \x7f34,1034
@@ -4279,6 +4280,15 @@ module A\x7f9,57
     alias_method ( :foo2,\x7ffoo2\x0137,586
 A::Constant \x7fConstant\x0142,655
 \f
+scm-src/test.scm,260
+(define hello \x7f1,0
+(set! hello \x7f3,32
+(define (hello-world)\x7f5,62
+(define (there-is-a-=-in-the-middle!)\x7fthere-is-a-=-in-the-middle!\x0110,128
+(define =starts-with-equals! \x7f=starts-with-equals!\x0112,171
+(define (((((curry-test \x7f14,205
+(define-syntax test-begin\x7f17,265
+\f
 tex-src/testenv.tex,52
 \newcommand{\nm}\x7f\nm\x014,77
 \section{blah}\x7fblah\x018,139
diff --git a/test/manual/etags/ETAGS.good_6 b/test/manual/etags/ETAGS.good_6
index 2cb0d05e72..b80e1dbb77 100644
--- a/test/manual/etags/ETAGS.good_6
+++ b/test/manual/etags/ETAGS.good_6
@@ -3253,10 +3253,11 @@ main(\x7f37,571
 		D(\x7fD::D\x0143,659
 		int x;\x7fD::x\x0144,694
 \f
-el-src/TAGTEST.EL,148
+el-src/TAGTEST.EL,179
 (foo::defmumble bletch \x7f1,0
-(defalias 'pending-delete-mode \x7fpending-delete-mode\x015,102
-(defalias (quote explicitly-quoted-pending-delete-mode)\x7f8,175
+(defun foo==bar \x7ffoo==bar\x012,33
+(defalias 'pending-delete-mode \x7fpending-delete-mode\x016,149
+(defalias (quote explicitly-quoted-pending-delete-mode)\x7f9,222
 \f
 el-src/emacs/lisp/progmodes/etags.el,5188
 (defvar tags-file-name \x7f34,1034
@@ -4279,6 +4280,15 @@ module A\x7f9,57
     alias_method ( :foo2,\x7ffoo2\x0137,586
 A::Constant \x7fConstant\x0142,655
 \f
+scm-src/test.scm,260
+(define hello \x7f1,0
+(set! hello \x7f3,32
+(define (hello-world)\x7f5,62
+(define (there-is-a-=-in-the-middle!)\x7fthere-is-a-=-in-the-middle!\x0110,128
+(define =starts-with-equals! \x7f=starts-with-equals!\x0112,171
+(define (((((curry-test \x7f14,205
+(define-syntax test-begin\x7f17,265
+\f
 tex-src/testenv.tex,52
 \newcommand{\nm}\x7f\nm\x014,77
 \section{blah}\x7fblah\x018,139
diff --git a/test/manual/etags/Makefile b/test/manual/etags/Makefile
index 07ad0f4641..c1df703905 100644
--- a/test/manual/etags/Makefile
+++ b/test/manual/etags/Makefile
@@ -25,12 +25,13 @@ PSSRC=
 PROLSRC=$(addprefix ./prol-src/,ordsets.prolog natded.prolog)
 PYTSRC=$(addprefix ./pyt-src/,server.py)
 RBSRC=$(addprefix ./ruby-src/,test.rb test1.ru)
+SCMSRC=$(addprefix ./scm-src/,test.scm)
 TEXSRC=$(addprefix ./tex-src/,testenv.tex gzip.texi texinfo.tex nonewline.tex)
 YSRC=$(addprefix ./y-src/,parse.y parse.c atest.y cccp.c cccp.y)
 SRCS=${ADASRC} ${ASRC} ${CSRC} ${CPSRC} ${ELSRC} ${ERLSRC} ${FSRC}\
      ${FORTHSRC} ${GOSRC} ${HTMLSRC} ${JAVASRC} ${LUASRC} ${MAKESRC}\
      ${OBJCSRC} ${OBJCPPSRC} ${PASSRC} ${PHPSRC} ${PERLSRC} ${PSSRC}\
-     ${PROLSRC} ${PYTSRC} ${RBSRC} ${TEXSRC} ${YSRC}
+     ${PROLSRC} ${PYTSRC} ${RBSRC} ${SCMSRC} ${TEXSRC} ${YSRC}
 NONSRCS=./f-src/entry.strange ./erl-src/lists.erl ./cp-src/clheir.hpp.gz
 
 ETAGS_PROG=../../../lib-src/etags
diff --git a/test/manual/etags/el-src/TAGTEST.EL b/test/manual/etags/el-src/TAGTEST.EL
index acf0baf82f..89a6791377 100644
--- a/test/manual/etags/el-src/TAGTEST.EL
+++ b/test/manual/etags/el-src/TAGTEST.EL
@@ -1,4 +1,5 @@
 (foo::defmumble bletch beuarghh)
+(defun foo==bar () (message "hi"))  ; Bug#5624
 ;;; Ctags test file for lisp mode.
 
 ;; from emacs/lisp/delsel.el:76:
diff --git a/test/manual/etags/scm-src/test.scm b/test/manual/etags/scm-src/test.scm
new file mode 100644
index 0000000000..e3921e718f
--- /dev/null
+++ b/test/manual/etags/scm-src/test.scm
@@ -0,0 +1,20 @@
+(define hello "Hello, Emacs!")
+
+(set! hello "Hello, world!")
+
+(define (hello-world)
+  (display hello)
+  (newline))
+
+;; Bug 5624
+(define (there-is-a-=-in-the-middle!) #t)
+
+(define =starts-with-equals! #t)
+
+(define (((((curry-test a) b) c) d) e)
+  (list a b c d e))
+
+(define-syntax test-begin
+  (syntax-rules ()
+    ((test-begin exp ...)
+     ((lambda () exp ...)))))
-- 
2.11.0