Skip to content

Commit c8e248d

Browse files
bronsastuarthalloway
bronsa
authored and
stuarthalloway
committed
CLJ-1208: load own namespace in deftype/defrecord class initializer when :load-ns is true
Signed-off-by: Stuart Halloway <[email protected]>
1 parent 52e623a commit c8e248d

6 files changed

Lines changed: 54 additions & 14 deletions

File tree

‎build.xml‎

Lines changed: 3 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -95,6 +95,7 @@
9595
<!--<sysproperty key="clojure.compiler.disable-locals-clearing" value="true"/>-->
9696
<arg value="clojure.test-clojure.protocols.examples"/>
9797
<arg value="clojure.test-clojure.genclass.examples"/>
98+
<arg value="clojure.test-clojure.compilation.load-ns"/>
9899
<arg value="clojure.test-clojure.annotations"/>
99100
</java>
100101
</target>
@@ -104,6 +105,8 @@
104105
depends="compile-tests"
105106
unless="maven.test.skip">
106107
<java classname="clojure.main" failonerror="true" fork="true">
108+
<sysproperty key="clojure.test-clojure.exclude-namespaces"
109+
value="#{clojure.test-clojure.compilation.load-ns}"/>
107110
<classpath>
108111
<pathelement path="${maven.test.classpath}"/>
109112
<path location="${test-classes}"/>

‎src/clj/clojure/core_deftype.clj‎

Lines changed: 11 additions & 9 deletions
Original file line numberDiff line numberDiff line change
@@ -63,7 +63,7 @@
6363
methods (map (fn [[name params & body]]
6464
(cons name (maybe-destructured params body)))
6565
(apply concat (vals impls)))]
66-
(when-let [bad-opts (seq (remove #{:no-print} (keys opts)))]
66+
(when-let [bad-opts (seq (remove #{:no-print :load-ns} (keys opts)))]
6767
(throw (IllegalArgumentException. (apply print-str "Unsupported option(s) -" bad-opts))))
6868
[interfaces methods opts]))
6969

@@ -148,8 +148,8 @@
148148
(defn- emit-defrecord
149149
"Do not use this directly - use defrecord"
150150
{:added "1.2"}
151-
[tagname name fields interfaces methods]
152-
(let [classname (with-meta (symbol (str (namespace-munge *ns*) "." name)) (meta name))
151+
[tagname cname fields interfaces methods opts]
152+
(let [classname (with-meta (symbol (str (namespace-munge *ns*) "." cname)) (meta cname))
153153
interfaces (vec interfaces)
154154
interface-set (set (map resolve interfaces))
155155
methodname-set (set (map first methods))
@@ -243,8 +243,9 @@
243243
`(entrySet [this#] (set this#)))])
244244
]
245245
(let [[i m] (-> [interfaces methods] irecord eqhash iobj ilookup imap ijavamap)]
246-
`(deftype* ~tagname ~classname ~(conj hinted-fields '__meta '__extmap)
246+
`(deftype* ~(symbol (name (ns-name *ns*)) (name tagname)) ~classname ~(conj hinted-fields '__meta '__extmap)
247247
:implements ~(vec i)
248+
~@(mapcat identity opts)
248249
~@m))))))
249250

250251
(defn- build-positional-factory
@@ -372,7 +373,7 @@
372373
`(let []
373374
(declare ~(symbol (str '-> gname)))
374375
(declare ~(symbol (str 'map-> gname)))
375-
~(emit-defrecord name gname (vec hinted-fields) (vec interfaces) methods)
376+
~(emit-defrecord name gname (vec hinted-fields) (vec interfaces) methods opts)
376377
(import ~classname)
377378
~(build-positional-factory gname classname fields)
378379
(defn ~(symbol (str 'map-> gname))
@@ -390,11 +391,12 @@
390391

391392
(defn- emit-deftype*
392393
"Do not use this directly - use deftype"
393-
[tagname name fields interfaces methods]
394-
(let [classname (with-meta (symbol (str (namespace-munge *ns*) "." name)) (meta name))
394+
[tagname cname fields interfaces methods opts]
395+
(let [classname (with-meta (symbol (str (namespace-munge *ns*) "." cname)) (meta cname))
395396
interfaces (conj interfaces 'clojure.lang.IType)]
396-
`(deftype* ~tagname ~classname ~fields
397+
`(deftype* ~(symbol (name (ns-name *ns*)) (name tagname)) ~classname ~fields
397398
:implements ~interfaces
399+
~@(mapcat identity opts)
398400
~@methods)))
399401

400402
(defmacro deftype
@@ -471,7 +473,7 @@
471473
fields (vec (map #(with-meta % nil) fields))
472474
[field-args over] (split-at 20 fields)]
473475
`(let []
474-
~(emit-deftype* name gname (vec hinted-fields) (vec interfaces) methods)
476+
~(emit-deftype* name gname (vec hinted-fields) (vec interfaces) methods opts)
475477
(import ~classname)
476478
~(build-positional-factory gname classname fields)
477479
~classname)))

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

Lines changed: 24 additions & 4 deletions
Original file line numberDiff line numberDiff line change
@@ -78,6 +78,7 @@ public class Compiler implements Opcodes{
7878
static final Symbol _AMP_ = Symbol.intern("&");
7979
static final Symbol ISEQ = Symbol.intern("clojure.lang.ISeq");
8080

81+
static final Keyword loadNs = Keyword.intern(null, "load-ns");
8182
static final Keyword inlineKey = Keyword.intern(null, "inline");
8283
static final Keyword inlineAritiesKey = Keyword.intern(null, "inline-arities");
8384
static final Keyword staticKey = Keyword.intern(null, "static");
@@ -4091,6 +4092,8 @@ static public class ObjExpr implements Expr{
40914092

40924093
Object src;
40934094

4095+
IPersistentMap opts = PersistentHashMap.EMPTY;
4096+
40944097
final static Method voidctor = Method.getMethod("void <init>()");
40954098
protected IPersistentMap classMeta;
40964099
protected boolean isStatic;
@@ -4299,6 +4302,22 @@ void compile(String superName, String[] interfaceNames, boolean oneTimeUse) thro
42994302
clinitgen.mark(endLabel);
43004303
}
43014304
*/
4305+
4306+
if(isDeftype() && RT.booleanCast(RT.get(opts, loadNs))) {
4307+
String nsname = ((Symbol)RT.second(src)).getNamespace();
4308+
if (!nsname.equals("clojure.core")) {
4309+
clinitgen.push("clojure.core");
4310+
clinitgen.push("require");
4311+
clinitgen.invokeStatic(RT_TYPE, Method.getMethod("clojure.lang.Var var(String,String)"));
4312+
clinitgen.invokeVirtual(VAR_TYPE,Method.getMethod("Object getRawRoot()"));
4313+
clinitgen.checkCast(IFN_TYPE);
4314+
clinitgen.push(nsname);
4315+
clinitgen.invokeStatic(SYMBOL_TYPE, Method.getMethod("clojure.lang.Symbol create(String)"));
4316+
clinitgen.invokeInterface(IFN_TYPE, Method.getMethod("Object invoke(Object)"));
4317+
clinitgen.pop();
4318+
}
4319+
}
4320+
43024321
clinitgen.returnValue();
43034322

43044323
clinitgen.endMethod();
@@ -7540,7 +7559,7 @@ public Expr parse(C context, final Object frm) {
75407559
ISeq rform = (ISeq) frm;
75417560
//(deftype* tagname classname [fields] :implements [interfaces] :tag tagname methods*)
75427561
rform = RT.next(rform);
7543-
String tagname = ((Symbol) rform.first()).toString();
7562+
String tagname = ((Symbol) rform.first()).getName();
75447563
rform = rform.next();
75457564
Symbol classname = (Symbol) rform.first();
75467565
rform = rform.next();
@@ -7554,7 +7573,7 @@ public Expr parse(C context, final Object frm) {
75547573
}
75557574

75567575
ObjExpr ret = build((IPersistentVector)RT.get(opts,implementsKey,PersistentVector.EMPTY),fields,null,tagname, classname,
7557-
(Symbol) RT.get(opts,RT.TAG_KEY),rform, frm);
7576+
(Symbol) RT.get(opts,RT.TAG_KEY),rform, frm, opts);
75587577
return ret;
75597578
}
75607579
}
@@ -7578,7 +7597,7 @@ public Expr parse(C context, Object frm) {
75787597
rform = RT.next(rform);
75797598

75807599

7581-
ObjExpr ret = build(interfaces, null, null, classname, Symbol.intern(classname), null, rform, frm);
7600+
ObjExpr ret = build(interfaces, null, null, classname, Symbol.intern(classname), null, rform, frm, null);
75827601
if(frm instanceof IObj && ((IObj) frm).meta() != null)
75837602
return new MetaExpr(ret, MapExpr
75847603
.parse(context == C.EVAL ? context : C.EXPRESSION, ((IObj) frm).meta()));
@@ -7589,14 +7608,15 @@ public Expr parse(C context, Object frm) {
75897608

75907609
static ObjExpr build(IPersistentVector interfaceSyms, IPersistentVector fieldSyms, Symbol thisSym,
75917610
String tagName, Symbol className,
7592-
Symbol typeTag, ISeq methodForms, Object frm) {
7611+
Symbol typeTag, ISeq methodForms, Object frm, IPersistentMap opts) {
75937612
NewInstanceExpr ret = new NewInstanceExpr(null);
75947613

75957614
ret.src = frm;
75967615
ret.name = className.toString();
75977616
ret.classMeta = RT.meta(className);
75987617
ret.internalName = ret.name.replace('.', '/');
75997618
ret.objtype = Type.getObjectType(ret.internalName);
7619+
ret.opts = opts;
76007620

76017621
if(thisSym != null)
76027622
ret.thisName = thisSym.name;

‎src/script/run_test.clj‎

Lines changed: 2 additions & 1 deletion
Original file line numberDiff line numberDiff line change
@@ -2,7 +2,8 @@
22
(require
33
'[clojure.test :as test]
44
'[clojure.tools.namespace.find :as ns])
5-
(def namespaces (ns/find-namespaces-in-dir (java.io.File. "test")))
5+
(def namespaces (remove (read-string (System/getProperty "clojure.test-clojure.exclude-namespaces"))
6+
(ns/find-namespaces-in-dir (java.io.File. "test"))))
67
(doseq [ns namespaces] (require ns))
78
(let [summary (apply test/run-tests namespaces)]
89
(System/exit (if (test/successful? summary) 0 -1)))

‎test/clojure/test_clojure/compilation.clj‎

Lines changed: 7 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -304,6 +304,13 @@
304304
(class (clojure.test_clojure.compilation.examples.T.))
305305
(class (clojure.test-clojure.compilation.examples/->T)))))
306306

307+
(deftest clj-1208
308+
;; clojure.test-clojure.compilation.load-ns has not been loaded
309+
;; so this would fail if the deftype didn't load it in its static
310+
;; initializer as the implementation of f requires a var from
311+
;; that namespace
312+
(is (= 1 (.f (clojure.test_clojure.compilation.load_ns.x.)))))
313+
307314
(deftest clj-1568
308315
(let [compiler-fails-at?
309316
(fn [row col source]

‎test/clojure/test_clojure/compilation/load_ns.clj‎

Lines changed: 7 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -0,0 +1,7 @@
1+
(ns clojure.test-clojure.compilation.load-ns)
2+
3+
(defn a [] 1)
4+
(defprotocol p (f [_]))
5+
(deftype x []
6+
:load-ns true
7+
p (f [_] (a)))

0 commit comments

Comments
 (0)