summaryrefslogtreecommitdiffstats
diff options
context:
space:
mode:
authorKaz Kylheku <kaz@kylheku.com>2021-10-12 00:42:16 -0700
committerKaz Kylheku <kaz@kylheku.com>2021-10-12 00:42:16 -0700
commitf2ba3dfc996bfcd67a723b23754e808276ab3b9f (patch)
tree8f9e81e66511ec5fe8d54eb59e66b1add696c25f
parent2034e70be87fa1635b7e5a445450c1777c16d2ba (diff)
downloadtxr-f2ba3dfc996bfcd67a723b23754e808276ab3b9f.tar.gz
txr-f2ba3dfc996bfcd67a723b23754e808276ab3b9f.tar.bz2
txr-f2ba3dfc996bfcd67a723b23754e808276ab3b9f.zip
printer: bug: fallback syms printed without prefix.
This is a basic read/print consistency problem. When a symbol is printed that is anywhere in the fallback list of the current package, we are dumping it unqualified, even if it is hidden by a same-named symbol in the current package itself or such a symbol occurring earlier in the fallback list. * lib.c (symbol_needs_prefix): When the to-be-printed symbol is found in the fallback list, re-scan the current package for a symbol having the same name, as well as the preceding nodes in the fallback list. If such a symbol is found, then the to-be printed symbol must be package-qualified. * tests/012/syms.expected: New file. * tests/012/syms.tl: Likewise. * tests/012/compile.tl: Pull syms into compile job. * txr.1: Clarify text about this. The existing text's only reasonable interpretation supports the behavior which this patch ensures (which is needed on grounds of read/print consistency) but the text lacks precision.
-rw-r--r--lib.c13
-rw-r--r--tests/012/compile.tl2
-rw-r--r--tests/012/syms.expected6
-rw-r--r--tests/012/syms.tl28
-rw-r--r--txr.18
5 files changed, 49 insertions, 8 deletions
diff --git a/lib.c b/lib.c
index cf2d6cf8..6b13be82 100644
--- a/lib.c
+++ b/lib.c
@@ -7015,6 +7015,7 @@ val symbol_needs_prefix(val self, val package, val sym)
{
val fallback = get_hash_userdata(package->pk.symhash);
+ val rescanfb = fallback;
for (; fallback; fallback = cdr(fallback)) {
val fb_pkg = car(fallback);
@@ -7024,11 +7025,17 @@ val symbol_needs_prefix(val self, val package, val sym)
val cell = gethash_e(self, fb_pkg->pk.symhash, name);
if (cell) {
int found_in_fallback = (eq(cdr(cell), sym) != nil);
- if (found_in_fallback)
- return nil;
- break;
+ if (!found_in_fallback)
+ break;
}
}
+ if (gethash_e(self, package->pk.symhash, name))
+ return sym_pkg->pk.name;
+ for (; rescanfb != fallback && rescanfb; rescanfb = cdr(rescanfb)) {
+ val fb_pkg = car(rescanfb);
+ if (gethash_e(self, fb_pkg->pk.symhash, name))
+ return sym_pkg->pk.name;
+ }
return nil;
} else {
if (gethash_e(self, fb_pkg->pk.symhash, name))
diff --git a/tests/012/compile.tl b/tests/012/compile.tl
index 58dcc275..d0c4913e 100644
--- a/tests/012/compile.tl
+++ b/tests/012/compile.tl
@@ -5,7 +5,7 @@
(each ((f '#"aseq ashwin circ cont defset except \
fini ifa man-or-boy oop-mi oop-seq oop \
- parse quasi quine seq stslot const"))
+ parse syms quasi quine seq stslot const"))
(let ((exf `@{%this-dir%}/@f.expected`))
(when (path-exists-p exf)
(file-append-string %expected-file%
diff --git a/tests/012/syms.expected b/tests/012/syms.expected
new file mode 100644
index 00000000..bfe9f694
--- /dev/null
+++ b/tests/012/syms.expected
@@ -0,0 +1,6 @@
+(loc-0 loc-1 loc-2 cons)
+(loc-0 loc-1 loc-2 cons)
+(fb-2:loc-0 fb-2:loc-1 loc-2 cons)
+(loc-0 loc-1 loc-2 cons)
+(fb-2:loc-0 fb-2:loc-1 loc-2 cons)
+(fb-1:loc-0 loc-1 loc-2 cons)
diff --git a/tests/012/syms.tl b/tests/012/syms.tl
new file mode 100644
index 00000000..007125e2
--- /dev/null
+++ b/tests/012/syms.tl
@@ -0,0 +1,28 @@
+(load "../common")
+
+(defpackage fb-2
+ (:local loc-0 loc-1 loc-2)
+ (:fallback usr))
+
+(defpackage fb-1
+ (:local loc-0 loc-1)
+ (:fallback fb-2 usr))
+
+(defpackage main
+ (:local loc-0)
+ (:fallback fb-1 fb-2 usr))
+
+(in-package fb-2)
+
+(prinl '(loc-0 loc-1 loc-2 cons))
+
+(in-package fb-1)
+
+(prinl '(loc-0 loc-1 loc-2 cons))
+(prinl '(fb-2:loc-0 fb-2:loc-1 fb-2:loc-2 fb-2:cons))
+
+(in-package main)
+
+(prinl '(loc-0 loc-1 loc-2 cons))
+(prinl '(fb-2:loc-0 fb-2:loc-1 fb-2:loc-2 fb-2:cons))
+(prinl '(fb-1:loc-0 fb-1:loc-1 fb-1:loc-2 fb-1:cons))
diff --git a/txr.1 b/txr.1
index 5d285a5c..e88765d1 100644
--- a/txr.1
+++ b/txr.1
@@ -61465,10 +61465,10 @@ recursion takes place.
The printer situation involving the fallback list is as follows.
If a symbol is being printed in a machine-readable way (not "pretty"),
has a home package and is not a keyword symbol, then a search takes place
-through the current package and its fallback list. If the symbol is found
-in any of those places, and if those places are devoid of any symbols
-which have the same name, thus causing ambiguity, then the symbol is printed
-without a package prefix.
+through the current package first and then its fallback list. If the symbol is
+found anywhere in that sequence of locations, and is not occluded by a
+same-named symbol occurring earlier in that sequence, then the symbol is
+printed without a package prefix.
The listener situation involving the fallback list is a follows.
When tab completion is used on a symbol without a package