feature/pkg c95a7090fe: Reading qualified symbols

[Gerd Moellmann]

branch: feature/pkg
commit c95a7090feb32dd6c1611c98e64671708b40ee71
Author: Gerd Möllmann <gerd@gnu.org>
Commit: Gerd Möllmann <gerd@gnu.org>

    Reading qualified symbols
    
    * src/pkg.c (pkg_qualified_symbol): Intern x::y in x.
    * test/src/pkg-tests.el (pkg-tests-read): New.
---
 src/pkg.c             |  9 +++++++--
 test/src/pkg-tests.el | 27 +++++++++++++++++++++++++++
 2 files changed, 34 insertions(+), 2 deletions(-)

diff --git a/src/pkg.c b/src/pkg.c
index 7098ba2bb2..e14bd56418 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 875c1fbda8..bf85c710cf 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))