Speed up unintern, and fix symbol shorthand edge case (bug#79035)

Don't do a full lookup if the argument is a symbol, and only compute the
hash index once.  Fix a bug that occurred when there is another symbol
whose shorthand is equal to the true name of the symbol being removed.

* src/lread.c (Funintern): Rewrite for speed and correctness.
(oblookup_last_bucket_number, oblookup): Remove now unused variable.
* test/src/lread-tests.el (lread-unintern): New test.

1 files changed, 77 insertions, 0 deletions

diff --git a/test/src/lread-tests.el b/test/src/lread-tests.el
index d9b31a6c438..51c93b38e4f 100644
--- a/test/src/lread-tests.el
+++ b/test/src/lread-tests.el
@@ -398,4 +398,81 @@ literals (Bug#20852)."
     (should (equal val "a\xff"))        ; not "aÿ"
     (should-not (multibyte-string-p val))))
 
+(ert-deftest lread-unintern ()
+  (cl-flet ((oa-syms (oa) (let ((syms nil))
+                            (mapatoms (lambda (s) (push s syms)) oa)
+                            (sort syms))))
+    (let* ((oa (obarray-make))
+           (s1 (intern "abc" oa))
+           (s2 (intern "def" oa)))
+      (should-not (eq s1 'abc))
+      (should (eq (unintern "xyz" oa) nil))
+      (should (eq (unintern 'abc oa) nil))
+      (should (eq (unintern 'xyz oa) nil))
+      (should (equal (oa-syms oa) (list s1 s2)))
+      (should (eq (intern-soft "abc" oa) s1))
+      (should (eq (intern-soft "def" oa) s2))
+
+      (should (eq (unintern "abc" oa) t))
+      (should-not (intern-soft "abc" oa))
+      (should (eq (intern-soft "def" oa) s2))
+      (should (equal (oa-syms oa) (list s2)))
+
+      (should (eq (unintern s2 oa) t))
+      (should-not (intern-soft "def" oa))
+      (should (eq (oa-syms oa) nil)))
+
+    ;; with shorthand
+    (let* ((oa (obarray-make))
+           (read-symbol-shorthands '(("a·" . "ZZ•")))
+           (s1 (intern "a·abc" oa))
+           (s2 (intern "a·def" oa))
+           (s3 (intern "a·ghi" oa)))
+      (should (equal (oa-syms oa) (list s1 s2 s3)))
+      (should (equal (symbol-name s1) "ZZ•abc"))
+      (should (eq (intern-soft "ZZ•abc" oa) s1))
+      (should (eq (intern-soft "a·abc" oa) s1))
+      (should (eq (intern-soft "ZZ•def" oa) s2))
+      (should (eq (intern-soft "a·def" oa) s2))
+      (should (eq (intern-soft "ZZ•ghi" oa) s3))
+      (should (eq (intern-soft "a·ghi" oa) s3))
+
+      ;; unintern using long name
+      (should (eq (unintern "ZZ•abc" oa) t))
+      (should-not (intern-soft "ZZ•abc" oa))
+      (should-not (intern-soft "a·abc" oa))
+      (should (equal (oa-syms oa) (list s2 s3)))
+      (should (eq (intern-soft "ZZ•def" oa) s2))
+      (should (eq (intern-soft "a·def" oa) s2))
+      (should (eq (intern-soft "ZZ•ghi" oa) s3))
+      (should (eq (intern-soft "a·ghi" oa) s3))
+
+      ;; unintern using short name
+      (should (eq (unintern "a·def" oa) t))
+      (should-not (intern-soft "ZZ•def" oa))
+      (should-not (intern-soft "a·def" oa))
+      (should (equal (oa-syms oa) (list s3)))
+      (should (eq (intern-soft "ZZ•ghi" oa) s3))
+      (should (eq (intern-soft "a·ghi" oa) s3))
+
+      ;; unintern using symbol
+      (should (eq (unintern s3 oa) t))
+      (should-not (intern-soft "ZZ•ghi" oa))
+      (should-not (intern-soft "a·ghi" oa))
+      (should (eq (oa-syms oa) nil)))
+
+    ;; edge case: a symbol whose true name is another's shorthand
+    (let* ((oa (obarray-make))
+           (s1 (intern "a·abc" oa))
+           (read-symbol-shorthands '(("a·" . "ZZ•")))
+           (s2 (intern "a·abc" oa)))
+      (should (equal (oa-syms oa) (list s2 s1)))
+      (should (equal (symbol-name s1) "a·abc"))
+      (should (equal (symbol-name s2) "ZZ•abc"))
+
+      ;; unintern by symbol
+      (should (eq (unintern s1 oa) t))
+      (should (equal (oa-syms oa) (list s2))))
+    ))
+
 ;;; lread-tests.el ends here