From: Gerd Möllmann <gerd@gnu.org>
Date: Wed, 26 Oct 2022 12:36:37 +0000 (+0200)
Subject: Reading qualified symbols
X-Git-Url: http://git.eshelyaron.com/gitweb/?a=commitdiff_plain;h=c95a7090feb32dd6c1611c98e64671708b40ee71;p=emacs.git

Reading qualified symbols

* src/pkg.c (pkg_qualified_symbol): Intern x::y in x.
* test/src/pkg-tests.el (pkg-tests-read): New.
---

diff --git a/src/pkg.c b/src/pkg.c
index 7098ba2bb22..e14bd564186 100644
--- a/src/pkg.c
+++ b/src/pkg.c
@@ -650,8 +650,13 @@ pkg_qualified_symbol (Lisp_Object name, Lisp_Object package, bool external)
     }
 
   if (EQ (found, Qunbound))
-    pkg_error ("Symbol '%s' is not accessible in package '%s'",
-	       SDATA (name), SDATA (PACKAGE_NAMEX (package)));
+    {
+      if (external)
+	pkg_error ("Symbol '%s' is not accessible in package '%s'",
+		   SDATA (name), SDATA (PACKAGE_NAMEX (package)));
+      /* Access with x::y. intern y into x.  */
+      return pkg_intern_symbol (name, package, NULL);
+    }
 
   /* Check if the symbol is accesible in the package as external
      symbol.  PKG-FIXME: Check what to do for inherited symbols.  */
diff --git a/test/src/pkg-tests.el b/test/src/pkg-tests.el
index 875c1fbda82..bf85c710cf4 100644
--- a/test/src/pkg-tests.el
+++ b/test/src/pkg-tests.el
@@ -82,6 +82,33 @@
           (should (eq (find-package "y") p)))
       (delete-package p))))
 
+(ert-deftest pkg-tests-read ()
+  (with-packages ((x :register t))
+    (let* ((package-prefixes nil)
+           (sym (read "x::y")))
+      (should (symbolp sym))
+      (should (equal (symbol-name sym) "x::y"))
+      (should (eq (symbol-package sym) *emacs-package*))
+
+      (setq sym (read ":b"))
+      (should (keywordp sym))
+      (should (equal (cl-symbol-name sym) "b"))
+      (should (equal (symbol-name sym) ":b"))
+      (should (eq (symbol-package sym) *keyword-package*))))
+
+  (with-packages ((x :register t))
+    (let* ((package-prefixes t)
+           (sym (read "x::y")))
+      (should (symbolp sym))
+      (should (equal (symbol-name sym) "y"))
+      (should (eq (symbol-package sym) x))
+
+      (setq sym (read ":a"))
+      (should (keywordp sym))
+      (should (equal (cl-symbol-name sym) "a"))
+      (should (equal (symbol-name sym) ":a"))
+      (should (eq (symbol-package sym) *keyword-package*)))))
+
 (ert-deftest pkg-tests-make-package-nicknames ()
   ;; Valid nicknames
   (dolist (nickname '("a" b ?c))