Forth related improvements for etags

Generate correct tags names for things like "(foo)".
Previously "(foo" created.

Fix a bug where a tag for "-bar" was created when encountering things
like "create-bar".

Recognize more words from the Forth-2012 Standard.

* lib-src/etags.c (Forth_words): Check for whitespace after defining
words.  Create tag with make_tag instead of get_tag to avoid notiname
which isn't appropriate for Forth.

* test/manual/etags/forth-src/test-forth.fth: Add some test cases.
* 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/CTAGS.good: Adapt to the changes in etags.c and
new test cases.

diff --git a/lib-src/etags.c b/lib-src/etags.c
index 6a722e0641c182dd0eb1e1debc27c842fc7facb3..7baa2a3e39f3d9757c6810abe1a8a09b4674ca87 100644 (file)
--- a/lib-src/etags.c
+++ b/lib-src/etags.c
@@ -5469,16 +5469,37 @@ Forth_words (FILE *inf)
        do                      /* skip to ) or eol */
          bp++;
        while (*bp != ')' && *bp != '\0');
-      else if ((bp[0] == ':' && c_isspace (bp[1]) && bp++)
-              || LOOKING_AT_NOCASE (bp, "constant")
-              || LOOKING_AT_NOCASE (bp, "code")
-              || LOOKING_AT_NOCASE (bp, "create")
-              || LOOKING_AT_NOCASE (bp, "defer")
-              || LOOKING_AT_NOCASE (bp, "value")
-              || LOOKING_AT_NOCASE (bp, "variable")
-              || LOOKING_AT_NOCASE (bp, "buffer:")
-              || LOOKING_AT_NOCASE (bp, "field"))
-       get_tag (skip_spaces (bp), NULL); /* Yay!  A definition! */
+      else if (((bp[0] == ':' && c_isspace (bp[1]) && bp++)
+               || LOOKING_AT_NOCASE (bp, "constant")
+               || LOOKING_AT_NOCASE (bp, "2constant")
+               || LOOKING_AT_NOCASE (bp, "fconstant")
+               || LOOKING_AT_NOCASE (bp, "code")
+               || LOOKING_AT_NOCASE (bp, "create")
+               || LOOKING_AT_NOCASE (bp, "defer")
+               || LOOKING_AT_NOCASE (bp, "value")
+               || LOOKING_AT_NOCASE (bp, "2value")
+               || LOOKING_AT_NOCASE (bp, "fvalue")
+               || LOOKING_AT_NOCASE (bp, "variable")
+               || LOOKING_AT_NOCASE (bp, "2variable")
+               || LOOKING_AT_NOCASE (bp, "fvariable")
+               || LOOKING_AT_NOCASE (bp, "buffer:")
+               || LOOKING_AT_NOCASE (bp, "field:")
+               || LOOKING_AT_NOCASE (bp, "+field")
+               || LOOKING_AT_NOCASE (bp, "field") /* not standard? */
+               || LOOKING_AT_NOCASE (bp, "begin-structure")
+               || LOOKING_AT_NOCASE (bp, "synonym")
+               )
+              && c_isspace (bp[0]))
+       {
+         /* Yay!  A definition! */
+         char* name_start = skip_spaces (bp);
+         char* name_end = skip_non_spaces (name_start);
+         if (name_start < name_end)
+           make_tag (name_start, name_end - name_start,
+                     true, lb.buffer, name_end - lb.buffer,
+                     lineno, linecharno);
+         bp = name_end;
+       }
       else
        bp = skip_non_spaces (bp);
 }

diff --git a/test/manual/etags/CTAGS.good b/test/manual/etags/CTAGS.good
index e6529890b8db73332568351d682e99e488924322..6f9df192c43fbab1945cc24891f254ed2cc40f87 100644 (file)
--- a/test/manual/etags/CTAGS.good
+++ b/test/manual/etags/CTAGS.good
@@ -36,7 +36,8 @@ ${CHECKOBJS}  make-src/Makefile       /^${CHECKOBJS}: CFLAGS=-g3 -DNULLFREECHECK=0$/
 ($prog,$_,@list        perl-src/yagrip.pl      39
 ($string,$flag,@string,@temp,@last     perl-src/yagrip.pl      40
 (a-forth-constant      forth-src/test-forth.fth        /^constant (a-forth-constant$/
-(another-forth-word    forth-src/test-forth.fth        /^: (another-forth-word) ( -- )$/
+(another-forth-word)   forth-src/test-forth.fth        /^: (another-forth-word) ( -- )$/
+(foo)  forth-src/test-forth.fth        /^: (foo) 1 ;$/
 +      ruby-src/test.rb        /^        def +(y)$/
 +      tex-src/texinfo.tex     /^\\def+{{\\tt \\char 43}}$/
 .PRECIOUS      make-src/Makefile       /^.PRECIOUS: ETAGS CTAGS ETAGS16 CTAGS16 ETAGS17 CTA/
@@ -170,6 +171,9 @@ ${CHECKOBJS}        make-src/Makefile       /^${CHECKOBJS}: CFLAGS=-g3 -DNULLFREECHECK=0$/
 /wbytes        ps-src/rfc1245.ps       /^\/wbytes { $/
 /wh    ps-src/rfc1245.ps       /^\/wh { $/
 /yen   ps-src/rfc1245.ps       /^\/yen \/.notdef \/.notdef \/.notdef \/.notdef \/.notdef /
+2const forth-src/test-forth.fth        /^3 4 2constant 2const$/
+2val   forth-src/test-forth.fth        /^2const 2value 2val$/
+2var   forth-src/test-forth.fth        /^2variable 2var$/
 :a-forth-dictionary-entry      forth-src/test-forth.fth        /^create :a-forth-dictionary-entry$/
 <      tex-src/texinfo.tex     /^\\def<{{\\tt \\less}}$/
 <<     ruby-src/test.rb        /^        def <<(y)$/
@@ -2725,6 +2729,7 @@ counter   cp-src/c.C      36
 cow    cp-src/c.C      127
 cow    cp-src/c.C      131
 cplpl  c-src/etags.c   2935
+create-bar     forth-src/test-forth.fth        /^: create-bar foo ;$/
 createPOEntries        php-src/lce_functions.php       /^      function createPOEntries()$/
 createWidgets  pyt-src/server.py       /^    def createWidgets(self, host):$/
 createWidgets  pyt-src/server.py       /^    def createWidgets(self):$/
@@ -2944,6 +2949,7 @@ fastmap   c-src/emacs/src/regex.h 355
 fastmap_accurate       c-src/emacs/src/regex.h 383
 fatal  c-src/etags.c   /^fatal (const char *s1, const char *s2)$/
 fatala c.c     /^void fatala () __attribute__ ((noreturn));$/
+fconst forth-src/test-forth.fth        /^3.1415e fconstant fconst$/
 fdHandler      objc-src/Subprocess.m   /^- fdHandler:(int)theFd$/
 fdHandler      objc-src/Subprocess.m   /^fdHandler (int theFd, id self)$/
 fdefunkey      c-src/etags.c   2409
@@ -3015,6 +3021,7 @@ foo       cp-src/x.cc     /^XX::foo()$/
 foo    f-src/entry.for /^       character*(*) function foo()$/
 foo    f-src/entry.strange_suffix      /^       character*(*) function foo()$/
 foo    f-src/entry.strange     /^       character*(*) function foo()$/
+foo    forth-src/test-forth.fth        /^: foo (foo) ;$/
 foo    php-src/ptest.php       /^foo()$/
 foo    ruby-src/test1.ru       /^    attr_reader :foo$/
 foo!   ruby-src/test1.ru       /^    def foo!$/
@@ -3057,6 +3064,8 @@ function  c-src/emacs/src/lisp.h  694
 function       c-src/emacs/src/lisp.h  1685
 function       c-src/emacs/src/lisp.h  2197
 functionp      c-src/emacs/src/lisp.h  /^functionp (Lisp_Object object)$/
+fval   forth-src/test-forth.fth        /^fconst fvalue fval$/
+fvar   forth-src/test-forth.fth        /^fvariable fvar$/
 fvdef  c-src/etags.c   2418
 fvextern       c-src/etags.c   2420
 fvnameseen     c-src/etags.c   2412
@@ -3515,6 +3524,7 @@ my_struct c.c     226
 my_struct      c-src/h.h       91
 my_typedef     c.c     228
 my_typedef     c-src/h.h       93
+mypi   forth-src/test-forth.fth        /^synonym mypi fconst$/
 n      c-src/exit.c    28
 n      c-src/exit.strange_suffix       28
 name   c-src/getopt.h  76
@@ -3719,6 +3729,8 @@ outputtable       html-src/algrthms.html  /^Output$/
 outsyn prol-src/natded.prolog  /^outsyn(['Any'],_).$/
 p      c-src/emacs/src/lisp.h  4673
 p      c-src/emacs/src/lisp.h  4679
+p.x    forth-src/test-forth.fth        /^  1 CELLS +FIELD p.x    \\ A single cell filed name/
+p.y    forth-src/test-forth.fth        /^  1 CELLS +FIELD p.y    \\ A single cell field name/
 p/f    ada-src/etags-test-for.ada      /^   function p pragma Import (C,$/
 p/f    ada-src/etags-test-for.ada      /^function p ("p");$/
 pD     c-src/emacs/src/lisp.h  165
@@ -3767,6 +3779,7 @@ plist     c-src/emacs/src/lisp.h  697
 plus   cp-src/functions.cpp    /^void Date::plus ( int days , int month , int year /
 plus   go-src/test1.go 5
 plusvalseq     prol-src/natded.prolog  /^plusvalseq([]) --> [].$/
+point  forth-src/test-forth.fth        /^BEGIN-STRUCTURE point \\ create the named structure/
 pointer        c-src/emacs/src/lisp.h  2125
 poll_for_input c-src/emacs/src/keyboard.c      /^poll_for_input (struct atimer *timer)$/
 poll_for_input_1       c-src/emacs/src/keyboard.c      /^poll_for_input_1 (void)$/

diff --git a/test/manual/etags/ETAGS.good_1 b/test/manual/etags/ETAGS.good_1
index 374692c5816c8c59fe7dd50edebc073bf4eac6e7..b3bd2410fcc24ce33798eb0862d7a41f91172c79 100644 (file)
--- a/test/manual/etags/ETAGS.good_1
+++ b/test/manual/etags/ETAGS.good_1
@@ -2311,19 +2311,32 @@ f-src/entry.strange,172
      & intensity1(\7f577,12231
        character*(*) function foo(\7f579,12307
 \f
-forth-src/test-forth.fth,408
-: a-forth-word \7f20,301
+forth-src/test-forth.fth,733
+: a-forth-word\7f20,301
 99 constant a-forth-constant!\7f22,343
 55 value a-forth-value?\7f23,373
 create :a-forth-dictionary-entry\7f24,397
 defer #a-defer-word\7f27,460
-: (another-forth-word)\7f(another-forth-word\ 129,481
+: (another-forth-word)\7f(another-forth-word)\ 129,481
    9   field   >field1\7f36,582
    5   field   >field2\7f37,605
 constant (a-forth-constant\7f(a-forth-constant\ 138,628
 2000 buffer: #some-storage\7f41,657
-code assemby-code-word \7f43,685
-: a-forth-word \7f50,870
+code assemby-code-word\7f43,685
+: a-forth-word\7f50,870
+: (foo)\7f(foo)\ 155,988
+: foo\7f56,1000
+: create-bar\7f58,1015
+3 4 2constant 2const\7f61,1074
+2const 2value 2val\7f62,1095
+2variable 2var\7f63,1114
+3.1415e fconstant fconst\7f65,1130
+fconst fvalue fval\7f66,1155
+fvariable fvar\7f67,1174
+synonym mypi\7f69,1190
+BEGIN-STRUCTURE point\7f71,1211
+  1 CELLS +FIELD p.x\7f72,1262
+  1 CELLS +FIELD p.y\7f73,1318
 \f
 go-src/test.go,48
 package main\7f1,0

diff --git a/test/manual/etags/ETAGS.good_2 b/test/manual/etags/ETAGS.good_2
index a21717af75f3dc6b28d99a5e3e5abe78b8eb844f..170d8457d19ce71c7cd0a37129c77a2227b6c412 100644 (file)
--- a/test/manual/etags/ETAGS.good_2
+++ b/test/manual/etags/ETAGS.good_2
@@ -2880,19 +2880,32 @@ f-src/entry.strange,172
      & intensity1(\7f577,12231
        character*(*) function foo(\7f579,12307
 \f
-forth-src/test-forth.fth,408
-: a-forth-word \7f20,301
+forth-src/test-forth.fth,733
+: a-forth-word\7f20,301
 99 constant a-forth-constant!\7f22,343
 55 value a-forth-value?\7f23,373
 create :a-forth-dictionary-entry\7f24,397
 defer #a-defer-word\7f27,460
-: (another-forth-word)\7f(another-forth-word\ 129,481
+: (another-forth-word)\7f(another-forth-word)\ 129,481
    9   field   >field1\7f36,582
    5   field   >field2\7f37,605
 constant (a-forth-constant\7f(a-forth-constant\ 138,628
 2000 buffer: #some-storage\7f41,657
-code assemby-code-word \7f43,685
-: a-forth-word \7f50,870
+code assemby-code-word\7f43,685
+: a-forth-word\7f50,870
+: (foo)\7f(foo)\ 155,988
+: foo\7f56,1000
+: create-bar\7f58,1015
+3 4 2constant 2const\7f61,1074
+2const 2value 2val\7f62,1095
+2variable 2var\7f63,1114
+3.1415e fconstant fconst\7f65,1130
+fconst fvalue fval\7f66,1155
+fvariable fvar\7f67,1174
+synonym mypi\7f69,1190
+BEGIN-STRUCTURE point\7f71,1211
+  1 CELLS +FIELD p.x\7f72,1262
+  1 CELLS +FIELD p.y\7f73,1318
 \f
 go-src/test.go,48
 package main\7f1,0

diff --git a/test/manual/etags/ETAGS.good_3 b/test/manual/etags/ETAGS.good_3
index 33bf110687b32a41a9e333d6395b897a78b06fbc..1d75314a37f3577589518d2c2a1e98fdf6a1d4a5 100644 (file)
--- a/test/manual/etags/ETAGS.good_3
+++ b/test/manual/etags/ETAGS.good_3
@@ -2628,19 +2628,32 @@ f-src/entry.strange,172
      & intensity1(\7f577,12231
        character*(*) function foo(\7f579,12307
 \f
-forth-src/test-forth.fth,408
-: a-forth-word \7f20,301
+forth-src/test-forth.fth,733
+: a-forth-word\7f20,301
 99 constant a-forth-constant!\7f22,343
 55 value a-forth-value?\7f23,373
 create :a-forth-dictionary-entry\7f24,397
 defer #a-defer-word\7f27,460
-: (another-forth-word)\7f(another-forth-word\ 129,481
+: (another-forth-word)\7f(another-forth-word)\ 129,481
    9   field   >field1\7f36,582
    5   field   >field2\7f37,605
 constant (a-forth-constant\7f(a-forth-constant\ 138,628
 2000 buffer: #some-storage\7f41,657
-code assemby-code-word \7f43,685
-: a-forth-word \7f50,870
+code assemby-code-word\7f43,685
+: a-forth-word\7f50,870
+: (foo)\7f(foo)\ 155,988
+: foo\7f56,1000
+: create-bar\7f58,1015
+3 4 2constant 2const\7f61,1074
+2const 2value 2val\7f62,1095
+2variable 2var\7f63,1114
+3.1415e fconstant fconst\7f65,1130
+fconst fvalue fval\7f66,1155
+fvariable fvar\7f67,1174
+synonym mypi\7f69,1190
+BEGIN-STRUCTURE point\7f71,1211
+  1 CELLS +FIELD p.x\7f72,1262
+  1 CELLS +FIELD p.y\7f73,1318
 \f
 go-src/test.go,48
 package main\7f1,0

diff --git a/test/manual/etags/ETAGS.good_4 b/test/manual/etags/ETAGS.good_4
index 3d9d6266421186b89bb0366d2ed3638117945fdd..e74db284274aff2211a6ba013b33fc5c5515fc7a 100644 (file)
--- a/test/manual/etags/ETAGS.good_4
+++ b/test/manual/etags/ETAGS.good_4
@@ -2475,19 +2475,32 @@ f-src/entry.strange,172
      & intensity1(\7f577,12231
        character*(*) function foo(\7f579,12307
 \f
-forth-src/test-forth.fth,408
-: a-forth-word \7f20,301
+forth-src/test-forth.fth,733
+: a-forth-word\7f20,301
 99 constant a-forth-constant!\7f22,343
 55 value a-forth-value?\7f23,373
 create :a-forth-dictionary-entry\7f24,397
 defer #a-defer-word\7f27,460
-: (another-forth-word)\7f(another-forth-word\ 129,481
+: (another-forth-word)\7f(another-forth-word)\ 129,481
    9   field   >field1\7f36,582
    5   field   >field2\7f37,605
 constant (a-forth-constant\7f(a-forth-constant\ 138,628
 2000 buffer: #some-storage\7f41,657
-code assemby-code-word \7f43,685
-: a-forth-word \7f50,870
+code assemby-code-word\7f43,685
+: a-forth-word\7f50,870
+: (foo)\7f(foo)\ 155,988
+: foo\7f56,1000
+: create-bar\7f58,1015
+3 4 2constant 2const\7f61,1074
+2const 2value 2val\7f62,1095
+2variable 2var\7f63,1114
+3.1415e fconstant fconst\7f65,1130
+fconst fvalue fval\7f66,1155
+fvariable fvar\7f67,1174
+synonym mypi\7f69,1190
+BEGIN-STRUCTURE point\7f71,1211
+  1 CELLS +FIELD p.x\7f72,1262
+  1 CELLS +FIELD p.y\7f73,1318
 \f
 go-src/test.go,48
 package main\7f1,0

diff --git a/test/manual/etags/ETAGS.good_5 b/test/manual/etags/ETAGS.good_5
index 1dff76852121e27316068d696378fd85c9a16944..e278678b5471b6399912d629cf56b09f851be1b9 100644 (file)
--- a/test/manual/etags/ETAGS.good_5
+++ b/test/manual/etags/ETAGS.good_5
@@ -3361,19 +3361,32 @@ f-src/entry.strange,172
      & intensity1(\7f577,12231
        character*(*) function foo(\7f579,12307
 \f
-forth-src/test-forth.fth,408
-: a-forth-word \7f20,301
+forth-src/test-forth.fth,733
+: a-forth-word\7f20,301
 99 constant a-forth-constant!\7f22,343
 55 value a-forth-value?\7f23,373
 create :a-forth-dictionary-entry\7f24,397
 defer #a-defer-word\7f27,460
-: (another-forth-word)\7f(another-forth-word\ 129,481
+: (another-forth-word)\7f(another-forth-word)\ 129,481
    9   field   >field1\7f36,582
    5   field   >field2\7f37,605
 constant (a-forth-constant\7f(a-forth-constant\ 138,628
 2000 buffer: #some-storage\7f41,657
-code assemby-code-word \7f43,685
-: a-forth-word \7f50,870
+code assemby-code-word\7f43,685
+: a-forth-word\7f50,870
+: (foo)\7f(foo)\ 155,988
+: foo\7f56,1000
+: create-bar\7f58,1015
+3 4 2constant 2const\7f61,1074
+2const 2value 2val\7f62,1095
+2variable 2var\7f63,1114
+3.1415e fconstant fconst\7f65,1130
+fconst fvalue fval\7f66,1155
+fvariable fvar\7f67,1174
+synonym mypi\7f69,1190
+BEGIN-STRUCTURE point\7f71,1211
+  1 CELLS +FIELD p.x\7f72,1262
+  1 CELLS +FIELD p.y\7f73,1318
 \f
 go-src/test.go,48
 package main\7f1,0

diff --git a/test/manual/etags/ETAGS.good_6 b/test/manual/etags/ETAGS.good_6
index fdcbd57e7ef4dbf2c9fc41a8a7861b543443ada6..68e474d628520dbe337a045aa9f576432bd6f82b 100644 (file)
--- a/test/manual/etags/ETAGS.good_6
+++ b/test/manual/etags/ETAGS.good_6
@@ -3361,19 +3361,32 @@ f-src/entry.strange,172
      & intensity1(\7f577,12231
        character*(*) function foo(\7f579,12307
 \f
-forth-src/test-forth.fth,408
-: a-forth-word \7f20,301
+forth-src/test-forth.fth,733
+: a-forth-word\7f20,301
 99 constant a-forth-constant!\7f22,343
 55 value a-forth-value?\7f23,373
 create :a-forth-dictionary-entry\7f24,397
 defer #a-defer-word\7f27,460
-: (another-forth-word)\7f(another-forth-word\ 129,481
+: (another-forth-word)\7f(another-forth-word)\ 129,481
    9   field   >field1\7f36,582
    5   field   >field2\7f37,605
 constant (a-forth-constant\7f(a-forth-constant\ 138,628
 2000 buffer: #some-storage\7f41,657
-code assemby-code-word \7f43,685
-: a-forth-word \7f50,870
+code assemby-code-word\7f43,685
+: a-forth-word\7f50,870
+: (foo)\7f(foo)\ 155,988
+: foo\7f56,1000
+: create-bar\7f58,1015
+3 4 2constant 2const\7f61,1074
+2const 2value 2val\7f62,1095
+2variable 2var\7f63,1114
+3.1415e fconstant fconst\7f65,1130
+fconst fvalue fval\7f66,1155
+fvariable fvar\7f67,1174
+synonym mypi\7f69,1190
+BEGIN-STRUCTURE point\7f71,1211
+  1 CELLS +FIELD p.x\7f72,1262
+  1 CELLS +FIELD p.y\7f73,1318
 \f
 go-src/test.go,48
 package main\7f1,0

diff --git a/test/manual/etags/forth-src/test-forth.fth b/test/manual/etags/forth-src/test-forth.fth
index ce4069dfa8f6d53d7cf1d6626a944210dad049c3..4521d32fae4743e5bf8d280a5f457533e1ae61e9 100644 (file)
--- a/test/manual/etags/forth-src/test-forth.fth
+++ b/test/manual/etags/forth-src/test-forth.fth
@@ -51,3 +51,24 @@ c;
     a-forth-word dup 200 > abort" Eek.  The number is too big"
     ." Result is " . cr
 ;
+
+: (foo) 1 ;
+: foo (foo) ;
+
+: create-bar foo ;
+create-bar  \ Do NOT create a tag here
+
+3 4 2constant 2const
+2const 2value 2val
+2variable 2var
+
+3.1415e fconstant fconst
+fconst fvalue fval
+fvariable fvar
+
+synonym mypi fconst
+
+BEGIN-STRUCTURE point \ create the named structure
+  1 CELLS +FIELD p.x    \ A single cell filed named p.x
+  1 CELLS +FIELD p.y    \ A single cell field named p.y
+END-STRUCTURE