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 7098ba2bb22e24e212626defce420aa9b1dcc453..e14bd564186c1772319e4392c70e24dc20d2f6df 100644 (file)
--- 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 875c1fbda82350d02c1ecb12b57d9b035c20551a..bf85c710cf4d2130c9330cbcf8a722f538a783ef 100644 (file)
--- 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))