Skip to content

Commit 1e8fb8f

Browse files
foguspuredanger
fogus
authored and
puredanger
committed
CLJ-2711: Implements namespace interning policy such that whenever interned vars (i.e. a mapping of sym => #'ns/sym in namespace ns) are defined, they cannot ever be replaced via refer or intern. Any attempt to replace interened vars will result in a warning and recommendation to use ns-unmap first.
1 parent 48e3292 commit 1e8fb8f

2 files changed

Lines changed: 74 additions & 44 deletions

File tree

‎src/jvm/clojure/lang/Namespace.java‎

Lines changed: 53 additions & 22 deletions
Original file line numberDiff line numberDiff line change
@@ -50,11 +50,22 @@ public IPersistentMap getMappings(){
5050
return mappings.get();
5151
}
5252

53+
/**
54+
* An interned mapping is one where a var's ns matches the current ns and its sym matches the mapping key.
55+
* Once established, interned mappings should never change.
56+
*/
57+
private boolean isInternedMapping(Symbol sym, Object o){
58+
return(o instanceof Var &&
59+
((Var) o).ns == this &&
60+
((Var) o).sym.equals(sym));
61+
}
62+
5363
public Var intern(Symbol sym){
5464
if(sym.ns != null)
5565
{
5666
throw new IllegalArgumentException("Can't intern namespace-qualified symbol");
5767
}
68+
5869
IPersistentMap map = getMappings();
5970
Object o;
6071
Var v = null;
@@ -66,39 +77,58 @@ public Var intern(Symbol sym){
6677
mappings.compareAndSet(map, newMap);
6778
map = getMappings();
6879
}
69-
if(o instanceof Var && ((Var) o).ns == this)
80+
if(isInternedMapping(sym, o))
7081
return (Var) o;
7182

7283
if(v == null)
7384
v = new Var(this, sym);
7485

75-
warnOrFailOnReplace(sym, o, v);
76-
86+
if(checkReplacement(sym, o, v)){
87+
while (!mappings.compareAndSet(map, map.assoc(sym, v)))
88+
map = getMappings();
7789

78-
while(!mappings.compareAndSet(map, map.assoc(sym, v)))
79-
map = getMappings();
90+
return v;
91+
}
8092

81-
return v;
93+
return (Var) o;
8294
}
8395

84-
private void warnOrFailOnReplace(Symbol sym, Object o, Object v){
85-
if (o instanceof Var)
86-
{
87-
Namespace ns = ((Var)o).ns;
88-
if (ns == this || (v instanceof Var && ((Var)v).ns == RT.CLOJURE_NS))
89-
return;
90-
if (ns != RT.CLOJURE_NS)
91-
throw new IllegalStateException(sym + " already refers to: " + o + " in namespace: " + name);
92-
}
93-
RT.errPrintWriter().println("WARNING: " + sym + " already refers to: " + o + " in namespace: " + name
94-
+ ", being replaced by: " + v);
96+
/*
97+
This method checks if a namespace's mapping is applicable and warns on problematic cases.
98+
It will return a boolean indicating if a mapping is replaceable.
99+
The semantics of what constitutes a legal replacement mapping is summarized as follows:
100+
101+
| classification | in namespace ns | newval = anything other than ns/name | newval = ns/name |
102+
|----------------+------------------------+--------------------------------------+-------------------------------------|
103+
| native mapping | name -> ns/name | no replace, warn-if newval not-core | no replace, warn-if newval not-core |
104+
| alias mapping | name -> other/whatever | warn + replace | warn + replace |
105+
*/
106+
private boolean checkReplacement(Symbol sym, Object old, Object neu){
107+
if(old instanceof Var) {
108+
Namespace ons = ((Var)old).ns;
109+
Namespace nns = neu instanceof Var ? ((Var) neu).ns : null;
110+
111+
if(isInternedMapping(sym, old)){
112+
if(nns != RT.CLOJURE_NS){
113+
RT.errPrintWriter().println("REJECTED: attempt to replace interned var "
114+
+ old + " with " + neu + " in " + name + ", you must ns-unmap first");
115+
return false;
116+
}
117+
else
118+
return false;
119+
}
120+
}
121+
RT.errPrintWriter().println("WARNING: " + sym + " already refers to: " + old + " in namespace: " + name
122+
+ ", being replaced by: " + neu);
123+
return true;
95124
}
96125

97126
Object reference(Symbol sym, Object val){
98127
if(sym.ns != null)
99128
{
100129
throw new IllegalArgumentException("Can't intern namespace-qualified symbol");
101130
}
131+
102132
IPersistentMap map = getMappings();
103133
Object o;
104134
while((o = map.valAt(sym)) == null)
@@ -110,13 +140,14 @@ Object reference(Symbol sym, Object val){
110140
if(o == val)
111141
return o;
112142

113-
warnOrFailOnReplace(sym, o, val);
114-
115-
while(!mappings.compareAndSet(map, map.assoc(sym, val)))
116-
map = getMappings();
143+
if(checkReplacement(sym, o, val)){
144+
while (!mappings.compareAndSet(map, map.assoc(sym, val)))
145+
map = getMappings();
117146

118-
return val;
147+
return val;
148+
}
119149

150+
return o;
120151
}
121152

122153
public static boolean areDifferentInstancesOfSameClassName(Class cls1, Class cls2) {

‎test/clojure/test_clojure/rt.clj‎

Lines changed: 21 additions & 22 deletions
Original file line numberDiff line numberDiff line change
@@ -9,7 +9,8 @@
99
; Author: Stuart Halloway
1010

1111
(ns clojure.test-clojure.rt
12-
(:require clojure.set)
12+
(:require [clojure.string :as string]
13+
clojure.set)
1314
(:use clojure.test clojure.test-helper))
1415

1516
(defn bare-rt-print
@@ -75,31 +76,29 @@
7576
(.bindRoot #'example-var 0)
7677
(is (not (contains? (meta #'example-var) :macro))))
7778

78-
(deftest last-var-wins-for-core
79+
(deftest ns-intern-policies
7980
(testing "you can replace a core name, with warning"
8081
(let [ns (temp-ns)
81-
replacement (gensym)]
82-
(with-err-string-writer (intern ns 'prefers replacement))
82+
replacement (gensym)
83+
e1 (with-err-string-writer (intern ns 'prefers replacement))]
84+
(is (string/starts-with? e1 "WARNING"))
8385
(is (= replacement @('prefers (ns-publics ns))))))
84-
(testing "you can replace a name you defined before"
86+
(testing "you can replace a defined alias"
8587
(let [ns (temp-ns)
8688
s (gensym)
8789
v1 (intern ns 'foo s)
88-
v2 (intern ns 'bar s)]
89-
(with-err-string-writer (.refer ns 'flatten v1))
90-
(.refer ns 'flatten v2)
90+
v2 (intern ns 'bar s)
91+
e1 (with-err-string-writer (.refer ns 'flatten v1))
92+
e2 (with-err-string-writer (.refer ns 'flatten v2))]
93+
(is (string/starts-with? e1 "WARNING"))
94+
(is (string/starts-with? e2 "WARNING"))
9195
(is (= v2 (ns-resolve ns 'flatten)))))
92-
(testing "you cannot intern over an existing non-core name"
93-
(let [ns (temp-ns 'clojure.set)
94-
replacement (gensym)]
95-
(is (thrown? IllegalStateException
96-
(intern ns 'subset? replacement)))
97-
(is (nil? ('subset? (ns-publics ns))))
98-
(is (= #'clojure.set/subset? ('subset? (ns-refers ns))))))
99-
(testing "you cannot refer over an existing non-core name"
100-
(let [ns (temp-ns 'clojure.set)
101-
replacement (gensym)]
102-
(is (thrown? IllegalStateException
103-
(.refer ns 'subset? #'clojure.set/intersection)))
104-
(is (nil? ('subset? (ns-publics ns))))
105-
(is (= #'clojure.set/subset? ('subset? (ns-refers ns)))))))
96+
(testing "you cannot replace an interned var"
97+
(let [ns1 (temp-ns)
98+
ns2 (temp-ns)
99+
v1 (intern ns1 'foo 1)
100+
v2 (intern ns2 'foo 2)
101+
e1 (with-err-string-writer (.refer ns1 'foo v2))]
102+
(is (string/starts-with? e1 "REJECTED"))
103+
(is (= v1 (ns-resolve ns1 'foo))))))
104+

0 commit comments

Comments
 (0)