Skip to content
Browse files

Changes to support defrecord and deftype literals. See CLJ-374

Signed-off-by: Stuart Halloway <stu@thinkrelevance.com>
  • Loading branch information...
1 parent 914b77f commit ac1e8ad9f182dc2e8a5254f3e4b7b77c0258353d @fogus fogus committed with stuarthalloway May 10, 2011
View
54 src/clj/clojure/core_deftype.clj
@@ -148,7 +148,10 @@
(throw (IllegalArgumentException. ":volatile-mutable or :unsynchronized-mutable not supported for record fields")))
(let [gs (gensym)]
(letfn
- [(eqhash [[i m]]
+ [(irecord [[i m]]
+ [(conj i 'clojure.lang.IRecord)
+ m])
+ (eqhash [[i m]]
[i
(conj m
`(hashCode [this#] (clojure.lang.APersistentMap/mapHash this#))
@@ -222,7 +225,7 @@
`(values [this#] (vals this#))
`(entrySet [this#] (set this#)))])
]
- (let [[i m] (-> [interfaces methods] eqhash iobj ilookup imap ijavamap)]
+ (let [[i m] (-> [interfaces methods] irecord eqhash iobj ilookup imap ijavamap)]
`(deftype* ~tagname ~classname ~(conj hinted-fields '__meta '__extmap)
:implements ~(vec i)
~@m))))))
@@ -292,26 +295,20 @@
[name [& fields] & opts+specs]
(let [gname name
[interfaces methods opts] (parse-opts+specs opts+specs)
- classname (symbol (str (namespace-munge *ns*) "." gname))
+ ns-part (namespace-munge *ns*)
+ classname (symbol (str ns-part "." gname))
tag (keyword (str *ns*) (str name))
hinted-fields fields
fields (vec (map #(with-meta % nil) fields))]
`(let []
~(emit-defrecord name gname (vec hinted-fields) (vec interfaces) methods)
- (defmethod print-method ~classname [o# w#]
- ((var print-defrecord) o# w#))
(import ~classname)
- #_(defn ~name
+ (defn ~(symbol (str '-> name))
([~@fields] (new ~classname ~@fields nil nil))
- ([~@fields meta# extmap#] (new ~classname ~@fields meta# extmap#))))))
-
-(defn- print-defrecord [o ^Writer w]
- (print-meta o w)
- (.write w "#:")
- (.write w (.getName (class o)))
- (print-map
- o
- pr-on w))
+ ([~@fields meta# extmap#] (new ~classname ~@fields meta# extmap#)))
+ (defn ~(symbol (str 'map-> name))
+ ([m#] (~(symbol (str classname "/create")) m#)))
+ ~classname)))
(defn- emit-deftype*
"Do not use this directly - use deftype"
@@ -384,16 +381,35 @@
[name [& fields] & opts+specs]
(let [gname name
[interfaces methods opts] (parse-opts+specs opts+specs)
- classname (symbol (str (namespace-munge *ns*) "." gname))
+ ns-part (namespace-munge *ns*)
+ classname (symbol (str ns-part "." gname))
tag (keyword (str *ns*) (str name))
hinted-fields fields
fields (vec (map #(with-meta % nil) fields))]
`(let []
~(emit-deftype* name gname (vec hinted-fields) (vec interfaces) methods)
- (import ~classname))))
-
-
+ (import ~classname)
+ (defmethod print-method ~classname [o# w#]
+ ((var print-deftype) o# w#))
+ (defmethod print-dup ~classname [o# w#]
+ ((var printdup-deftype) o# w#))
+ (defn ~(symbol (str '-> name))
+ ([~@fields] (new ~classname ~@fields)))
+ ~classname)))
+
+(defn- print-deftype [o ^Writer w]
+ (.write w "#")
+ (.write w (.getName (class o)))
+ (let [basii (for [fld (map str (clojure.lang.Reflector/invokeStaticMethod (class o) "getBasis" (to-array [])))]
+ (clojure.lang.Reflector/getInstanceField o fld))]
+ (print-sequential "[" pr-on ", " "]" basii w)))
+(defn- printdup-deftype [o ^Writer w]
+ (.write w "#")
+ (.write w (.getName (class o)))
+ (let [basii (for [fld (map str (clojure.lang.Reflector/invokeStaticMethod (class o) "getBasis" (to-array [])))]
+ (clojure.lang.Reflector/getInstanceField o fld))]
+ (print-sequential "[" pr-on ", " "]" basii w)))
;;;;;;;;;;;;;;;;;;;;;;; protocols ;;;;;;;;;;;;;;;;;;;;;;;;
View
28 src/clj/clojure/core_print.clj
@@ -33,7 +33,9 @@
*print-level*, the printer prints '#' to represent it. The root binding
is nil indicating no limit."
:added "1.0"}
-*print-level* nil)
+ *print-level* nil)
+
+(def ^:dynamic *verbose-defrecords* false)
(defn- print-sequential [^String begin, print-one, ^String sep, ^String end, sequence, ^Writer w]
(binding [*print-level* (and (not *print-dup*) *print-level* (dec *print-level*))]
@@ -150,6 +152,7 @@
(print-ctor o #(print-sequential "[" print-dup " " "]" %1 %2) w))
(defmethod print-dup clojure.lang.IPersistentCollection [o, ^Writer w]
+ (print " ipcpd ")
(print-meta o w)
(.write w "#=(")
(.write w (.getName ^Class (class o)))
@@ -191,7 +194,7 @@
(defn- print-map [m print-one w]
(print-sequential
"{"
- (fn [e ^Writer w]
+ (fn [e ^Writer w]
(do (print-one (key e) w) (.append w \space) (print-one (val e) w)))
", "
"}"
@@ -212,7 +215,26 @@
(print-map m print-dup w)
(.write w ")"))
+(defmethod print-method clojure.lang.IRecord [r, ^Writer w]
+ (print-meta r w)
+ (.write w "#")
+ (.write w (.getName (class r)))
+ (print-map r pr-on w))
+
+(defmethod print-dup clojure.lang.IRecord [r, ^Writer w]
+ (print-meta r w)
+ (.write w "#")
+ (.write w (.getName (class r)))
+ (if *verbose-defrecords*
+ (print-map r print-dup w)
+ (print-sequential "[" pr-on ", " "]" (vals r) w)))
+
+(prefer-method print-method clojure.lang.IRecord java.util.Map)
+(prefer-method print-method clojure.lang.IRecord clojure.lang.IPersistentMap)
+(prefer-method print-dup clojure.lang.IRecord clojure.lang.IPersistentMap)
(prefer-method print-dup clojure.lang.IPersistentCollection java.util.Map)
+(prefer-method print-dup clojure.lang.IRecord clojure.lang.IPersistentCollection)
+(prefer-method print-dup clojure.lang.IRecord java.util.Map)
(defmethod print-method clojure.lang.IPersistentSet [s, ^Writer w]
(print-meta s w)
@@ -244,7 +266,7 @@
(defmethod print-dup java.math.BigDecimal [o w] (print-method o w))
(defmethod print-dup clojure.lang.BigInt [o w] (print-method o w))
(defmethod print-dup java.math.BigInteger [o w] (print-method o w))
-(defmethod print-dup clojure.lang.PersistentHashMap [o w] (print-method o w))
+(defmethod print-dup clojure.lang.PersistentHashMap [o w] (print " phmpd ") (print-method o w))
(defmethod print-dup clojure.lang.PersistentHashSet [o w] (print-method o w))
(defmethod print-dup clojure.lang.PersistentVector [o w] (print-method o w))
(defmethod print-dup clojure.lang.LazilyPersistentVector [o w] (print-method o w))
View
148 src/jvm/clojure/lang/Compiler.java
@@ -15,8 +15,15 @@
//*
import clojure.asm.*;
-import clojure.asm.commons.Method;
import clojure.asm.commons.GeneratorAdapter;
+import clojure.asm.commons.Method;
+
+import java.io.*;
+import java.lang.reflect.Constructor;
+import java.lang.reflect.Modifier;
+import java.util.*;
+import java.util.regex.Pattern;
+
//*/
/*
@@ -27,13 +34,6 @@
import org.objectweb.asm.util.CheckClassAdapter;
//*/
-import java.io.*;
-import java.lang.reflect.InvocationTargetException;
-import java.util.*;
-import java.lang.reflect.Constructor;
-import java.lang.reflect.Modifier;
-import java.util.regex.Pattern;
-
public class Compiler implements Opcodes{
static final Symbol DEF = Symbol.intern("def");
@@ -1723,6 +1723,7 @@ Object val(){
public void emit(C context, ObjExpr objx, GeneratorAdapter gen){
objx.emitConstant(gen, id);
+
if(context == C.STATEMENT)
{
gen.pop();
@@ -3692,6 +3693,9 @@ public void emitForDefn(ObjExpr objx, GeneratorAdapter gen){
//symbol->lb
IPersistentMap fields = null;
+ //hinted fields
+ IPersistentVector hintedFields = PersistentVector.EMPTY;
+
//Keyword->KeywordExpr
IPersistentMap keywords = PersistentHashMap.EMPTY;
IPersistentMap vars = PersistentHashMap.EMPTY;
@@ -4052,7 +4056,7 @@ void compile(String superName, String[] interfaceNames, boolean oneTimeUse) thro
if(supportsMeta())
{
- //ctor that takes closed-overs but not meta
+ //ctor that takes closed-overs but not meta
Type[] ctorTypes = ctorTypes();
Type[] noMetaCtorTypes = new Type[ctorTypes.length-1];
for(int i=1;i<ctorTypes.length;i++)
@@ -4119,7 +4123,8 @@ void compile(String superName, String[] interfaceNames, boolean oneTimeUse) thro
gen.returnValue();
gen.endMethod();
}
-
+
+ emitStatics(cv);
emitMethods(cv);
if(keywordCallsites.count() > 0)
@@ -4182,6 +4187,9 @@ private void emitKeywordCallsites(GeneratorAdapter clinitgen){
}
}
+ protected void emitStatics(ClassVisitor gen){
+ }
+
protected void emitMethods(ClassVisitor gen){
}
@@ -4286,6 +4294,19 @@ else if(value instanceof Var)
gen.push(var.sym.toString());
gen.invokeStatic(RT_TYPE, Method.getMethod("clojure.lang.Var var(String,String)"));
}
+ else if(value instanceof IRecord)
+ {
+ Method createMethod = Method.getMethod(value.getClass().getName() + " create(clojure.lang.IPersistentMap)");
+ List entries = new ArrayList();
+ for(Map.Entry entry : (Set<Map.Entry>) ((Map) value).entrySet())
+ {
+ entries.add(entry.getKey());
+ entries.add(entry.getValue());
+ }
+ emitListAsObjectArray(entries, gen);
+ gen.invokeStatic(RT_TYPE, Method.getMethod("clojure.lang.IPersistentMap map(Object[])"));
+ gen.invokeStatic(getType(value.getClass()), createMethod);
+ }
else if(value instanceof IPersistentMap)
{
List entries = new ArrayList();
@@ -6111,6 +6132,8 @@ else if(form instanceof ISeq)
return analyzeSeq(context, (ISeq) form, name);
else if(form instanceof IPersistentVector)
return VectorExpr.parse(context, (IPersistentVector) form);
+ else if(form instanceof IRecord)
+ return new ConstantExpr(form);
else if(form instanceof IPersistentMap)
return MapExpr.parse(context, (IPersistentMap) form);
else if(form instanceof IPersistentSet)
@@ -7174,6 +7197,8 @@ static ObjExpr build(IPersistentVector interfaceSyms, IPersistentVector fieldSym
LOCAL_ENV, ret.fields
, COMPILE_STUB_SYM, Symbol.intern(null, tagName)
, COMPILE_STUB_CLASS, stub));
+
+ ret.hintedFields = RT.subvec(fieldSyms, 0, fieldSyms.count() - ret.altCtorDrops);
}
//now (methodname [args] body)*
@@ -7302,6 +7327,82 @@ static String slashname(Class c){
return c.getName().replace('.', '/');
}
+ protected void emitStatics(ClassVisitor cv) {
+ if(this.isDeftype())
+ {
+ //getBasis()
+ Method meth = Method.getMethod("clojure.lang.IPersistentVector getBasis()");
+ GeneratorAdapter gen = new GeneratorAdapter(ACC_PUBLIC + ACC_STATIC,
+ meth,
+ null,
+ null,
+ cv);
+ emitValue(hintedFields, gen);
+ gen.returnValue();
+ gen.endMethod();
+
+ if (this.isDeftype() && this.fields.count() > this.hintedFields.count())
+ {
+ //create(IPersistentMap)
+ String className = name.replace('.', '/');
+ int i = 1;
+ int fieldCount = hintedFields.count();
+
+ MethodVisitor mv = cv.visitMethod(ACC_PUBLIC + ACC_STATIC, "create", "(Lclojure/lang/IPersistentMap;)L"+className+";", null, null);
+ mv.visitCode();
+
+ for(ISeq s = RT.seq(hintedFields); s!=null; s=s.next(), i++)
+ {
+ String bName = ((Symbol)s.first()).name;
+ Class k = tagClass(tagOf(s.first()));
+
+ mv.visitVarInsn(ALOAD, 0);
+ mv.visitLdcInsn(bName);
+ mv.visitMethodInsn(INVOKESTATIC, "clojure/lang/Keyword", "intern", "(Ljava/lang/String;)Lclojure/lang/Keyword;");
+ mv.visitInsn(ACONST_NULL);
+ mv.visitMethodInsn(INVOKEINTERFACE, "clojure/lang/IPersistentMap", "valAt", "(Ljava/lang/Object;Ljava/lang/Object;)Ljava/lang/Object;");
+ if(k.isPrimitive())
+ {
+ mv.visitTypeInsn(CHECKCAST, Type.getType(boxClass(k)).getInternalName());
+ }
+ mv.visitVarInsn(ASTORE, i);
+ mv.visitVarInsn(ALOAD, 0);
+ mv.visitLdcInsn(bName);
+ mv.visitMethodInsn(INVOKESTATIC, "clojure/lang/Keyword", "intern", "(Ljava/lang/String;)Lclojure/lang/Keyword;");
+ mv.visitMethodInsn(INVOKEINTERFACE, "clojure/lang/IPersistentMap", "without", "(Ljava/lang/Object;)Lclojure/lang/IPersistentMap;");
+ mv.visitVarInsn(ASTORE, 0);
+ }
+
+ mv.visitTypeInsn(Opcodes.NEW, className);
+ mv.visitInsn(DUP);
+
+ Method ctor = new Method("<init>", Type.VOID_TYPE, ctorTypes());
+
+ if(hintedFields.count() > 0)
+ for(i=1; i<=fieldCount; i++)
+ {
+ mv.visitVarInsn(ALOAD, i);
+ Class k = tagClass(tagOf(hintedFields.nth(i-1)));
+ if(k.isPrimitive())
+ {
+ String b = Type.getType(boxClass(k)).getInternalName();
+ String p = Type.getType(k).getDescriptor();
+ String n = k.getName();
+
+ mv.visitMethodInsn(INVOKEVIRTUAL, b, n+"Value", "()"+p);
+ }
+ }
+
+ mv.visitInsn(ACONST_NULL);
+ mv.visitVarInsn(ALOAD, 0);
+ mv.visitMethodInsn(INVOKESTATIC, "clojure/lang/RT", "seqOrElse", "(Ljava/lang/Object;)Ljava/lang/Object;");
+ mv.visitMethodInsn(INVOKESPECIAL, className, "<init>", ctor.getDescriptor());
+ mv.visitInsn(ARETURN);
+ mv.visitMaxs(4+fieldCount, 1+fieldCount);
+ mv.visitEnd();
+ }
+ }
+ }
protected void emitMethods(ClassVisitor cv){
for(ISeq s = RT.seq(methods); s != null; s = s.next())
@@ -7695,6 +7796,33 @@ static Class primClass(Class c){
return c.isPrimitive()?c:Object.class;
}
+ static Class boxClass(Class p) {
+ if(!p.isPrimitive())
+ return p;
+
+ Class c = null;
+ Type t = Type.getType(p);
+
+ if(t == Type.INT_TYPE)
+ c = Integer.class;
+ else if(t == Type.LONG_TYPE)
+ c = Long.class;
+ else if(t == Type.FLOAT_TYPE)
+ c = Float.class;
+ else if(t == Type.DOUBLE_TYPE)
+ c = Double.class;
+ else if(t == Type.CHAR_TYPE)
+ c = Character.class;
+ else if(t == Type.SHORT_TYPE)
+ c = Short.class;
+ else if(t == Type.BYTE_TYPE)
+ c = Byte.class;
+ else if(t == Type.BOOLEAN_TYPE)
+ c = Boolean.class;
+
+ return c;
+ }
+
static public class MethodParamExpr implements Expr, MaybePrimitiveExpr{
final Class c;
View
14 src/jvm/clojure/lang/IRecord.java
@@ -0,0 +1,14 @@
+/**
+ * Copyright (c) Rich Hickey. All rights reserved.
+ * The use and distribution terms for this software are covered by the
+ * Eclipse Public License 1.0 (http://opensource.org/licenses/eclipse-1.0.php)
+ * which can be found in the file epl-v10.html at the root of this distribution.
+ * By using this software in any fashion, you are agreeing to be bound by
+ * the terms of this license.
+ * You must not remove this notice, or any other, from this software.
+ **/
+
+package clojure.lang;
+
+public interface IRecord {
+}
View
138 src/jvm/clojure/lang/LispReader.java
@@ -10,15 +10,31 @@
package clojure.lang;
-import java.io.*;
-import java.util.regex.Pattern;
-import java.util.regex.Matcher;
+import java.io.IOException;
+import java.io.PushbackReader;
+import java.io.Reader;
+import java.lang.Character;
+import java.lang.Class;
+import java.lang.Exception;
+import java.lang.IllegalArgumentException;
+import java.lang.IllegalStateException;
+import java.lang.Integer;
+import java.lang.Number;
+import java.lang.NumberFormatException;
+import java.lang.Object;
+import java.lang.RuntimeException;
+import java.lang.String;
+import java.lang.StringBuilder;
+import java.lang.Throwable;
+import java.lang.UnsupportedOperationException;
+import java.lang.reflect.Constructor;
+import java.math.BigDecimal;
+import java.math.BigInteger;
import java.util.ArrayList;
import java.util.List;
import java.util.Map;
-import java.math.BigInteger;
-import java.math.BigDecimal;
-import java.lang.*;
+import java.util.regex.Matcher;
+import java.util.regex.Pattern;
public class LispReader{
@@ -61,6 +77,7 @@
static Var GENSYM_ENV = Var.create(null).setDynamic();
//sorted-map num->gensymbol
static Var ARG_ENV = Var.create(null).setDynamic();
+static IFn ctorReader = new CtorReader();
static
{
@@ -587,8 +604,17 @@ public Object invoke(Object reader, Object hash) {
if(ch == -1)
throw Util.runtimeException("EOF while reading character");
IFn fn = dispatchMacros[ch];
- if(fn == null)
- throw Util.runtimeException(String.format("No dispatch macro for: %c", (char) ch));
+
+ // Try the ctor reader first
+ if(fn == null) {
+ unread((PushbackReader) reader, ch);
+ Object result = ctorReader.invoke(reader, ch);
+
+ if(result != null)
+ return result;
+ else
+ throw Util.runtimeException(String.format("No dispatch macro for: %c", (char) ch));
+ }
return fn.invoke(reader, ch);
}
}
@@ -946,6 +972,7 @@ public Object invoke(Object reader, Object leftparen) {
}
+/*
static class CtorReader extends AFn{
static final Symbol cls = Symbol.intern("class");
@@ -974,8 +1001,8 @@ else if(s.ns != null) //static method
return Reflector.invokeConstructor(RT.classForName(s.name), args);
}
}
-
}
+*/
public static class EvalReader extends AFn{
public Object invoke(Object reader, Object eq) {
@@ -1115,6 +1142,99 @@ public static List readDelimitedList(char delim, PushbackReader r, boolean isRec
return a;
}
+public static class CtorReader extends AFn{
+ public Object invoke(Object reader, Object firstChar){
+ PushbackReader r = (PushbackReader) reader;
+
+ Object recordName = read(r, true, null, false);
+ Class recordClass = RT.classForName(recordName.toString());
+ int ch = read1(r);
+ char endch;
+ boolean shortForm = true;
+
+ // A defrecord ctor can take two forms. Check for map->R version first.
+ if(ch == '{')
+ {
+ endch = '}';
+ shortForm = false;
+ }
+ else if (ch == '[')
+ endch = ']';
+ else
+ throw Util.runtimeException("Unreadable constructor form starting with \"#" + recordName + (char) ch + "\"");
+
+ Object[] recordEntries = readDelimitedList(endch, r, true).toArray();
+ Object ret = null;
+ Constructor[] allctors = ((Class)recordClass).getConstructors();
+
+ if(shortForm)
+ {
+ boolean ctorFound = false;
+ for (Constructor ctor : allctors)
+ if(ctor.getParameterTypes().length == recordEntries.length)
+ ctorFound = true;
+
+ if(!ctorFound)
+ throw Util.runtimeException("Unexpected number of constructor arguments to " + recordClass.toString() + ": got " + recordEntries.length);
+
+ ret = Reflector.invokeConstructor(recordClass, RT.seqToArray(resolveEach(recordEntries)));
+ }
+ else
+ {
+ ret = Reflector.invokeStaticMethod(recordClass, "create", new Object[]{RT.map(RT.seqToArray(resolveEach(recordEntries)))});
+ }
+
+ return ret;
+ }
+
+ static public ISeq resolveEach(Object[] a) {
+ ISeq ret = null;
+ for(int i = a.length - 1; i >= 0; --i)
+ ret = (ISeq) RT.cons(resolve(a[i]), ret);
+ return ret;
+ }
+
+ static private Object resolve(Object o) {
+ if(o instanceof Symbol)
+ {
+ try
+ {
+ return RT.classForName(o.toString());
+ }
+ catch(Exception cfe)
+ {
+ throw new IllegalArgumentException("Constructor literal can only contain constants or statics. "
+ + o.toString()
+ + " does not name a known class.");
+ }
+ }
+ else if(o instanceof ISeq)
+ {
+ Symbol fs = (Symbol) RT.first(o);
+
+ if(fs == null && o == PersistentList.EMPTY)
+ {
+ return o;
+ }
+
+ throw new IllegalArgumentException("Constructor literal can only contain constants or statics. " + o.toString());
+ }
+ else if(o instanceof IPersistentCollection && ((IPersistentCollection) o).count() == 0 ||
+ o instanceof IPersistentCollection ||
+ o instanceof Number ||
+ o instanceof String ||
+ o instanceof Keyword ||
+ o instanceof Symbol ||
+ o == Boolean.TRUE ||
+ o == Boolean.FALSE ||
+ o == null) {
+ return o;
+ }
+ else
+ throw new IllegalArgumentException("Constructor literal can only contain constants or statics. " + o.toString());
+ }
+}
+
/*
public static void main(String[] args) throws Exception{
//RT.init();
View
4 src/jvm/clojure/lang/RT.java
@@ -488,6 +488,10 @@ else if(coll instanceof Map)
}
}
+static public Object seqOrElse(Object o) {
+ return seq(o) == null ? null : o;
+}
+
static public ISeq keys(Object coll){
return APersistentMap.KeySeq.create(seq(coll));
}
View
37 src/jvm/clojure/lang/Reflector.java
@@ -12,11 +12,13 @@
package clojure.lang;
-import java.lang.reflect.*;
+import java.lang.reflect.Constructor;
+import java.lang.reflect.Field;
+import java.lang.reflect.Method;
+import java.lang.reflect.Modifier;
import java.util.ArrayList;
import java.util.Iterator;
import java.util.List;
-import java.util.Arrays;
public class Reflector{
@@ -105,8 +107,7 @@ public static Method getAsMethodOfPublicBase(Class c, Method m){
{
for(Method im : iface.getMethods())
{
- if(im.getName().equals(m.getName())
- && Arrays.equals(m.getParameterTypes(), im.getParameterTypes()))
+ if(isMatch(im, m))
{
return im;
}
@@ -117,16 +118,38 @@ public static Method getAsMethodOfPublicBase(Class c, Method m){
return null;
for(Method scm : sc.getMethods())
{
- if(scm.getName().equals(m.getName())
- && Arrays.equals(m.getParameterTypes(), scm.getParameterTypes())
- && Modifier.isPublic(scm.getDeclaringClass().getModifiers()))
+ if(isMatch(scm, m))
{
return scm;
}
}
return getAsMethodOfPublicBase(sc, m);
}
+public static boolean isMatch(Method lhs, Method rhs) {
+ if(!lhs.getName().equals(rhs.getName())
+ || !Modifier.isPublic(lhs.getDeclaringClass().getModifiers()))
+ {
+ return false;
+ }
+
+ Class[] types1 = lhs.getParameterTypes();
+ Class[] types2 = rhs.getParameterTypes();
+ if(types1.length != types2.length)
+ return false;
+
+ boolean match = true;
+ for (int i=0; i<types1.length; ++i)
+ {
+ if(!types1[i].isAssignableFrom(types2[i]))
+ {
+ match = false;
+ break;
+ }
+ }
+ return match;
+}
+
public static Object invokeConstructor(Class c, Object[] args) {
try
{
View
197 test/clojure/test_clojure/protocols.clj
@@ -231,6 +231,203 @@
(is (= (seq rec) '([:this 1] [:that 2] [:k 3] [:m 4] [:o 5])))
(is (= (dissoc rec :k) {:this 1, :that 2, :m 4, :o 5}))))
+(defrecord RecordToTestStatics1 [a])
+(defrecord RecordToTestStatics2 [a b])
+(defrecord RecordToTestStatics3 [a b c])
+(defrecord RecordToTestBasis [a b c])
+(defrecord RecordToTestBasisHinted [^String a ^Long b c])
+
+(deftest defrecord-statics
+ (testing "that a record has its generated static methods"
+ (let [r1 (RecordToTestStatics1. 1)
+ r2 (RecordToTestStatics2. 1 2)
+ r3 (RecordToTestStatics3. 1 2 3)
+ rn (RecordToTestStatics3. 1 nil nil)]
+ (testing "that a record created with the ctor equals one by the static factory method"
+ (is (= r1 (RecordToTestStatics1/create {:a 1})))
+ (is (= r2 (RecordToTestStatics2/create {:a 1 :b 2})))
+ (is (= r3 (RecordToTestStatics3/create {:a 1 :b 2 :c 3})))
+ (is (= rn (RecordToTestStatics3/create {:a 1}))))
+ (testing "that a literal record equals one by the static factory method"
+ (is (= #clojure.test_clojure.protocols.RecordToTestStatics1{:a 1} (RecordToTestStatics1/create {:a 1})))
+ (is (= #clojure.test_clojure.protocols.RecordToTestStatics2{:a 1 :b 2} (RecordToTestStatics2/create {:a 1 :b 2})))
+ (is (= #clojure.test_clojure.protocols.RecordToTestStatics3{:a 1 :b 2 :c 3} (RecordToTestStatics3/create {:a 1 :b 2 :c 3})))
+ (is (= #clojure.test_clojure.protocols.RecordToTestStatics3{:a 1} (RecordToTestStatics3/create {:a 1})))
+ (is (= #clojure.test_clojure.protocols.RecordToTestStatics3{:a 1 :b nil :c nil} (RecordToTestStatics3/create {:a 1}))))))
+ (testing "that a record has a sane generated basis method"
+ (let [b (clojure.test_clojure.protocols.RecordToTestBasis/getBasis)
+ bh (clojure.test_clojure.protocols.RecordToTestBasisHinted/getBasis)]
+ (is (= '[a b c] b))
+ (is (= (:tag (meta (bh 0))) 'String))
+ (is (= (:tag (meta (bh 1))) 'Long))
+ (is (nil? (:tag (meta (bh 2))))))))
+
+(defrecord RecordToTestFactories [a b c])
+(deftest defrecord-factory-fns
+ (testing "if the definition of a defrecord generates the appropriate factory funcitons"
+ (let [r (RecordToTestFactories. 1 2 3)
+ r-n (RecordToTestFactories. nil nil nil)]
+ (testing "that a record created with the ctor equals one by the positional factory fn"
+ (is (= r (->RecordToTestFactories 1 2 3)))
+ (is (= r (->RecordToTestFactories 1 2 3 nil nil)))
+ (is (= r (->RecordToTestFactories 1 2 3 {:something true} nil)))
+ (is (not= r (->RecordToTestFactories 1 2 3 nil {:d 4}))))
+ (testing "that a record created with the ctor equals one by the map-> factory fn"
+ (is (= r (map->RecordToTestFactories {:a 1 :b 2 :c 3})))
+ (is (= r-n (map->RecordToTestFactories {}))))
+ (testing "that a literal record equals one by the positional factory fn"
+ (is (= #clojure.test_clojure.protocols.RecordToTestFactories{:a 1 :b 2 :c 3} (->RecordToTestFactories 1 2 3)))
+ (is (= #clojure.test_clojure.protocols.RecordToTestFactories{:a 1 :b nil :c nil} (->RecordToTestFactories 1 nil nil)))
+ (is (= #clojure.test_clojure.protocols.RecordToTestFactories{:a [] :b {} :c ()} (->RecordToTestFactories [] {} ()))))
+ (testing "that a literal record equals one by the map-> factory fn"
+ (is (= #clojure.test_clojure.protocols.RecordToTestFactories{:a 1 :b 2 :c 3} (map->RecordToTestFactories {:a 1 :b 2 :c 3})))
+ (is (= #clojure.test_clojure.protocols.RecordToTestFactories{:a 1 :b nil :c nil} (map->RecordToTestFactories {:a 1})))
+ (is (= #clojure.test_clojure.protocols.RecordToTestFactories{:a nil :b nil :c nil} (map->RecordToTestFactories {})))))))
+
+(deftype TypeToTestFactory [a])
+(deftest deftype-factory-fn
+ (testing "that the ->T factory is gen'd for a deftype and that it works"
+ (is (= (.a (TypeToTestFactory. 42)) (.a (->TypeToTestFactory 42))))))
+
+(deftest ctor-literals
+ (testing "that constructor calls to print-dup'able classes are supported as literals"
+ (is (= "Hi" #java.lang.String["Hi"]))
+ (is (= 42 #java.lang.Long[42]))
+ (is (= 42 #java.lang.Long["42"]))
+ (is (= [:a 42] #clojure.lang.MapEntry[:a 42])))
+ (testing "that constructor literals are embeddable"
+ (is (= 42 #java.lang.Long[#java.lang.String["42"]])))
+ (testing "that constructor literals work for deftypes too"
+ (is (= (.a (TypeToTestFactory. 42)) (.a (->TypeToTestFactory 42))))))
+
+(defrecord RecordToTestLiterals [a])
+(defrecord TestNode [v l r])
+(deftype TypeToTestLiterals [a])
+(def lang-str "en")
+(deftest exercise-literals
+ (testing "that ctor literals can be used in common 'places'"
+ (is (= (RecordToTestLiterals. ()) #clojure.test_clojure.protocols.RecordToTestLiterals[()]))
+ (is (= (.a (TypeToTestLiterals. ())) (.a #clojure.test_clojure.protocols.TypeToTestLiterals[()])))
+ (is (= (RecordToTestLiterals. 42) (into #clojure.test_clojure.protocols.RecordToTestLiterals[0] {:a 42})))
+ (is (= (RecordToTestLiterals. (RecordToTestLiterals. 42)) (RecordToTestLiterals. #clojure.test_clojure.protocols.RecordToTestLiterals[42])))
+ (is (= (RecordToTestLiterals. (RecordToTestLiterals. 42)) (->RecordToTestLiterals #clojure.test_clojure.protocols.RecordToTestLiterals[42])))
+ (is (= (RecordToTestLiterals. (RecordToTestLiterals. 42))
+ #clojure.test_clojure.protocols.RecordToTestLiterals[#clojure.test_clojure.protocols.RecordToTestLiterals[42]]))
+ (is (= (TestNode. 1
+ (TestNode. 2
+ (TestNode. 3
+ nil
+ nil)
+ nil)
+ (TestNode. 4
+ (TestNode. 5
+ (TestNode. 6
+ nil
+ nil)
+ nil)
+ (TestNode. 7
+ nil
+ nil)))
+ #clojure.test_clojure.protocols.TestNode{:v 1
+ :l #clojure.test_clojure.protocols.TestNode{:v 2
+ :l #clojure.test_clojure.protocols.TestNode{:v 3 :l nil :r nil}
+ :r nil}
+ :r #clojure.test_clojure.protocols.TestNode{:v 4
+ :l #clojure.test_clojure.protocols.TestNode{:v 5
+ :l #clojure.test_clojure.protocols.TestNode{:v 6 :l nil :r nil}
+ :r nil}
+ :r #clojure.test_clojure.protocols.TestNode{:v 7 :l nil :r nil}}})))
+
+ (testing "that records and types are evalable"
+ (is (= (RecordToTestLiterals. 42) (eval #clojure.test_clojure.protocols.RecordToTestLiterals[42])))
+ (is (= (RecordToTestLiterals. 42) (eval #clojure.test_clojure.protocols.RecordToTestLiterals{:a 42})))
+ (is (= (RecordToTestLiterals. 42) (eval (RecordToTestLiterals. 42))))
+ (is (= (RecordToTestLiterals. (RecordToTestLiterals. 42))
+ (eval #clojure.test_clojure.protocols.RecordToTestLiterals[#clojure.test_clojure.protocols.RecordToTestLiterals[42]])))
+ (is (= (RecordToTestLiterals. (RecordToTestLiterals. 42))
+ (eval #clojure.test_clojure.protocols.RecordToTestLiterals[#clojure.test_clojure.protocols.RecordToTestLiterals{:a 42}])))
+ (is (= (RecordToTestLiterals. (RecordToTestLiterals. 42))
+ (eval #clojure.test_clojure.protocols.RecordToTestLiterals{:a #clojure.test_clojure.protocols.RecordToTestLiterals[42]})))
+ (is (= 42 (.a (eval #clojure.test_clojure.protocols.TypeToTestLiterals[42])))))
+
+ (testing "that ctor literals only work with constants or statics"
+ (is (thrown? Exception (read-string "#java.util.Locale[(str 'en)]")))
+ (is (thrown? Exception (read-string "(let [s \"en\"] #java.util.Locale[(str 'en)])")))
+ (is (thrown? Exception (read-string "#clojure.test_clojure.protocols.RecordToTestLiterals{(keyword \"a\") 42}"))))
+
+ (testing "that the correct errors are thrown with malformed literals"
+ (is (thrown-with-msg?
+ Exception
+ #"Unreadable constructor form.*"
+ (read-string "#java.util.Locale(\"en\")")))
+ (is (thrown-with-msg?
+ Exception
+ #"Unexpected number of constructor arguments.*"
+ (read-string "#java.util.Locale[\"\" \"\" \"\" \"\"]")))
+ (is (thrown-with-msg?
+ Exception
+ #"Constructor literal can only contain constants or statics.*"
+ (read-string "#clojure.lang.Ref[#clojure.lang.Ref[(+ 1 2)]]")))
+ (is (thrown? Exception (read-string "#java.util.Nachos(\"en\")")))))
+
+(defrecord RecordToTestPrinting [a b])
+(deftest defrecord-printing
+ (testing "that the default printer gives the proper representation"
+ (let [r (RecordToTestPrinting. 1 2)]
+ (is (= "#clojure.test_clojure.protocols.RecordToTestPrinting{:a 1, :b 2}"
+ (pr-str r)))
+ (is (= "#clojure.test_clojure.protocols.RecordToTestPrinting[#=(java.lang.Long. \"1\"), #=(java.lang.Long. \"2\")]"
+ (binding [*print-dup* true] (pr-str r))))
+ (is (= "#clojure.test_clojure.protocols.RecordToTestPrinting{:a #=(java.lang.Long. \"1\"), :b #=(java.lang.Long. \"2\")}"
+ (binding [*print-dup* true *verbose-defrecords* true] (pr-str r))))
+ (is (= "#clojure.test_clojure.protocols.TypeToTestLiterals[#=(java.lang.Long. \"42\")]"
+ (binding [*print-dup* true] (pr-str (TypeToTestLiterals. 42))))))))
+
+(defrecord RecordToTestLongHint [^long a])
+(defrecord RecordToTestByteHint [^byte a])
+(defrecord RecordToTestBoolHint [^boolean a])
+(defrecord RecordToTestCovariantHint [^String a]) ;; same for arrays also
+
+(deftest defrecord-hinting
+ (testing "that primitive hinting requiring no coercion works as expected"
+ (is (= (RecordToTestLongHint. 42) #clojure.test_clojure.protocols.RecordToTestLongHint{:a 42}))
+ (is (= (RecordToTestLongHint. 42) #clojure.test_clojure.protocols.RecordToTestLongHint[42]))
+ (is (= (RecordToTestLongHint. 42) (clojure.test_clojure.protocols.RecordToTestLongHint/create {:a 42})))
+ (is (= (RecordToTestLongHint. 42) (map->RecordToTestLongHint {:a 42})))
+ (is (= (RecordToTestLongHint. 42) (->RecordToTestLongHint 42)))
+ (testing "that invalid primitive types on hinted defrecord fields fails"
+ (is (thrown-with-msg?
+ ClassCastException
+ #"java.lang.String cannot be cast to java.lang.Long.*"
+ (read-string "#clojure.test_clojure.protocols.RecordToTestLongHint{:a \"\"}")))
+ (is (thrown-with-msg?
+ IllegalArgumentException
+ #"Unexpected param type, expected: long, given: java.lang.String.*"
+ (read-string "#clojure.test_clojure.protocols.RecordToTestLongHint[\"\"]")))
+ (is (thrown-with-msg?
+ ClassCastException
+ #"java.lang.String cannot be cast to java.lang.Long.*"
+ (clojure.test_clojure.protocols.RecordToTestLongHint/create {:a ""})))
+ (is (thrown-with-msg?
+ ClassCastException
+ #"java.lang.String cannot be cast to java.lang.Long.*"
+ (map->RecordToTestLongHint {:a ""})))
+ (is (thrown-with-msg?
+ ClassCastException
+ #"java.lang.String cannot be cast to java.lang.Number.*"
+ (->RecordToTestLongHint "")))))
+ (testing "that primitive hinting requiring coercion works as expected"
+ (is (= (RecordToTestByteHint. 42) (clojure.test_clojure.protocols.RecordToTestByteHint/create {:a (byte 42)})))
+ (is (= (RecordToTestByteHint. 42) (map->RecordToTestByteHint {:a (byte 42)})))
+ (is (= (RecordToTestByteHint. 42) (->RecordToTestByteHint (byte 42)))))
+ (testing "that primitive hinting for non-numerics works as expected"
+ (is (= (RecordToTestBoolHint. true) #clojure.test_clojure.protocols.RecordToTestBoolHint{:a true}))
+ (is (= (RecordToTestBoolHint. true) #clojure.test_clojure.protocols.RecordToTestBoolHint[true]))
+ (is (= (RecordToTestBoolHint. true) (clojure.test_clojure.protocols.RecordToTestBoolHint/create {:a true})))
+ (is (= (RecordToTestBoolHint. true) (map->RecordToTestBoolHint {:a true})))
+ (is (= (RecordToTestBoolHint. true) (->RecordToTestBoolHint true))))
+ (testing "covariant hints -- deferred"))
+
(deftest reify-test
(testing "of an interface"
(let [s :foo

0 comments on commit ac1e8ad

Please sign in to comment.
Something went wrong with that request. Please try again.