Allow specifying the expected number of shift/reduce conflicts

* admin/grammars/grammar.wy: Add %expectedconflicts.

* lisp/cedet/semantic/grammar-wy.el
(semantic-grammar-wy--keyword-table): Ditto.

* lisp/cedet/semantic/grammar.el
(semantic-grammar-expected-conflicts): New function.
(semantic-grammar-insert-defconst-with-eval): New function.
(semantic-grammar-create-package): Output the number of expected
shift/reduce conflicts.

* lisp/cedet/semantic/wisent/comp.el (wisent-total-conflicts):
Don't output the warning if the number of shift/reduce conflicts
is expected.
(wisent-expected-conflicts): Made obsolete.

5 files changed, 57 insertions, 16 deletions

diff --git a/admin/grammars/grammar.wy b/admin/grammars/grammar.wy
index 5b06917d7db..81fd1b0b79c 100644
--- a/admin/grammars/grammar.wy
+++ b/admin/grammars/grammar.wy
@@ -52,6 +52,7 @@
 %keyword LEFT            "%left"
 %keyword NONASSOC        "%nonassoc"
 %keyword PACKAGE         "%package"
+%keyword EXPECTEDCONFLICTS "%expectedconflicts"
 %keyword PROVIDE         "%provide"
 %keyword PREC            "%prec"
 %keyword PUT             "%put"
@@ -135,6 +136,7 @@ decl:
   | no_default_prec_decl
   | languagemode_decl
   | package_decl
+  | expectedconflicts_decl
   | provide_decl
   | precedence_decl
   | put_decl
@@ -167,6 +169,11 @@ package_decl:
     `(PACKAGE-TAG ',$2 nil)
   ;
 
+expectedconflicts_decl:
+    EXPECTEDCONFLICTS symbols
+    `(TAG ',(car $2) 'expectedconflicts :rest ',(cdr $2))
+  ;
+
 provide_decl:
     PROVIDE SYMBOL
     `(TAG ',$2 'provide)
diff --git a/admin/grammars/python.wy b/admin/grammars/python.wy
index 082850df59c..0e926ad3636 100644
--- a/admin/grammars/python.wy
+++ b/admin/grammars/python.wy
@@ -88,6 +88,7 @@
 
 %package wisent-python-wy
 %provide semantic/wisent/python-wy
+%expectedconflicts 4
 
 %{
 (declare-function wisent-python-reconstitute-function-tag
diff --git a/lisp/cedet/semantic/grammar-wy.el b/lisp/cedet/semantic/grammar-wy.el
index cc5942fa323..b5066d3d27b 100644
--- a/lisp/cedet/semantic/grammar-wy.el
+++ b/lisp/cedet/semantic/grammar-wy.el
@@ -41,6 +41,7 @@
    '(("%default-prec" . DEFAULT-PREC)
      ("%no-default-prec" . NO-DEFAULT-PREC)
      ("%keyword" . KEYWORD)
+     ("%expectedconflicts" . EXPECTEDCONFLICTS)
      ("%languagemode" . LANGUAGEMODE)
      ("%left" . LEFT)
      ("%nonassoc" . NONASSOC)
@@ -110,7 +111,7 @@
     (eval-when-compile
       (require 'semantic/wisent/comp))
     (wisent-compile-grammar
-     '((DEFAULT-PREC NO-DEFAULT-PREC KEYWORD LANGUAGEMODE LEFT NONASSOC PACKAGE PROVIDE PREC PUT QUOTEMODE RIGHT SCOPESTART START TOKEN TYPE USE-MACROS STRING SYMBOL PERCENT_PERCENT CHARACTER PREFIXED_LIST SEXP PROLOGUE EPILOGUE PAREN_BLOCK BRACE_BLOCK LPAREN RPAREN LBRACE RBRACE COLON SEMI OR LT GT)
+     '((DEFAULT-PREC NO-DEFAULT-PREC KEYWORD LANGUAGEMODE EXPECTEDCONFLICTS LEFT NONASSOC PACKAGE PROVIDE PREC PUT QUOTEMODE RIGHT SCOPESTART START TOKEN TYPE USE-MACROS STRING SYMBOL PERCENT_PERCENT CHARACTER PREFIXED_LIST SEXP PROLOGUE EPILOGUE PAREN_BLOCK BRACE_BLOCK LPAREN RPAREN LBRACE RBRACE COLON SEMI OR LT GT)
        nil
        (grammar
         ((prologue))
@@ -133,6 +134,7 @@
         ((default_prec_decl))
         ((no_default_prec_decl))
         ((languagemode_decl))
+        ((expectedconflicts_decl))
         ((package_decl))
         ((provide_decl))
         ((precedence_decl))
@@ -159,6 +161,11 @@
          `(wisent-raw-tag
            (semantic-tag ',(car $2)
                          'languagemode :rest ',(cdr $2)))))
+       (expectedconflicts_decl
+        ((EXPECTEDCONFLICTS symbols)
+         `(wisent-raw-tag
+           (semantic-tag ',(car $2)
+                         'expectedconflicts :rest ',(cdr $2)))))
        (package_decl
         ((PACKAGE SYMBOL)
          `(wisent-raw-tag
diff --git a/lisp/cedet/semantic/grammar.el b/lisp/cedet/semantic/grammar.el
index 8ffa4c6d83e..3c35583dd3c 100644
--- a/lisp/cedet/semantic/grammar.el
+++ b/lisp/cedet/semantic/grammar.el
@@ -277,6 +277,10 @@ foo.by it is foo-by."
              (i    (string-match (format "\\([.]\\)%s\\'" ext) file)))
         (concat (substring file 0 i) "-" ext))))
 
+(defun semantic-grammar-expected-conflicts ()
+  "Return the number of expected shift/reduce conflicts in the package."
+  (semantic-grammar-tag-symbols 'expectedconflicts))
+
 (defsubst semantic-grammar-languagemode ()
   "Return the %languagemode value as a list of symbols or nil."
   (semantic-grammar-tag-symbols 'languagemode))
@@ -533,6 +537,14 @@ Also load the specified macro libraries."
       (goto-char start)
       (indent-sexp))))
 
+(defun semantic-grammar-insert-defconst-with-eval (name value docstring)
+  "Insert declaration of constant NAME with VALUE and DOCSTRING."
+  (let ((start (point)))
+    (insert (format "(eval-and-compile (defconst %s\n%s%S))\n\n" name value docstring))
+    (save-excursion
+      (goto-char start)
+      (indent-sexp))))
+
 (defun semantic-grammar-insert-defun (name body docstring)
   "Insert declaration of function NAME with BODY and DOCSTRING."
   (let ((start (point)))
@@ -890,6 +902,12 @@ Lisp code."
 
         (insert "\n;;; Declarations\n;;\n")
 
+        (semantic-grammar-insert-defconst-with-eval
+         (concat semantic--grammar-package "--expected-conflicts")
+         (with-current-buffer semantic--grammar-input-buffer
+           (format "%s\n" (car (semantic-grammar-expected-conflicts))))
+         "The number of expected shift/reduce conflicts in this grammar.")
+
         ;; `eval-defun' is not necessary to reset `defconst' values.
         (semantic-grammar-insert-defconst
          (semantic-grammar-keywordtable)
@@ -987,7 +1005,7 @@ Return non-nil if there were no errors, nil if errors."
                        (vc-handled-backends nil))
                    (setq semanticdb-new-database-class 'semanticdb-project-database)
                    (semantic-mode 1)
-                   (semantic-grammar-create-package)))
+                   (semantic-grammar-create-package t)))
              (error
               (message "%s" (error-message-string err))
               nil))))
diff --git a/lisp/cedet/semantic/wisent/comp.el b/lisp/cedet/semantic/wisent/comp.el
index 051b898ed78..4e222fa70eb 100644
--- a/lisp/cedet/semantic/wisent/comp.el
+++ b/lisp/cedet/semantic/wisent/comp.el
@@ -2263,26 +2263,34 @@ warning is given if there are either more or fewer conflicts, or if
 there are any reduce/reduce conflicts."
   :group 'wisent
   :type '(choice (const nil) integer))
+(make-obsolete-variable 'wisent-expected-conflicts
+                        "use %expectedconflicts in the .wy file instead"
+                        "27.1")
 
 (defun wisent-total-conflicts ()
   "Report the total number of conflicts."
-  (unless (and (zerop rrc-total)
-               (or (zerop src-total)
-                   (= src-total (or wisent-expected-conflicts 0))))
-    (let* ((src (wisent-source))
-           (src (if src (concat " in " src) ""))
-           (msg (format "Grammar%s contains" src)))
-      (if (> src-total 0)
+  (let* ((src (wisent-source))
+         (symbol (intern (format "wisent-%s--expected-conflicts"
+                                 (replace-regexp-in-string "\\.el$" "" src))
+                         obarray)))
+    (when (or (not (zerop rrc-total))
+              (and (not (zerop src-total))
+                   (not (= src-total (or wisent-expected-conflicts 0)))
+                   (or (not (boundp symbol))
+                       (not (equal (symbol-value symbol) src-total)))))
+      (let* ((src (if src (concat " in " src) ""))
+             (msg (format "Grammar%s contains" src)))
+        (when (and (> src-total 0))
           (setq msg (format "%s %d shift/reduce conflict%s"
                             msg src-total (if (> src-total 1)
                                               "s" ""))))
-      (if (and (> src-total 0) (> rrc-total 0))
-          (setq msg (format "%s and" msg)))
-      (if (> rrc-total 0)
-        (setq msg (format "%s %d reduce/reduce conflict%s"
-                          msg rrc-total (if (> rrc-total 1)
-                                            "s" ""))))
-      (message msg))))
+        (if (and (> src-total 0) (> rrc-total 0))
+            (setq msg (format "%s and" msg)))
+        (if (> rrc-total 0)
+            (setq msg (format "%s %d reduce/reduce conflict%s"
+                              msg rrc-total (if (> rrc-total 1)
+                                                "s" ""))))
+        (message msg)))))
 
 (defun wisent-print-conflicts ()
   "Report conflicts."