By default, etags produces unqualified Perl tag names

* lib-src/etags.c (Perl_functions): Produce unqualified names,
unless -Q was specified.
(print_help): Update the description of -Q.

* doc/man/etags.1: Update the documentation of -Q.

* test/etags/ETAGS.good_1:
* test/etags/ETAGS.good_2:
* test/etags/ETAGS.good_3:
* test/etags/ETAGS.good_4:
* test/etags/ETAGS.good_5:
* test/etags/CTAGS.good: Adapt the expected test results to the
changed Perl functionality.

1 files changed, 21 insertions, 6 deletions

diff --git a/lib-src/etags.c b/lib-src/etags.c
index 182cb4cc876..e8e15769606 100644
--- a/lib-src/etags.c
+++ b/lib-src/etags.c
@@ -971,11 +971,12 @@ Relative ones are stored relative to the output file's directory.\n");
         in some languages.");
 
   puts ("-Q, --class-qualify\n\
-        Qualify tag names with their class name in C++, ObjC, and Java.\n\
+        Qualify tag names with their class name in C++, ObjC, Java, and Perl.\n\
         This produces tag names of the form \"class::member\" for C++,\n\
         \"class(category)\" for Objective C, and \"class.member\" for Java.\n\
         For Objective C, this also produces class methods qualified with\n\
-        their arguments, as in \"foo:bar:baz:more\".");
+        their arguments, as in \"foo:bar:baz:more\".\n\
+        For Perl, this produces \"package::member\".");
   puts ("-r REGEXP, --regex=REGEXP or --regex=@regexfile\n\
         Make a tag for each line matching a regular expression pattern\n\
         in the following files.  {LANGUAGE}REGEXP uses REGEXP for LANGUAGE\n\
@@ -4534,10 +4535,21 @@ Perl_functions (FILE *inf)
             continue;           /* nothing found */
           pos = strchr (sp, ':');
           if (pos && pos < cp && pos[1] == ':')
-            /* The name is already qualified. */
-            make_tag (sp, cp - sp, true,
-                      lb.buffer, cp - lb.buffer + 1, lineno, linecharno);
-          else
+            {
+              /* The name is already qualified. */
+              if (!class_qualify)
+                {
+                  char *q = pos + 2, *qpos;
+                  while ((qpos = strchr (q, ':')) != NULL
+                         && qpos < cp
+                         && qpos[1] == ':')
+                    q = qpos + 2;
+                  sp = q;
+                }
+              make_tag (sp, cp - sp, true,
+                        lb.buffer, cp - lb.buffer + 1, lineno, linecharno);
+            }
+          else if (class_qualify)
             /* Qualify it. */
             {
               char savechar, *name;
@@ -4550,6 +4562,9 @@ Perl_functions (FILE *inf)
                         lb.buffer, cp - lb.buffer + 1, lineno, linecharno);
               free (name);
             }
+          else
+            make_tag (sp, cp - sp, true,
+                      lb.buffer, cp - lb.buffer + 1, lineno, linecharno);
         }
       else if (LOOKING_AT (cp, "use constant")
                || LOOKING_AT (cp, "use constant::defer"))