val = e.getValue();
if(val != null && val.get() == null)
cache.remove(e.getKey(), val);
}
}
}
static public RuntimeException runtimeException(String s){
return new RuntimeException(s);
}
static public RuntimeException runtimeException(String s, Throwable e){
return new RuntimeException(s, e);
}
/**
* Throw even checked exceptions without being required
* to declare them or catch them. Suggested idiom:
*
* throw sneakyThrow( some exception );
*/
static public RuntimeException sneakyThrow(Throwable t) {
// http://www.mail-archive.com/javaposse@googlegroups.com/msg05984.html
if (t == null)
throw new NullPointerException();
Util.sneakyThrow0(t);
return null;
}
@SuppressWarnings("unchecked")
static private void sneakyThrow0(Throwable t) throws T {
throw (T) t;
}
}
clojure1.6_1.6.0+dfsg.orig/src/jvm/clojure/lang/Var.java 0000664 0000000 0000000 00000060212 12346720654 0022722 0 ustar 00root root 0000000 0000000 /**
* 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.
**/
/* rich Jul 31, 2007 */
package clojure.lang;
import java.util.concurrent.atomic.AtomicBoolean;
public final class Var extends ARef implements IFn, IRef, Settable{
static class TBox{
volatile Object val;
final Thread thread;
public TBox(Thread t, Object val){
this.thread = t;
this.val = val;
}
}
static public class Unbound extends AFn{
final public Var v;
public Unbound(Var v){
this.v = v;
}
public String toString(){
return "Unbound: " + v;
}
public Object throwArity(int n){
throw new IllegalStateException("Attempting to call unbound fn: " + v);
}
}
static class Frame{
final static Frame TOP = new Frame(PersistentHashMap.EMPTY, null);
//Var->TBox
Associative bindings;
//Var->val
// Associative frameBindings;
Frame prev;
public Frame(Associative bindings, Frame prev){
// this.frameBindings = frameBindings;
this.bindings = bindings;
this.prev = prev;
}
protected Object clone() {
return new Frame(this.bindings, null);
}
}
static final ThreadLocal dvals = new ThreadLocal(){
protected Frame initialValue(){
return Frame.TOP;
}
};
static public volatile int rev = 0;
static Keyword privateKey = Keyword.intern(null, "private");
static IPersistentMap privateMeta = new PersistentArrayMap(new Object[]{privateKey, Boolean.TRUE});
static Keyword macroKey = Keyword.intern(null, "macro");
static Keyword nameKey = Keyword.intern(null, "name");
static Keyword nsKey = Keyword.intern(null, "ns");
//static Keyword tagKey = Keyword.intern(null, "tag");
volatile Object root;
volatile boolean dynamic = false;
transient final AtomicBoolean threadBound;
public final Symbol sym;
public final Namespace ns;
//IPersistentMap _meta;
public static Object getThreadBindingFrame(){
return dvals.get();
}
public static Object cloneThreadBindingFrame(){
return dvals.get().clone();
}
public static void resetThreadBindingFrame(Object frame){
dvals.set((Frame) frame);
}
public Var setDynamic(){
this.dynamic = true;
return this;
}
public Var setDynamic(boolean b){
this.dynamic = b;
return this;
}
public final boolean isDynamic(){
return dynamic;
}
public static Var intern(Namespace ns, Symbol sym, Object root){
return intern(ns, sym, root, true);
}
public static Var intern(Namespace ns, Symbol sym, Object root, boolean replaceRoot){
Var dvout = ns.intern(sym);
if(!dvout.hasRoot() || replaceRoot)
dvout.bindRoot(root);
return dvout;
}
public String toString(){
if(ns != null)
return "#'" + ns.name + "/" + sym;
return "#";
}
public static Var find(Symbol nsQualifiedSym){
if(nsQualifiedSym.ns == null)
throw new IllegalArgumentException("Symbol must be namespace-qualified");
Namespace ns = Namespace.find(Symbol.intern(nsQualifiedSym.ns));
if(ns == null)
throw new IllegalArgumentException("No such namespace: " + nsQualifiedSym.ns);
return ns.findInternedVar(Symbol.intern(nsQualifiedSym.name));
}
public static Var intern(Symbol nsName, Symbol sym){
Namespace ns = Namespace.findOrCreate(nsName);
return intern(ns, sym);
}
public static Var internPrivate(String nsName, String sym){
Namespace ns = Namespace.findOrCreate(Symbol.intern(nsName));
Var ret = intern(ns, Symbol.intern(sym));
ret.setMeta(privateMeta);
return ret;
}
public static Var intern(Namespace ns, Symbol sym){
return ns.intern(sym);
}
public static Var create(){
return new Var(null, null);
}
public static Var create(Object root){
return new Var(null, null, root);
}
Var(Namespace ns, Symbol sym){
this.ns = ns;
this.sym = sym;
this.threadBound = new AtomicBoolean(false);
this.root = new Unbound(this);
setMeta(PersistentHashMap.EMPTY);
}
Var(Namespace ns, Symbol sym, Object root){
this(ns, sym);
this.root = root;
++rev;
}
public boolean isBound(){
return hasRoot() || (threadBound.get() && dvals.get().bindings.containsKey(this));
}
final public Object get(){
if(!threadBound.get())
return root;
return deref();
}
final public Object deref(){
TBox b = getThreadBinding();
if(b != null)
return b.val;
return root;
}
public void setValidator(IFn vf){
if(hasRoot())
validate(vf, root);
validator = vf;
}
public Object alter(IFn fn, ISeq args) {
set(fn.applyTo(RT.cons(deref(), args)));
return this;
}
public Object set(Object val){
validate(getValidator(), val);
TBox b = getThreadBinding();
if(b != null)
{
if(Thread.currentThread() != b.thread)
throw new IllegalStateException(String.format("Can't set!: %s from non-binding thread", sym));
return (b.val = val);
}
throw new IllegalStateException(String.format("Can't change/establish root binding of: %s with set", sym));
}
public Object doSet(Object val) {
return set(val);
}
public Object doReset(Object val) {
bindRoot(val);
return val;
}
public void setMeta(IPersistentMap m) {
//ensure these basis keys
resetMeta(m.assoc(nameKey, sym).assoc(nsKey, ns));
}
public void setMacro() {
alterMeta(assoc, RT.list(macroKey, RT.T));
}
public boolean isMacro(){
return RT.booleanCast(meta().valAt(macroKey));
}
//public void setExported(boolean state){
// _meta = _meta.assoc(privateKey, state);
//}
public boolean isPublic(){
return !RT.booleanCast(meta().valAt(privateKey));
}
final public Object getRawRoot(){
return root;
}
public Object getTag(){
return meta().valAt(RT.TAG_KEY);
}
public void setTag(Symbol tag) {
alterMeta(assoc, RT.list(RT.TAG_KEY, tag));
}
final public boolean hasRoot(){
return !(root instanceof Unbound);
}
//binding root always clears macro flag
synchronized public void bindRoot(Object root){
validate(getValidator(), root);
Object oldroot = this.root;
this.root = root;
++rev;
alterMeta(dissoc, RT.list(macroKey));
notifyWatches(oldroot,this.root);
}
synchronized void swapRoot(Object root){
validate(getValidator(), root);
Object oldroot = this.root;
this.root = root;
++rev;
notifyWatches(oldroot,root);
}
synchronized public void unbindRoot(){
this.root = new Unbound(this);
++rev;
}
synchronized public void commuteRoot(IFn fn) {
Object newRoot = fn.invoke(root);
validate(getValidator(), newRoot);
Object oldroot = root;
this.root = newRoot;
++rev;
notifyWatches(oldroot,newRoot);
}
synchronized public Object alterRoot(IFn fn, ISeq args) {
Object newRoot = fn.applyTo(RT.cons(root, args));
validate(getValidator(), newRoot);
Object oldroot = root;
this.root = newRoot;
++rev;
notifyWatches(oldroot,newRoot);
return newRoot;
}
public static void pushThreadBindings(Associative bindings){
Frame f = dvals.get();
Associative bmap = f.bindings;
for(ISeq bs = bindings.seq(); bs != null; bs = bs.next())
{
IMapEntry e = (IMapEntry) bs.first();
Var v = (Var) e.key();
if(!v.dynamic)
throw new IllegalStateException(String.format("Can't dynamically bind non-dynamic var: %s/%s", v.ns, v.sym));
v.validate(v.getValidator(), e.val());
v.threadBound.set(true);
bmap = bmap.assoc(v, new TBox(Thread.currentThread(), e.val()));
}
dvals.set(new Frame(bmap, f));
}
public static void popThreadBindings(){
Frame f = dvals.get().prev;
if (f == null) {
throw new IllegalStateException("Pop without matching push");
} else if (f == Frame.TOP) {
dvals.remove();
} else {
dvals.set(f);
}
}
public static Associative getThreadBindings(){
Frame f = dvals.get();
IPersistentMap ret = PersistentHashMap.EMPTY;
for(ISeq bs = f.bindings.seq(); bs != null; bs = bs.next())
{
IMapEntry e = (IMapEntry) bs.first();
Var v = (Var) e.key();
TBox b = (TBox) e.val();
ret = ret.assoc(v, b.val);
}
return ret;
}
public final TBox getThreadBinding(){
if(threadBound.get())
{
IMapEntry e = dvals.get().bindings.entryAt(this);
if(e != null)
return (TBox) e.val();
}
return null;
}
final public IFn fn(){
return (IFn) deref();
}
public Object call() {
return invoke();
}
public void run(){
invoke();
}
public Object invoke() {
return fn().invoke();
}
public Object invoke(Object arg1) {
return fn().invoke(Util.ret1(arg1,arg1=null));
}
public Object invoke(Object arg1, Object arg2) {
return fn().invoke(Util.ret1(arg1,arg1=null),
Util.ret1(arg2,arg2=null));
}
public Object invoke(Object arg1, Object arg2, Object arg3) {
return fn().invoke(Util.ret1(arg1,arg1=null),
Util.ret1(arg2,arg2=null),
Util.ret1(arg3,arg3=null));
}
public Object invoke(Object arg1, Object arg2, Object arg3, Object arg4) {
return fn().invoke(Util.ret1(arg1,arg1=null),
Util.ret1(arg2,arg2=null),
Util.ret1(arg3,arg3=null),
Util.ret1(arg4,arg4=null));
}
public Object invoke(Object arg1, Object arg2, Object arg3, Object arg4, Object arg5) {
return fn().invoke(Util.ret1(arg1,arg1=null),
Util.ret1(arg2,arg2=null),
Util.ret1(arg3,arg3=null),
Util.ret1(arg4,arg4=null),
Util.ret1(arg5,arg5=null));
}
public Object invoke(Object arg1, Object arg2, Object arg3, Object arg4, Object arg5, Object arg6) {
return fn().invoke(Util.ret1(arg1,arg1=null),
Util.ret1(arg2,arg2=null),
Util.ret1(arg3,arg3=null),
Util.ret1(arg4,arg4=null),
Util.ret1(arg5,arg5=null),
Util.ret1(arg6,arg6=null));
}
public Object invoke(Object arg1, Object arg2, Object arg3, Object arg4, Object arg5, Object arg6, Object arg7)
{
return fn().invoke(Util.ret1(arg1,arg1=null),
Util.ret1(arg2,arg2=null),
Util.ret1(arg3,arg3=null),
Util.ret1(arg4,arg4=null),
Util.ret1(arg5,arg5=null),
Util.ret1(arg6,arg6=null),
Util.ret1(arg7,arg7=null));
}
public Object invoke(Object arg1, Object arg2, Object arg3, Object arg4, Object arg5, Object arg6, Object arg7,
Object arg8) {
return fn().invoke(Util.ret1(arg1,arg1=null),
Util.ret1(arg2,arg2=null),
Util.ret1(arg3,arg3=null),
Util.ret1(arg4,arg4=null),
Util.ret1(arg5,arg5=null),
Util.ret1(arg6,arg6=null),
Util.ret1(arg7,arg7=null),
Util.ret1(arg8,arg8=null));
}
public Object invoke(Object arg1, Object arg2, Object arg3, Object arg4, Object arg5, Object arg6, Object arg7,
Object arg8, Object arg9) {
return fn().invoke(Util.ret1(arg1,arg1=null),
Util.ret1(arg2,arg2=null),
Util.ret1(arg3,arg3=null),
Util.ret1(arg4,arg4=null),
Util.ret1(arg5,arg5=null),
Util.ret1(arg6,arg6=null),
Util.ret1(arg7,arg7=null),
Util.ret1(arg8,arg8=null),
Util.ret1(arg9,arg9=null));
}
public Object invoke(Object arg1, Object arg2, Object arg3, Object arg4, Object arg5, Object arg6, Object arg7,
Object arg8, Object arg9, Object arg10) {
return fn().invoke(Util.ret1(arg1,arg1=null),
Util.ret1(arg2,arg2=null),
Util.ret1(arg3,arg3=null),
Util.ret1(arg4,arg4=null),
Util.ret1(arg5,arg5=null),
Util.ret1(arg6,arg6=null),
Util.ret1(arg7,arg7=null),
Util.ret1(arg8,arg8=null),
Util.ret1(arg9,arg9=null),
Util.ret1(arg10,arg10=null));
}
public Object invoke(Object arg1, Object arg2, Object arg3, Object arg4, Object arg5, Object arg6, Object arg7,
Object arg8, Object arg9, Object arg10, Object arg11) {
return fn().invoke(Util.ret1(arg1,arg1=null),
Util.ret1(arg2,arg2=null),
Util.ret1(arg3,arg3=null),
Util.ret1(arg4,arg4=null),
Util.ret1(arg5,arg5=null),
Util.ret1(arg6,arg6=null),
Util.ret1(arg7,arg7=null),
Util.ret1(arg8,arg8=null),
Util.ret1(arg9,arg9=null),
Util.ret1(arg10,arg10=null),
Util.ret1(arg11,arg11=null));
}
public Object invoke(Object arg1, Object arg2, Object arg3, Object arg4, Object arg5, Object arg6, Object arg7,
Object arg8, Object arg9, Object arg10, Object arg11, Object arg12) {
return fn().invoke(Util.ret1(arg1,arg1=null),
Util.ret1(arg2,arg2=null),
Util.ret1(arg3,arg3=null),
Util.ret1(arg4,arg4=null),
Util.ret1(arg5,arg5=null),
Util.ret1(arg6,arg6=null),
Util.ret1(arg7,arg7=null),
Util.ret1(arg8,arg8=null),
Util.ret1(arg9,arg9=null),
Util.ret1(arg10,arg10=null),
Util.ret1(arg11,arg11=null),
Util.ret1(arg12,arg12=null));
}
public Object invoke(Object arg1, Object arg2, Object arg3, Object arg4, Object arg5, Object arg6, Object arg7,
Object arg8, Object arg9, Object arg10, Object arg11, Object arg12, Object arg13)
{
return fn().invoke(Util.ret1(arg1,arg1=null),
Util.ret1(arg2,arg2=null),
Util.ret1(arg3,arg3=null),
Util.ret1(arg4,arg4=null),
Util.ret1(arg5,arg5=null),
Util.ret1(arg6,arg6=null),
Util.ret1(arg7,arg7=null),
Util.ret1(arg8,arg8=null),
Util.ret1(arg9,arg9=null),
Util.ret1(arg10,arg10=null),
Util.ret1(arg11,arg11=null),
Util.ret1(arg12,arg12=null),
Util.ret1(arg13,arg13=null));
}
public Object invoke(Object arg1, Object arg2, Object arg3, Object arg4, Object arg5, Object arg6, Object arg7,
Object arg8, Object arg9, Object arg10, Object arg11, Object arg12, Object arg13, Object arg14)
{
return fn().invoke(Util.ret1(arg1,arg1=null),
Util.ret1(arg2,arg2=null),
Util.ret1(arg3,arg3=null),
Util.ret1(arg4,arg4=null),
Util.ret1(arg5,arg5=null),
Util.ret1(arg6,arg6=null),
Util.ret1(arg7,arg7=null),
Util.ret1(arg8,arg8=null),
Util.ret1(arg9,arg9=null),
Util.ret1(arg10,arg10=null),
Util.ret1(arg11,arg11=null),
Util.ret1(arg12,arg12=null),
Util.ret1(arg13,arg13=null),
Util.ret1(arg14,arg14=null));
}
public Object invoke(Object arg1, Object arg2, Object arg3, Object arg4, Object arg5, Object arg6, Object arg7,
Object arg8, Object arg9, Object arg10, Object arg11, Object arg12, Object arg13, Object arg14,
Object arg15) {
return fn().invoke(Util.ret1(arg1,arg1=null),
Util.ret1(arg2,arg2=null),
Util.ret1(arg3,arg3=null),
Util.ret1(arg4,arg4=null),
Util.ret1(arg5,arg5=null),
Util.ret1(arg6,arg6=null),
Util.ret1(arg7,arg7=null),
Util.ret1(arg8,arg8=null),
Util.ret1(arg9,arg9=null),
Util.ret1(arg10,arg10=null),
Util.ret1(arg11,arg11=null),
Util.ret1(arg12,arg12=null),
Util.ret1(arg13,arg13=null),
Util.ret1(arg14,arg14=null),
Util.ret1(arg15,arg15=null));
}
public Object invoke(Object arg1, Object arg2, Object arg3, Object arg4, Object arg5, Object arg6, Object arg7,
Object arg8, Object arg9, Object arg10, Object arg11, Object arg12, Object arg13, Object arg14,
Object arg15, Object arg16) {
return fn().invoke(Util.ret1(arg1,arg1=null),
Util.ret1(arg2,arg2=null),
Util.ret1(arg3,arg3=null),
Util.ret1(arg4,arg4=null),
Util.ret1(arg5,arg5=null),
Util.ret1(arg6,arg6=null),
Util.ret1(arg7,arg7=null),
Util.ret1(arg8,arg8=null),
Util.ret1(arg9,arg9=null),
Util.ret1(arg10,arg10=null),
Util.ret1(arg11,arg11=null),
Util.ret1(arg12,arg12=null),
Util.ret1(arg13,arg13=null),
Util.ret1(arg14,arg14=null),
Util.ret1(arg15,arg15=null),
Util.ret1(arg16,arg16=null));
}
public Object invoke(Object arg1, Object arg2, Object arg3, Object arg4, Object arg5, Object arg6, Object arg7,
Object arg8, Object arg9, Object arg10, Object arg11, Object arg12, Object arg13, Object arg14,
Object arg15, Object arg16, Object arg17) {
return fn().invoke(Util.ret1(arg1,arg1=null),
Util.ret1(arg2,arg2=null),
Util.ret1(arg3,arg3=null),
Util.ret1(arg4,arg4=null),
Util.ret1(arg5,arg5=null),
Util.ret1(arg6,arg6=null),
Util.ret1(arg7,arg7=null),
Util.ret1(arg8,arg8=null),
Util.ret1(arg9,arg9=null),
Util.ret1(arg10,arg10=null),
Util.ret1(arg11,arg11=null),
Util.ret1(arg12,arg12=null),
Util.ret1(arg13,arg13=null),
Util.ret1(arg14,arg14=null),
Util.ret1(arg15,arg15=null),
Util.ret1(arg16,arg16=null),
Util.ret1(arg17,arg17=null));
}
public Object invoke(Object arg1, Object arg2, Object arg3, Object arg4, Object arg5, Object arg6, Object arg7,
Object arg8, Object arg9, Object arg10, Object arg11, Object arg12, Object arg13, Object arg14,
Object arg15, Object arg16, Object arg17, Object arg18) {
return fn().invoke(Util.ret1(arg1,arg1=null),
Util.ret1(arg2,arg2=null),
Util.ret1(arg3,arg3=null),
Util.ret1(arg4,arg4=null),
Util.ret1(arg5,arg5=null),
Util.ret1(arg6,arg6=null),
Util.ret1(arg7,arg7=null),
Util.ret1(arg8,arg8=null),
Util.ret1(arg9,arg9=null),
Util.ret1(arg10,arg10=null),
Util.ret1(arg11,arg11=null),
Util.ret1(arg12,arg12=null),
Util.ret1(arg13,arg13=null),
Util.ret1(arg14,arg14=null),
Util.ret1(arg15,arg15=null),
Util.ret1(arg16,arg16=null),
Util.ret1(arg17,arg17=null),
Util.ret1(arg18,arg18=null));
}
public Object invoke(Object arg1, Object arg2, Object arg3, Object arg4, Object arg5, Object arg6, Object arg7,
Object arg8, Object arg9, Object arg10, Object arg11, Object arg12, Object arg13, Object arg14,
Object arg15, Object arg16, Object arg17, Object arg18, Object arg19) {
return fn().invoke(Util.ret1(arg1,arg1=null),
Util.ret1(arg2,arg2=null),
Util.ret1(arg3,arg3=null),
Util.ret1(arg4,arg4=null),
Util.ret1(arg5,arg5=null),
Util.ret1(arg6,arg6=null),
Util.ret1(arg7,arg7=null),
Util.ret1(arg8,arg8=null),
Util.ret1(arg9,arg9=null),
Util.ret1(arg10,arg10=null),
Util.ret1(arg11,arg11=null),
Util.ret1(arg12,arg12=null),
Util.ret1(arg13,arg13=null),
Util.ret1(arg14,arg14=null),
Util.ret1(arg15,arg15=null),
Util.ret1(arg16,arg16=null),
Util.ret1(arg17,arg17=null),
Util.ret1(arg18,arg18=null),
Util.ret1(arg19,arg19=null));
}
public Object invoke(Object arg1, Object arg2, Object arg3, Object arg4, Object arg5, Object arg6, Object arg7,
Object arg8, Object arg9, Object arg10, Object arg11, Object arg12, Object arg13, Object arg14,
Object arg15, Object arg16, Object arg17, Object arg18, Object arg19, Object arg20)
{
return fn().invoke(Util.ret1(arg1,arg1=null),
Util.ret1(arg2,arg2=null),
Util.ret1(arg3,arg3=null),
Util.ret1(arg4,arg4=null),
Util.ret1(arg5,arg5=null),
Util.ret1(arg6,arg6=null),
Util.ret1(arg7,arg7=null),
Util.ret1(arg8,arg8=null),
Util.ret1(arg9,arg9=null),
Util.ret1(arg10,arg10=null),
Util.ret1(arg11,arg11=null),
Util.ret1(arg12,arg12=null),
Util.ret1(arg13,arg13=null),
Util.ret1(arg14,arg14=null),
Util.ret1(arg15,arg15=null),
Util.ret1(arg16,arg16=null),
Util.ret1(arg17,arg17=null),
Util.ret1(arg18,arg18=null),
Util.ret1(arg19,arg19=null),
Util.ret1(arg20,arg20=null));
}
public Object invoke(Object arg1, Object arg2, Object arg3, Object arg4, Object arg5, Object arg6, Object arg7,
Object arg8, Object arg9, Object arg10, Object arg11, Object arg12, Object arg13, Object arg14,
Object arg15, Object arg16, Object arg17, Object arg18, Object arg19, Object arg20,
Object... args)
{
return fn().invoke(Util.ret1(arg1,arg1=null),
Util.ret1(arg2,arg2=null),
Util.ret1(arg3,arg3=null),
Util.ret1(arg4,arg4=null),
Util.ret1(arg5,arg5=null),
Util.ret1(arg6,arg6=null),
Util.ret1(arg7,arg7=null),
Util.ret1(arg8,arg8=null),
Util.ret1(arg9,arg9=null),
Util.ret1(arg10,arg10=null),
Util.ret1(arg11,arg11=null),
Util.ret1(arg12,arg12=null),
Util.ret1(arg13,arg13=null),
Util.ret1(arg14,arg14=null),
Util.ret1(arg15,arg15=null),
Util.ret1(arg16,arg16=null),
Util.ret1(arg17,arg17=null),
Util.ret1(arg18,arg18=null),
Util.ret1(arg19,arg19=null),
Util.ret1(arg20,arg20=null),
(Object[])Util.ret1(args, args=null));
}
public Object applyTo(ISeq arglist) {
return AFn.applyToHelper(this, arglist);
}
static IFn assoc = new AFn(){
@Override
public Object invoke(Object m, Object k, Object v) {
return RT.assoc(m, k, v);
}
};
static IFn dissoc = new AFn() {
@Override
public Object invoke(Object c, Object k) {
return RT.dissoc(c, k);
}
};
}
clojure1.6_1.6.0+dfsg.orig/src/jvm/clojure/lang/XMLHandler.java 0000664 0000000 0000000 00000004472 12346720654 0024136 0 ustar 00root root 0000000 0000000 /**
* 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.
**/
/* rich Dec 17, 2007 */
package clojure.lang;
import org.xml.sax.Attributes;
import org.xml.sax.ContentHandler;
import org.xml.sax.Locator;
import org.xml.sax.SAXException;
import org.xml.sax.helpers.DefaultHandler;
public class XMLHandler extends DefaultHandler{
ContentHandler h;
public XMLHandler(ContentHandler h){
this.h = h;
}
public void setDocumentLocator(Locator locator){
h.setDocumentLocator(locator);
}
public void startDocument() throws SAXException{
h.startDocument();
}
public void endDocument() throws SAXException{
h.endDocument();
}
public void startPrefixMapping(String prefix, String uri) throws SAXException{
h.startPrefixMapping(prefix, uri);
}
public void endPrefixMapping(String prefix) throws SAXException{
h.endPrefixMapping(prefix);
}
public void startElement(String uri, String localName, String qName, Attributes atts) throws SAXException{
h.startElement(uri, localName, qName, atts);
}
public void endElement(String uri, String localName, String qName) throws SAXException{
h.endElement(uri, localName, qName);
}
public void characters(char ch[], int start, int length) throws SAXException{
h.characters(ch, start, length);
}
public void ignorableWhitespace(char ch[], int start, int length) throws SAXException{
h.ignorableWhitespace(ch, start, length);
}
public void processingInstruction(String target, String data) throws SAXException{
h.processingInstruction(target, data);
}
public void skippedEntity(String name) throws SAXException{
h.skippedEntity(name);
}
/*
public static void main(String[] args){
try
{
ContentHandler dummy = new DefaultHandler();
SAXParserFactory f = SAXParserFactory.newInstance();
//f.setNamespaceAware(true);
SAXParser p = f.newSAXParser();
p.parse("http://arstechnica.com/journals.rssx",new XMLHandler(dummy));
}
catch(Exception e)
{
e.printStackTrace();
}
}
//*/
}
clojure1.6_1.6.0+dfsg.orig/src/jvm/clojure/lang/package.html 0000664 0000000 0000000 00000001342 12346720654 0023607 0 ustar 00root root 0000000 0000000
Clojure language implementation.
The clojure.lang package holds the implementation for Clojure.
The only class considered part of the public API is
{@link clojure.lang.IFn}. All other classes should be considered
implementation details.
clojure1.6_1.6.0+dfsg.orig/src/jvm/clojure/main.java 0000664 0000000 0000000 00000002456 12346720654 0022203 0 ustar 00root root 0000000 0000000 /**
* 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;
import clojure.lang.Symbol;
import clojure.lang.Var;
import clojure.lang.RT;
public class main{
final static private Symbol CLOJURE_MAIN = Symbol.intern("clojure.main");
final static private Var REQUIRE = RT.var("clojure.core", "require");
final static private Var LEGACY_REPL = RT.var("clojure.main", "legacy-repl");
final static private Var LEGACY_SCRIPT = RT.var("clojure.main", "legacy-script");
final static private Var MAIN = RT.var("clojure.main", "main");
public static void legacy_repl(String[] args) {
REQUIRE.invoke(CLOJURE_MAIN);
LEGACY_REPL.invoke(RT.seq(args));
}
public static void legacy_script(String[] args) {
REQUIRE.invoke(CLOJURE_MAIN);
LEGACY_SCRIPT.invoke(RT.seq(args));
}
public static void main(String[] args) {
REQUIRE.invoke(CLOJURE_MAIN);
MAIN.applyTo(RT.seq(args));
}
}
clojure1.6_1.6.0+dfsg.orig/src/resources/ 0000775 0000000 0000000 00000000000 12346720654 0020160 5 ustar 00root root 0000000 0000000 clojure1.6_1.6.0+dfsg.orig/src/resources/clojure/ 0000775 0000000 0000000 00000000000 12346720654 0021623 5 ustar 00root root 0000000 0000000 clojure1.6_1.6.0+dfsg.orig/src/resources/clojure/version.properties 0000664 0000000 0000000 00000000022 12346720654 0025420 0 ustar 00root root 0000000 0000000 version=${version} clojure1.6_1.6.0+dfsg.orig/src/script/ 0000775 0000000 0000000 00000000000 12346720654 0017452 5 ustar 00root root 0000000 0000000 clojure1.6_1.6.0+dfsg.orig/src/script/run_tests.clj 0000664 0000000 0000000 00000000271 12346720654 0022172 0 ustar 00root root 0000000 0000000 (System/setProperty "clojure.test.generative.msec" "60000")
(System/setProperty "java.awt.headless" "true")
(require '[clojure.test.generative.runner :as runner])
(runner/-main "test")
clojure1.6_1.6.0+dfsg.orig/test/ 0000775 0000000 0000000 00000000000 12346720654 0016336 5 ustar 00root root 0000000 0000000 clojure1.6_1.6.0+dfsg.orig/test/clojure/ 0000775 0000000 0000000 00000000000 12346720654 0020001 5 ustar 00root root 0000000 0000000 clojure1.6_1.6.0+dfsg.orig/test/clojure/test_clojure/ 0000775 0000000 0000000 00000000000 12346720654 0022503 5 ustar 00root root 0000000 0000000 clojure1.6_1.6.0+dfsg.orig/test/clojure/test_clojure/agents.clj 0000664 0000000 0000000 00000014443 12346720654 0024464 0 ustar 00root root 0000000 0000000 ; 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.
;; Author: Shawn Hoover
(ns clojure.test-clojure.agents
(:use clojure.test)
(:import [java.util.concurrent CountDownLatch TimeUnit]))
;; tests are fragile. If wait fails, could indicate that
;; build box is thrashing.
(def fragile-wait 1000)
(deftest handle-all-throwables-during-agent-actions
;; Bug fixed in r1198; previously hung Clojure or didn't report agent errors
;; after OutOfMemoryError, yet wouldn't execute new actions.
(let [agt (agent nil)]
(send agt (fn [state] (throw (Throwable. "just testing Throwables"))))
(try
;; Let the action finish; eat the "agent has errors" error that bubbles up
(await-for fragile-wait agt)
(catch RuntimeException _))
(is (instance? Throwable (first (agent-errors agt))))
(is (= 1 (count (agent-errors agt))))
;; And now send an action that should work
(clear-agent-errors agt)
(is (= nil @agt))
(send agt nil?)
(is (true? (await-for fragile-wait agt)))
(is (true? @agt))))
(deftest default-modes
(is (= :fail (error-mode (agent nil))))
(is (= :continue (error-mode (agent nil :error-handler println)))))
(deftest continue-handler
(let [err (atom nil)
agt (agent 0 :error-mode :continue :error-handler #(reset! err %&))]
(send agt /)
(is (true? (await-for fragile-wait agt)))
(is (= 0 @agt))
(is (nil? (agent-error agt)))
(is (= agt (first @err)))
(is (true? (instance? ArithmeticException (second @err))))))
;; TODO: make these tests deterministic (i.e. not sleep and hope)
#_(deftest fail-handler
(let [err (atom nil)
agt (agent 0 :error-mode :fail :error-handler #(reset! err %&))]
(send agt /)
(Thread/sleep 100)
(is (true? (instance? ArithmeticException (agent-error agt))))
(is (= 0 @agt))
(is (= agt (first @err)))
(is (true? (instance? ArithmeticException (second @err))))
(is (thrown? RuntimeException (send agt inc)))))
(deftest can-send-from-error-handler-before-popping-action-that-caused-error
(let [latch (CountDownLatch. 1)
target-agent (agent :before-error)
handler (fn [agt err]
(send target-agent
(fn [_] (.countDown latch))))
failing-agent (agent nil :error-handler handler)]
(send failing-agent (fn [_] (throw (RuntimeException.))))
(is (.await latch 10 TimeUnit/SECONDS))))
(deftest can-send-to-self-from-error-handler-before-popping-action-that-caused-error
(let [latch (CountDownLatch. 1)
handler (fn [agt err]
(send *agent*
(fn [_] (.countDown latch))))
failing-agent (agent nil :error-handler handler)]
(send failing-agent (fn [_] (throw (RuntimeException.))))
(is (.await latch 10 TimeUnit/SECONDS))))
#_(deftest restart-no-clear
(let [p (promise)
agt (agent 1 :error-mode :fail)]
(send agt (fn [v] @p))
(send agt /)
(send agt inc)
(send agt inc)
(deliver p 0)
(Thread/sleep 100)
(is (= 0 @agt))
(is (= ArithmeticException (class (agent-error agt))))
(restart-agent agt 10)
(is (true? (await-for fragile-wait agt)))
(is (= 12 @agt))
(is (nil? (agent-error agt)))))
#_(deftest restart-clear
(let [p (promise)
agt (agent 1 :error-mode :fail)]
(send agt (fn [v] @p))
(send agt /)
(send agt inc)
(send agt inc)
(deliver p 0)
(Thread/sleep 100)
(is (= 0 @agt))
(is (= ArithmeticException (class (agent-error agt))))
(restart-agent agt 10 :clear-actions true)
(is (true? (await-for fragile-wait agt)))
(is (= 10 @agt))
(is (nil? (agent-error agt)))
(send agt inc)
(is (true? (await-for fragile-wait agt)))
(is (= 11 @agt))
(is (nil? (agent-error agt)))))
#_(deftest invalid-restart
(let [p (promise)
agt (agent 2 :error-mode :fail :validator even?)]
(is (thrown? RuntimeException (restart-agent agt 4)))
(send agt (fn [v] @p))
(send agt (partial + 2))
(send agt (partial + 2))
(deliver p 3)
(Thread/sleep 100)
(is (= 2 @agt))
(is (= IllegalStateException (class (agent-error agt))))
(is (thrown? RuntimeException (restart-agent agt 5)))
(restart-agent agt 6)
(is (true? (await-for fragile-wait agt)))
(is (= 10 @agt))
(is (nil? (agent-error agt)))))
(deftest earmuff-agent-bound
(let [a (agent 1)]
(send a (fn [_] *agent*))
(await a)
(is (= a @a))))
(def ^:dynamic *bind-me* :root-binding)
(deftest thread-conveyance-to-agents
(let [a (agent nil)]
(doto (Thread.
(fn []
(binding [*bind-me* :thread-binding]
(send a (constantly *bind-me*)))
(await a)))
(.start)
(.join))
(is (= @a :thread-binding))))
;; check for a race condition that was causing seque to leak threads from the
;; send-off pool. Specifically, if we consume all items from the seque, and
;; the LBQ continues to grow, it means there was an agent action blocking on
;; the .put, which would block indefinitely outside of this test.
(deftest seque-threads
(let [queue-size 5
slow-seq (for [x (take (* 2 queue-size) (iterate inc 0))]
(do (Thread/sleep 25)
x))
small-lbq (java.util.concurrent.LinkedBlockingQueue. queue-size)
worker (seque small-lbq slow-seq)]
(doall worker)
(is (= worker slow-seq))
(Thread/sleep 250) ;; make sure agents have time to run or get blocked
(let [queue-backlog (.size small-lbq)]
(is (<= 0 queue-backlog queue-size))
(when-not (zero? queue-backlog)
(.take small-lbq)
(Thread/sleep 250) ;; see if agent was blocking, indicating a thread leak
(is (= (.size small-lbq)
(dec queue-backlog)))))))
; http://clojure.org/agents
; agent
; deref, @-reader-macro, agent-errors
; send send-off clear-agent-errors
; await await-for
; set-validator get-validator
; add-watch remove-watch
; shutdown-agents
clojure1.6_1.6.0+dfsg.orig/test/clojure/test_clojure/annotations.clj 0000664 0000000 0000000 00000001243 12346720654 0025532 0 ustar 00root root 0000000 0000000 ; 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.
;; Authors: Stuart Halloway, Rich Hickey
(ns clojure.test-clojure.annotations
(:use clojure.test))
(case (System/getProperty "java.specification.version")
"1.6" (load "annotations/java_6")
nil)
clojure1.6_1.6.0+dfsg.orig/test/clojure/test_clojure/annotations/ 0000775 0000000 0000000 00000000000 12346720654 0025040 5 ustar 00root root 0000000 0000000 clojure1.6_1.6.0+dfsg.orig/test/clojure/test_clojure/annotations/java_5.clj 0000664 0000000 0000000 00000004255 12346720654 0026705 0 ustar 00root root 0000000 0000000 ;; java 5 annotation tests
(in-ns 'clojure.test-clojure.annotations)
(import [java.lang.annotation Annotation Retention RetentionPolicy Target ElementType])
(definterface Foo (foo []))
(deftype #^{Deprecated true
Retention RetentionPolicy/RUNTIME}
Bar [#^int a
#^{:tag int
Deprecated true
Retention RetentionPolicy/RUNTIME} b]
Foo (#^{Deprecated true
Retention RetentionPolicy/RUNTIME}
foo [this] 42))
(defn annotation->map
"Converts a Java annotation (which conceals data)
into a map (which makes is usable). Not lazy.
Works recursively. Returns non-annotations unscathed."
[#^java.lang.annotation.Annotation o]
(cond
(instance? Annotation o)
(let [type (.annotationType o)
itfs (-> (into #{type} (supers type)) (disj java.lang.annotation.Annotation))
data-methods (into #{} (mapcat #(.getDeclaredMethods %) itfs))]
(into
{:annotationType (.annotationType o)}
(map
(fn [m] [(keyword (.getName m)) (annotation->map (.invoke m o nil))])
data-methods)))
(or (sequential? o) (.isArray (class o)))
(map annotation->map o)
:else o))
(def expected-annotations
#{{:annotationType java.lang.annotation.Retention, :value RetentionPolicy/RUNTIME}
{:annotationType java.lang.Deprecated}})
(deftest test-annotations-on-type
(is (=
expected-annotations
(into #{} (map annotation->map (.getAnnotations Bar))))))
(deftest test-annotations-on-field
(is (=
expected-annotations
(into #{} (map annotation->map (.getAnnotations (.getField Bar "b")))))))
(deftest test-annotations-on-method
(is (=
expected-annotations
(into #{} (map annotation->map (.getAnnotations (.getMethod Bar "foo" nil)))))))
(gen-class :name foo.Bar
:extends clojure.lang.Box
:constructors {^{Deprecated true} [Object] [Object]}
:init init
:prefix "foo")
(defn foo-init [obj]
[[obj] nil])
(deftest test-annotations-on-constructor
(is (some #(instance? Deprecated %)
(for [ctor (.getConstructors (Class/forName "foo.Bar"))
annotation (.getAnnotations ctor)]
annotation))))
clojure1.6_1.6.0+dfsg.orig/test/clojure/test_clojure/annotations/java_6.clj 0000664 0000000 0000000 00000007207 12346720654 0026706 0 ustar 00root root 0000000 0000000 ;; java 6 annotation tests
(in-ns 'clojure.test-clojure.annotations)
(import [java.lang.annotation Annotation Retention RetentionPolicy Target ElementType]
[javax.xml.ws WebServiceRef WebServiceRefs])
(definterface Foo (foo []))
(deftype #^{Deprecated true
Retention RetentionPolicy/RUNTIME
javax.annotation.processing.SupportedOptions ["foo" "bar" "baz"]
javax.xml.ws.soap.Addressing {:enabled false :required true}
WebServiceRefs [(WebServiceRef {:name "fred" :type String})
(WebServiceRef {:name "ethel" :mappedName "lucy"})]}
Bar [#^int a
#^{:tag int
Deprecated true
Retention RetentionPolicy/RUNTIME
javax.annotation.processing.SupportedOptions ["foo" "bar" "baz"]
javax.xml.ws.soap.Addressing {:enabled false :required true}
WebServiceRefs [(WebServiceRef {:name "fred" :type String})
(WebServiceRef {:name "ethel" :mappedName "lucy"})]}
b]
Foo (#^{Deprecated true
Retention RetentionPolicy/RUNTIME
javax.annotation.processing.SupportedOptions ["foo" "bar" "baz"]
javax.xml.ws.soap.Addressing {:enabled false :required true}
WebServiceRefs [(WebServiceRef {:name "fred" :type String})
(WebServiceRef {:name "ethel" :mappedName "lucy"})]}
foo [this] 42))
(defn annotation->map
"Converts a Java annotation (which conceals data)
into a map (which makes is usable). Not lazy.
Works recursively. Returns non-annotations unscathed."
[#^java.lang.annotation.Annotation o]
(cond
(instance? Annotation o)
(let [type (.annotationType o)
itfs (-> (into #{type} (supers type)) (disj java.lang.annotation.Annotation))
data-methods (into #{} (mapcat #(.getDeclaredMethods %) itfs))]
(into
{:annotationType (.annotationType o)}
(map
(fn [m] [(keyword (.getName m)) (annotation->map (.invoke m o nil))])
data-methods)))
(or (sequential? o) (.isArray (class o)))
(map annotation->map o)
:else o))
(def expected-annotations
#{{:annotationType java.lang.annotation.Retention, :value RetentionPolicy/RUNTIME}
{:annotationType javax.xml.ws.WebServiceRefs,
:value [{:annotationType javax.xml.ws.WebServiceRef, :name "fred", :mappedName "", :type java.lang.String, :wsdlLocation "", :value java.lang.Object}
{:annotationType javax.xml.ws.WebServiceRef, :name "ethel", :mappedName "lucy", :type java.lang.Object, :wsdlLocation "", :value java.lang.Object}]}
{:annotationType javax.xml.ws.soap.Addressing, :enabled false, :required true}
{:annotationType javax.annotation.processing.SupportedOptions, :value ["foo" "bar" "baz"]}
{:annotationType java.lang.Deprecated}})
(deftest test-annotations-on-type
(is (=
expected-annotations
(into #{} (map annotation->map (.getAnnotations Bar))))))
(deftest test-annotations-on-field
(is (=
expected-annotations
(into #{} (map annotation->map (.getAnnotations (.getField Bar "b")))))))
(deftest test-annotations-on-method
(is (=
expected-annotations
(into #{} (map annotation->map (.getAnnotations (.getMethod Bar "foo" nil)))))))
(gen-class :name foo.Bar
:extends clojure.lang.Box
:constructors {^{Deprecated true} [Object] [Object]}
:init init
:prefix "foo")
(defn foo-init [obj]
[[obj] nil])
(deftest test-annotations-on-constructor
(is (some #(instance? Deprecated %)
(for [ctor (.getConstructors (Class/forName "foo.Bar"))
annotation (.getAnnotations ctor)]
annotation))))
clojure1.6_1.6.0+dfsg.orig/test/clojure/test_clojure/api.clj 0000664 0000000 0000000 00000003134 12346720654 0023747 0 ustar 00root root 0000000 0000000 ; 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.
(ns clojure.test-clojure.api
(:require [clojure.test.generative :refer (defspec)]
[clojure.test-clojure.generators :as cgen])
(:import clojure.lang.IFn
clojure.java.api.Clojure
clojure.lang.Var))
(set! *warn-on-reflection* true)
(defn roundtrip
"Print an object and read it back with Clojure/read"
[o]
(binding [*print-length* nil
*print-dup* nil
*print-level* nil]
(Clojure/read (pr-str o))))
(defn api-var-str
[^Var v]
(Clojure/var (str (.name (.ns v)))
(str (.sym v))))
(defn api-var
[^Var v]
(Clojure/var (.name (.ns v))
(.sym v)))
(defspec api-can-read
roundtrip
[^{:tag cgen/ednable} o]
(when-not (= o %)
(throw (ex-info "Value cannot roundtrip with Clojure/read" {:printed o :read %}))))
(defspec api-can-find-var
api-var
[^{:tag cgen/var} v]
(when-not (= v %)
(throw (ex-info "Var cannot roundtrip through Clojure/var" {:from v :to %}))))
(defspec api-can-find-var-str
api-var-str
[^{:tag cgen/var} v]
(when-not (= v %)
(throw (ex-info "Var cannot roundtrip strings through Clojure/var" {:from v :to %}))))
clojure1.6_1.6.0+dfsg.orig/test/clojure/test_clojure/atoms.clj 0000664 0000000 0000000 00000001202 12346720654 0024313 0 ustar 00root root 0000000 0000000 ; 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.
;;Author: Frantisek Sodomka
(ns clojure.test-clojure.atoms
(:use clojure.test))
; http://clojure.org/atoms
; atom
; deref, @-reader-macro
; swap! reset!
; compare-and-set!
clojure1.6_1.6.0+dfsg.orig/test/clojure/test_clojure/clojure_set.clj 0000664 0000000 0000000 00000017234 12346720654 0025522 0 ustar 00root root 0000000 0000000 ; 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.
;; Author: Frantisek Sodomka
(ns clojure.test-clojure.clojure-set
(:use clojure.test)
(:require [clojure.set :as set]))
(deftest test-union
(are [x y] (= x y)
(set/union) #{}
; identity
(set/union #{}) #{}
(set/union #{1}) #{1}
(set/union #{1 2 3}) #{1 2 3}
; 2 sets, at least one is empty
(set/union #{} #{}) #{}
(set/union #{} #{1}) #{1}
(set/union #{} #{1 2 3}) #{1 2 3}
(set/union #{1} #{}) #{1}
(set/union #{1 2 3} #{}) #{1 2 3}
; 2 sets
(set/union #{1} #{2}) #{1 2}
(set/union #{1} #{1 2}) #{1 2}
(set/union #{2} #{1 2}) #{1 2}
(set/union #{1 2} #{3}) #{1 2 3}
(set/union #{1 2} #{2 3}) #{1 2 3}
; 3 sets, some are empty
(set/union #{} #{} #{}) #{}
(set/union #{1} #{} #{}) #{1}
(set/union #{} #{1} #{}) #{1}
(set/union #{} #{} #{1}) #{1}
(set/union #{1 2} #{2 3} #{}) #{1 2 3}
; 3 sets
(set/union #{1 2} #{3 4} #{5 6}) #{1 2 3 4 5 6}
(set/union #{1 2} #{2 3} #{1 3 4}) #{1 2 3 4}
; different data types
(set/union #{1 2} #{:a :b} #{nil} #{false true} #{\c "abc"} #{[] [1 2]}
#{{} {:a 1}} #{#{} #{1 2}})
#{1 2 :a :b nil false true \c "abc" [] [1 2] {} {:a 1} #{} #{1 2}}
; different types of sets
(set/union (hash-set) (hash-set 1 2) (hash-set 2 3))
(hash-set 1 2 3)
(set/union (sorted-set) (sorted-set 1 2) (sorted-set 2 3))
(sorted-set 1 2 3)
(set/union (hash-set) (hash-set 1 2) (hash-set 2 3)
(sorted-set) (sorted-set 4 5) (sorted-set 5 6))
(hash-set 1 2 3 4 5 6) ; also equals (sorted-set 1 2 3 4 5 6)
))
(deftest test-intersection
; at least one argument is needed
(is (thrown? IllegalArgumentException (set/intersection)))
(are [x y] (= x y)
; identity
(set/intersection #{}) #{}
(set/intersection #{1}) #{1}
(set/intersection #{1 2 3}) #{1 2 3}
; 2 sets, at least one is empty
(set/intersection #{} #{}) #{}
(set/intersection #{} #{1}) #{}
(set/intersection #{} #{1 2 3}) #{}
(set/intersection #{1} #{}) #{}
(set/intersection #{1 2 3} #{}) #{}
; 2 sets
(set/intersection #{1 2} #{1 2}) #{1 2}
(set/intersection #{1 2} #{3 4}) #{}
(set/intersection #{1 2} #{1}) #{1}
(set/intersection #{1 2} #{2}) #{2}
(set/intersection #{1 2 4} #{2 3 4 5}) #{2 4}
; 3 sets, some are empty
(set/intersection #{} #{} #{}) #{}
(set/intersection #{1} #{} #{}) #{}
(set/intersection #{1} #{1} #{}) #{}
(set/intersection #{1} #{} #{1}) #{}
(set/intersection #{1 2} #{2 3} #{}) #{}
; 3 sets
(set/intersection #{1 2} #{2 3} #{5 2}) #{2}
(set/intersection #{1 2 3} #{1 3 4} #{1 3}) #{1 3}
(set/intersection #{1 2 3} #{3 4 5} #{8 2 3}) #{3}
; different types of sets
(set/intersection (hash-set 1 2) (hash-set 2 3)) #{2}
(set/intersection (sorted-set 1 2) (sorted-set 2 3)) #{2}
(set/intersection
(hash-set 1 2) (hash-set 2 3)
(sorted-set 1 2) (sorted-set 2 3)) #{2} ))
(deftest test-difference
(are [x y] (= x y)
; identity
(set/difference #{}) #{}
(set/difference #{1}) #{1}
(set/difference #{1 2 3}) #{1 2 3}
; 2 sets
(set/difference #{1 2} #{1 2}) #{}
(set/difference #{1 2} #{3 4}) #{1 2}
(set/difference #{1 2} #{1}) #{2}
(set/difference #{1 2} #{2}) #{1}
(set/difference #{1 2 4} #{2 3 4 5}) #{1}
; 3 sets
(set/difference #{1 2} #{2 3} #{5 2}) #{1}
(set/difference #{1 2 3} #{1 3 4} #{1 3}) #{2}
(set/difference #{1 2 3} #{3 4 5} #{8 2 3}) #{1} ))
(deftest test-select
(are [x y] (= x y)
(set/select integer? #{}) #{}
(set/select integer? #{1 2}) #{1 2}
(set/select integer? #{1 2 :a :b :c}) #{1 2}
(set/select integer? #{:a :b :c}) #{}) )
(def compositions
#{{:name "Art of the Fugue" :composer "J. S. Bach"}
{:name "Musical Offering" :composer "J. S. Bach"}
{:name "Requiem" :composer "Giuseppe Verdi"}
{:name "Requiem" :composer "W. A. Mozart"}})
(deftest test-project
(are [x y] (= x y)
(set/project compositions [:name]) #{{:name "Art of the Fugue"}
{:name "Requiem"}
{:name "Musical Offering"}}
(set/project compositions [:composer]) #{{:composer "W. A. Mozart"}
{:composer "Giuseppe Verdi"}
{:composer "J. S. Bach"}}
(set/project compositions [:year]) #{{}}
(set/project #{{}} [:name]) #{{}} ))
(deftest test-rename
(are [x y] (= x y)
(set/rename compositions {:name :title}) #{{:title "Art of the Fugue" :composer "J. S. Bach"}
{:title "Musical Offering" :composer "J. S. Bach"}
{:title "Requiem" :composer "Giuseppe Verdi"}
{:title "Requiem" :composer "W. A. Mozart"}}
(set/rename compositions {:year :decade}) #{{:name "Art of the Fugue" :composer "J. S. Bach"}
{:name "Musical Offering" :composer "J. S. Bach"}
{:name "Requiem" :composer "Giuseppe Verdi"}
{:name "Requiem" :composer "W. A. Mozart"}}
(set/rename #{{}} {:year :decade}) #{{}}))
(deftest test-rename-keys
(are [x y] (= x y)
(set/rename-keys {:a "one" :b "two"} {:a :z}) {:z "one" :b "two"}
(set/rename-keys {:a "one" :b "two"} {:a :z :c :y}) {:z "one" :b "two"}
(set/rename-keys {:a "one" :b "two" :c "three"} {:a :b :b :a}) {:a "two" :b "one" :c "three"}))
(deftest test-index
(are [x y] (= x y)
(set/index #{{:c 2} {:b 1} {:a 1 :b 2}} [:b]) {{:b 2} #{{:a 1 :b 2}}, {:b 1} #{{:b 1}} {} #{{:c 2}}}
))
(deftest test-join
(are [x y] (= x y)
(set/join compositions compositions) compositions
(set/join compositions #{{:name "Art of the Fugue" :genre "Classical"}})
#{{:name "Art of the Fugue" :composer "J. S. Bach" :genre "Classical"}}
))
(deftest test-map-invert
(are [x y] (= x y)
(set/map-invert {:a "one" :b "two"}) {"one" :a "two" :b}))
(deftest test-subset?
(are [sub super] (set/subset? sub super)
#{} #{}
#{} #{1}
#{1} #{1}
#{1 2} #{1 2}
#{1 2} #{1 2 42}
#{false} #{false}
#{nil} #{nil}
#{nil} #{nil false}
#{1 2 nil} #{1 2 nil 4})
(are [notsub super] (not (set/subset? notsub super))
#{1} #{}
#{2} #{1}
#{1 3} #{1}
#{nil} #{false}
#{false} #{nil}
#{false nil} #{nil}
#{1 2 nil} #{1 2}))
(deftest test-superset?
(are [super sub] (set/superset? super sub)
#{} #{}
#{1} #{}
#{1} #{1}
#{1 2} #{1 2}
#{1 2 42} #{1 2}
#{false} #{false}
#{nil} #{nil}
#{false nil} #{false}
#{1 2 4 nil false} #{1 2 nil})
(are [notsuper sub] (not (set/superset? notsuper sub))
#{} #{1}
#{2} #{1}
#{1} #{1 3}
#{nil} #{false}
#{false} #{nil}
#{nil} #{false nil}
#{nil 2 3} #{false nil 2 3}))
clojure1.6_1.6.0+dfsg.orig/test/clojure/test_clojure/clojure_walk.clj 0000664 0000000 0000000 00000004164 12346720654 0025663 0 ustar 00root root 0000000 0000000 (ns clojure.test-clojure.clojure-walk
(:require [clojure.walk :as w])
(:use clojure.test))
(deftest t-prewalk-replace
(is (= (w/prewalk-replace {:a :b} [:a {:a :a} (list 3 :c :a)])
[:b {:b :b} (list 3 :c :b)])))
(deftest t-postwalk-replace
(is (= (w/postwalk-replace {:a :b} [:a {:a :a} (list 3 :c :a)])
[:b {:b :b} (list 3 :c :b)])))
(deftest t-stringify-keys
(is (= (w/stringify-keys {:a 1, nil {:b 2 :c 3}, :d 4})
{"a" 1, nil {"b" 2 "c" 3}, "d" 4})))
(deftest t-prewalk-order
(is (= (let [a (atom [])]
(w/prewalk (fn [form] (swap! a conj form) form)
[1 2 {:a 3} (list 4 [5])])
@a)
[[1 2 {:a 3} (list 4 [5])]
1 2 {:a 3} [:a 3] :a 3 (list 4 [5])
4 [5] 5])))
(deftest t-postwalk-order
(is (= (let [a (atom [])]
(w/postwalk (fn [form] (swap! a conj form) form)
[1 2 {:a 3} (list 4 [5])])
@a)
[1 2
:a 3 [:a 3] {:a 3}
4 5 [5] (list 4 [5])
[1 2 {:a 3} (list 4 [5])]])))
(defrecord Foo [a b c])
(deftest walk
"Checks that walk returns the correct result and type of collection"
(let [colls ['(1 2 3)
[1 2 3]
#{1 2 3}
(sorted-set-by > 1 2 3)
{:a 1, :b 2, :c 3}
(sorted-map-by > 1 10, 2 20, 3 30)
(->Foo 1 2 3)
(map->Foo {:a 1 :b 2 :c 3 :extra 4})]]
(doseq [c colls]
(let [walked (w/walk identity identity c)]
(is (= c walked))
(is (= (type c) (type walked)))
(if (map? c)
(is (= (w/walk #(update-in % [1] inc) #(reduce + (vals %)) c)
(reduce + (map (comp inc val) c))))
(is (= (w/walk inc #(reduce + %) c)
(reduce + (map inc c)))))
(when (or (instance? clojure.lang.PersistentTreeMap c)
(instance? clojure.lang.PersistentTreeSet c))
(is (= (.comparator c) (.comparator walked))))))))
clojure1.6_1.6.0+dfsg.orig/test/clojure/test_clojure/clojure_xml.clj 0000664 0000000 0000000 00000001157 12346720654 0025524 0 ustar 00root root 0000000 0000000 ; 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.
;;Author: Frantisek Sodomka
(ns clojure.test-clojure.clojure-xml
(:use clojure.test)
(:require [clojure.xml :as xml]))
; parse
; emit-element
; emit
clojure1.6_1.6.0+dfsg.orig/test/clojure/test_clojure/clojure_zip.clj 0000664 0000000 0000000 00000001543 12346720654 0025525 0 ustar 00root root 0000000 0000000 ; 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.
; Author: Frantisek Sodomka
(ns clojure.test-clojure.clojure-zip
(:use clojure.test)
(:require [clojure.zip :as zip]))
; zipper
;
; seq-zip
; vector-zip
; xml-zip
;
; node
; branch?
; children
; make-node
; path
; lefts
; rights
; down
; up
; root
; right
; rightmost
; left
; leftmost
;
; insert-left
; insert-right
; replace
; edit
; insert-child
; append-child
; next
; prev
; end?
; remove
clojure1.6_1.6.0+dfsg.orig/test/clojure/test_clojure/compilation.clj 0000664 0000000 0000000 00000022746 12346720654 0025526 0 ustar 00root root 0000000 0000000 ; 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.
; Author: Frantisek Sodomka
(ns clojure.test-clojure.compilation
(:import (clojure.lang Compiler Compiler$CompilerException))
(:require [clojure.test.generative :refer (defspec)]
[clojure.data.generators :as gen])
(:use clojure.test
[clojure.test-helper :only (should-not-reflect should-print-err-message)]))
; http://clojure.org/compilation
; compile
; gen-class, gen-interface
(deftest test-compiler-metadata
(let [m (meta #'when)]
(are [x y] (= x y)
(list? (:arglists m)) true
(> (count (:arglists m)) 0) true
(string? (:doc m)) true
(> (.length (:doc m)) 0) true
(string? (:file m)) true
(> (.length (:file m)) 0) true
(integer? (:line m)) true
(> (:line m) 0) true
(integer? (:column m)) true
(> (:column m) 0) true
(:macro m) true
(:name m) 'when )))
(deftest test-embedded-constants
(testing "Embedded constants"
(is (eval `(= Boolean/TYPE ~Boolean/TYPE)))
(is (eval `(= Byte/TYPE ~Byte/TYPE)))
(is (eval `(= Character/TYPE ~Character/TYPE)))
(is (eval `(= Double/TYPE ~Double/TYPE)))
(is (eval `(= Float/TYPE ~Float/TYPE)))
(is (eval `(= Integer/TYPE ~Integer/TYPE)))
(is (eval `(= Long/TYPE ~Long/TYPE)))
(is (eval `(= Short/TYPE ~Short/TYPE)))))
(deftest test-compiler-resolution
(testing "resolve nonexistent class create should return nil (assembla #262)"
(is (nil? (resolve 'NonExistentClass.)))))
(deftest test-no-recur-across-try
(testing "don't recur to function from inside try"
(is (thrown? Compiler$CompilerException
(eval '(fn [x] (try (recur 1)))))))
(testing "don't recur to loop from inside try"
(is (thrown? Compiler$CompilerException
(eval '(loop [x 5]
(try (recur 1)))))))
(testing "don't recur to loop from inside of catch inside of try"
(is (thrown? Compiler$CompilerException
(eval '(loop [x 5]
(try
(catch Exception e
(recur 1))))))))
(testing "don't recur to loop from inside of finally inside of try"
(is (thrown? Compiler$CompilerException
(eval '(loop [x 5]
(try
(finally
(recur 1))))))))
(testing "don't get confused about what the recur is targeting"
(is (thrown? Compiler$CompilerException
(eval '(loop [x 5]
(try (fn [x]) (recur 1)))))))
(testing "don't allow recur across binding"
(is (thrown? Compiler$CompilerException
(eval '(fn [x] (binding [+ *] (recur 1)))))))
(testing "allow loop/recur inside try"
(is (= 0 (eval '(try (loop [x 3]
(if (zero? x) x (recur (dec x)))))))))
(testing "allow loop/recur fully inside catch"
(is (= 3 (eval '(try
(throw (Exception.))
(catch Exception e
(loop [x 0]
(if (< x 3) (recur (inc x)) x))))))))
(testing "allow loop/recur fully inside finally"
(is (= "012" (eval '(with-out-str
(try
:return-val-discarded-because-of-with-out-str
(finally (loop [x 0]
(when (< x 3)
(print x)
(recur (inc x)))))))))))
(testing "allow fn/recur inside try"
(is (= 0 (eval '(try
((fn [x]
(if (zero? x)
x
(recur (dec x))))
3)))))))
;; disabled until build box can call java from mvn
#_(deftest test-numeric-dispatch
(is (= "(int, int)" (TestDispatch/someMethod (int 1) (int 1))))
(is (= "(int, long)" (TestDispatch/someMethod (int 1) (long 1))))
(is (= "(long, long)" (TestDispatch/someMethod (long 1) (long 1)))))
(deftest test-CLJ-671-regression
(testing "that the presence of hints does not cause the compiler to infinitely loop"
(letfn [(gcd [x y]
(loop [x (long x) y (long y)]
(if (== y 0)
x
(recur y ^Long(rem x y)))))]
(is (= 4 (gcd 8 100))))))
;; ensure proper use of hints / type decls
(defn hinted
(^String [])
(^Integer [a])
(^java.util.List [a & args]))
;; fn names need to be fully-qualified because should-not-reflect evals its arg in a throwaway namespace
(deftest recognize-hinted-arg-vector
(should-not-reflect #(.substring (clojure.test-clojure.compilation/hinted) 0))
(should-not-reflect #(.floatValue (clojure.test-clojure.compilation/hinted "arg")))
(should-not-reflect #(.size (clojure.test-clojure.compilation/hinted :many :rest :args :here))))
(defn ^String hinting-conflict ^Integer [])
(deftest calls-use-arg-vector-hint
(should-not-reflect #(.floatValue (clojure.test-clojure.compilation/hinting-conflict)))
(should-print-err-message #"(?s)Reflection warning.*"
#(.substring (clojure.test-clojure.compilation/hinting-conflict) 0)))
(deftest deref-uses-var-tag
(should-not-reflect #(.substring clojure.test-clojure.compilation/hinting-conflict 0))
(should-print-err-message #"(?s)Reflection warning.*"
#(.floatValue clojure.test-clojure.compilation/hinting-conflict)))
(defn ^String legacy-hinting [])
(deftest legacy-call-hint
(should-not-reflect #(.substring (clojure.test-clojure.compilation/legacy-hinting) 0)))
(defprotocol HintedProtocol
(hintedp ^String [a]
^Integer [a b]))
(deftest hinted-protocol-arg-vector
(should-not-reflect #(.substring (clojure.test-clojure.compilation/hintedp "") 0))
(should-not-reflect #(.floatValue (clojure.test-clojure.compilation/hintedp :a :b))))
(defn primfn
(^long [])
(^double [a]))
(deftest primitive-return-decl
(should-not-reflect #(loop [k 5] (recur (clojure.test-clojure.compilation/primfn))))
(should-not-reflect #(loop [k 5.0] (recur (clojure.test-clojure.compilation/primfn 0))))
(should-print-err-message #"(?s).*k is not matching primitive.*"
#(loop [k (clojure.test-clojure.compilation/primfn)] (recur :foo))))
#_(deftest CLJ-1154-use-out-after-compile
;; This test creates a dummy file to compile, sets up a dummy
;; compiled output directory, and a dummy output stream, and
;; verifies the stream is still usable after compiling.
(spit "test/dummy.clj" "(ns dummy)")
(try
(let [compile-path (System/getProperty "clojure.compile.path")
tmp (java.io.File. "tmp")
new-out (java.io.OutputStreamWriter. (java.io.ByteArrayOutputStream.))]
(binding [clojure.core/*out* new-out]
(try
(.mkdir tmp)
(System/setProperty "clojure.compile.path" "tmp")
(clojure.lang.Compile/main (into-array ["dummy"]))
(println "this should still work without throwing an exception" )
(finally
(if compile-path
(System/setProperty "clojure.compile.path" compile-path)
(System/clearProperty "clojure.compile.path"))
(doseq [f (.listFiles tmp)]
(.delete f))
(.delete tmp)))))
(finally
(doseq [f (.listFiles (java.io.File. "test"))
:when (re-find #"dummy.clj" (str f))]
(.delete f)))))
(deftest CLJ-1184-do-in-non-list-test
(testing "do in a vector throws an exception"
(is (thrown? Compiler$CompilerException
(eval '[do 1 2 3]))))
(testing "do in a set throws an exception"
(is (thrown? Compiler$CompilerException
(eval '#{do}))))
;; compile uses a separate code path so we have to call it directly
;; to test it
(letfn [(compile [s]
(spit "test/clojure/bad_def_test.clj" (str "(ns clojure.bad-def-test)\n" s))
(try
(binding [*compile-path* "test"]
(clojure.core/compile 'clojure.bad-def-test))
(finally
(doseq [f (.listFiles (java.io.File. "test/clojure"))
:when (re-find #"bad_def_test" (str f))]
(.delete f)))))]
(testing "do in a vector throws an exception in compilation"
(is (thrown? Compiler$CompilerException (compile "[do 1 2 3]"))))
(testing "do in a set throws an exception in compilation"
(is (thrown? Compiler$CompilerException (compile "#{do}"))))))
(defn gen-name []
;; Not all names can be correctly demunged. Skip names that contain
;; a munge word as they will not properly demunge.
(let [munge-words (remove clojure.string/blank?
(conj (map #(clojure.string/replace % "_" "")
(vals Compiler/CHAR_MAP)) "_"))]
(first (filter (fn [n] (not-any? #(>= (.indexOf n %) 0) munge-words))
(repeatedly #(name (gen/symbol (constantly 10))))))))
(defn munge-roundtrip [n]
(Compiler/demunge (Compiler/munge n)))
(defspec test-munge-roundtrip
munge-roundtrip
[^{:tag clojure.test-clojure.compilation/gen-name} n]
(assert (= n %)))
clojure1.6_1.6.0+dfsg.orig/test/clojure/test_clojure/control.clj 0000664 0000000 0000000 00000027500 12346720654 0024661 0 ustar 00root root 0000000 0000000 ; 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.
; Author: Frantisek Sodomka, Mike Hinchey, Stuart Halloway
;;
;; Test "flow control" constructs.
;;
(ns clojure.test-clojure.control
(:use clojure.test
clojure.test-helper))
;; *** Helper functions ***
(defn maintains-identity [f]
(are [x] (= (f x) x)
nil
false true
0 42
0.0 3.14
2/3
0M 1M
\c
"" "abc"
'sym
:kw
() '(1 2)
[] [1 2]
{} {:a 1 :b 2}
#{} #{1 2} ))
; http://clojure.org/special_forms
; http://clojure.org/macros
(deftest test-do
(are [x y] (= x y)
; no params => nil
(do) nil
; return last
(do 1) 1
(do 1 2) 2
(do 1 2 3 4 5) 5
; evaluate and return last
(let [a (atom 0)]
(do (reset! a (+ @a 1)) ; 1
(reset! a (+ @a 1)) ; 2
(reset! a (+ @a 1)) ; 3
@a)) 3 )
; identity (= (do x) x)
(maintains-identity (fn [_] (do _))) )
;; loop/recur
(deftest test-loop
(are [x y] (= x y)
1 (loop []
1)
3 (loop [a 1]
(if (< a 3)
(recur (inc a))
a))
[2 4 6] (loop [a []
b [1 2 3]]
(if (seq b)
(recur (conj a (* 2 (first b)))
(next b))
a))
[6 4 2] (loop [a ()
b [1 2 3]]
(if (seq b)
(recur (conj a (* 2 (first b)))
(next b))
a))
)
)
;; throw, try
; if: see logic.clj
(deftest test-when
(are [x y] (= x y)
1 (when true 1)
nil (when true)
nil (when false)
nil (when false (exception))
))
(deftest test-when-not
(are [x y] (= x y)
1 (when-not false 1)
nil (when-not true)
nil (when-not false)
nil (when-not true (exception))
))
(deftest test-if-not
(are [x y] (= x y)
1 (if-not false 1)
1 (if-not false 1 (exception))
nil (if-not true 1)
2 (if-not true 1 2)
nil (if-not true (exception))
1 (if-not true (exception) 1)
))
(deftest test-when-let
(are [x y] (= x y)
1 (when-let [a 1]
a)
2 (when-let [[a b] '(1 2)]
b)
nil (when-let [a false]
(exception))
))
(deftest test-if-let
(are [x y] (= x y)
1 (if-let [a 1]
a)
2 (if-let [[a b] '(1 2)]
b)
nil (if-let [a false]
(exception))
1 (if-let [a false]
a 1)
1 (if-let [[a b] nil]
b 1)
1 (if-let [a false]
(exception)
1)
))
(deftest test-when-first
(are [x y] (= x y)
1 (when-first [a [1 2]]
a)
2 (when-first [[a b] '((1 2) 3)]
b)
nil (when-first [a nil]
(exception))
))
(deftest test-if-some
(are [x y] (= x y)
1 (if-some [a 1] a)
false (if-some [a false] a)
nil (if-some [a nil] (exception))
3 (if-some [[a b] [1 2]] (+ a b))
1 (if-some [[a b] nil] b 1)
1 (if-some [a nil] (exception) 1)))
(deftest test-when-some
(are [x y] (= x y)
1 (when-some [a 1] a)
2 (when-some [[a b] [1 2]] b)
false (when-some [a false] a)
nil (when-some [a nil] (exception))))
(deftest test-cond
(are [x y] (= x y)
(cond) nil
(cond nil true) nil
(cond false true) nil
(cond true 1 true (exception)) 1
(cond nil 1 false 2 true 3 true 4) 3
(cond nil 1 false 2 true 3 true (exception)) 3 )
; false
(are [x] (= (cond x :a true :b) :b)
nil false )
; true
(are [x] (= (cond x :a true :b) :a)
true
0 42
0.0 3.14
2/3
0M 1M
\c
"" "abc"
'sym
:kw
() '(1 2)
[] [1 2]
{} {:a 1 :b 2}
#{} #{1 2} )
; evaluation
(are [x y] (= x y)
(cond (> 3 2) (+ 1 2) true :result true (exception)) 3
(cond (< 3 2) (+ 1 2) true :result true (exception)) :result )
; identity (= (cond true x) x)
(maintains-identity (fn [_] (cond true _))) )
(deftest test-condp
(are [x] (= :pass x)
(condp = 1
1 :pass
2 :fail)
(condp = 1
2 :fail
1 :pass)
(condp = 1
2 :fail
:pass)
(condp = 1
:pass)
(condp = 1
2 :fail
;; doc of condp says result-expr is returned
;; shouldn't it say similar to cond: "evaluates and returns
;; the value of the corresponding expr and doesn't evaluate any of the
;; other tests or exprs."
(identity :pass))
(condp + 1
1 :>> #(if (= % 2) :pass :fail))
(condp + 1
1 :>> #(if (= % 3) :fail :pass))
)
(is (thrown? IllegalArgumentException
(condp = 1)
))
(is (thrown? IllegalArgumentException
(condp = 1
2 :fail)
))
)
; [for, doseq (for.clj)]
(deftest test-dotimes
;; dotimes always returns nil
(is (= nil (dotimes [n 1] n)))
;; test using an atom since dotimes is for modifying
;; test executes n times
(is (= 3
(let [a (atom 0)]
(dotimes [n 3]
(swap! a inc))
@a)
))
;; test all values of n
(is (= [0 1 2]
(let [a (atom [])]
(dotimes [n 3]
(swap! a conj n))
@a)))
(is (= []
(let [a (atom [])]
(dotimes [n 0]
(swap! a conj n))
@a)))
)
(deftest test-while
(is (= nil (while nil (throw (Exception. "never")))))
(is (= [0 nil]
;; a will dec to 0
;; while always returns nil
(let [a (atom 3)
w (while (pos? @a)
(swap! a dec))]
[@a w])))
(is (thrown? Exception (while true (throw (Exception. "expected to throw")))))
)
; locking, monitor-enter, monitor-exit
; case
(deftest test-case
(testing "can match many kinds of things"
(let [two 2
test-fn
#(case %
1 :number
"foo" :string
\a :char
pow :symbol
:zap :keyword
(2 \b "bar") :one-of-many
[1 2] :sequential-thing
{:a 2} :map
{:r 2 :d 2} :droid
#{2 3 4 5} :set
[1 [[[2]]]] :deeply-nested
nil :nil
:default)]
(are [result input] (= result (test-fn input))
:number 1
:string "foo"
:char \a
:keyword :zap
:symbol 'pow
:one-of-many 2
:one-of-many \b
:one-of-many "bar"
:sequential-thing [1 2]
:sequential-thing (list 1 2)
:sequential-thing [1 two]
:map {:a 2}
:map {:a two}
:set #{2 3 4 5}
:set #{two 3 4 5}
:default #{2 3 4 5 6}
:droid {:r 2 :d 2}
:deeply-nested [1 [[[two]]]]
:nil nil
:default :anything-not-appearing-above)))
(testing "throws IllegalArgumentException if no match"
(is (thrown-with-msg?
IllegalArgumentException #"No matching clause: 2"
(case 2 1 :ok))))
(testing "sorting doesn't matter"
(let [test-fn
#(case %
{:b 2 :a 1} :map
#{3 2 1} :set
:default)]
(are [result input] (= result (test-fn input))
:map {:a 1 :b 2}
:map (sorted-map :a 1 :b 2)
:set #{3 2 1}
:set (sorted-set 2 1 3))))
(testing "test number equivalence"
(is (= :1 (case 1N 1 :1 :else))))
(testing "test warn when boxing/hashing expr for all-ints case"
(should-print-err-message
#"Performance warning, .*:\d+ - case has int tests, but tested expression is not primitive..*\r?\n"
(let [x (Object.)] (case x 1 1 2))))
(testing "test correct behavior on sparse ints"
(are [result input] (= result (case input
2r1000000000000000000000000000000 :big
1 :small
:else))
:small 1
:big 1073741824
:else 2)
(are [result input] (= result (case input
1 :small
2r1000000000000000000000000000000 :big
:else))
:small 1
:big 1073741824
:else 2))
(testing "test emits return types"
(should-not-reflect (Long. (case 1 1 1))) ; new Long(long)
(should-not-reflect (Long. (case 1 1 "1")))) ; new Long(String)
(testing "non-equivalence of chars and nums"
(are [result input] (= result (case input 97 :97 :else))
:else \a
:else (char \a)
:97 (int \a))
(are [result input] (= result (case input \a :a :else))
:else 97
:else 97N
:a (char 97)))
(testing "test error on duplicate test constants"
(is (thrown-with-msg?
IllegalArgumentException
#"Duplicate case test constant: 1"
(eval `(case 0 1 :x 1 :y)))))
(testing "test correct behaviour on Number truncation"
(let [^Object x (Long. 8589934591) ; force bindings to not be emitted as a primitive long
^Object y (Long. -1)]
(is (= :diff (case x -1 :oops :diff)))
(is (= :same (case y -1 :same :oops)))))
(testing "test correct behavior on hash collision"
;; case uses Java .hashCode to put values into hash buckets.
(is (== (.hashCode 1) (.hashCode 9223372039002259457N)))
(are [result input] (= result (case input
1 :long
9223372039002259457N :big
:else))
:long 1
:big 9223372039002259457N
:else 4294967296
:else 2)
(are [result input] (= result (case input
9223372039002259457N :big
1 :long
:else))
:long 1
:big 9223372039002259457N
:else 4294967296
:else 2)
(are [result input] (= result (case input
0 :zero
-1 :neg1
2 :two
:oops :OOPS))
:zero 0
:neg1 -1
:two 2
:OOPS :oops)
(are [result input] (= result (case input
1204766517646190306 :a
1 :b
-2 :c
:d))
:a 1204766517646190306
:b 1
:c -2
:d 4294967296
:d 3))
(testing "test warn for hash collision"
(should-print-err-message
#"Performance warning, .*:\d+ - hash collision of some case test constants; if selected, those entries will be tested sequentially..*\r?\n"
(case 1 1 :long 9223372039002259457N :big 2)))
(testing "test constants are *not* evaluated"
(let [test-fn
;; never write code like this...
#(case %
(throw (RuntimeException. "boom")) :piece-of-throw-expr
:no-match)]
(are [result input] (= result (test-fn input))
:piece-of-throw-expr 'throw
:piece-of-throw-expr '[RuntimeException. "boom"]
:no-match nil))))
clojure1.6_1.6.0+dfsg.orig/test/clojure/test_clojure/data.clj 0000664 0000000 0000000 00000002651 12346720654 0024112 0 ustar 00root root 0000000 0000000 ; 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.
(ns clojure.test-clojure.data
(:use clojure.data clojure.test)
(import java.util.HashSet))
(deftest diff-test
(are [d x y] (= d (diff x y))
[nil nil nil] nil nil
[1 2 nil] 1 2
[nil nil [1 2 3]] [1 2 3] '(1 2 3)
[1 [:a :b] nil] 1 [:a :b]
[{:a 1} :b nil] {:a 1} :b
[:team #{:p1 :p2} nil] :team #{:p1 :p2}
[{0 :a} [:a] nil] {0 :a} [:a]
[nil [nil 2] [1]] [1] [1 2]
[nil nil [1 2]] [1 2] (into-array [1 2])
[#{:a} #{:b} #{:c :d}] #{:a :c :d} #{:b :c :d}
[nil nil {:a 1}] {:a 1} {:a 1}
[{:a #{2}} {:a #{4}} {:a #{3}}] {:a #{2 3}} {:a #{3 4}}
[#{1} #{3} #{2}] (HashSet. [1 2]) (HashSet. [2 3])
[nil nil [1 2]] [1 2] (into-array [1 2])
[nil nil [1 2]] (into-array [1 2]) [1 2]
[{:a {:c [1]}} {:a {:c [0]}} {:a {:c [nil 2] :b 1}}] {:a {:b 1 :c [1 2]}} {:a {:b 1 :c [0 2]}}
[{:a nil} {:a false} {:b nil :c false}] {:a nil :b nil :c false} {:a false :b nil :c false}))
clojure1.6_1.6.0+dfsg.orig/test/clojure/test_clojure/data_structures.clj 0000664 0000000 0000000 00000075547 12346720654 0026433 0 ustar 00root root 0000000 0000000 ; 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.
; Author: Frantisek Sodomka
(ns clojure.test-clojure.data-structures
(:use clojure.test
[clojure.test.generative :exclude (is)])
(:require [clojure.test-clojure.generators :as cgen]
[clojure.data.generators :as gen]
[clojure.string :as string]))
;; *** Helper functions ***
(defn diff [s1 s2]
(seq (reduce disj (set s1) (set s2))))
;; *** Generative ***
(defspec subcollection-counts-are-consistent
identity
[^{:tag cgen/ednable-collection} coll]
(let [n (count coll)]
(dotimes [i n]
(is (= n
(+ i (count (nthnext coll i)))
(+ i (count (drop i coll))))))))
(defn- transient? [x]
(instance? clojure.lang.ITransientCollection x))
(defn gen-transient-action []
(gen/rand-nth [[#(conj! %1 %2) #(conj %1 %2) (gen/uniform -100 100)]
[#(disj! %1 %2) #(disj %1 %2) (gen/uniform -100 100)]
[persistent! identity]
[identity transient]]))
(defn gen-transient-actions []
(gen/reps #(gen/uniform 0 100) gen-transient-action))
(defn assert-same-collection [a b]
(assert (= (count a) (count b) (.size a) (.size b)))
(assert (= a b))
(assert (= b a))
(assert (.equals ^Object a b))
(assert (.equals ^Object b a))
(assert (= (hash a) (hash b)))
(assert (= (.hashCode ^Object a) (.hashCode ^Object b)))
(assert (= a
(into (empty a) a)
(into (empty b) b)
(into (empty a) b)
(into (empty b) a))))
(defn apply-actions [coll actions]
(reduce (fn [c [tfunc pfunc & args]]
(apply (if (transient? c) tfunc pfunc) c args))
coll
actions))
(defn to-persistent [c]
(if (transient? c) (persistent! c) c))
(defspec conj-persistent-transient
identity
[^{:tag clojure.test-clojure.data-structures/gen-transient-actions} actions]
(assert-same-collection
(to-persistent (apply-actions #{} actions))
(to-persistent (apply-actions #{} actions))))
;; *** General ***
(defstruct equality-struct :a :b)
(deftest test-equality
; nil is not equal to any other value
(are [x] (not (= nil x))
true false
0 0.0
\space
"" #""
() [] #{} {}
(lazy-seq nil) ; SVN 1292: fixed (= (lazy-seq nil) nil)
(lazy-seq ())
(lazy-seq [])
(lazy-seq {})
(lazy-seq #{})
(lazy-seq "")
(lazy-seq (into-array []))
(new Object) )
; numbers equality across types (see tests below - NOT IMPLEMENTED YET)
; ratios
(is (== 1/2 0.5))
(is (== 1/1000 0.001))
(is (not= 2/3 0.6666666666666666))
; vectors equal other seqs by items equality
(are [x y] (= x y)
'() [] ; regression fixed in r1208; was not equal
'(1) [1]
'(1 2) [1 2]
[] '() ; same again, but vectors first
[1] '(1)
[1 2] '(1 2) )
(is (not= [1 2] '(2 1))) ; order of items matters
; list and vector vs. set and map
(are [x y] (not= x y)
; only () equals []
() #{}
() {}
[] #{}
[] {}
#{} {}
; only '(1) equals [1]
'(1) #{1}
[1] #{1} )
; sorted-map, hash-map and array-map - classes differ, but content is equal
;; TODO: reimplement all-are with new do-template?
;; (all-are (not= (class _1) (class _2))
;; (sorted-map :a 1)
;; (hash-map :a 1)
;; (array-map :a 1))
;; (all-are (= _1 _2)
;; (sorted-map)
;; (hash-map)
;; (array-map))
;; (all-are (= _1 _2)
;; (sorted-map :a 1)
;; (hash-map :a 1)
;; (array-map :a 1))
;; (all-are (= _1 _2)
;; (sorted-map :a 1 :z 3 :c 2)
;; (hash-map :a 1 :z 3 :c 2)
;; (array-map :a 1 :z 3 :c 2))
; struct-map vs. sorted-map, hash-map and array-map
(are [x] (and (not= (class (struct equality-struct 1 2)) (class x))
(= (struct equality-struct 1 2) x))
(sorted-map-by compare :a 1 :b 2)
(sorted-map :a 1 :b 2)
(hash-map :a 1 :b 2)
(array-map :a 1 :b 2))
; sorted-set vs. hash-set
(is (not= (class (sorted-set 1)) (class (hash-set 1))))
(are [x y] (= x y)
(sorted-set-by <) (hash-set)
(sorted-set-by < 1) (hash-set 1)
(sorted-set-by < 3 2 1) (hash-set 3 2 1)
(sorted-set) (hash-set)
(sorted-set 1) (hash-set 1)
(sorted-set 3 2 1) (hash-set 3 2 1) ))
;; *** Collections ***
(deftest test-count
(let [EMPTY clojure.lang.PersistentQueue/EMPTY]
(are [x y] (= (count x) y)
EMPTY 0
(into EMPTY [:a :b]) 2
(-> (into EMPTY [:a :b]) pop pop) 0
nil 0
() 0
'(1) 1
'(1 2 3) 3
[] 0
[1] 1
[1 2 3] 3
#{} 0
#{1} 1
#{1 2 3} 3
{} 0
{:a 1} 1
{:a 1 :b 2 :c 3} 3
"" 0
"a" 1
"abc" 3
(into-array []) 0
(into-array [1]) 1
(into-array [1 2 3]) 3
(java.util.ArrayList. []) 0
(java.util.ArrayList. [1]) 1
(java.util.ArrayList. [1 2 3]) 3
(java.util.HashMap. {}) 0
(java.util.HashMap. {:a 1}) 1
(java.util.HashMap. {:a 1 :b 2 :c 3}) 3 ))
; different types
(are [x] (= (count [x]) 1)
nil true false
0 0.0 "" \space
() [] #{} {} ))
(deftest test-conj
; doesn't work on strings or arrays
(is (thrown? ClassCastException (conj "" \a)))
(is (thrown? ClassCastException (conj (into-array []) 1)))
(are [x y] (= x y)
(conj nil 1) '(1)
(conj nil 3 2 1) '(1 2 3)
(conj nil nil) '(nil)
(conj nil nil nil) '(nil nil)
(conj nil nil nil 1) '(1 nil nil)
; list -> conj puts the item at the front of the list
(conj () 1) '(1)
(conj () 1 2) '(2 1)
(conj '(2 3) 1) '(1 2 3)
(conj '(2 3) 1 4 3) '(3 4 1 2 3)
(conj () nil) '(nil)
(conj () ()) '(())
; vector -> conj puts the item at the end of the vector
(conj [] 1) [1]
(conj [] 1 2) [1 2]
(conj [2 3] 1) [2 3 1]
(conj [2 3] 1 4 3) [2 3 1 4 3]
(conj [] nil) [nil]
(conj [] []) [[]]
; map -> conj expects another (possibly single entry) map as the item,
; and returns a new map which is the old map plus the entries
; from the new, which may overwrite entries of the old.
; conj also accepts a MapEntry or a vector of two items (key and value).
(conj {} {}) {}
(conj {} {:a 1}) {:a 1}
(conj {} {:a 1 :b 2}) {:a 1 :b 2}
(conj {} {:a 1 :b 2} {:c 3}) {:a 1 :b 2 :c 3}
(conj {} {:a 1 :b 2} {:a 3 :c 4}) {:a 3 :b 2 :c 4}
(conj {:a 1} {:a 7}) {:a 7}
(conj {:a 1} {:b 2}) {:a 1 :b 2}
(conj {:a 1} {:a 7 :b 2}) {:a 7 :b 2}
(conj {:a 1} {:a 7 :b 2} {:c 3}) {:a 7 :b 2 :c 3}
(conj {:a 1} {:a 7 :b 2} {:b 4 :c 5}) {:a 7 :b 4 :c 5}
(conj {} (first {:a 1})) {:a 1} ; MapEntry
(conj {:a 1} (first {:b 2})) {:a 1 :b 2}
(conj {:a 1} (first {:a 7})) {:a 7}
(conj {:a 1} (first {:b 2}) (first {:a 5})) {:a 5 :b 2}
(conj {} [:a 1]) {:a 1} ; vector
(conj {:a 1} [:b 2]) {:a 1 :b 2}
(conj {:a 1} [:a 7]) {:a 7}
(conj {:a 1} [:b 2] [:a 5]) {:a 5 :b 2}
(conj {} {nil {}}) {nil {}}
(conj {} {{} nil}) {{} nil}
(conj {} {{} {}}) {{} {}}
; set
(conj #{} 1) #{1}
(conj #{} 1 2 3) #{1 2 3}
(conj #{2 3} 1) #{3 1 2}
(conj #{3 2} 1) #{1 2 3}
(conj #{2 3} 2) #{2 3}
(conj #{2 3} 2 3) #{2 3}
(conj #{2 3} 4 1 2 3) #{1 2 3 4}
(conj #{} nil) #{nil}
(conj #{} #{}) #{#{}} ))
;; *** Lists and Vectors ***
(deftest test-peek
; doesn't work for sets and maps
(is (thrown? ClassCastException (peek #{1})))
(is (thrown? ClassCastException (peek {:a 1})))
(are [x y] (= x y)
(peek nil) nil
; list = first
(peek ()) nil
(peek '(1)) 1
(peek '(1 2 3)) 1
(peek '(nil)) nil ; special cases
(peek '(1 nil)) 1
(peek '(nil 2)) nil
(peek '(())) ()
(peek '(() nil)) ()
(peek '(() 2 nil)) ()
; vector = last
(peek []) nil
(peek [1]) 1
(peek [1 2 3]) 3
(peek [nil]) nil ; special cases
(peek [1 nil]) nil
(peek [nil 2]) 2
(peek [[]]) []
(peek [[] nil]) nil
(peek [[] 2 nil]) nil ))
(deftest test-pop
; doesn't work for sets and maps
(is (thrown? ClassCastException (pop #{1})))
(is (thrown? ClassCastException (pop #{:a 1})))
; collection cannot be empty
(is (thrown? IllegalStateException (pop ())))
(is (thrown? IllegalStateException (pop [])))
(are [x y] (= x y)
(pop nil) nil
; list - pop first
(pop '(1)) ()
(pop '(1 2 3)) '(2 3)
(pop '(nil)) ()
(pop '(1 nil)) '(nil)
(pop '(nil 2)) '(2)
(pop '(())) ()
(pop '(() nil)) '(nil)
(pop '(() 2 nil)) '(2 nil)
; vector - pop last
(pop [1]) []
(pop [1 2 3]) [1 2]
(pop [nil]) []
(pop [1 nil]) [1]
(pop [nil 2]) [nil]
(pop [[]]) []
(pop [[] nil]) [[]]
(pop [[] 2 nil]) [[] 2] ))
;; *** Lists (IPersistentList) ***
(deftest test-list
(are [x] (list? x)
()
'()
(list)
(list 1 2 3) )
; order is important
(are [x y] (not (= x y))
(list 1 2) (list 2 1)
(list 3 1 2) (list 1 2 3) )
(are [x y] (= x y)
'() ()
(list) '()
(list 1) '(1)
(list 1 2) '(1 2)
; nesting
(list 1 (list 2 3) (list 3 (list 4 5 (list 6 (list 7)))))
'(1 (2 3) (3 (4 5 (6 (7)))))
; different data structures
(list true false nil)
'(true false nil)
(list 1 2.5 2/3 "ab" \x 'cd :kw)
'(1 2.5 2/3 "ab" \x cd :kw)
(list (list 1 2) [3 4] {:a 1 :b 2} #{:c :d})
'((1 2) [3 4] {:a 1 :b 2} #{:c :d})
; evaluation
(list (+ 1 2) [(+ 2 3) 'a] (list (* 2 3) 8))
'(3 [5 a] (6 8))
; special cases
(list nil) '(nil)
(list 1 nil) '(1 nil)
(list nil 2) '(nil 2)
(list ()) '(())
(list 1 ()) '(1 ())
(list () 2) '(() 2) ))
;; *** Maps (IPersistentMap) ***
(deftest test-find
(are [x y] (= x y)
(find {} :a) nil
(find {:a 1} :a) [:a 1]
(find {:a 1} :b) nil
(find {:a 1 :b 2} :a) [:a 1]
(find {:a 1 :b 2} :b) [:b 2]
(find {:a 1 :b 2} :c) nil
(find {} nil) nil
(find {:a 1} nil) nil
(find {:a 1 :b 2} nil) nil ))
(deftest test-contains?
; contains? is designed to work preferably on maps and sets
(are [x y] (= x y)
(contains? {} :a) false
(contains? {} nil) false
(contains? {:a 1} :a) true
(contains? {:a 1} :b) false
(contains? {:a 1} nil) false
(contains? {:a 1 :b 2} :a) true
(contains? {:a 1 :b 2} :b) true
(contains? {:a 1 :b 2} :c) false
(contains? {:a 1 :b 2} nil) false
; sets
(contains? #{} 1) false
(contains? #{} nil) false
(contains? #{1} 1) true
(contains? #{1} 2) false
(contains? #{1} nil) false
(contains? #{1 2 3} 1) true
(contains? #{1 2 3} 3) true
(contains? #{1 2 3} 10) false
(contains? #{1 2 3} nil) false)
; contains? also works on java.util.Map and java.util.Set.
(are [x y] (= x y)
(contains? (java.util.HashMap. {}) :a) false
(contains? (java.util.HashMap. {}) nil) false
(contains? (java.util.HashMap. {:a 1}) :a) true
(contains? (java.util.HashMap. {:a 1}) :b) false
(contains? (java.util.HashMap. {:a 1}) nil) false
(contains? (java.util.HashMap. {:a 1 :b 2}) :a) true
(contains? (java.util.HashMap. {:a 1 :b 2}) :b) true
(contains? (java.util.HashMap. {:a 1 :b 2}) :c) false
(contains? (java.util.HashMap. {:a 1 :b 2}) nil) false
; sets
(contains? (java.util.HashSet. #{}) 1) false
(contains? (java.util.HashSet. #{}) nil) false
(contains? (java.util.HashSet. #{1}) 1) true
(contains? (java.util.HashSet. #{1}) 2) false
(contains? (java.util.HashSet. #{1}) nil) false
(contains? (java.util.HashSet. #{1 2 3}) 1) true
(contains? (java.util.HashSet. #{1 2 3}) 3) true
(contains? (java.util.HashSet. #{1 2 3}) 10) false
(contains? (java.util.HashSet. #{1 2 3}) nil) false)
; numerically indexed collections (e.g. vectors and Java arrays)
; => test if the numeric key is WITHIN THE RANGE OF INDEXES
(are [x y] (= x y)
(contains? [] 0) false
(contains? [] -1) false
(contains? [] 1) false
(contains? [1] 0) true
(contains? [1] -1) false
(contains? [1] 1) false
(contains? [1 2 3] 0) true
(contains? [1 2 3] 2) true
(contains? [1 2 3] 3) false
(contains? [1 2 3] -1) false
; arrays
(contains? (into-array []) 0) false
(contains? (into-array []) -1) false
(contains? (into-array []) 1) false
(contains? (into-array [1]) 0) true
(contains? (into-array [1]) -1) false
(contains? (into-array [1]) 1) false
(contains? (into-array [1 2 3]) 0) true
(contains? (into-array [1 2 3]) 2) true
(contains? (into-array [1 2 3]) 3) false
(contains? (into-array [1 2 3]) -1) false)
; 'contains?' will not operate on non-associative things
(are [x] (is (thrown? Exception (contains? x 1)))
'(1 2 3)
3))
(deftest test-keys
(are [x y] (= x y) ; other than map data structures
(keys ()) nil
(keys []) nil
(keys #{}) nil
(keys "") nil )
(are [x y] (= x y)
; (class {:a 1}) => clojure.lang.PersistentArrayMap
(keys {}) nil
(keys {:a 1}) '(:a)
(diff (keys {:a 1 :b 2}) '(:a :b)) nil ; (keys {:a 1 :b 2}) '(:a :b)
; (class (sorted-map :a 1)) => clojure.lang.PersistentTreeMap
(keys (sorted-map)) nil
(keys (sorted-map :a 1)) '(:a)
(diff (keys (sorted-map :a 1 :b 2)) '(:a :b)) nil ; (keys (sorted-map :a 1 :b 2)) '(:a :b)
; (class (hash-map :a 1)) => clojure.lang.PersistentHashMap
(keys (hash-map)) nil
(keys (hash-map :a 1)) '(:a)
(diff (keys (hash-map :a 1 :b 2)) '(:a :b)) nil )) ; (keys (hash-map :a 1 :b 2)) '(:a :b)
(deftest test-vals
(are [x y] (= x y) ; other than map data structures
(vals ()) nil
(vals []) nil
(vals #{}) nil
(vals "") nil )
(are [x y] (= x y)
; (class {:a 1}) => clojure.lang.PersistentArrayMap
(vals {}) nil
(vals {:a 1}) '(1)
(diff (vals {:a 1 :b 2}) '(1 2)) nil ; (vals {:a 1 :b 2}) '(1 2)
; (class (sorted-map :a 1)) => clojure.lang.PersistentTreeMap
(vals (sorted-map)) nil
(vals (sorted-map :a 1)) '(1)
(diff (vals (sorted-map :a 1 :b 2)) '(1 2)) nil ; (vals (sorted-map :a 1 :b 2)) '(1 2)
; (class (hash-map :a 1)) => clojure.lang.PersistentHashMap
(vals (hash-map)) nil
(vals (hash-map :a 1)) '(1)
(diff (vals (hash-map :a 1 :b 2)) '(1 2)) nil )) ; (vals (hash-map :a 1 :b 2)) '(1 2)
(deftest test-key
(are [x] (= (key (first (hash-map x :value))) x)
nil
false true
0 42
0.0 3.14
2/3
0M 1M
\c
"" "abc"
'sym
:kw
() '(1 2)
[] [1 2]
{} {:a 1 :b 2}
#{} #{1 2} ))
(deftest test-val
(are [x] (= (val (first (hash-map :key x))) x)
nil
false true
0 42
0.0 3.14
2/3
0M 1M
\c
"" "abc"
'sym
:kw
() '(1 2)
[] [1 2]
{} {:a 1 :b 2}
#{} #{1 2} ))
(deftest test-get
(let [m {:a 1, :b 2, :c {:d 3, :e 4}, :f nil, :g false, nil {:h 5}}]
(is (thrown? IllegalArgumentException (get-in {:a 1} 5)))
(are [x y] (= x y)
(get m :a) 1
(get m :e) nil
(get m :e 0) 0
(get m :b 0) 2
(get m :f 0) nil
(get-in m [:c :e]) 4
(get-in m '(:c :e)) 4
(get-in m [:c :x]) nil
(get-in m [:f]) nil
(get-in m [:g]) false
(get-in m [:h]) nil
(get-in m []) m
(get-in m nil) m
(get-in m [:c :e] 0) 4
(get-in m '(:c :e) 0) 4
(get-in m [:c :x] 0) 0
(get-in m [:b] 0) 2
(get-in m [:f] 0) nil
(get-in m [:g] 0) false
(get-in m [:h] 0) 0
(get-in m [:x :y] {:y 1}) {:y 1}
(get-in m [] 0) m
(get-in m nil 0) m)))
(deftest test-nested-map-destructuring
(let [sample-map {:a 1 :b {:a 2}}
{ao1 :a {ai1 :a} :b} sample-map
{ao2 :a {ai2 :a :as m1} :b :as m2} sample-map
{ao3 :a {ai3 :a :as m} :b :as m} sample-map
{{ai4 :a :as m} :b ao4 :a :as m} sample-map]
(are [i o] (and (= i 2)
(= o 1))
ai1 ao1
ai2 ao2
ai3 ao3
ai4 ao4)))
;; *** Sets ***
(deftest test-hash-set
(are [x] (set? x)
#{}
#{1 2}
(hash-set)
(hash-set 1 2) )
; order isn't important
(are [x y] (= x y)
#{1 2} #{2 1}
#{3 1 2} #{1 2 3}
(hash-set 1 2) (hash-set 2 1)
(hash-set 3 1 2) (hash-set 1 2 3) )
(are [x y] (= x y)
; equal classes
(class #{}) (class (hash-set))
(class #{1 2}) (class (hash-set 1 2))
; creating
(hash-set) #{}
(hash-set 1) #{1}
(hash-set 1 2) #{1 2}
; nesting
(hash-set 1 (hash-set 2 3) (hash-set 3 (hash-set 4 5 (hash-set 6 (hash-set 7)))))
#{1 #{2 3} #{3 #{4 5 #{6 #{7}}}}}
; different data structures
(hash-set true false nil)
#{true false nil}
(hash-set 1 2.5 2/3 "ab" \x 'cd :kw)
#{1 2.5 2/3 "ab" \x 'cd :kw}
(hash-set (list 1 2) [3 4] {:a 1 :b 2} #{:c :d})
#{'(1 2) [3 4] {:a 1 :b 2} #{:c :d}}
; evaluation
(hash-set (+ 1 2) [(+ 2 3) :a] (hash-set (* 2 3) 8))
#{3 [5 :a] #{6 8}}
; special cases
(hash-set nil) #{nil}
(hash-set 1 nil) #{1 nil}
(hash-set nil 2) #{nil 2}
(hash-set #{}) #{#{}}
(hash-set 1 #{}) #{1 #{}}
(hash-set #{} 2) #{#{} 2}
(hash-set (Integer. -1)) (hash-set (Long. -1))))
(deftest test-sorted-set
; only compatible types can be used
(is (thrown? ClassCastException (sorted-set 1 "a")))
(is (thrown? ClassCastException (sorted-set '(1 2) [3 4])))
; creates set?
(are [x] (set? x)
(sorted-set)
(sorted-set 1 2) )
; equal and unique
(are [x] (and (= (sorted-set x) #{x})
(= (sorted-set x x) (sorted-set x)))
nil
false true
0 42
0.0 3.14
2/3
0M 1M
\c
"" "abc"
'sym
:kw
() ; '(1 2)
[] [1 2]
{} ; {:a 1 :b 2}
#{} ; #{1 2}
)
; cannot be cast to java.lang.Comparable
(is (thrown? ClassCastException (sorted-set '(1 2) '(1 2))))
(is (thrown? ClassCastException (sorted-set {:a 1 :b 2} {:a 1 :b 2})))
(is (thrown? ClassCastException (sorted-set #{1 2} #{1 2})))
(are [x y] (= x y)
; generating
(sorted-set) #{}
(sorted-set 1) #{1}
(sorted-set 1 2) #{1 2}
; sorting
(seq (sorted-set 5 4 3 2 1)) '(1 2 3 4 5)
; special cases
(sorted-set nil) #{nil}
(sorted-set 1 nil) #{nil 1}
(sorted-set nil 2) #{nil 2}
(sorted-set #{}) #{#{}} ))
(deftest test-sorted-set-by
; only compatible types can be used
; NB: not a ClassCastException, but a RuntimeException is thrown,
; requires discussion on whether this should be symmetric with test-sorted-set
(is (thrown? Exception (sorted-set-by < 1 "a")))
(is (thrown? Exception (sorted-set-by < '(1 2) [3 4])))
; creates set?
(are [x] (set? x)
(sorted-set-by <)
(sorted-set-by < 1 2) )
; equal and unique
(are [x] (and (= (sorted-set-by compare x) #{x})
(= (sorted-set-by compare x x) (sorted-set-by compare x)))
nil
false true
0 42
0.0 3.14
2/3
0M 1M
\c
"" "abc"
'sym
:kw
() ; '(1 2)
[] [1 2]
{} ; {:a 1 :b 2}
#{} ; #{1 2}
)
; cannot be cast to java.lang.Comparable
; NB: not a ClassCastException, but a RuntimeException is thrown,
; requires discussion on whether this should be symmetric with test-sorted-set
(is (thrown? Exception (sorted-set-by compare '(1 2) '(1 2))))
(is (thrown? Exception (sorted-set-by compare {:a 1 :b 2} {:a 1 :b 2})))
(is (thrown? Exception (sorted-set-by compare #{1 2} #{1 2})))
(are [x y] (= x y)
; generating
(sorted-set-by >) #{}
(sorted-set-by > 1) #{1}
(sorted-set-by > 1 2) #{1 2}
; sorting
(seq (sorted-set-by < 5 4 3 2 1)) '(1 2 3 4 5)
; special cases
(sorted-set-by compare nil) #{nil}
(sorted-set-by compare 1 nil) #{nil 1}
(sorted-set-by compare nil 2) #{nil 2}
(sorted-set-by compare #{}) #{#{}} ))
(deftest test-set
; set?
(are [x] (set? (set x))
() '(1 2)
[] [1 2]
#{} #{1 2}
{} {:a 1 :b 2}
(into-array []) (into-array [1 2])
"" "abc" )
; unique
(are [x] (= (set [x x]) #{x})
nil
false true
0 42
0.0 3.14
2/3
0M 1M
\c
"" "abc"
'sym
:kw
() '(1 2)
[] [1 2]
{} {:a 1 :b 2}
#{} #{1 2} )
; conversion
(are [x y] (= (set x) y)
() #{}
'(1 2) #{1 2}
[] #{}
[1 2] #{1 2}
#{} #{} ; identity
#{1 2} #{1 2} ; identity
{} #{}
{:a 1 :b 2} #{[:a 1] [:b 2]}
(into-array []) #{}
(into-array [1 2]) #{1 2}
"" #{}
"abc" #{\a \b \c} ))
(deftest test-disj
; doesn't work on lists, vectors or maps
(is (thrown? ClassCastException (disj '(1 2) 1)))
(is (thrown? ClassCastException (disj [1 2] 1)))
(is (thrown? ClassCastException (disj {:a 1} :a)))
; identity
(are [x] (= (disj x) x)
nil
#{}
#{1 2 3}
; different data types
#{nil
false true
0 42
0.0 3.14
2/3
0M 1M
\c
"" "abc"
'sym
:kw
[] [1 2]
{} {:a 1 :b 2}
#{} #{1 2}} )
; type identity
(are [x] (= (class (disj x)) (class x))
(hash-set)
(hash-set 1 2)
(sorted-set)
(sorted-set 1 2) )
(are [x y] (= x y)
(disj nil :a) nil
(disj nil :a :b) nil
(disj #{} :a) #{}
(disj #{} :a :b) #{}
(disj #{:a} :a) #{}
(disj #{:a} :a :b) #{}
(disj #{:a} :c) #{:a}
(disj #{:a :b :c :d} :a) #{:b :c :d}
(disj #{:a :b :c :d} :a :d) #{:b :c}
(disj #{:a :b :c :d} :a :b :c) #{:d}
(disj #{:a :b :c :d} :d :a :c :b) #{}
(disj #{nil} :a) #{nil}
(disj #{nil} #{}) #{nil}
(disj #{nil} nil) #{}
(disj #{#{}} nil) #{#{}}
(disj #{#{}} #{}) #{}
(disj #{#{nil}} #{nil}) #{} ))
;; *** Queues ***
(deftest test-queues
(let [EMPTY clojure.lang.PersistentQueue/EMPTY]
(are [x y] (= x y)
EMPTY EMPTY
(into EMPTY (range 50)) (into EMPTY (range 50))
(conj EMPTY (Long. -1)) (conj EMPTY (Integer. -1))
(hash (conj EMPTY (Long. -1))) (hash (conj EMPTY (Integer. -1)))
(hash [1 2 3]) (hash (conj EMPTY 1 2 3))
(range 5) (into EMPTY (range 5))
(range 1 6) (-> EMPTY
(into (range 6))
pop))
(are [x y] (not= x y)
(range 5) (into EMPTY (range 6))
(range 6) (into EMPTY (range 5))
(range 0 6) (-> EMPTY
(into (range 6))
pop)
(range 1 6) (-> EMPTY
(into (range 7))
pop))))
(deftest test-duplicates
(let [equal-sets-incl-meta (fn [s1 s2]
(and (= s1 s2)
(let [ss1 (sort s1)
ss2 (sort s2)]
(every? identity
(map #(and (= %1 %2)
(= (meta %1) (meta %2)))
ss1 ss2)))))
all-equal-sets-incl-meta (fn [& ss]
(every? (fn [[s1 s2]]
(equal-sets-incl-meta s1 s2))
(partition 2 1 ss)))
equal-maps-incl-meta (fn [m1 m2]
(and (= m1 m2)
(equal-sets-incl-meta (set (keys m1))
(set (keys m2)))
(every? #(= (meta (m1 %)) (meta (m2 %)))
(keys m1))))
all-equal-maps-incl-meta (fn [& ms]
(every? (fn [[m1 m2]]
(equal-maps-incl-meta m1 m2))
(partition 2 1 ms)))
cmp-first #(> (first %1) (first %2))
x1 (with-meta [1] {:me "x"})
y2 (with-meta [2] {:me "y"})
z3a (with-meta [3] {:me "z3a"})
z3b (with-meta [3] {:me "z3b"})
v4a (with-meta [4] {:me "v4a"})
v4b (with-meta [4] {:me "v4b"})
v4c (with-meta [4] {:me "v4c"})
w5a (with-meta [5] {:me "w5a"})
w5b (with-meta [5] {:me "w5b"})
w5c (with-meta [5] {:me "w5c"})]
;; Sets
(is (thrown? IllegalArgumentException
(read-string "#{1 2 3 4 1 5}")))
;; If there are duplicate items when doing (conj #{} x1 x2 ...),
;; the behavior is that the metadata of the first item is kept.
(are [s x] (all-equal-sets-incl-meta s
(apply conj #{} x)
(set x)
(apply hash-set x)
(apply sorted-set x)
(apply sorted-set-by cmp-first x))
#{x1 y2} [x1 y2]
#{x1 z3a} [x1 z3a z3b]
#{w5b} [w5b w5a w5c]
#{z3a x1} [z3a z3b x1])
;; Maps
(is (thrown? IllegalArgumentException
(read-string "{:a 1, :b 2, :a -1, :c 3}")))
;; If there are duplicate keys when doing (assoc {} k1 v1 k2 v2
;; ...), the behavior is that the metadata of the first duplicate
;; key is kept, but mapped to the last value with an equal key
;; (where metadata of keys are not compared).
(are [h x] (all-equal-maps-incl-meta h
(apply assoc {} x)
(apply hash-map x)
(apply sorted-map x)
(apply sorted-map-by cmp-first x)
(apply array-map x))
{x1 2, z3a 4} [x1 2, z3a 4]
{x1 2, z3a 5} [x1 2, z3a 4, z3b 5]
{z3a 5} [z3a 2, z3a 4, z3b 5]
{z3b 4, x1 5} [z3b 2, z3a 4, x1 5]
{z3b v4b, x1 5} [z3b v4a, z3a v4b, x1 5]
{x1 v4a, w5a v4c, v4a z3b, y2 2} [x1 v4a, w5a v4a, w5b v4b,
v4a z3a, y2 2, v4b z3b, w5c v4c])))
(deftest test-assoc
(are [x y] (= x y)
[4] (assoc [] 0 4)
[5 -7] (assoc [] 0 5 1 -7)
{:a 1} (assoc {} :a 1)
{:a 2 :b -2} (assoc {} :b -2 :a 2))
(is (thrown? IllegalArgumentException (assoc [] 0 5 1)))
(is (thrown? IllegalArgumentException (assoc {} :b -2 :a))))
(defn is-same-collection [a b]
(let [msg (format "(class a)=%s (class b)=%s a=%s b=%s"
(.getName (class a)) (.getName (class b)) a b)]
(is (= (count a) (count b) (.size a) (.size b)) msg)
(is (= a b) msg)
(is (= b a) msg)
(is (.equals ^Object a b) msg)
(is (.equals ^Object b a) msg)
(is (= (hash a) (hash b)) msg)
(is (= (.hashCode ^Object a) (.hashCode ^Object b)) msg)))
(deftest ordered-collection-equality-test
(let [empty-colls [ []
'()
(lazy-seq)
clojure.lang.PersistentQueue/EMPTY
(vector-of :long) ]]
(doseq [c1 empty-colls, c2 empty-colls]
(is-same-collection c1 c2)))
(let [colls1 [ [-3 :a "7th"]
'(-3 :a "7th")
(lazy-seq (cons -3
(lazy-seq (cons :a
(lazy-seq (cons "7th" nil))))))
(into clojure.lang.PersistentQueue/EMPTY
[-3 :a "7th"]) ]]
(doseq [c1 colls1, c2 colls1]
(is-same-collection c1 c2)))
(is-same-collection [-3 1 7] (vector-of :long -3 1 7)))
(defn case-indendent-string-cmp [s1 s2]
(compare (string/lower-case s1) (string/lower-case s2)))
(deftest set-equality-test
(let [empty-sets [ #{}
(hash-set)
(sorted-set)
(sorted-set-by case-indendent-string-cmp) ]]
(doseq [s1 empty-sets, s2 empty-sets]
(is-same-collection s1 s2)))
(let [sets1 [ #{"Banana" "apple" "7th"}
(hash-set "Banana" "apple" "7th")
(sorted-set "Banana" "apple" "7th")
(sorted-set-by case-indendent-string-cmp "Banana" "apple" "7th") ]]
(doseq [s1 sets1, s2 sets1]
(is-same-collection s1 s2))))
(deftest map-equality-test
(let [empty-maps [ {}
(hash-map)
(array-map)
(sorted-map)
(sorted-map-by case-indendent-string-cmp) ]]
(doseq [m1 empty-maps, m2 empty-maps]
(is-same-collection m1 m2)))
(let [maps1 [ {"Banana" "like", "apple" "love", "7th" "indifferent"}
(hash-map "Banana" "like", "apple" "love", "7th" "indifferent")
(array-map "Banana" "like", "apple" "love", "7th" "indifferent")
(sorted-map "Banana" "like", "apple" "love", "7th" "indifferent")
(sorted-map-by case-indendent-string-cmp
"Banana" "like", "apple" "love", "7th" "indifferent") ]]
(doseq [m1 maps1, m2 maps1]
(is-same-collection m1 m2))))
;; *** Collection hashes ***
;; See: http://clojure.org/data_structures#hash
(defn hash-ordered [collection]
(-> (reduce (fn [acc e] (unchecked-add-int (unchecked-multiply-int 31 acc) (hash e)))
1
collection)
(mix-collection-hash (count collection))))
(defn hash-unordered [collection]
(-> (reduce unchecked-add-int 0 (map hash collection))
(mix-collection-hash (count collection))))
(defn gen-elements
[]
(gen/vec gen/anything))
(defspec ordered-collection-hashes-match
identity
[^{:tag clojure.test-clojure.data-structures/gen-elements} elem]
(let [v (vec elem)
l (apply list elem)]
(is (= (hash v)
(hash l)
(hash (map identity elem))
(hash-ordered elem)))))
(defspec unordered-set-hashes-match
identity
[^{:tag clojure.test-clojure.data-structures/gen-elements} elem]
(let [unique-elem (distinct elem)
s (into #{} unique-elem)]
(is (= (hash s)
(hash-unordered unique-elem)))))
clojure1.6_1.6.0+dfsg.orig/test/clojure/test_clojure/def.clj 0000664 0000000 0000000 00000006137 12346720654 0023742 0 ustar 00root root 0000000 0000000 ; 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.
(ns clojure.test-clojure.def
(:use clojure.test clojure.test-helper
clojure.test-clojure.protocols))
(deftest defn-error-messages
(testing "multiarity syntax invalid parameter declaration"
(is (fails-with-cause?
IllegalArgumentException
#"Parameter declaration arg1 should be a vector"
(eval-in-temp-ns (defn foo (arg1 arg2))))))
(testing "multiarity syntax invalid signature"
(is (fails-with-cause?
IllegalArgumentException
#"Invalid signature \[a b\] should be a list"
(eval-in-temp-ns (defn foo
([a] 1)
[a b])))))
(testing "assume single arity syntax"
(is (fails-with-cause?
IllegalArgumentException
#"Parameter declaration a should be a vector"
(eval-in-temp-ns (defn foo a)))))
(testing "bad name"
(is (fails-with-cause?
IllegalArgumentException
#"First argument to defn must be a symbol"
(eval-in-temp-ns (defn "bad docstring" testname [arg1 arg2])))))
(testing "missing parameter/signature"
(is (fails-with-cause?
IllegalArgumentException
#"Parameter declaration missing"
(eval-in-temp-ns (defn testname)))))
(testing "allow trailing map"
(is (eval-in-temp-ns (defn a "asdf" ([a] 1) {:a :b}))))
(testing "don't allow interleaved map"
(is (fails-with-cause?
IllegalArgumentException
#"Invalid signature \{:a :b\} should be a list"
(eval-in-temp-ns (defn a "asdf" ([a] 1) {:a :b} ([] 1)))))))
(deftest non-dynamic-warnings
(testing "no warning for **"
(is (empty? (with-err-print-writer
(eval-in-temp-ns (defn ** ([a b] (Math/pow (double a) (double b)))))))))
(testing "warning for *hello*"
(is (not (empty? (with-err-print-writer
(eval-in-temp-ns (def *hello* "hi"))))))))
(deftest dynamic-redefinition
;; too many contextual things for this kind of caching to work...
(testing "classes are never cached, even if their bodies are the same"
(is (= :b
(eval
'(do
(defmacro my-macro [] :a)
(defn do-macro [] (my-macro))
(defmacro my-macro [] :b)
(defn do-macro [] (my-macro))
(do-macro)))))))
(deftest nested-dynamic-declaration
(testing "vars :dynamic meta data is applied immediately to vars declared anywhere"
(is (= 10
(eval
'(do
(list
(declare ^:dynamic p)
(defn q [] @p))
(binding [p (atom 10)]
(q)))))))) clojure1.6_1.6.0+dfsg.orig/test/clojure/test_clojure/delays.clj 0000664 0000000 0000000 00000001020 12346720654 0024447 0 ustar 00root root 0000000 0000000 (ns clojure.test-clojure.delays
(:use clojure.test))
(deftest calls-once
(let [a (atom 0)
d (delay (swap! a inc))]
(is (= 0 @a))
(is (= 1 @d))
(is (= 1 @d))
(is (= 1 @a))))
(deftest saves-exceptions
(let [f #(do (throw (Exception. "broken"))
1)
d (delay (f))
try-call #(try
@d
(catch Exception e e))
first-result (try-call)]
(is (instance? Exception first-result))
(is (identical? first-result (try-call)))))
clojure1.6_1.6.0+dfsg.orig/test/clojure/test_clojure/edn.clj 0000664 0000000 0000000 00000002466 12346720654 0023753 0 ustar 00root root 0000000 0000000 ; 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.
; Author: Stuart Halloway
(ns clojure.test-clojure.edn
(:require [clojure.test.generative :refer (defspec)]
[clojure.test-clojure.generators :as cgen]
[clojure.edn :as edn]))
(defn roundtrip
"Print an object and read it back as edn. Returns rather than throws
any exceptions."
[o]
(binding [*print-length* nil
*print-dup* nil
*print-level* nil]
(try
(-> o pr-str edn/read-string)
(catch Throwable t t))))
(defspec types-that-should-roundtrip
roundtrip
[^{:tag cgen/ednable} o]
(when-not (= o %)
(throw (ex-info "Value cannot roundtrip, see ex-data" {:printed o :read %}))))
(defspec types-that-should-not-roundtrip
roundtrip
[^{:tag cgen/non-ednable} o]
(when-not (instance? Throwable %)
(throw (ex-info "edn/read should have thrown, see ex-data" {:printed o :read %}))))
clojure1.6_1.6.0+dfsg.orig/test/clojure/test_clojure/errors.clj 0000664 0000000 0000000 00000004734 12346720654 0024521 0 ustar 00root root 0000000 0000000 ; 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.
;; Tests for error handling and messages
(ns clojure.test-clojure.errors
(:use clojure.test)
(:import clojure.lang.ArityException))
(defn f0 [] 0)
(defn f1 [a] a)
;; Function name that includes many special characters to test demunge
(defn f2:+><->!#%&*|b [x] x)
(defmacro m0 [] `(identity 0))
(defmacro m1 [a] `(inc ~a))
(deftest arity-exception
;; IllegalArgumentException is pre-1.3
(is (thrown-with-msg? IllegalArgumentException #"Wrong number of args \(1\) passed to"
(f0 1)))
(is (thrown-with-msg? ArityException #"Wrong number of args \(0\) passed to"
(f1)))
(is (thrown-with-msg? ArityException #"Wrong number of args \(1\) passed to"
(macroexpand `(m0 1))))
(is (thrown-with-msg? ArityException #"Wrong number of args \(2\) passed to"
(macroexpand `(m1 1 2))))
(is (thrown-with-msg? ArityException #"\Q/f2:+><->!#%&*|b\E"
(f2:+><->!#%&*|b 1 2))
"ArityException messages should demunge function names"))
(deftest assert-arg-messages
; used to ensure that error messages properly use local names for macros
(refer 'clojure.core :rename '{with-open renamed-with-open})
; would have used `are` here, but :line meta on &form doesn't survive successive macroexpansions
(doseq [[msg-regex-str form] [["if-let .* in %s:\\d+" '(if-let [a 5
b 6]
true nil)]
["let .* in %s:\\d+" '(let [a])]
["let .* in %s:\\d+" '(let (a))]
["renamed-with-open .* in %s:\\d+" '(renamed-with-open [a])]]]
(is (thrown-with-msg? IllegalArgumentException
(re-pattern (format msg-regex-str *ns*))
(macroexpand form)))))
(deftest extract-ex-data
(try
(throw (ex-info "example error" {:foo 1}))
(catch Throwable t
(is (= {:foo 1} (ex-data t)))))
(is (nil? (ex-data (RuntimeException. "example non ex-data")))))
clojure1.6_1.6.0+dfsg.orig/test/clojure/test_clojure/evaluation.clj 0000664 0000000 0000000 00000017041 12346720654 0025347 0 ustar 00root root 0000000 0000000 ; 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.
;; Tests for the Clojure functions documented at the URL:
;;
;; http://clojure.org/Evaluation
;;
;; by J. McConnell
;; Created 22 October 2008
(ns clojure.test-clojure.evaluation
(:use clojure.test))
(import '(java.lang Boolean)
'(clojure.lang Compiler Compiler$CompilerException))
(defmacro test-that
"Provides a useful way for specifying the purpose of tests. If the first-level
forms are lists that make a call to a clojure.test function, it supplies the
purpose as the msg argument to those functions. Otherwise, the purpose just
acts like a comment and the forms are run unchanged."
[purpose & test-forms]
(let [tests (map
#(if (= (:ns (meta (resolve (first %))))
(the-ns 'clojure.test))
(concat % (list purpose))
%)
test-forms)]
`(do ~@tests)))
(deftest Eval
(is (= (eval '(+ 1 2 3)) (Compiler/eval '(+ 1 2 3))))
(is (= (eval '(list 1 2 3)) '(1 2 3)))
(is (= (eval '(list + 1 2 3)) (list clojure.core/+ 1 2 3)))
(test-that "Non-closure fns are supported as code"
(is (= (eval (eval '(list + 1 2 3))) 6)))
(is (= (eval (list '+ 1 2 3)) 6)))
; not using Clojure's RT/classForName since a bug in it could hide a bug in
; eval's resolution
(defn class-for-name [name]
(java.lang.Class/forName name))
(defmacro in-test-ns [& body]
`(binding [*ns* *ns*]
(in-ns 'clojure.test-clojure.evaluation)
~@body))
;;; Literals tests ;;;
(defmacro #^{:private true} evaluates-to-itself? [expr]
`(let [v# ~expr
q# (quote ~expr)]
(is (= (eval q#) q#) (str q# " does not evaluate to itself"))))
(deftest Literals
; Strings, numbers, characters, nil and keywords should evaluate to themselves
(evaluates-to-itself? "test")
(evaluates-to-itself? "test
multi-line
string")
(evaluates-to-itself? 1)
(evaluates-to-itself? 1.0)
(evaluates-to-itself? 1.123456789)
(evaluates-to-itself? 1/2)
(evaluates-to-itself? 1M)
(evaluates-to-itself? 999999999999999999)
(evaluates-to-itself? \a)
(evaluates-to-itself? \newline)
(evaluates-to-itself? nil)
(evaluates-to-itself? :test)
; Boolean literals should evaluate to Boolean.{TRUE|FALSE}
(is (identical? (eval true) Boolean/TRUE))
(is (identical? (eval false) Boolean/FALSE)))
;;; Symbol resolution tests ;;;
(def foo "abc")
(in-ns 'resolution-test)
(def bar 123)
(def #^{:private true} baz 456)
(in-ns 'clojure.test-clojure.evaluation)
(defn a-match? [re s] (not (nil? (re-matches re s))))
(defmacro throws-with-msg
([re form] `(throws-with-msg ~re ~form Exception))
([re form x] `(throws-with-msg
~re
~form
~(if (instance? Exception x) x Exception)
~(if (instance? String x) x nil)))
([re form class msg]
`(let [ex# (try
~form
(catch ~class e# e#)
(catch Exception e#
(let [cause# (.getCause e#)]
(if (= ~class (class cause#)) cause# (throw e#)))))]
(is (a-match? ~re (.toString ex#))
(or ~msg
(str "Expected exception that matched " (pr-str ~re)
", but got exception with message: \"" ex#))))))
(deftest SymbolResolution
(test-that
"If a symbol is namespace-qualified, the evaluated value is the value
of the binding of the global var named by the symbol"
(is (= (eval 'resolution-test/bar) 123)))
(test-that
"It is an error if there is no global var named by the symbol"
(throws-with-msg
#".*Unable to resolve symbol: bar.*" (eval 'bar)))
(test-that
"It is an error if the symbol reference is to a non-public var in a
different namespace"
(throws-with-msg
#".*resolution-test/baz is not public.*"
(eval 'resolution-test/baz)
Compiler$CompilerException))
(test-that
"If a symbol is package-qualified, its value is the Java class named by the
symbol"
(is (= (eval 'java.lang.Math) (class-for-name "java.lang.Math"))))
(test-that
"If a symbol is package-qualified, it is an error if there is no Class named
by the symbol"
(is (thrown? Compiler$CompilerException (eval 'java.lang.FooBar))))
(test-that
"If a symbol is not qualified, the following applies, in this order:
1. If it names a special form it is considered a special form, and must
be utilized accordingly.
2. A lookup is done in the current namespace to see if there is a mapping
from the symbol to a class. If so, the symbol is considered to name a
Java class object.
3. If in a local scope (i.e. in a function definition), a lookup is done
to see if it names a local binding (e.g. a function argument or
let-bound name). If so, the value is the value of the local binding.
4. A lookup is done in the current namespace to see if there is a mapping
from the symbol to a var. If so, the value is the value of the binding
of the var referred-to by the symbol.
5. It is an error."
; First
(doall (for [form '(def if do let quote var fn loop recur throw try
monitor-enter monitor-exit)]
(is (thrown? Compiler$CompilerException (eval form)))))
(let [if "foo"]
(is (thrown? Compiler$CompilerException (eval 'if)))
; Second
(is (= (eval 'Boolean) (class-for-name "java.lang.Boolean"))))
(let [Boolean "foo"]
(is (= (eval 'Boolean) (class-for-name "java.lang.Boolean"))))
; Third
(is (= (eval '(let [foo "bar"] foo)) "bar"))
; Fourth
(in-test-ns (is (= (eval 'foo) "abc")))
(is (thrown? Compiler$CompilerException (eval 'bar))) ; not in this namespace
; Fifth
(is (thrown? Compiler$CompilerException (eval 'foobar)))))
;;; Metadata tests ;;;
(defstruct struct-with-symbols (with-meta 'k {:a "A"}))
(deftest Metadata
(test-that
"find returns key symbols and their metadata"
(let [s (struct struct-with-symbols 1)]
(is (= {:a "A"} (meta (first (find s 'k))))))))
;;; Collections tests ;;;
(def x 1)
(def y 2)
(deftest Collections
(in-test-ns
(test-that
"Vectors and Maps yield vectors and (hash) maps whose contents are the
evaluated values of the objects they contain."
(is (= (eval '[x y 3]) [1 2 3]))
(is (= (eval '{:x x :y y :z 3}) {:x 1 :y 2 :z 3}))
(is (instance? clojure.lang.IPersistentMap (eval '{:x x :y y})))))
(in-test-ns
(test-that
"Metadata maps yield maps whose contents are the evaluated values of
the objects they contain. If a vector or map has metadata, the evaluated
metadata map will become the metadata of the resulting value."
(is (= (eval #^{:x x} '[x y]) #^{:x 1} [1 2]))))
(test-that
"An empty list () evaluates to an empty list."
(is (= (eval '()) ()))
(is (empty? (eval ())))
(is (= (eval (list)) ())))
;aargh, fragile tests, please fix
#_(test-that
"Non-empty lists are considered calls"
(is (thrown? Compiler$CompilerException (eval '(1 2 3))))))
(deftest Macros)
(deftest Loading)
clojure1.6_1.6.0+dfsg.orig/test/clojure/test_clojure/fn.clj 0000664 0000000 0000000 00000004176 12346720654 0023610 0 ustar 00root root 0000000 0000000 ; 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.
; Author: Ambrose Bonnaire-Sergeant
(ns clojure.test-clojure.fn
(:use clojure.test))
(deftest fn-error-checking
(testing "bad arglist"
(is (fails-with-cause? java.lang.IllegalArgumentException
#"Parameter declaration a should be a vector"
(eval '(fn "a" a)))))
(testing "treat first param as args"
(is (fails-with-cause? java.lang.IllegalArgumentException
#"Parameter declaration a should be a vector"
(eval '(fn "a" [])))))
(testing "looks like listy signature, but malformed declaration"
(is (fails-with-cause? java.lang.IllegalArgumentException
#"Parameter declaration 1 should be a vector"
(eval '(fn (1))))))
(testing "checks each signature"
(is (fails-with-cause? java.lang.IllegalArgumentException
#"Parameter declaration a should be a vector"
(eval '(fn
([a] 1)
("a" 2))))))
(testing "correct name but invalid args"
(is (fails-with-cause? java.lang.IllegalArgumentException
#"Parameter declaration a should be a vector"
(eval '(fn a "a")))))
(testing "first sig looks multiarity, rest of sigs should be lists"
(is (fails-with-cause? java.lang.IllegalArgumentException
#"Invalid signature \[a b\] should be a list"
(eval '(fn a
([a] 1)
[a b])))))
(testing "missing parameter declaration"
(is (fails-with-cause? java.lang.IllegalArgumentException
#"Parameter declaration missing"
(eval '(fn a))))
(is (fails-with-cause? java.lang.IllegalArgumentException
#"Parameter declaration missing"
(eval '(fn))))))
clojure1.6_1.6.0+dfsg.orig/test/clojure/test_clojure/for.clj 0000664 0000000 0000000 00000013446 12346720654 0023773 0 ustar 00root root 0000000 0000000 ; 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.
;; Tests for the Clojure 'for' macro
;;
;; by Chouser
;; Created Dec 2008
(ns clojure.test-clojure.for
(:use clojure.test))
(deftest Docstring-Example
(is (= (take 100 (for [x (range 100000000)
y (range 1000000) :while (< y x)]
[x y]))
'([1 0] [2 0] [2 1] [3 0] [3 1] [3 2] [4 0] [4 1] [4 2] [4 3]
[5 0] [5 1] [5 2] [5 3] [5 4]
[6 0] [6 1] [6 2] [6 3] [6 4] [6 5]
[7 0] [7 1] [7 2] [7 3] [7 4] [7 5] [7 6]
[8 0] [8 1] [8 2] [8 3] [8 4] [8 5] [8 6] [8 7]
[9 0] [9 1] [9 2] [9 3] [9 4] [9 5] [9 6] [9 7] [9 8]
[10 0] [10 1] [10 2] [10 3] [10 4] [10 5] [10 6] [10 7] [10 8] [10 9]
[11 0] [11 1] [11 2] [11 3] [11 4] [11 5] [11 6] [11 7] [11 8] [11 9]
[11 10]
[12 0] [12 1] [12 2] [12 3] [12 4] [12 5] [12 6] [12 7] [12 8] [12 9]
[12 10] [12 11]
[13 0] [13 1] [13 2] [13 3] [13 4] [13 5] [13 6] [13 7] [13 8] [13 9]
[13 10] [13 11] [13 12]
[14 0] [14 1] [14 2] [14 3] [14 4] [14 5] [14 6] [14 7] [14 8]))))
(defmacro deftest-both [txt & ises]
`(do
(deftest ~(symbol (str "For-" txt)) ~@ises)
(deftest ~(symbol (str "Doseq-" txt))
~@(map (fn [[x-is [x-= [x-for binds body] value]]]
(when (and (= x-is 'is) (= x-= '=) (= x-for 'for))
`(is (= (let [acc# (atom [])]
(doseq ~binds (swap! acc# conj ~body))
@acc#)
~value))))
ises))))
(deftest-both When
(is (= (for [x (range 10) :when (odd? x)] x) '(1 3 5 7 9)))
(is (= (for [x (range 4) y (range 4) :when (odd? y)] [x y])
'([0 1] [0 3] [1 1] [1 3] [2 1] [2 3] [3 1] [3 3])))
(is (= (for [x (range 4) y (range 4) :when (odd? x)] [x y])
'([1 0] [1 1] [1 2] [1 3] [3 0] [3 1] [3 2] [3 3])))
(is (= (for [x (range 4) :when (odd? x) y (range 4)] [x y])
'([1 0] [1 1] [1 2] [1 3] [3 0] [3 1] [3 2] [3 3])))
(is (= (for [x (range 5) y (range 5) :when (< x y)] [x y])
'([0 1] [0 2] [0 3] [0 4] [1 2] [1 3] [1 4] [2 3] [2 4] [3 4]))))
(defn only
"Returns a lazy seq of increasing ints starting at 0. Trying to get
the nth+1 value of the seq throws an exception. This is meant to
help detecting over-eagerness in lazy seq consumers."
[n]
(lazy-cat (range n)
(throw (Exception. "consumer went too far in lazy seq"))))
(deftest-both While
(is (= (for [x (only 6) :while (< x 5)] x) '(0 1 2 3 4)))
(is (= (for [x (range 4) y (only 4) :while (< y 3)] [x y])
'([0 0] [0 1] [0 2] [1 0] [1 1] [1 2]
[2 0] [2 1] [2 2] [3 0] [3 1] [3 2])))
(is (= (for [x (range 4) y (range 4) :while (< x 3)] [x y])
'([0 0] [0 1] [0 2] [0 3] [1 0] [1 1] [1 2] [1 3]
[2 0] [2 1] [2 2] [2 3])))
(is (= (for [x (only 4) :while (< x 3) y (range 4)] [x y])
'([0 0] [0 1] [0 2] [0 3] [1 0] [1 1] [1 2] [1 3]
[2 0] [2 1] [2 2] [2 3])))
(is (= (for [x (range 4) y (range 4) :while (even? x)] [x y])
'([0 0] [0 1] [0 2] [0 3] [2 0] [2 1] [2 2] [2 3])))
(is (= (for [x (only 2) :while (even? x) y (range 4)] [x y])
'([0 0] [0 1] [0 2] [0 3])))
(is (= (for [x (range 4) y (only 4) :while (< y x)] [x y])
'([1 0] [2 0] [2 1] [3 0] [3 1] [3 2]))))
(deftest-both While-and-When
(is (= (for [x (only 6) :while (< x 5) y (range 4) :when (odd? y)] [x y])
'([0 1] [0 3] [1 1] [1 3] [2 1] [2 3] [3 1] [3 3] [4 1] [4 3])))
(is (= (for [x (range 4) :when (odd? x) y (only 6) :while (< y 5)] [x y])
'([1 0] [1 1] [1 2] [1 3] [1 4] [3 0] [3 1] [3 2] [3 3] [3 4])))
(is (= (for [x (only 6) :while (< x 5) y (range 4) :when (odd? (+ x y))]
[x y])
'([0 1] [0 3] [1 0] [1 2] [2 1] [2 3] [3 0] [3 2] [4 1] [4 3])))
(is (= (for [x (range 4) :when (odd? x) y (only 2) :while (odd? (+ x y))]
[x y])
'([1 0] [3 0]))))
(deftest-both While-and-When-Same-Binding
(is (= (for [x (only 6) :while (< x 5) :when (odd? x)] x) '(1 3)))
(is (= (for [x (only 6)
:while (< x 5) ; if :while is false, :when should not be evaled
:when (do (if (< x 5) (odd? x)))] x) '(1 3)))
(is (= (for [a (range -2 5)
:when (not= a 0) ; :when may guard :while
:while (> (Math/abs (/ 1.0 a)) 1/3)] a) '(-2 -1 1 2))))
(deftest-both Nesting
(is (= (for [x '(a b) y (interpose x '(1 2)) z (list x y)] [x y z])
'([a 1 a] [a 1 1] [a a a] [a a a] [a 2 a] [a 2 2]
[b 1 b] [b 1 1] [b b b] [b b b] [b 2 b] [b 2 2])))
(is (= (for [x ['a nil] y [x 'b]] [x y])
'([a a] [a b] [nil nil] [nil b]))))
(deftest-both Destructuring
(is (= (for [{:syms [a b c]} (map #(zipmap '(a b c) (range % 5)) (range 3))
x [a b c]]
(Integer. (str a b c x)))
'(120 121 122 1231 1232 1233 2342 2343 2344))))
(deftest-both Let
(is (= (for [x (range 3) y (range 3) :let [z (+ x y)] :when (odd? z)] [x y z])
'([0 1 1] [1 0 1] [1 2 3] [2 1 3])))
(is (= (for [x (range 6) :let [y (rem x 2)] :when (even? y) z [8 9]] [x z])
'([0 8] [0 9] [2 8] [2 9] [4 8] [4 9]))))
; :while must skip all subsequent chunks as well as the remainder of
; the current chunk:
(deftest-both Chunked-While
(is (= (for [x (range 100) :while (even? x)] x) '(0))))
clojure1.6_1.6.0+dfsg.orig/test/clojure/test_clojure/genclass.clj 0000664 0000000 0000000 00000015450 12346720654 0025001 0 ustar 00root root 0000000 0000000 ; 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.
(ns ^{:doc "Tests for clojure.core/gen-class"
:author "Stuart Halloway, Daniel Solano Gómez"}
clojure.test-clojure.genclass
(:use clojure.test clojure.test-helper)
(:import [clojure.test_clojure.genclass.examples
ExampleClass
ExampleAnnotationClass
ProtectedFinalTester
ArrayDefInterface
ArrayGenInterface]
[java.lang.annotation ElementType
Retention
RetentionPolicy
Target]))
(deftest arg-support
(let [example (ExampleClass.)
o (Object.)]
(is (= "foo with o, o" (.foo example o o)))
(is (= "foo with o, i" (.foo example o (int 1))))
(is (thrown? java.lang.UnsupportedOperationException (.foo example o)))))
(deftest name-munging
(testing "mapping from Java fields to Clojure vars"
(is (= #'clojure.test-clojure.genclass.examples/-foo-Object-int
(get-field ExampleClass 'foo_Object_int__var)))
(is (= #'clojure.test-clojure.genclass.examples/-toString
(get-field ExampleClass 'toString__var)))))
;todo - fix this, it depends on the order of things out of a hash-map
#_(deftest test-annotations
(let [annot-class ExampleAnnotationClass
foo-method (.getDeclaredMethod annot-class "foo" (into-array [String]))]
(testing "Class annotations:"
(is (= 2 (count (.getDeclaredAnnotations annot-class))))
(testing "@Deprecated"
(let [deprecated (.getAnnotation annot-class Deprecated)]
(is deprecated)))
(testing "@Target([])"
(let [resource (.getAnnotation annot-class Target)]
(is (= 0 (count (.value resource)))))))
(testing "Method annotations:"
(testing "@Deprecated void foo(String):"
(is (= 1 (count (.getDeclaredAnnotations foo-method))))
(is (.getAnnotation foo-method Deprecated))))
(testing "Parameter annotations:"
(let [param-annots (.getParameterAnnotations foo-method)]
(is (= 1 (alength param-annots)))
(let [first-param-annots (aget param-annots 0)]
(is (= 2 (alength first-param-annots)))
(testing "void foo(@Retention(…) String)"
(let [retention (aget first-param-annots 0)]
(is (instance? Retention retention))
(= RetentionPolicy/SOURCE (.value retention))))
(testing "void foo(@Target(…) String)"
(let [target (aget first-param-annots 1)]
(is (instance? Target target))
(is (= [ElementType/TYPE ElementType/PARAMETER] (seq (.value target)))))))))))
(deftest genclass-option-validation
(is (fails-with-cause? IllegalArgumentException #"Not a valid method name: has-hyphen"
(@#'clojure.core/validate-generate-class-options {:methods '[[fine [] void] [has-hyphen [] void]]}))))
(deftest protected-final-access
(let [obj (ProtectedFinalTester.)]
(testing "Protected final method visibility"
(is (thrown? IllegalArgumentException (.findSystemClass obj "java.lang.String"))))
(testing "Allow exposition of protected final method."
(is (= String (.superFindSystemClass obj "java.lang.String"))))))
(deftest interface-array-type-hints
(let [array-types {:ints (class (int-array 0))
:bytes (class (byte-array 0))
:shorts (class (short-array 0))
:chars (class (char-array 0))
:longs (class (long-array 0))
:floats (class (float-array 0))
:doubles (class (double-array 0))
:booleans (class (boolean-array 0))
:maps (class (into-array java.util.Map []))}
array-types (assoc array-types
:maps-2d (class (into-array (:maps array-types) [])))
method-with-name (fn [name methods] (first (filter #(= name (.getName %)) methods)))
parameter-type (fn [method] (first (.getParameterTypes method)))
return-type (fn [method] (.getReturnType method))]
(testing "definterface"
(let [method-with-name #(method-with-name % (.getMethods ArrayDefInterface))]
(testing "sugar primitive array hints"
(are [name type] (= (type array-types)
(parameter-type (method-with-name name)))
"takesByteArray" :bytes
"takesCharArray" :chars
"takesShortArray" :shorts
"takesIntArray" :ints
"takesLongArray" :longs
"takesFloatArray" :floats
"takesDoubleArray" :doubles
"takesBooleanArray" :booleans))
(testing "raw primitive array hints"
(are [name type] (= (type array-types)
(return-type (method-with-name name)))
"returnsByteArray" :bytes
"returnsCharArray" :chars
"returnsShortArray" :shorts
"returnsIntArray" :ints
"returnsLongArray" :longs
"returnsFloatArray" :floats
"returnsDoubleArray" :doubles
"returnsBooleanArray" :booleans))))
(testing "gen-interface"
(let [method-with-name #(method-with-name % (.getMethods ArrayGenInterface))]
(testing "sugar primitive array hints"
(are [name type] (= (type array-types)
(parameter-type (method-with-name name)))
"takesByteArray" :bytes
"takesCharArray" :chars
"takesShortArray" :shorts
"takesIntArray" :ints
"takesLongArray" :longs
"takesFloatArray" :floats
"takesDoubleArray" :doubles
"takesBooleanArray" :booleans))
(testing "raw primitive array hints"
(are [name type] (= (type array-types)
(return-type (method-with-name name)))
"returnsByteArray" :bytes
"returnsCharArray" :chars
"returnsShortArray" :shorts
"returnsIntArray" :ints
"returnsLongArray" :longs
"returnsFloatArray" :floats
"returnsDoubleArray" :doubles
"returnsBooleanArray" :booleans))))))
clojure1.6_1.6.0+dfsg.orig/test/clojure/test_clojure/genclass/ 0000775 0000000 0000000 00000000000 12346720654 0024302 5 ustar 00root root 0000000 0000000 clojure1.6_1.6.0+dfsg.orig/test/clojure/test_clojure/genclass/examples.clj 0000664 0000000 0000000 00000007175 12346720654 0026624 0 ustar 00root root 0000000 0000000 ; 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.
(ns ^{:doc "Test classes that are AOT-compile for the tests in
clojure.test-clojure.genclass."
:author "Stuart Halloway, Daniel Solano Gómez"}
clojure.test-clojure.genclass.examples)
(definterface ExampleInterface
(foo [a])
(foo [a b])
(foo [a #^int b]))
(gen-class :name clojure.test_clojure.genclass.examples.ExampleClass
:implements [clojure.test_clojure.genclass.examples.ExampleInterface])
;; -foo-Object unimplemented to test missing fn case
(defn -foo-Object-Object
[_ o1 o2]
"foo with o, o")
(defn -foo-Object-int
[_ o i]
"foo with o, i")
(gen-class :name ^{Deprecated {}
SuppressWarnings ["Warning1"] ; discarded
java.lang.annotation.Target []}
clojure.test_clojure.genclass.examples.ExampleAnnotationClass
:prefix "annot-"
:methods [[^{Deprecated {}
Override {}} ;discarded
foo [^{java.lang.annotation.Retention java.lang.annotation.RetentionPolicy/SOURCE
java.lang.annotation.Target [java.lang.annotation.ElementType/TYPE
java.lang.annotation.ElementType/PARAMETER]}
String] void]])
(gen-class :name clojure.test_clojure.genclass.examples.ProtectedFinalTester
:extends java.lang.ClassLoader
:main false
:prefix "pf-"
:exposes-methods {findSystemClass superFindSystemClass})
(defn pf-findSystemClass
"This function should never be called."
[_ name]
clojure.lang.RT)
(definterface ArrayDefInterface
; primitive array sugar
(^void takesByteArray [^bytes a])
(^void takesCharArray [^chars a])
(^void takesShortArray [^shorts a])
(^void takesIntArray [^ints a])
(^void takesLongArray [^longs a])
(^void takesFloatArray [^floats a])
(^void takesDoubleArray [^doubles a])
(^void takesBooleanArray [^booleans a])
; raw primitive arrays
(^"[B" returnsByteArray [])
(^"[C" returnsCharArray [])
(^"[I" returnsIntArray [])
(^"[S" returnsShortArray [])
(^"[J" returnsLongArray [])
(^"[F" returnsFloatArray [])
(^"[D" returnsDoubleArray [])
(^"[Z" returnsBooleanArray []))
(definterface UsesPreviousInterfaceFromThisFile
(^clojure.test-clojure.genclass.examples.ArrayDefInterface
identity
[^clojure.test-clojure.genclass.examples.ArrayDefInterface a]))
(gen-interface
:name clojure.test_clojure.genclass.examples.ArrayGenInterface
:methods [; sugar
[takesByteArray [bytes] void]
[takesCharArray [chars] void]
[takesShortArray [shorts] void]
[takesIntArray [ints] void]
[takesLongArray [longs] void]
[takesFloatArray [floats] void]
[takesDoubleArray [doubles] void]
[takesBooleanArray [booleans] void]
; raw primitive types
[returnsByteArray [] "[B"]
[returnsCharArray [] "[C"]
[returnsShortArray [] "[S"]
[returnsIntArray [] "[I"]
[returnsLongArray [] "[J"]
[returnsFloatArray [] "[F"]
[returnsDoubleArray [] "[D"]
[returnsBooleanArray [] "[Z"]])
clojure1.6_1.6.0+dfsg.orig/test/clojure/test_clojure/generators.clj 0000664 0000000 0000000 00000006161 12346720654 0025352 0 ustar 00root root 0000000 0000000 (ns clojure.test-clojure.generators
(:require [clojure.data.generators :as gen])
(:refer-clojure :exclude [namespace]))
(defn var-value-source
"Generates a scalar suitable for an initial var value."
[]
(let [v (gen/scalar)]
(if (symbol? v)
`(quote ~v)
v)))
(defn var-source
[n]
`(def ~(symbol (str "var" n))
~(var-value-source)))
(defn record-source
[n]
(let [rname (str "ExampleRecord" "-" n)
fldct (gen/geometric 0.1)]
`(defrecord ~(symbol rname) ~(vec (map #(symbol (str "f" %)) (range fldct))))))
(defn generate-namespaces
"Returns a map with :nses, :vars, :records"
[{:keys [nses vars-per-ns records-per-ns]}]
(let [nses (mapv #(create-ns (symbol (str "clojure.generated.ns" %)))
(range nses))
_ (doseq [ns nses] (binding [*ns* ns] (refer 'clojure.core)))
make-in-ns (fn [ns src] (binding [*ns* ns] (eval src)))
vars (->> (mapcat
(fn [ns]
(map
#(make-in-ns ns (var-source %))
(range vars-per-ns)))
nses)
(into []))
records (->> (mapcat
(fn [ns]
(map
#(make-in-ns ns (record-source %))
(range records-per-ns)))
nses)
(into []))]
{:nses nses
:vars vars
:records records}))
(def shared-generation
(delay (generate-namespaces {:nses 5 :vars-per-ns 5 :records-per-ns 5})))
(defn namespace
[]
(gen/rand-nth (:nses @shared-generation)))
(defn var
[]
(gen/rand-nth (:vars @shared-generation)))
(defn record
[]
(gen/rand-nth (:records @shared-generation)))
(def keyword-pool
(delay
(binding [gen/*rnd* (java.util.Random. 42)]
(into [] (repeatedly 1000 gen/keyword)))))
(defn keyword-from-pool
[]
(gen/rand-nth @keyword-pool))
(def symbol-pool
(delay
(binding [gen/*rnd* (java.util.Random. 42)]
(into [] (repeatedly 1000 gen/symbol)))))
(defn symbol-from-pool
[]
(gen/rand-nth @keyword-pool))
(def ednable-scalars
[(constantly nil)
gen/byte
gen/long
gen/boolean
gen/printable-ascii-char
gen/string
symbol-from-pool
keyword-from-pool
gen/uuid
gen/date
gen/ratio
gen/bigint
gen/bigdec])
(defn- call-through
"Recursively call x until it doesn't return a function."
[x]
(if (fn? x)
(recur (x))
x))
(defn ednable-scalar
[]
(call-through (rand-nth ednable-scalars)))
(def ednable-collections
[[gen/vec [ednable-scalars]]
[gen/set [ednable-scalars]]
[gen/hash-map [ednable-scalars ednable-scalars]]])
(defn ednable-collection
[]
(let [[coll args] (rand-nth ednable-collections)]
(apply coll (map rand-nth args))))
(defn ednable
[]
(gen/one-of ednable-scalar ednable-collection))
(defn non-ednable
"Generate something that can be printed with *print-dup*, but
cannot be read back via edn/read."
[]
(gen/one-of namespace var))
(defn dup-readable
"Generate something that requires print-dup to be printed in
a roundtrippable way."
[]
(gen/one-of namespace var))
clojure1.6_1.6.0+dfsg.orig/test/clojure/test_clojure/java/ 0000775 0000000 0000000 00000000000 12346720654 0023424 5 ustar 00root root 0000000 0000000 clojure1.6_1.6.0+dfsg.orig/test/clojure/test_clojure/java/io.clj 0000664 0000000 0000000 00000022364 12346720654 0024534 0 ustar 00root root 0000000 0000000 ; 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.
(ns clojure.test-clojure.java.io
(:use clojure.test clojure.java.io
[clojure.test-helper :only [platform-newlines]])
(:import (java.io File BufferedInputStream
FileInputStream InputStreamReader InputStream
FileOutputStream OutputStreamWriter OutputStream
ByteArrayInputStream ByteArrayOutputStream)
(java.net URL URI Socket ServerSocket)))
(defn temp-file
[prefix suffix]
(doto (File/createTempFile prefix suffix)
(.deleteOnExit)))
;; does not work on IBM JDK
#_(deftest test-spit-and-slurp
(let [f (temp-file "clojure.java.io" "test")
content (apply str (concat "a" (repeat 500 "\u226a\ud83d\ude03")))]
(spit f content)
(is (= content (slurp f)))
;; UTF-16 must be last for the following test
(doseq [enc [ "UTF-8" "UTF-16BE" "UTF-16LE" "UTF-16" ]]
(spit f content :encoding enc)
(is (= content (slurp f :encoding enc))))
(testing "deprecated arity"
(is (=
(platform-newlines "WARNING: (slurp f enc) is deprecated, use (slurp f :encoding enc).\n")
(with-out-str
(is (= content (slurp f "UTF-16")))))))))
(deftest test-streams-defaults
(let [f (temp-file "clojure.java.io" "test-reader-writer")
content "testing"]
(try
(is (thrown? Exception (reader (Object.))))
(is (thrown? Exception (writer (Object.))))
(are [write-to read-from] (= content (do
(spit write-to content :encoding "UTF-8")
(slurp read-from :encoding "UTF-8")))
f f
(.getAbsolutePath f) (.getAbsolutePath f)
(.toURL f) (.toURL f)
(.toURI f) (.toURI f)
(FileOutputStream. f) (FileInputStream. f)
(OutputStreamWriter. (FileOutputStream. f) "UTF-8") (reader f :encoding "UTF-8")
f (FileInputStream. f)
(writer f :encoding "UTF-8") (InputStreamReader. (FileInputStream. f) "UTF-8"))
(is (= content (slurp (.getBytes content "UTF-8"))))
(is (= content (slurp (.toCharArray content))))
(finally
(.delete f)))))
(defn bytes-should-equal [byte-array-1 byte-array-2 msg]
(is (= @#'clojure.java.io/byte-array-type (class byte-array-1) (class byte-array-2)) msg)
(is (= (into [] byte-array-1) (into [] byte-array-2)) msg))
(defn data-fixture
"in memory fixture data for tests"
[encoding]
(let [s (apply str (concat "a" (repeat 500 "\u226a\ud83d\ude03")))
bs (.getBytes s encoding)
cs (.toCharArray s)
i (ByteArrayInputStream. bs)
;; Make UTF-8 encoding explicit for the InputStreamReader and
;; OutputStreamWriter, since some JVMs use a different default
;; encoding.
r (InputStreamReader. i "UTF-8")
o (ByteArrayOutputStream.)
w (OutputStreamWriter. o "UTF-8")]
{:bs bs
:i i
:r r
:o o
:s s
:cs cs
:w w}))
(deftest test-copy
(dorun
(for [{:keys [in out flush] :as test}
[{:in :i :out :o}
{:in :i :out :w}
{:in :r :out :o}
{:in :r :out :w}
{:in :cs :out :o}
{:in :cs :out :w}
{:in :bs :out :o}
{:in :bs :out :w}]
opts
[{} {:buffer-size 16} {:buffer-size 256}]]
(let [{:keys [s o] :as d} (data-fixture "UTF-8")]
(apply copy (in d) (out d) (flatten (vec opts)))
#_(when (= out :w) (.flush (:w d)))
(.flush (out d))
(bytes-should-equal (.getBytes s "UTF-8")
(.toByteArray o)
(str "combination " test opts))))))
;; does not work on IBM JDK
#_(deftest test-copy-encodings
(doseq [enc [ "UTF-8" "UTF-16" "UTF-16BE" "UTF-16LE" ]]
(testing (str "from inputstream " enc " to writer UTF-8")
(let [{:keys [i s o w bs]} (data-fixture enc)]
(copy i w :encoding enc :buffer-size 16)
(.flush w)
(bytes-should-equal (.getBytes s "UTF-8") (.toByteArray o) "")))
(testing (str "from reader UTF-8 to output-stream " enc)
(let [{:keys [r o s]} (data-fixture "UTF-8")]
(copy r o :encoding enc :buffer-size 16)
(bytes-should-equal (.getBytes s enc) (.toByteArray o) "")))))
(deftest test-as-file
(are [result input] (= result (as-file input))
(File. "foo") "foo"
(File. "bar") (File. "bar")
(File. "baz") (URL. "file:baz")
(File. "bar+baz") (URL. "file:bar+baz")
(File. "bar baz qux") (URL. "file:bar%20baz%20qux")
(File. "quux") (URI. "file:quux")
(File. "abcíd/foo.txt") (URL. "file:abc%c3%add/foo.txt")
nil nil))
(deftest test-resources-with-spaces
(let [file-with-spaces (temp-file "test resource 2" "txt")
url (as-url (.getParentFile file-with-spaces))
loader (java.net.URLClassLoader. (into-array [url]))
r (resource (.getName file-with-spaces) loader)]
(is (= r (as-url file-with-spaces)))
(spit r "foobar")
(is (= "foobar" (slurp r)))))
(deftest test-file
(are [result args] (= (File. result) (apply file args))
"foo" ["foo"]
"foo/bar" ["foo" "bar"]
"foo/bar/baz" ["foo" "bar" "baz"]))
(deftest test-as-url
(are [file-part input] (= (URL. (str "file:" file-part)) (as-url input))
"foo" "file:foo"
"baz" (URL. "file:baz")
"quux" (URI. "file:quux"))
(is (nil? (as-url nil))))
(deftest test-delete-file
(let [file (temp-file "test" "deletion")
not-file (File. (str (java.util.UUID/randomUUID)))]
(delete-file (.getAbsolutePath file))
(is (not (.exists file)))
(is (thrown? java.io.IOException (delete-file not-file)))
(is (= :silently (delete-file not-file :silently)))))
(deftest test-as-relative-path
(testing "strings"
(is (= "foo" (as-relative-path "foo"))))
(testing "absolute path strings are forbidden"
(is (thrown? IllegalArgumentException (as-relative-path (.getAbsolutePath (File. "baz"))))))
(testing "relative File paths"
(is (= "bar" (as-relative-path (File. "bar")))))
(testing "absolute File paths are forbidden"
(is (thrown? IllegalArgumentException (as-relative-path (File. (.getAbsolutePath (File. "quux"))))))))
(defn stream-should-have [stream expected-bytes msg]
(let [actual-bytes (byte-array (alength expected-bytes))]
(.read stream actual-bytes)
(is (= -1 (.read stream)) (str msg " : should be end of stream"))
(is (= (seq expected-bytes) (seq actual-bytes)) (str msg " : byte arrays should match"))))
(deftest test-input-stream
(let [file (temp-file "test-input-stream" "txt")
content (apply str (concat "a" (repeat 500 "\u226a\ud83d\ude03")))
bytes (.getBytes content "UTF-8")]
(spit file content)
(doseq [[expr msg]
[[file File]
[(FileInputStream. file) FileInputStream]
[(BufferedInputStream. (FileInputStream. file)) BufferedInputStream]
[(.. file toURI) URI]
[(.. file toURI toURL) URL]
[(.. file toURI toURL toString) "URL as String"]
[(.. file toString) "File as String"]]]
(with-open [s (input-stream expr)]
(stream-should-have s bytes msg)))))
(deftest test-streams-buffering
(let [data (.getBytes "")]
(is (instance? java.io.BufferedReader (reader data)))
(is (instance? java.io.BufferedWriter (writer (java.io.ByteArrayOutputStream.))))
(is (instance? java.io.BufferedInputStream (input-stream data)))
(is (instance? java.io.BufferedOutputStream (output-stream (java.io.ByteArrayOutputStream.))))))
(deftest test-resource
(is (nil? (resource "non/existent/resource")))
(is (instance? URL (resource "clojure/core.clj")))
(let [file (temp-file "test-resource" "txt")
url (as-url (.getParentFile file))
loader (java.net.URLClassLoader. (into-array [url]))]
(is (nil? (resource "non/existent/resource" loader)))
(is (instance? URL (resource (.getName file) loader)))))
(deftest test-make-parents
(let [tmp (System/getProperty "java.io.tmpdir")]
(delete-file (file tmp "test-make-parents" "child" "grandchild") :silently)
(delete-file (file tmp "test-make-parents" "child") :silently)
(delete-file (file tmp "test-make-parents") :silently)
(make-parents tmp "test-make-parents" "child" "grandchild")
(is (.isDirectory (file tmp "test-make-parents" "child")))
(is (not (.isDirectory (file tmp "test-make-parents" "child" "grandchild"))))
(delete-file (file tmp "test-make-parents" "child"))
(delete-file (file tmp "test-make-parents"))))
(deftest test-socket-iofactory
(let [port 65321
server-socket (ServerSocket. port)
client-socket (Socket. "localhost" port)]
(try
(is (instance? InputStream (input-stream client-socket)))
(is (instance? OutputStream (output-stream client-socket)))
(finally (.close server-socket)
(.close client-socket)))))
clojure1.6_1.6.0+dfsg.orig/test/clojure/test_clojure/java/javadoc.clj 0000664 0000000 0000000 00000002013 12346720654 0025521 0 ustar 00root root 0000000 0000000 ; 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.
(ns clojure.test-clojure.java.javadoc
(:use clojure.test
[clojure.java.javadoc :as j])
(:import (java.io File)))
(deftest javadoc-url-test
(testing "for a core api"
(binding [*feeling-lucky* false]
(are [x y] (= x (#'j/javadoc-url y))
nil "foo.Bar"
(str *core-java-api* "java/lang/String.html") "java.lang.String")))
(testing "for a remote javadoc"
(binding [*remote-javadocs* (ref (sorted-map "java." "http://example.com/"))]
(is (= "http://example.com/java/lang/Number.html" (#'j/javadoc-url "java.lang.Number"))))))
clojure1.6_1.6.0+dfsg.orig/test/clojure/test_clojure/java/shell.clj 0000664 0000000 0000000 00000003425 12346720654 0025231 0 ustar 00root root 0000000 0000000 ; 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.
(ns clojure.test-clojure.java.shell
(:use clojure.test
[clojure.java.shell :as sh])
(:import (java.io File)))
(def platform-enc (.name (java.nio.charset.Charset/defaultCharset)))
(def default-enc "UTF-8")
(deftest test-parse-args
(are [x y] (= x y)
[[] {:in-enc default-enc :out-enc default-enc :dir nil :env nil}] (#'sh/parse-args [])
[["ls"] {:in-enc default-enc :out-enc default-enc :dir nil :env nil}] (#'sh/parse-args ["ls"])
[["ls" "-l"] {:in-enc default-enc :out-enc default-enc :dir nil :env nil}] (#'sh/parse-args ["ls" "-l"])
[["ls"] {:in-enc default-enc :out-enc "ISO-8859-1" :dir nil :env nil}] (#'sh/parse-args ["ls" :out-enc "ISO-8859-1"])
[[] {:in-enc platform-enc :out-enc platform-enc :dir nil :env nil}] (#'sh/parse-args [:in-enc platform-enc :out-enc platform-enc])))
(deftest test-with-sh-dir
(are [x y] (= x y)
nil *sh-dir*
"foo" (with-sh-dir "foo" *sh-dir*)))
(deftest test-with-sh-env
(are [x y] (= x y)
nil *sh-env*
{:KEY "VAL"} (with-sh-env {:KEY "VAL"} *sh-env*)))
(deftest test-as-env-strings
(are [x y] (= x y)
nil (#'sh/as-env-strings nil)
["FOO=BAR"] (seq (#'sh/as-env-strings {"FOO" "BAR"}))
["FOO_SYMBOL=BAR"] (seq (#'sh/as-env-strings {'FOO_SYMBOL "BAR"}))
["FOO_KEYWORD=BAR"] (seq (#'sh/as-env-strings {:FOO_KEYWORD "BAR"}))))
clojure1.6_1.6.0+dfsg.orig/test/clojure/test_clojure/java_interop.clj 0000664 0000000 0000000 00000033713 12346720654 0025665 0 ustar 00root root 0000000 0000000 ; 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.
; Author: Frantisek Sodomka
(ns clojure.test-clojure.java-interop
(:use clojure.test))
; http://clojure.org/java_interop
; http://clojure.org/compilation
(deftest test-dot
; (.instanceMember instance args*)
(are [x] (= x "FRED")
(.toUpperCase "fred")
(. "fred" toUpperCase)
(. "fred" (toUpperCase)) )
(are [x] (= x true)
(.startsWith "abcde" "ab")
(. "abcde" startsWith "ab")
(. "abcde" (startsWith "ab")) )
; (.instanceMember Classname args*)
(are [x] (= x "java.lang.String")
(.getName String)
(. (identity String) getName)
(. (identity String) (getName)) )
; (Classname/staticMethod args*)
(are [x] (= x 7)
(Math/abs -7)
(. Math abs -7)
(. Math (abs -7)) )
; (. target -prop)
(let [p (java.awt.Point. 1 2)]
(are [x y] (= x y)
1 (.-x p)
2 (.-y p)
1 (. p -x)
2 (. p -y)
1 (. (java.awt.Point. 1 2) -x)
2 (. (java.awt.Point. 1 2) -y)))
; Classname/staticField
(are [x] (= x 2147483647)
Integer/MAX_VALUE
(. Integer MAX_VALUE) ))
(definterface I (a []))
(deftype T [a] I (a [_] "method"))
(deftest test-reflective-field-name-ambiguous
(let [t (->T "field")]
(is (= "method" (. ^T t a)))
(is (= "field" (. ^T t -a)))
(is (= "method" (. t a)))
(is (= "field" (. t -a)))
(is (thrown? IllegalArgumentException (. t -BOGUS)))))
(deftest test-double-dot
(is (= (.. System (getProperties) (get "os.name"))
(. (. System (getProperties)) (get "os.name")))))
(deftest test-doto
(let [m (doto (new java.util.HashMap)
(.put "a" 1)
(.put "b" 2))]
(are [x y] (= x y)
(class m) java.util.HashMap
m {"a" 1 "b" 2} )))
(deftest test-new
; Integer
(are [expr cls value] (and (= (class expr) cls)
(= expr value))
(new java.lang.Integer 42) java.lang.Integer 42
(java.lang.Integer. 123) java.lang.Integer 123 )
; Date
(are [x] (= (class x) java.util.Date)
(new java.util.Date)
(java.util.Date.) ))
(deftest test-instance?
; evaluation
(are [x y] (= x y)
(instance? java.lang.Integer (+ 1 2)) false
(instance? java.lang.Long (+ 1 2)) true )
; different types
(are [type literal] (instance? literal type)
1 java.lang.Long
1.0 java.lang.Double
1M java.math.BigDecimal
\a java.lang.Character
"a" java.lang.String )
; it is a Long, nothing else
(are [x y] (= (instance? x 42) y)
java.lang.Integer false
java.lang.Long true
java.lang.Character false
java.lang.String false )
; test compiler macro
(is (let [Long String] (instance? Long "abc")))
(is (thrown? clojure.lang.ArityException (instance? Long))))
; set!
; memfn
(deftest test-bean
(let [b (bean java.awt.Color/black)]
(are [x y] (= x y)
(map? b) true
(:red b) 0
(:green b) 0
(:blue b) 0
(:RGB b) -16777216
(:alpha b) 255
(:transparency b) 1
(:missing b) nil
(:missing b :default) :default
(get b :missing) nil
(get b :missing :default) :default
(:class b) java.awt.Color )))
; proxy, proxy-super
(deftest test-proxy-chain
(testing "That the proxy functions can chain"
(are [x y] (= x y)
(-> (get-proxy-class Object)
construct-proxy
(init-proxy {})
(update-proxy {"toString" (fn [_] "chain chain chain")})
str)
"chain chain chain"
(-> (proxy [Object] [] (toString [] "superfuzz bigmuff"))
(update-proxy {"toString" (fn [_] "chain chain chain")})
str)
"chain chain chain")))
(deftest test-bases
(are [x y] (= x y)
(bases java.lang.Math)
(list java.lang.Object)
(bases java.util.Collection)
(list java.lang.Iterable)
(bases java.lang.Object)
nil
(bases java.lang.Comparable)
nil
(bases java.lang.Integer)
(list java.lang.Number java.lang.Comparable) ))
(deftest test-supers
(are [x y] (= x y)
(supers java.lang.Math)
#{java.lang.Object}
(supers java.lang.Integer)
#{java.lang.Number java.lang.Object
java.lang.Comparable java.io.Serializable} ))
(deftest test-proxy-super
(let [d (proxy [java.util.BitSet] []
(flip [bitIndex]
(try
(proxy-super flip bitIndex)
(catch IndexOutOfBoundsException e
(throw (IllegalArgumentException. "replaced"))))))]
;; normal call
(is (nil? (.flip d 0)))
;; exception should use proxied form and return IllegalArg
(is (thrown? IllegalArgumentException (.flip d -1)))
;; same behavior on second call
(is (thrown? IllegalArgumentException (.flip d -1)))))
; Arrays: [alength] aget aset [make-array to-array into-array to-array-2d aclone]
; [float-array, int-array, etc]
; amap, areduce
(defmacro deftest-type-array [type-array type]
`(deftest ~(symbol (str "test-" type-array))
; correct type
#_(is (= (class (first (~type-array [1 2]))) (class (~type 1))))
; given size (and empty)
(are [x] (and (= (alength (~type-array x)) x)
(= (vec (~type-array x)) (repeat x 0)))
0 1 5 )
; copy of a sequence
(are [x] (and (= (alength (~type-array x)) (count x))
(= (vec (~type-array x)) x))
[]
[1]
[1 -2 3 0 5] )
; given size and init-value
(are [x] (and (= (alength (~type-array x 42)) x)
(= (vec (~type-array x 42)) (repeat x 42)))
0 1 5 )
; given size and init-seq
(are [x y z] (and (= (alength (~type-array x y)) x)
(= (vec (~type-array x y)) z))
0 [] []
0 [1] []
0 [1 2 3] []
1 [] [0]
1 [1] [1]
1 [1 2 3] [1]
5 [] [0 0 0 0 0]
5 [1] [1 0 0 0 0]
5 [1 2 3] [1 2 3 0 0]
5 [1 2 3 4 5] [1 2 3 4 5]
5 [1 2 3 4 5 6 7] [1 2 3 4 5] )))
(deftest-type-array int-array int)
(deftest-type-array long-array long)
;todo, fix, test broken for float/double, should compare to 1.0 2.0 etc
#_(deftest-type-array float-array float)
#_(deftest-type-array double-array double)
; separate test for exceptions (doesn't work with above macro...)
(deftest test-type-array-exceptions
(are [x] (thrown? NegativeArraySizeException x)
(int-array -1)
(long-array -1)
(float-array -1)
(double-array -1) ))
(deftest test-make-array
; negative size
(is (thrown? NegativeArraySizeException (make-array Integer -1)))
; one-dimensional
(are [x] (= (alength (make-array Integer x)) x)
0 1 5 )
(let [a (make-array Long 5)]
(aset a 3 42)
(are [x y] (= x y)
(aget a 3) 42
(class (aget a 3)) Long ))
; multi-dimensional
(let [a (make-array Long 3 2 4)]
(aset a 0 1 2 987)
(are [x y] (= x y)
(alength a) 3
(alength (first a)) 2
(alength (first (first a))) 4
(aget a 0 1 2) 987
(class (aget a 0 1 2)) Long )))
(deftest test-to-array
(let [v [1 "abc" :kw \c []]
a (to-array v)]
(are [x y] (= x y)
; length
(alength a) (count v)
; content
(vec a) v
(class (aget a 0)) (class (nth v 0))
(class (aget a 1)) (class (nth v 1))
(class (aget a 2)) (class (nth v 2))
(class (aget a 3)) (class (nth v 3))
(class (aget a 4)) (class (nth v 4)) ))
; different kinds of collections
(are [x] (and (= (alength (to-array x)) (count x))
(= (vec (to-array x)) (vec x)))
()
'(1 2)
[]
[1 2]
(sorted-set)
(sorted-set 1 2)
(int-array 0)
(int-array [1 2 3])
(to-array [])
(to-array [1 2 3]) ))
(defn queue [& contents]
(apply conj (clojure.lang.PersistentQueue/EMPTY) contents))
(defn array-typed-equals [expected actual]
(and (= (class expected) (class actual))
(java.util.Arrays/equals expected actual)))
(defmacro test-to-passed-array-for [collection-type]
`(deftest ~(symbol (str "test-to-passed-array-for-" collection-type))
(let [string-array# (make-array String 5)
shorter# (~collection-type "1" "2" "3")
same-length# (~collection-type "1" "2" "3" "4" "5")
longer# (~collection-type "1" "2" "3" "4" "5" "6")]
(are [expected actual] (array-typed-equals expected actual)
(into-array String ["1" "2" "3" nil nil]) (.toArray shorter# string-array#)
(into-array String ["1" "2" "3" "4" "5"]) (.toArray same-length# string-array#)
(into-array String ["1" "2" "3" "4" "5" "6"]) (.toArray longer# string-array#)))))
(test-to-passed-array-for vector)
(test-to-passed-array-for list)
;;(test-to-passed-array-for hash-set)
(test-to-passed-array-for queue)
(deftest test-into-array
; compatible types only
(is (thrown? IllegalArgumentException (into-array [1 "abc" :kw])))
(is (thrown? IllegalArgumentException (into-array [1.2 4])))
(is (thrown? IllegalArgumentException (into-array [(byte 2) (short 3)])))
(is (thrown? IllegalArgumentException (into-array Byte/TYPE [100000000000000])))
; simple case
(let [v [1 2 3 4 5]
a (into-array v)]
(are [x y] (= x y)
(alength a) (count v)
(vec a) v
(class (first a)) (class (first v)) ))
(is (= \a (aget (into-array Character/TYPE [\a \b \c]) 0)))
(let [types [Integer/TYPE
Byte/TYPE
Float/TYPE
Short/TYPE
Double/TYPE
Long/TYPE]
values [(byte 2) (short 3) (int 4) 5]]
(for [t types]
(let [a (into-array t values)]
(is (== (aget a 0) 2))
(is (== (aget a 1) 3))
(is (== (aget a 2) 4))
(is (== (aget a 3) 5)))))
; different kinds of collections
(are [x] (and (= (alength (into-array x)) (count x))
(= (vec (into-array x)) (vec x))
(= (alength (into-array Long/TYPE x)) (count x))
(= (vec (into-array Long/TYPE x)) (vec x)))
()
'(1 2)
[]
[1 2]
(sorted-set)
(sorted-set 1 2)
(int-array 0)
(int-array [1 2 3])
(to-array [])
(to-array [1 2 3]) ))
(deftest test-to-array-2d
; needs to be a collection of collection(s)
(is (thrown? Exception (to-array-2d [1 2 3])))
; ragged array
(let [v [[1] [2 3] [4 5 6]]
a (to-array-2d v)]
(are [x y] (= x y)
(alength a) (count v)
(alength (aget a 0)) (count (nth v 0))
(alength (aget a 1)) (count (nth v 1))
(alength (aget a 2)) (count (nth v 2))
(vec (aget a 0)) (nth v 0)
(vec (aget a 1)) (nth v 1)
(vec (aget a 2)) (nth v 2) ))
; empty array
(let [a (to-array-2d [])]
(are [x y] (= x y)
(alength a) 0
(vec a) [] )))
(deftest test-alength
(are [x] (= (alength x) 0)
(int-array 0)
(long-array 0)
(float-array 0)
(double-array 0)
(boolean-array 0)
(byte-array 0)
(char-array 0)
(short-array 0)
(make-array Integer/TYPE 0)
(to-array [])
(into-array [])
(to-array-2d []) )
(are [x] (= (alength x) 1)
(int-array 1)
(long-array 1)
(float-array 1)
(double-array 1)
(boolean-array 1)
(byte-array 1)
(char-array 1)
(short-array 1)
(make-array Integer/TYPE 1)
(to-array [1])
(into-array [1])
(to-array-2d [[1]]) )
(are [x] (= (alength x) 3)
(int-array 3)
(long-array 3)
(float-array 3)
(double-array 3)
(boolean-array 3)
(byte-array 3)
(char-array 3)
(short-array 3)
(make-array Integer/TYPE 3)
(to-array [1 "a" :k])
(into-array [1 2 3])
(to-array-2d [[1] [2 3] [4 5 6]]) ))
(deftest test-aclone
; clone all arrays except 2D
(are [x] (and (= (alength (aclone x)) (alength x))
(= (vec (aclone x)) (vec x)))
(int-array 0)
(long-array 0)
(float-array 0)
(double-array 0)
(boolean-array 0)
(byte-array 0)
(char-array 0)
(short-array 0)
(make-array Integer/TYPE 0)
(to-array [])
(into-array [])
(int-array [1 2 3])
(long-array [1 2 3])
(float-array [1 2 3])
(double-array [1 2 3])
(boolean-array [true false])
(byte-array [(byte 1) (byte 2)])
(byte-array [1 2])
(byte-array 2 [1 2])
(char-array [\a \b \c])
(short-array [(short 1) (short 2)])
(short-array [1 2])
(short-array 2 [1 2])
(make-array Integer/TYPE 3)
(to-array [1 "a" :k])
(into-array [1 2 3]) )
; clone 2D
(are [x] (and (= (alength (aclone x)) (alength x))
(= (map alength (aclone x)) (map alength x))
(= (map vec (aclone x)) (map vec x)))
(to-array-2d [])
(to-array-2d [[1] [2 3] [4 5 6]]) ))
; Type Hints, *warn-on-reflection*
; #^ints, #^floats, #^longs, #^doubles
; Coercions: [int, long, float, double, char, boolean, short, byte]
; num
; ints/longs/floats/doubles
(deftest test-boolean
(are [x y] (and (instance? java.lang.Boolean (boolean x))
(= (boolean x) y))
nil false
false false
true true
0 true
1 true
() true
[1] true
"" true
\space true
:kw true ))
(deftest test-char
; int -> char
(is (instance? java.lang.Character (char 65)))
; char -> char
(is (instance? java.lang.Character (char \a)))
(is (= (char \a) \a)))
;; Note: More coercions in numbers.clj
clojure1.6_1.6.0+dfsg.orig/test/clojure/test_clojure/keywords.clj 0000664 0000000 0000000 00000001746 12346720654 0025054 0 ustar 00root root 0000000 0000000 ; 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.
(ns clojure.test-clojure.keywords
(:use clojure.test))
(let [this-ns (str (.name *ns*))]
(deftest test-find-keyword
:foo
::foo
(let [absent-keyword-sym (gensym "absent-keyword-sym")]
(are [result lookup] (= result (find-keyword lookup))
:foo :foo
:foo 'foo
:foo "foo"
nil absent-keyword-sym
nil (str absent-keyword-sym))
(are [result lookup] (= result (find-keyword this-ns lookup))
::foo "foo"
nil (str absent-keyword-sym)))))
clojure1.6_1.6.0+dfsg.orig/test/clojure/test_clojure/logic.clj 0000664 0000000 0000000 00000007263 12346720654 0024302 0 ustar 00root root 0000000 0000000 ; 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.
; Author: Frantisek Sodomka
;;
;; Created 1/29/2009
(ns clojure.test-clojure.logic
(:use clojure.test
[clojure.test-helper :only (exception)]))
;; *** Tests ***
(deftest test-if
; true/false/nil
(are [x y] (= x y)
(if true :t) :t
(if true :t :f) :t
(if true :t (exception)) :t
(if false :t) nil
(if false :t :f) :f
(if false (exception) :f) :f
(if nil :t) nil
(if nil :t :f) :f
(if nil (exception) :f) :f )
; zero/empty is true
(are [x] (= (if x :t :f) :t)
(byte 0)
(short 0)
(int 0)
(long 0)
(bigint 0)
(float 0)
(double 0)
(bigdec 0)
0/2
""
#""
(symbol "")
()
[]
{}
#{}
(into-array []) )
; anything except nil/false is true
(are [x] (= (if x :t :f) :t)
(byte 2)
(short 2)
(int 2)
(long 2)
(bigint 2)
(float 2)
(double 2)
(bigdec 2)
2/3
\a
"abc"
#"a*b"
'abc
:kw
'(1 2)
[1 2]
{:a 1 :b 2}
#{1 2}
(into-array [1 2])
(new java.util.Date) ))
(deftest test-nil-punning
(are [x y] (= (if x :no :yes) y)
(first []) :yes
(next [1]) :yes
(rest [1]) :no
(butlast [1]) :yes
(seq nil) :yes
(seq []) :yes
(sequence nil) :no
(sequence []) :no
(lazy-seq nil) :no
(lazy-seq []) :no
(filter #(> % 10) [1 2 3]) :no
(map identity []) :no
(apply concat []) :no
(concat) :no
(concat []) :no
(reverse nil) :no
(reverse []) :no
(sort nil) :no
(sort []) :no ))
(deftest test-and
(are [x y] (= x y)
(and) true
(and true) true
(and nil) nil
(and false) false
(and true nil) nil
(and true false) false
(and 1 true :kw 'abc "abc") "abc"
(and 1 true :kw nil 'abc "abc") nil
(and 1 true :kw nil (exception) 'abc "abc") nil
(and 1 true :kw 'abc "abc" false) false
(and 1 true :kw 'abc "abc" false (exception)) false ))
(deftest test-or
(are [x y] (= x y)
(or) nil
(or true) true
(or nil) nil
(or false) false
(or nil false true) true
(or nil false 1 2) 1
(or nil false "abc" :kw) "abc"
(or false nil) nil
(or nil false) false
(or nil nil nil false) false
(or nil true false) true
(or nil true (exception) false) true
(or nil false "abc" (exception)) "abc" ))
(deftest test-not
; (is (thrown? IllegalArgumentException (not)))
(are [x] (= (not x) true)
nil
false )
(are [x] (= (not x) false)
true
; numbers
0
0.0
42
1.2
0/2
2/3
; characters
\space
\tab
\a
; strings
""
"abc"
; regexes
#""
#"a*b"
; symbols
(symbol "")
'abc
; keywords
:kw
; collections/arrays
()
'(1 2)
[]
[1 2]
{}
{:a 1 :b 2}
#{}
#{1 2}
(into-array [])
(into-array [1 2])
; Java objects
(new java.util.Date) ))
(deftest test-some?
(are [expected x] (= expected (some? x))
false nil
true false
true 0
true "abc"
true []))
clojure1.6_1.6.0+dfsg.orig/test/clojure/test_clojure/macros.clj 0000664 0000000 0000000 00000004435 12346720654 0024467 0 ustar 00root root 0000000 0000000 ; 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.
; Author: Frantisek Sodomka
(ns clojure.test-clojure.macros
(:use clojure.test))
; http://clojure.org/macros
; ->
; defmacro definline macroexpand-1 macroexpand
;; -> and ->> should not be dependent on the meaning of their arguments
(defmacro c
[arg]
(if (= 'b (first arg))
:foo
:bar))
(deftest ->test
(let [a 2, b identity]
(is (= (-> a b c)
(c (b a))))))
(deftest ->>test
(let [a 2, b identity]
(is (= (->> a b c)
(c (b a))))))
(deftest ->metadata-test
(testing "a trivial form"
(is (= {:hardy :har :har :-D}
(meta (macroexpand-1 (list `-> (with-meta
'quoted-symbol
{:hardy :har :har :-D})))))))
(testing "a nontrivial form"
(let [a (with-meta 'a {:foo :bar})
b (with-meta '(b c d) {:bar :baz})
e (with-meta 'e {:baz :quux})
expanded (macroexpand-1 (list `-> a b e))]
(is (= expanded '(e (b a c d))))
(is (= {:baz :quux} (meta (first expanded))))
(is (= {:bar :baz} (meta (second expanded))))
(is (= {:foo :bar} (meta (second (second expanded))))))))
(deftest ->>metadata-test
(testing "a trivial form"
(is (= {:hardy :har :har :-D}
(meta (macroexpand-1 (list `->> (with-meta
'quoted-symbol
{:hardy :har :har :-D})))))))
(testing "a non-trivial form"
(let [a (with-meta 'a {:foo :bar})
b (with-meta '(b c d) {:bar :baz})
e (with-meta 'e {:baz :quux})
expanded (macroexpand-1 (list `->> a b e))]
(is (= expanded '(e (b c d a))))
(is (= {:baz :quux} (meta (first expanded))))
(is (= {:bar :baz} (meta (second expanded))))
(is (= {:foo :bar} (meta (last (second expanded))))))))
clojure1.6_1.6.0+dfsg.orig/test/clojure/test_clojure/main.clj 0000664 0000000 0000000 00000003544 12346720654 0024127 0 ustar 00root root 0000000 0000000 ; 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.
; Author: Stuart Halloway
(ns clojure.test-clojure.main
(:use clojure.test
[clojure.test-helper :only [platform-newlines]])
(:require [clojure.main :as main]))
(deftest eval-opt
(testing "evals and prints forms"
(is (= (platform-newlines "2\n4\n") (with-out-str (#'clojure.main/eval-opt "(+ 1 1) (+ 2 2)")))))
(testing "skips printing nils"
(is (= (platform-newlines ":a\n:c\n") (with-out-str (#'clojure.main/eval-opt ":a nil :c")))))
(testing "does not block access to *in* (#299)"
(with-in-str "(+ 1 1)"
(is (= (platform-newlines "(+ 1 1)\n") (with-out-str (#'clojure.main/eval-opt "(read)")))))))
(defmacro with-err-str
"Evaluates exprs in a context in which *err* is bound to a fresh
StringWriter. Returns the string created by any nested printing
calls."
[& body]
`(let [s# (new java.io.StringWriter)
p# (new java.io.PrintWriter s#)]
(binding [*err* p#]
~@body
(str s#))))
(defn run-repl-and-return-err
"Run repl, swallowing stdout and returing stderr."
[in-str]
(with-err-str
(with-out-str
(with-in-str in-str
(main/repl)))))
;argh - test fragility, please fix
#_(deftest repl-exception-safety
(testing "catches and prints exception on bad equals"
(is (re-matches #"java\.lang\.NullPointerException\r?\n"
(run-repl-and-return-err
"(proxy [Object] [] (equals [o] (.toString nil)))")))))
clojure1.6_1.6.0+dfsg.orig/test/clojure/test_clojure/metadata.clj 0000664 0000000 0000000 00000020554 12346720654 0024763 0 ustar 00root root 0000000 0000000 ; 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.
; Authors: Stuart Halloway, Frantisek Sodomka
(ns clojure.test-clojure.metadata
(:use clojure.test
[clojure.test-helper :only (eval-in-temp-ns)])
(:require [clojure.set :as set]))
(def public-namespaces
'[clojure.core
clojure.pprint
clojure.inspector
clojure.set
clojure.stacktrace
clojure.test
clojure.walk
clojure.xml
clojure.zip
clojure.java.io
clojure.java.browse
clojure.java.javadoc
clojure.java.shell
clojure.string
clojure.data])
(doseq [ns public-namespaces]
(require ns))
(def public-vars
(mapcat #(vals (ns-publics %)) public-namespaces))
(def public-vars-with-docstrings
(filter (comp :doc meta) public-vars))
(def public-vars-with-docstrings-not-generated
(remove #(re-find #"^->[A-Z]" (name (.sym %))) public-vars-with-docstrings))
(deftest public-vars-with-docstrings-have-added
(is (= [] (remove (comp :added meta) public-vars-with-docstrings-not-generated))))
(deftest interaction-of-def-with-metadata
(testing "initial def sets metadata"
(let [v (eval-in-temp-ns
(def ^{:a 1} foo 0)
#'foo)]
(is (= 1 (-> v meta :a)))))
#_(testing "subsequent declare doesn't overwrite metadata"
(let [v (eval-in-temp-ns
(def ^{:b 2} bar 0)
(declare bar)
#'bar)]
(is (= 2 (-> v meta :b))))
(testing "when compiled"
(let [v (eval-in-temp-ns
(def ^{:c 3} bar 0)
(defn declare-bar []
(declare bar))
(declare-bar)
#'bar)]
(is (= 3 (-> v meta :c))))))
(testing "subsequent def with init-expr *does* overwrite metadata"
(let [v (eval-in-temp-ns
(def ^{:d 4} quux 0)
(def quux 1)
#'quux)]
(is (nil? (-> v meta :d))))
(testing "when compiled"
(let [v (eval-in-temp-ns
(def ^{:e 5} quux 0)
(defn def-quux []
(def quux 1))
(def-quux)
#'quux)]
(is (nil? (-> v meta :e))))))
(testing "IllegalArgumentException should not be thrown"
(testing "when defining var whose value is calculated with a primitive fn."
(testing "This case fails without a fix for CLJ-852"
(is (eval-in-temp-ns
(defn foo ^long [^long x] x)
(def x (inc (foo 10))))))
(testing "This case should pass even without a fix for CLJ-852"
(is (eval-in-temp-ns
(defn foo ^long [^long x] x)
(def x (foo (inc 10)))))))))
(deftest fns-preserve-metadata-on-maps
(let [xm {:a 1 :b -7}
x (with-meta {:foo 1 :bar 2} xm)
ym {:c "foo"}
y (with-meta {:baz 4 :guh x} ym)]
(is (= xm (meta (:guh y))))
(is (= xm (meta (reduce #(assoc %1 %2 (inc %2)) x (range 1000)))))
(is (= xm (meta (-> x (dissoc :foo) (dissoc :bar)))))
(let [z (assoc-in y [:guh :la] 18)]
(is (= ym (meta z)))
(is (= xm (meta (:guh z)))))
(let [z (update-in y [:guh :bar] inc)]
(is (= ym (meta z)))
(is (= xm (meta (:guh z)))))
(is (= xm (meta (get-in y [:guh]))))
(is (= xm (meta (into x y))))
(is (= ym (meta (into y x))))
(is (= xm (meta (merge x y))))
(is (= ym (meta (merge y x))))
(is (= xm (meta (merge-with + x y))))
(is (= ym (meta (merge-with + y x))))
(is (= xm (meta (select-keys x [:bar]))))
(is (= xm (meta (set/rename-keys x {:foo :new-foo}))))
;; replace returns a seq when given a set. Can seqs have
;; metadata?
;; TBD: rseq, subseq, and rsubseq returns seqs. If it is even
;; possible to put metadata on a seq, does it make sense that the
;; seqs returned by these functions should have the same metadata
;; as the sorted collection on which they are called?
))
(deftest fns-preserve-metadata-on-vectors
(let [xm {:a 1 :b -7}
x (with-meta [1 2 3] xm)
ym {:c "foo"}
y (with-meta [4 x 6] ym)]
(is (= xm (meta (y 1))))
(is (= xm (meta (assoc x 1 "one"))))
(is (= xm (meta (reduce #(conj %1 %2) x (range 1000)))))
(is (= xm (meta (pop (pop (pop x))))))
(let [z (assoc-in y [1 2] 18)]
(is (= ym (meta z)))
(is (= xm (meta (z 1)))))
(let [z (update-in y [1 2] inc)]
(is (= ym (meta z)))
(is (= xm (meta (z 1)))))
(is (= xm (meta (get-in y [1]))))
(is (= xm (meta (into x y))))
(is (= ym (meta (into y x))))
(is (= xm (meta (replace {2 "two"} x))))
(is (= [1 "two" 3] (replace {2 "two"} x)))
;; TBD: Currently subvec drops metadata. Should it preserve it?
;;(is (= xm (meta (subvec x 2 3))))
;; TBD: rseq returns a seq. If it is even possible to put
;; metadata on a seq, does it make sense that the seqs returned by
;; these functions should have the same metadata as the sorted
;; collection on which they are called?
))
(deftest fns-preserve-metadata-on-sets
;; TBD: Do tests independently for set, hash-set, and sorted-set,
;; perhaps with a loop here.
(let [xm {:a 1 :b -7}
x (with-meta #{1 2 3} xm)
ym {:c "foo"}
y (with-meta #{4 x 6} ym)]
(is (= xm (meta (y #{3 2 1}))))
(is (= xm (meta (reduce #(conj %1 %2) x (range 1000)))))
(is (= xm (meta (-> x (disj 1) (disj 2) (disj 3)))))
(is (= xm (meta (into x y))))
(is (= ym (meta (into y x))))
(is (= xm (meta (set/select even? x))))
(let [cow1m {:what "betsy cow"}
cow1 (with-meta {:name "betsy" :id 33} cow1m)
cow2m {:what "panda cow"}
cow2 (with-meta {:name "panda" :id 34} cow2m)
cowsm {:what "all the cows"}
cows (with-meta #{cow1 cow2} cowsm)
cow-names (set/project cows [:name])
renamed (set/rename cows {:id :number})]
(is (= cowsm (meta cow-names)))
(is (= cow1m (meta (first (filter #(= "betsy" (:name %)) cow-names)))))
(is (= cow2m (meta (first (filter #(= "panda" (:name %)) cow-names)))))
(is (= cowsm (meta renamed)))
(is (= cow1m (meta (first (filter #(= "betsy" (:name %)) renamed)))))
(is (= cow2m (meta (first (filter #(= "panda" (:name %)) renamed))))))
;; replace returns a seq when given a set. Can seqs have
;; metadata?
;; union: Currently returns the metadata of the largest input set.
;; This is an artifact of union's current implementation. I doubt
;; any explicit design decision was made to do so. Like join,
;; there doesn't seem to be much reason to prefer the metadata of
;; one input set over another, if at least two input sets are
;; given, but perhaps defining it to always return a set with the
;; metadata of the first input set would be reasonable?
;; intersection: Returns metadata of the smallest input set.
;; Otherwise similar to union.
;; difference: Seems to always return a set with metadata of first
;; input set. Seems reasonable. Not sure we want to add a test
;; for it, if it is an accident of the current implementation.
;; join, index, map-invert: Currently always returns a value with
;; no metadata. This seems reasonable.
))
(deftest defn-primitive-args
(testing "Hinting the arg vector of a primitive-taking fn with a non-primitive type should not result in AbstractMethodError when invoked."
(testing "CLJ-850 is fixed when this case passes."
(is (= "foo"
(eval-in-temp-ns
(defn f ^String [^String s ^long i] s)
(f "foo" 1)))))
(testing "These cases should pass, even without a fix for CLJ-850."
(is (= "foo"
(eval-in-temp-ns
(defn f ^String [^String s] s)
(f "foo"))))
(is (= 1
(eval-in-temp-ns
(defn f ^long [^String s ^long i] i)
(f "foo" 1))))
(is (= 1
(eval-in-temp-ns
(defn f ^long [^long i] i)
(f 1)))))))
clojure1.6_1.6.0+dfsg.orig/test/clojure/test_clojure/multimethods.clj 0000664 0000000 0000000 00000021207 12346720654 0025715 0 ustar 00root root 0000000 0000000 ; 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.
; Author: Frantisek Sodomka, Robert Lachlan
(ns clojure.test-clojure.multimethods
(:use clojure.test [clojure.test-helper :only (with-var-roots)])
(:require [clojure.set :as set]))
; http://clojure.org/multimethods
; defmulti
; defmethod
; remove-method
; prefer-method
; methods
; prefers
(defmacro for-all
[& args]
`(dorun (for ~@args)))
(defn hierarchy-tags
"Return all tags in a derivation hierarchy"
[h]
(set/select
#(instance? clojure.lang.Named %)
(reduce into #{} (map keys (vals h)))))
(defn transitive-closure
"Return all objects reachable by calling f starting with o,
not including o itself. f should return a collection."
[o f]
(loop [results #{}
more #{o}]
(let [new-objects (set/difference more results)]
(if (seq new-objects)
(recur (set/union results more) (reduce into #{} (map f new-objects)))
(disj results o)))))
(defn tag-descendants
"Set of descedants which are tags (i.e. Named)."
[& args]
(set/select
#(instance? clojure.lang.Named %)
(or (apply descendants args) #{})))
(defn assert-valid-hierarchy
[h]
(let [tags (hierarchy-tags h)]
(testing "ancestors are the transitive closure of parents"
(for-all [tag tags]
(is (= (transitive-closure tag #(parents h %))
(or (ancestors h tag) #{})))))
(testing "ancestors are transitive"
(for-all [tag tags]
(is (= (transitive-closure tag #(ancestors h %))
(or (ancestors h tag) #{})))))
(testing "tag descendants are transitive"
(for-all [tag tags]
(is (= (transitive-closure tag #(tag-descendants h %))
(or (tag-descendants h tag) #{})))))
(testing "a tag isa? all of its parents"
(for-all [tag tags
:let [parents (parents h tag)]
parent parents]
(is (isa? h tag parent))))
(testing "a tag isa? all of its ancestors"
(for-all [tag tags
:let [ancestors (ancestors h tag)]
ancestor ancestors]
(is (isa? h tag ancestor))))
(testing "all my descendants have me as an ancestor"
(for-all [tag tags
:let [descendants (descendants h tag)]
descendant descendants]
(is (isa? h descendant tag))))
(testing "there are no cycles in parents"
(for-all [tag tags]
(is (not (contains? (transitive-closure tag #(parents h %)) tag)))))
(testing "there are no cycles in descendants"
(for-all [tag tags]
(is (not (contains? (descendants h tag) tag)))))))
(def family
(reduce #(apply derive (cons %1 %2)) (make-hierarchy)
[[::parent-1 ::ancestor-1]
[::parent-1 ::ancestor-2]
[::parent-2 ::ancestor-2]
[::child ::parent-2]
[::child ::parent-1]]))
(deftest cycles-are-forbidden
(testing "a tag cannot be its own parent"
(is (thrown-with-msg? Throwable #"\(not= tag parent\)"
(derive family ::child ::child))))
(testing "a tag cannot be its own ancestor"
(is (thrown-with-msg? Throwable #"Cyclic derivation: :clojure.test-clojure.multimethods/child has :clojure.test-clojure.multimethods/ancestor-1 as ancestor"
(derive family ::ancestor-1 ::child)))))
(deftest using-diamond-inheritance
(let [diamond (reduce #(apply derive (cons %1 %2)) (make-hierarchy)
[[::mammal ::animal]
[::bird ::animal]
[::griffin ::mammal]
[::griffin ::bird]])
bird-no-more (underive diamond ::griffin ::bird)]
(assert-valid-hierarchy diamond)
(assert-valid-hierarchy bird-no-more)
(testing "a griffin is a mammal, indirectly through mammal and bird"
(is (isa? diamond ::griffin ::animal)))
(testing "a griffin is a bird"
(is (isa? diamond ::griffin ::bird)))
(testing "after underive, griffin is no longer a bird"
(is (not (isa? bird-no-more ::griffin ::bird))))
(testing "but it is still an animal, via mammal"
(is (isa? bird-no-more ::griffin ::animal)))))
(deftest derivation-world-bridges-to-java-inheritance
(let [h (derive (make-hierarchy) java.util.Map ::map)]
(testing "a Java class can be isa? a tag"
(is (isa? h java.util.Map ::map)))
(testing "if a Java class isa? a tag, so are its subclasses..."
(is (isa? h java.util.HashMap ::map)))
(testing "...but not its superclasses!"
(is (not (isa? h java.util.Collection ::map))))))
(deftest global-hierarchy-test
(with-var-roots {#'clojure.core/global-hierarchy (make-hierarchy)}
(assert-valid-hierarchy @#'clojure.core/global-hierarchy)
(testing "when you add some derivations..."
(derive ::lion ::cat)
(derive ::manx ::cat)
(assert-valid-hierarchy @#'clojure.core/global-hierarchy))
(testing "...isa? sees the derivations"
(is (isa? ::lion ::cat))
(is (not (isa? ::cat ::lion))))
(testing "... you can traverse the derivations"
(is (= #{::manx ::lion} (descendants ::cat)))
(is (= #{::cat} (parents ::manx)))
(is (= #{::cat} (ancestors ::manx))))
(testing "then, remove a derivation..."
(underive ::manx ::cat))
(testing "... traversals update accordingly"
(is (= #{::lion} (descendants ::cat)))
(is (nil? (parents ::manx)))
(is (nil? (ancestors ::manx))))))
#_(defmacro for-all
"Better than the actual for-all, if only it worked."
[& args]
`(reduce
#(and %1 %2)
(map true? (for ~@args))))
(deftest basic-multimethod-test
(testing "Check basic dispatch"
(defmulti too-simple identity)
(defmethod too-simple :a [x] :a)
(defmethod too-simple :b [x] :b)
(defmethod too-simple :default [x] :default)
(is (= :a (too-simple :a)))
(is (= :b (too-simple :b)))
(is (= :default (too-simple :c))))
(testing "Remove a method works"
(remove-method too-simple :a)
(is (= :default (too-simple :a))))
(testing "Add another method works"
(defmethod too-simple :d [x] :d)
(is (= :d (too-simple :d)))))
(deftest isA-multimethod-test
(testing "Dispatch on isA"
;; Example from the multimethod docs.
(derive java.util.Map ::collection)
(derive java.util.Collection ::collection)
(defmulti foo class)
(defmethod foo ::collection [c] :a-collection)
(defmethod foo String [s] :a-string)
(is (= :a-collection (foo [])))
(is (= :a-collection (foo (java.util.HashMap.))))
(is (= :a-string (foo "bar")))))
(deftest preferences-multimethod-test
(testing "Multiple method match dispatch error is caught"
;; Example from the multimethod docs.
(derive ::rect ::shape)
(defmulti bar (fn [x y] [x y]))
(defmethod bar [::rect ::shape] [x y] :rect-shape)
(defmethod bar [::shape ::rect] [x y] :shape-rect)
(is (thrown? java.lang.IllegalArgumentException
(bar ::rect ::rect))))
(testing "The prefers method returns empty table w/ no prefs"
(= {} (prefers bar)))
(testing "Adding a preference to resolve it dispatches correctly"
(prefer-method bar [::rect ::shape] [::shape ::rect])
(is (= :rect-shape (bar ::rect ::rect))))
(testing "The prefers method now returns the correct table"
(is (= {[::rect ::shape] #{[::shape ::rect]}} (prefers bar)))))
(deftest remove-all-methods-test
(testing "Core function remove-all-methods works"
(defmulti simple1 identity)
(defmethod simple1 :a [x] :a)
(defmethod simple1 :b [x] :b)
(is (= {} (methods (remove-all-methods simple1))))))
(deftest methods-test
(testing "Core function methods works"
(defmulti simple2 identity)
(defmethod simple2 :a [x] :a)
(defmethod simple2 :b [x] :b)
(is (= #{:a :b} (into #{} (keys (methods simple2)))))
(is (= :a ((:a (methods simple2)) 1)))
(defmethod simple2 :c [x] :c)
(is (= #{:a :b :c} (into #{} (keys (methods simple2)))))
(remove-method simple2 :a)
(is (= #{:b :c} (into #{} (keys (methods simple2)))))))
(deftest get-method-test
(testing "Core function get-method works"
(defmulti simple3 identity)
(defmethod simple3 :a [x] :a)
(defmethod simple3 :b [x] :b)
(is (fn? (get-method simple3 :a)))
(is (= (:a ((get-method simple3 :a) 1))))
(is (fn? (get-method simple3 :b)))
(is (= (:b ((get-method simple3 :b) 1))))
(is (nil? (get-method simple3 :c)))))
clojure1.6_1.6.0+dfsg.orig/test/clojure/test_clojure/ns_libs.clj 0000664 0000000 0000000 00000007504 12346720654 0024634 0 ustar 00root root 0000000 0000000 ; 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.
; Authors: Frantisek Sodomka, Stuart Halloway
(ns clojure.test-clojure.ns-libs
(:use clojure.test))
; http://clojure.org/namespaces
; in-ns ns create-ns
; alias import intern refer
; all-ns find-ns
; ns-name ns-aliases ns-imports ns-interns ns-map ns-publics ns-refers
; resolve ns-resolve namespace
; ns-unalias ns-unmap remove-ns
; http://clojure.org/libs
; require use
; loaded-libs
(deftest test-alias
(is (thrown-with-msg? Exception #"No namespace: epicfail found" (alias 'bogus 'epicfail))))
(deftest test-require
(is (thrown? Exception (require :foo)))
(is (thrown? Exception (require))))
(deftest test-use
(is (thrown? Exception (use :foo)))
(is (thrown? Exception (use))))
(deftest reimporting-deftypes
(let [inst1 (binding [*ns* *ns*]
(eval '(do (ns exporter)
(defrecord ReimportMe [a])
(ns importer)
(import exporter.ReimportMe)
(ReimportMe. 1))))
inst2 (binding [*ns* *ns*]
(eval '(do (ns exporter)
(defrecord ReimportMe [a b])
(ns importer)
(import exporter.ReimportMe)
(ReimportMe. 1 2))))]
(testing "you can reimport a changed class and see the changes"
(is (= [:a] (keys inst1)))
(is (= [:a :b] (keys inst2))))
;fragile tests, please fix
#_(testing "you cannot import same local name from a different namespace"
(is (thrown? clojure.lang.Compiler$CompilerException
#"ReimportMe already refers to: class exporter.ReimportMe in namespace: importer"
(binding [*ns* *ns*]
(eval '(do (ns exporter-2)
(defrecord ReimportMe [a b])
(ns importer)
(import exporter-2.ReimportMe)
(ReimportMe. 1 2)))))))))
(deftest naming-types
(testing "you cannot use a name already referred from another namespace"
(is (thrown? IllegalStateException
#"String already refers to: class java.lang.String"
(definterface String)))
(is (thrown? IllegalStateException
#"StringBuffer already refers to: class java.lang.StringBuffer"
(deftype StringBuffer [])))
(is (thrown? IllegalStateException
#"Integer already refers to: class java.lang.Integer"
(defrecord Integer [])))))
(deftest resolution
(let [s (gensym)]
(are [result expr] (= result expr)
#'clojure.core/first (ns-resolve 'clojure.core 'first)
nil (ns-resolve 'clojure.core s)
nil (ns-resolve 'clojure.core {'first :local-first} 'first)
nil (ns-resolve 'clojure.core {'first :local-first} s))))
(deftest refer-error-messages
(let [temp-ns (gensym)]
(binding [*ns* *ns*]
(in-ns temp-ns)
(eval '(def ^{:private true} hidden-var)))
(testing "referring to something that does not exist"
(is (thrown-with-msg? IllegalAccessError #"nonexistent-var does not exist"
(refer temp-ns :only '(nonexistent-var)))))
(testing "referring to something non-public"
(is (thrown-with-msg? IllegalAccessError #"hidden-var is not public"
(refer temp-ns :only '(hidden-var)))))))
clojure1.6_1.6.0+dfsg.orig/test/clojure/test_clojure/numbers.clj 0000664 0000000 0000000 00000056752 12346720654 0024667 0 ustar 00root root 0000000 0000000 ; 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.
; Author: Stephen C. Gilardi
;; scgilardi (gmail)
;; Created 30 October 2008
;;
(ns clojure.test-clojure.numbers
(:use clojure.test
[clojure.test.generative :exclude (is)]
clojure.template)
(:require [clojure.data.generators :as gen]))
; TODO:
; ==
; and more...
;; *** Types ***
(deftest Coerced-BigDecimal
(doseq [v [(bigdec 3) (bigdec (inc (bigint Long/MAX_VALUE)))]]
(are [x] (true? x)
(instance? BigDecimal v)
(number? v)
(decimal? v)
(not (float? v)))))
(deftest BigInteger-conversions
(doseq [coerce-fn [bigint biginteger]]
(doseq [v (map coerce-fn [ Long/MAX_VALUE
13178456923875639284562345789M
13178456923875639284562345789N
Float/MAX_VALUE
(- Float/MAX_VALUE)
Double/MAX_VALUE
(- Double/MAX_VALUE)
(* 2 (bigdec Double/MAX_VALUE)) ])]
(are [x] (true? x)
(integer? v)
(number? v)
(not (decimal? v))
(not (float? v))))))
(defn all-pairs-equal [equal-var vals]
(doseq [val1 vals]
(doseq [val2 vals]
(is (equal-var val1 val2)
(str "Test that " val1 " (" (class val1) ") "
equal-var " " val2 " (" (class val2) ")")))))
(defn all-pairs-hash-consistent-with-= [vals]
(doseq [val1 vals]
(doseq [val2 vals]
(when (= val1 val2)
(is (= (hash val1) (hash val2))
(str "Test that (hash " val1 ") (" (class val1) ") "
" = (hash " val2 ") (" (class val2) ")"))))))
(deftest equality-tests
;; = only returns true for numbers that are in the same category,
;; where category is one of INTEGER, FLOATING, DECIMAL, RATIO.
(all-pairs-equal #'= [(byte 2) (short 2) (int 2) (long 2)
(bigint 2) (biginteger 2)])
(all-pairs-equal #'= [(float 2.0) (double 2.0)])
(all-pairs-equal #'= [2.0M 2.00M])
(all-pairs-equal #'= [(float 1.5) (double 1.5)])
(all-pairs-equal #'= [1.50M 1.500M])
(all-pairs-equal #'= [0.0M 0.00M])
(all-pairs-equal #'= [(/ 1 2) (/ 2 4)])
;; No BigIntegers or floats in following tests, because hash
;; consistency with = for them is out of scope for Clojure
;; (CLJ-1036).
(all-pairs-hash-consistent-with-= [(byte 2) (short 2) (int 2) (long 2)
(bigint 2)
(double 2.0) 2.0M 2.00M])
(all-pairs-hash-consistent-with-= [(/ 3 2) (double 1.5) 1.50M 1.500M])
(all-pairs-hash-consistent-with-= [(double 0.0) 0.0M 0.00M])
;; == tests for numerical equality, returning true even for numbers
;; in different categories.
(all-pairs-equal #'== [(byte 0) (short 0) (int 0) (long 0)
(bigint 0) (biginteger 0)
(float 0.0) (double 0.0) 0.0M 0.00M])
(all-pairs-equal #'== [(byte 2) (short 2) (int 2) (long 2)
(bigint 2) (biginteger 2)
(float 2.0) (double 2.0) 2.0M 2.00M])
(all-pairs-equal #'== [(/ 3 2) (float 1.5) (double 1.5) 1.50M 1.500M]))
(deftest unchecked-cast-num-obj
(do-template [prim-array cast]
(are [n]
(let [a (prim-array 1)]
(aset a 0 (cast n)))
(Byte. Byte/MAX_VALUE)
(Short. Short/MAX_VALUE)
(Integer. Integer/MAX_VALUE)
(Long. Long/MAX_VALUE)
(Float. Float/MAX_VALUE)
(Double. Double/MAX_VALUE))
byte-array
unchecked-byte
short-array
unchecked-short
char-array
unchecked-char
int-array
unchecked-int
long-array
unchecked-long
float-array
unchecked-float
double-array
unchecked-double))
(deftest unchecked-cast-num-prim
(do-template [prim-array cast]
(are [n]
(let [a (prim-array 1)]
(aset a 0 (cast n)))
Byte/MAX_VALUE
Short/MAX_VALUE
Integer/MAX_VALUE
Long/MAX_VALUE
Float/MAX_VALUE
Double/MAX_VALUE)
byte-array
unchecked-byte
short-array
unchecked-short
char-array
unchecked-char
int-array
unchecked-int
long-array
unchecked-long
float-array
unchecked-float
double-array
unchecked-double))
(deftest unchecked-cast-char
; in keeping with the checked cast functions, char and Character can only be cast to int
(is (unchecked-int (char 0xFFFF)))
(is (let [c (char 0xFFFF)] (unchecked-int c)))) ; force primitive char
(def expected-casts
[
[:input [-1 0 1 Byte/MAX_VALUE Short/MAX_VALUE Integer/MAX_VALUE Long/MAX_VALUE Float/MAX_VALUE Double/MAX_VALUE]]
[char [:error (char 0) (char 1) (char 127) (char 32767) :error :error :error :error]]
[unchecked-char [(char 65535) (char 0) (char 1) (char 127) (char 32767) (char 65535) (char 65535) (char 65535) (char 65535)]]
[byte [-1 0 1 Byte/MAX_VALUE :error :error :error :error :error]]
[unchecked-byte [-1 0 1 Byte/MAX_VALUE -1 -1 -1 -1 -1]]
[short [-1 0 1 Byte/MAX_VALUE Short/MAX_VALUE :error :error :error :error]]
[unchecked-short [-1 0 1 Byte/MAX_VALUE Short/MAX_VALUE -1 -1 -1 -1]]
[int [-1 0 1 Byte/MAX_VALUE Short/MAX_VALUE Integer/MAX_VALUE :error :error :error]]
[unchecked-int [-1 0 1 Byte/MAX_VALUE Short/MAX_VALUE Integer/MAX_VALUE -1 Integer/MAX_VALUE Integer/MAX_VALUE]]
[long [-1 0 1 Byte/MAX_VALUE Short/MAX_VALUE Integer/MAX_VALUE Long/MAX_VALUE :error :error]]
[unchecked-long [-1 0 1 Byte/MAX_VALUE Short/MAX_VALUE Integer/MAX_VALUE Long/MAX_VALUE Long/MAX_VALUE Long/MAX_VALUE]]
;; 2.14748365E9 if when float/double conversion is avoided...
[float [-1.0 0.0 1.0 127.0 32767.0 2.147483648E9 9.223372036854776E18 Float/MAX_VALUE :error]]
[unchecked-float [-1.0 0.0 1.0 127.0 32767.0 2.147483648E9 9.223372036854776E18 Float/MAX_VALUE Float/POSITIVE_INFINITY]]
[double [-1.0 0.0 1.0 127.0 32767.0 2.147483647E9 9.223372036854776E18 Float/MAX_VALUE Double/MAX_VALUE]]
[unchecked-double [-1.0 0.0 1.0 127.0 32767.0 2.147483647E9 9.223372036854776E18 Float/MAX_VALUE Double/MAX_VALUE]]])
(deftest test-expected-casts
(let [[[_ inputs] & expectations] expected-casts]
(doseq [[f vals] expectations]
(let [wrapped (fn [x]
(try
(f x)
(catch IllegalArgumentException e :error)))]
(is (= vals (map wrapped inputs)))))))
;; *** Functions ***
(defonce DELTA 1e-12)
(deftest test-add
(are [x y] (= x y)
(+) 0
(+ 1) 1
(+ 1 2) 3
(+ 1 2 3) 6
(+ -1) -1
(+ -1 -2) -3
(+ -1 +2 -3) -2
(+ 1 -1) 0
(+ -1 1) 0
(+ 2/3) 2/3
(+ 2/3 1) 5/3
(+ 2/3 1/3) 1 )
(are [x y] (< (- x y) DELTA)
(+ 1.2) 1.2
(+ 1.1 2.4) 3.5
(+ 1.1 2.2 3.3) 6.6 )
(is (> (+ Integer/MAX_VALUE 10) Integer/MAX_VALUE)) ; no overflow
(is (thrown? ClassCastException (+ "ab" "cd"))) ) ; no string concatenation
(deftest test-subtract
(is (thrown? IllegalArgumentException (-)))
(are [x y] (= x y)
(- 1) -1
(- 1 2) -1
(- 1 2 3) -4
(- -2) 2
(- 1 -2) 3
(- 1 -2 -3) 6
(- 1 1) 0
(- -1 -1) 0
(- 2/3) -2/3
(- 2/3 1) -1/3
(- 2/3 1/3) 1/3 )
(are [x y] (< (- x y) DELTA)
(- 1.2) -1.2
(- 2.2 1.1) 1.1
(- 6.6 2.2 1.1) 3.3 )
(is (< (- Integer/MIN_VALUE 10) Integer/MIN_VALUE)) ) ; no underflow
(deftest test-multiply
(are [x y] (= x y)
(*) 1
(* 2) 2
(* 2 3) 6
(* 2 3 4) 24
(* -2) -2
(* 2 -3) -6
(* 2 -3 -1) 6
(* 1/2) 1/2
(* 1/2 1/3) 1/6
(* 1/2 1/3 -1/4) -1/24 )
(are [x y] (< (- x y) DELTA)
(* 1.2) 1.2
(* 2.0 1.2) 2.4
(* 3.5 2.0 1.2) 8.4 )
(is (> (* 3 (int (/ Integer/MAX_VALUE 2.0))) Integer/MAX_VALUE)) ) ; no overflow
(deftest test-multiply-longs-at-edge
(are [x] (= x 9223372036854775808N)
(*' -1 Long/MIN_VALUE)
(*' Long/MIN_VALUE -1)
(* -1N Long/MIN_VALUE)
(* Long/MIN_VALUE -1N)
(* -1 (bigint Long/MIN_VALUE))
(* (bigint Long/MIN_VALUE) -1))
(is (thrown? ArithmeticException (* Long/MIN_VALUE -1)))
(is (thrown? ArithmeticException (* -1 Long/MIN_VALUE))))
(deftest test-ratios-simplify-to-ints-where-appropriate
(testing "negative denominator (assembla #275)"
(is (integer? (/ 1 -1/2)))
(is (integer? (/ 0 -1/2)))))
(deftest test-divide
(are [x y] (= x y)
(/ 1) 1
(/ 2) 1/2
(/ 3 2) 3/2
(/ 4 2) 2
(/ 24 3 2) 4
(/ 24 3 2 -1) -4
(/ -1) -1
(/ -2) -1/2
(/ -3 -2) 3/2
(/ -4 -2) 2
(/ -4 2) -2 )
(are [x y] (< (- x y) DELTA)
(/ 4.5 3) 1.5
(/ 4.5 3.0 3.0) 0.5 )
(is (thrown? ArithmeticException (/ 0)))
(is (thrown? ArithmeticException (/ 2 0)))
(is (thrown? IllegalArgumentException (/))) )
;; mod
;; http://en.wikipedia.org/wiki/Modulo_operation
;; http://mathforum.org/library/drmath/view/52343.html
;;
;; is mod correct?
;; http://groups.google.com/group/clojure/browse_frm/thread/2a0ee4d248f3d131#
;;
;; Issue 23: mod (modulo) operator
;; http://code.google.com/p/clojure/issues/detail?id=23
(deftest test-mod
; wrong number of args
; (is (thrown? IllegalArgumentException (mod)))
; (is (thrown? IllegalArgumentException (mod 1)))
; (is (thrown? IllegalArgumentException (mod 3 2 1)))
; divide by zero
(is (thrown? ArithmeticException (mod 9 0)))
(is (thrown? ArithmeticException (mod 0 0)))
(are [x y] (= x y)
(mod 4 2) 0
(mod 3 2) 1
(mod 6 4) 2
(mod 0 5) 0
(mod 2 1/2) 0
(mod 2/3 1/2) 1/6
(mod 1 2/3) 1/3
(mod 4.0 2.0) 0.0
(mod 4.5 2.0) 0.5
; |num| > |div|, num != k * div
(mod 42 5) 2 ; (42 / 5) * 5 + (42 mod 5) = 8 * 5 + 2 = 42
(mod 42 -5) -3 ; (42 / -5) * (-5) + (42 mod -5) = -9 * (-5) + (-3) = 42
(mod -42 5) 3 ; (-42 / 5) * 5 + (-42 mod 5) = -9 * 5 + 3 = -42
(mod -42 -5) -2 ; (-42 / -5) * (-5) + (-42 mod -5) = 8 * (-5) + (-2) = -42
; |num| > |div|, num = k * div
(mod 9 3) 0 ; (9 / 3) * 3 + (9 mod 3) = 3 * 3 + 0 = 9
(mod 9 -3) 0
(mod -9 3) 0
(mod -9 -3) 0
; |num| < |div|
(mod 2 5) 2 ; (2 / 5) * 5 + (2 mod 5) = 0 * 5 + 2 = 2
(mod 2 -5) -3 ; (2 / -5) * (-5) + (2 mod -5) = (-1) * (-5) + (-3) = 2
(mod -2 5) 3 ; (-2 / 5) * 5 + (-2 mod 5) = (-1) * 5 + 3 = -2
(mod -2 -5) -2 ; (-2 / -5) * (-5) + (-2 mod -5) = 0 * (-5) + (-2) = -2
; num = 0, div != 0
(mod 0 3) 0 ; (0 / 3) * 3 + (0 mod 3) = 0 * 3 + 0 = 0
(mod 0 -3) 0
; large args
(mod 3216478362187432 432143214) 120355456
)
)
;; rem & quot
;; http://en.wikipedia.org/wiki/Remainder
(deftest test-rem
; wrong number of args
; (is (thrown? IllegalArgumentException (rem)))
; (is (thrown? IllegalArgumentException (rem 1)))
; (is (thrown? IllegalArgumentException (rem 3 2 1)))
; divide by zero
(is (thrown? ArithmeticException (rem 9 0)))
(is (thrown? ArithmeticException (rem 0 0)))
(are [x y] (= x y)
(rem 4 2) 0
(rem 3 2) 1
(rem 6 4) 2
(rem 0 5) 0
(rem 2 1/2) 0
(rem 2/3 1/2) 1/6
(rem 1 2/3) 1/3
(rem 4.0 2.0) 0.0
(rem 4.5 2.0) 0.5
; |num| > |div|, num != k * div
(rem 42 5) 2 ; (8 * 5) + 2 == 42
(rem 42 -5) 2 ; (-8 * -5) + 2 == 42
(rem -42 5) -2 ; (-8 * 5) + -2 == -42
(rem -42 -5) -2 ; (8 * -5) + -2 == -42
; |num| > |div|, num = k * div
(rem 9 3) 0
(rem 9 -3) 0
(rem -9 3) 0
(rem -9 -3) 0
; |num| < |div|
(rem 2 5) 2
(rem 2 -5) 2
(rem -2 5) -2
(rem -2 -5) -2
; num = 0, div != 0
(rem 0 3) 0
(rem 0 -3) 0
)
)
(deftest test-quot
; wrong number of args
; (is (thrown? IllegalArgumentException (quot)))
; (is (thrown? IllegalArgumentException (quot 1)))
; (is (thrown? IllegalArgumentException (quot 3 2 1)))
; divide by zero
(is (thrown? ArithmeticException (quot 9 0)))
(is (thrown? ArithmeticException (quot 0 0)))
(are [x y] (= x y)
(quot 4 2) 2
(quot 3 2) 1
(quot 6 4) 1
(quot 0 5) 0
(quot 2 1/2) 4
(quot 2/3 1/2) 1
(quot 1 2/3) 1
(quot 4.0 2.0) 2.0
(quot 4.5 2.0) 2.0
; |num| > |div|, num != k * div
(quot 42 5) 8 ; (8 * 5) + 2 == 42
(quot 42 -5) -8 ; (-8 * -5) + 2 == 42
(quot -42 5) -8 ; (-8 * 5) + -2 == -42
(quot -42 -5) 8 ; (8 * -5) + -2 == -42
; |num| > |div|, num = k * div
(quot 9 3) 3
(quot 9 -3) -3
(quot -9 3) -3
(quot -9 -3) 3
; |num| < |div|
(quot 2 5) 0
(quot 2 -5) 0
(quot -2 5) 0
(quot -2 -5) 0
; num = 0, div != 0
(quot 0 3) 0
(quot 0 -3) 0
)
)
;; *** Predicates ***
;; pos? zero? neg?
(deftest test-pos?-zero?-neg?
(let [nums [[(byte 2) (byte 0) (byte -2)]
[(short 3) (short 0) (short -3)]
[(int 4) (int 0) (int -4)]
[(long 5) (long 0) (long -5)]
[(bigint 6) (bigint 0) (bigint -6)]
[(float 7) (float 0) (float -7)]
[(double 8) (double 0) (double -8)]
[(bigdec 9) (bigdec 0) (bigdec -9)]
[2/3 0 -2/3]]
pred-result [[pos? [true false false]]
[zero? [false true false]]
[neg? [false false true]]] ]
(doseq [pr pred-result]
(doseq [n nums]
(is (= (map (first pr) n) (second pr))
(pr-str (first pr) n))))))
;; even? odd?
(deftest test-even?
(are [x] (true? x)
(even? -4)
(not (even? -3))
(even? 0)
(not (even? 5))
(even? 8))
(is (thrown? IllegalArgumentException (even? 1/2)))
(is (thrown? IllegalArgumentException (even? (double 10)))))
(deftest test-odd?
(are [x] (true? x)
(not (odd? -4))
(odd? -3)
(not (odd? 0))
(odd? 5)
(not (odd? 8)))
(is (thrown? IllegalArgumentException (odd? 1/2)))
(is (thrown? IllegalArgumentException (odd? (double 10)))))
(defn- expt
"clojure.contrib.math/expt is a better and much faster impl, but this works.
Math/pow overflows to Infinity."
[x n] (apply *' (replicate n x)))
(deftest test-bit-shift-left
(are [x y] (= x y)
2r10 (bit-shift-left 2r1 1)
2r100 (bit-shift-left 2r1 2)
2r1000 (bit-shift-left 2r1 3)
2r00101110 (bit-shift-left 2r00010111 1)
2r00101110 (apply bit-shift-left [2r00010111 1])
0 (bit-shift-left 2r10 -1) ; truncated to least 6-bits, 63
(expt 2 32) (bit-shift-left 1 32)
(expt 2 16) (bit-shift-left 1 10000) ; truncated to least 6-bits, 16
)
(is (thrown? IllegalArgumentException (bit-shift-left 1N 1))))
(deftest test-bit-shift-right
(are [x y] (= x y)
2r0 (bit-shift-right 2r1 1)
2r010 (bit-shift-right 2r100 1)
2r001 (bit-shift-right 2r100 2)
2r000 (bit-shift-right 2r100 3)
2r0001011 (bit-shift-right 2r00010111 1)
2r0001011 (apply bit-shift-right [2r00010111 1])
0 (bit-shift-right 2r10 -1) ; truncated to least 6-bits, 63
1 (bit-shift-right (expt 2 32) 32)
1 (bit-shift-right (expt 2 16) 10000) ; truncated to least 6-bits, 16
-1 (bit-shift-right -2r10 1)
)
(is (thrown? IllegalArgumentException (bit-shift-right 1N 1))))
(deftest test-unsigned-bit-shift-right
(are [x y] (= x y)
2r0 (unsigned-bit-shift-right 2r1 1)
2r010 (unsigned-bit-shift-right 2r100 1)
2r001 (unsigned-bit-shift-right 2r100 2)
2r000 (unsigned-bit-shift-right 2r100 3)
2r0001011 (unsigned-bit-shift-right 2r00010111 1)
2r0001011 (apply unsigned-bit-shift-right [2r00010111 1])
0 (unsigned-bit-shift-right 2r10 -1) ; truncated to least 6-bits, 63
1 (unsigned-bit-shift-right (expt 2 32) 32)
1 (unsigned-bit-shift-right (expt 2 16) 10000) ; truncated to least 6-bits, 16
9223372036854775807 (unsigned-bit-shift-right -2r10 1)
)
(is (thrown? IllegalArgumentException (unsigned-bit-shift-right 1N 1))))
(deftest test-bit-clear
(is (= 2r1101 (bit-clear 2r1111 1)))
(is (= 2r1101 (bit-clear 2r1101 1))))
(deftest test-bit-set
(is (= 2r1111 (bit-set 2r1111 1)))
(is (= 2r1111 (bit-set 2r1101 1))))
(deftest test-bit-flip
(is (= 2r1101 (bit-flip 2r1111 1)))
(is (= 2r1111 (bit-flip 2r1101 1))))
(deftest test-bit-test
(is (true? (bit-test 2r1111 1)))
(is (false? (bit-test 2r1101 1))))
;; arrays
(deftest test-array-types
(are [x y z] (= (Class/forName x) (class y) (class z))
"[Z" (boolean-array 1) (booleans (boolean-array 1 true))
"[B" (byte-array 1) (bytes (byte-array 1 (byte 1)))
"[C" (char-array 1) (chars (char-array 1 \a))
"[S" (short-array 1) (shorts (short-array 1 (short 1)))
"[F" (float-array 1) (floats (float-array 1 1))
"[D" (double-array 1) (doubles (double-array 1 1))
"[I" (int-array 1) (ints (int-array 1 1))
"[J" (long-array 1) (longs (long-array 1 1))))
(deftest test-ratios
(is (== (denominator 1/2) 2))
(is (== (numerator 1/2) 1))
(is (= (bigint (/ 100000000000000000000 3)) 33333333333333333333))
(is (= (long 10000000000000000000/3) 3333333333333333333)))
(deftest test-arbitrary-precision-subtract
(are [x y] (= x y)
9223372036854775808N (-' 0 -9223372036854775808)
clojure.lang.BigInt (class (-' 0 -9223372036854775808))
java.lang.Long (class (-' 0 -9223372036854775807))))
(deftest test-min-max
(testing "min/max on different numbers of floats and doubles"
(are [xmin xmax a]
(and (= (Float. xmin) (min (Float. a)))
(= (Float. xmax) (max (Float. a)))
(= xmin (min a))
(= xmax (max a)))
0.0 0.0 0.0)
(are [xmin xmax a b]
(and (= (Float. xmin) (min (Float. a) (Float. b)))
(= (Float. xmax) (max (Float. a) (Float. b)))
(= xmin (min a b))
(= xmax (max a b)))
-1.0 0.0 0.0 -1.0
-1.0 0.0 -1.0 0.0
0.0 1.0 0.0 1.0
0.0 1.0 1.0 0.0)
(are [xmin xmax a b c]
(and (= (Float. xmin) (min (Float. a) (Float. b) (Float. c)))
(= (Float. xmax) (max (Float. a) (Float. b) (Float. c)))
(= xmin (min a b c))
(= xmax (max a b c)))
-1.0 1.0 0.0 1.0 -1.0
-1.0 1.0 0.0 -1.0 1.0
-1.0 1.0 -1.0 1.0 0.0))
(testing "min/max preserves type of winner"
(is (= java.lang.Long (class (max 10))))
(is (= java.lang.Long (class (max 1.0 10))))
(is (= java.lang.Long (class (max 10 1.0))))
(is (= java.lang.Long (class (max 10 1.0 2.0))))
(is (= java.lang.Long (class (max 1.0 10 2.0))))
(is (= java.lang.Long (class (max 1.0 2.0 10))))
(is (= java.lang.Double (class (max 1 2 10.0 3 4 5))))
(is (= java.lang.Long (class (min 10))))
(is (= java.lang.Long (class (min 1.0 -10))))
(is (= java.lang.Long (class (min -10 1.0))))
(is (= java.lang.Long (class (min -10 1.0 2.0))))
(is (= java.lang.Long (class (min 1.0 -10 2.0))))
(is (= java.lang.Long (class (min 1.0 2.0 -10))))
(is (= java.lang.Double (class (min 1 2 -10.0 3 4 5))))))
(deftest clj-868
(testing "min/max: NaN is contagious"
(letfn [(fnan? [^Float x] (Float/isNaN x))
(dnan? [^double x] (Double/isNaN x))]
(are [minmax]
(are [nan? nan zero]
(every? nan? (map minmax
[ nan zero zero]
[zero nan zero]
[zero zero nan]))
fnan? Float/NaN (Float. 0.0)
dnan? Double/NaN 0.0)
min
max))))
(defn integer
"Distribution of integers biased towards the small, but
including all longs."
[]
(gen/one-of #(gen/uniform -1 32) gen/byte gen/short gen/int gen/long))
(defn longable?
[n]
(try
(long n)
true
(catch Exception _)))
(defspec integer-commutative-laws
(partial map identity)
[^{:tag `integer} a ^{:tag `integer} b]
(if (longable? (+' a b))
(assert (= (+ a b) (+ b a)
(+' a b) (+' b a)
(unchecked-add a b) (unchecked-add b a)))
(assert (= (+' a b) (+' b a))))
(if (longable? (*' a b))
(assert (= (* a b) (* b a)
(*' a b) (*' b a)
(unchecked-multiply a b) (unchecked-multiply b a)))
(assert (= (*' a b) (*' b a)))))
(defspec integer-associative-laws
(partial map identity)
[^{:tag `integer} a ^{:tag `integer} b ^{:tag `integer} c]
(if (every? longable? [(+' a b) (+' b c) (+' a b c)])
(assert (= (+ (+ a b) c) (+ a (+ b c))
(+' (+' a b) c) (+' a (+' b c))
(unchecked-add (unchecked-add a b) c) (unchecked-add a (unchecked-add b c))))
(assert (= (+' (+' a b) c) (+' a (+' b c))
(+ (+ (bigint a) b) c) (+ a (+ (bigint b) c)))))
(if (every? longable? [(*' a b) (*' b c) (*' a b c)])
(assert (= (* (* a b) c) (* a (* b c))
(*' (*' a b) c) (*' a (*' b c))
(unchecked-multiply (unchecked-multiply a b) c) (unchecked-multiply a (unchecked-multiply b c))))
(assert (= (*' (*' a b) c) (*' a (*' b c))
(* (* (bigint a) b) c) (* a (* (bigint b) c))))))
(defspec integer-distributive-laws
(partial map identity)
[^{:tag `integer} a ^{:tag `integer} b ^{:tag `integer} c]
(if (every? longable? [(*' a (+' b c)) (+' (*' a b) (*' a c))
(*' a b) (*' a c) (+' b c)])
(assert (= (* a (+ b c)) (+ (* a b) (* a c))
(*' a (+' b c)) (+' (*' a b) (*' a c))
(unchecked-multiply a (+' b c)) (+' (unchecked-multiply a b) (unchecked-multiply a c))))
(assert (= (*' a (+' b c)) (+' (*' a b) (*' a c))
(* a (+ (bigint b) c)) (+ (* (bigint a) b) (* (bigint a) c))))))
(defspec addition-undoes-subtraction
(partial map identity)
[^{:tag `integer} a ^{:tag `integer} b]
(if (longable? (-' a b))
(assert (= a
(-> a (- b) (+ b))
(-> a (unchecked-subtract b) (unchecked-add b)))))
(assert (= a
(-> a (-' b) (+' b)))))
(defspec quotient-and-remainder
(fn [a b] (sort [a b]))
[^{:tag `integer} a ^{:tag `integer} b]
(when-not (zero? (second %))
(let [[a d] %
q (quot a d)
r (rem a d)]
(assert (= a
(+ (* q d) r)
(unchecked-add (unchecked-multiply q d) r))))))
clojure1.6_1.6.0+dfsg.orig/test/clojure/test_clojure/other_functions.clj 0000664 0000000 0000000 00000032235 12346720654 0026413 0 ustar 00root root 0000000 0000000 ; 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.
; Author: Frantisek Sodomka
(ns clojure.test-clojure.other-functions
(:use clojure.test))
; http://clojure.org/other_functions
; [= not= (tests in data_structures.clj and elsewhere)]
(deftest test-identity
; exactly 1 argument needed
; (is (thrown? IllegalArgumentException (identity)))
; (is (thrown? IllegalArgumentException (identity 1 2)))
(are [x] (= (identity x) x)
nil
false true
0 42
0.0 3.14
2/3
0M 1M
\c
"" "abc"
'sym
:kw
() '(1 2)
[] [1 2]
{} {:a 1 :b 2}
#{} #{1 2} )
; evaluation
(are [x y] (= (identity x) y)
(+ 1 2) 3
(> 5 0) true ))
(deftest test-name
(are [x y] (= x (name y))
"foo" :foo
"bar" 'bar
"quux" "quux"))
(deftest test-fnil
(let [f1 (fnil vector :a)
f2 (fnil vector :a :b)
f3 (fnil vector :a :b :c)]
(are [result input] (= result [(apply f1 input) (apply f2 input) (apply f3 input)])
[[1 2 3 4] [1 2 3 4] [1 2 3 4]] [1 2 3 4]
[[:a 2 3 4] [:a 2 3 4] [:a 2 3 4]] [nil 2 3 4]
[[:a nil 3 4] [:a :b 3 4] [:a :b 3 4]] [nil nil 3 4]
[[:a nil nil 4] [:a :b nil 4] [:a :b :c 4]] [nil nil nil 4]
[[:a nil nil nil] [:a :b nil nil] [:a :b :c nil]] [nil nil nil nil]))
(are [x y] (= x y)
((fnil + 0) nil 42) 42
((fnil conj []) nil 42) [42]
(reduce #(update-in %1 [%2] (fnil inc 0)) {}
["fun" "counting" "words" "fun"])
{"words" 1, "counting" 1, "fun" 2}
(reduce #(update-in %1 [(first %2)] (fnil conj []) (second %2)) {}
[[:a 1] [:a 2] [:b 3]])
{:b [3], :a [1 2]}))
; time assert comment doc
; partial
; comp
(deftest test-comp
(let [c0 (comp)]
(are [x] (= (identity x) (c0 x))
nil
42
[1 2 3]
#{}
:foo)
(are [x y] (= (identity x) (c0 y))
(+ 1 2 3) 6
(keyword "foo") :foo)))
; complement
(deftest test-complement
(let [not-contains? (complement contains?)]
(is (= true (not-contains? [2 3 4] 5)))
(is (= false (not-contains? [2 3 4] 2))))
(let [first-elem-not-1? (complement (fn [x] (= 1 (first x))))]
(is (= true (first-elem-not-1? [2 3])))
(is (= false (first-elem-not-1? [1 2])))))
; constantly
(deftest test-constantly
(let [c0 (constantly 10)]
(are [x] (= 10 (c0 x))
nil
42
"foo")))
;juxt
(deftest test-juxt
;; juxt for colls
(let [m0 {:a 1 :b 2}
a0 [1 2]]
(is (= [1 2] ((juxt :a :b) m0)))
(is (= [2 1] ((juxt fnext first) a0))))
;; juxt for fns
(let [a1 (fn [a] (+ 2 a))
b1 (fn [b] (* 2 b))]
(is (= [5 6] ((juxt a1 b1) 3)))))
;partial
(deftest test-partial
(let [p0 (partial inc)
p1 (partial + 20)
p2 (partial conj [1 2])]
(is (= 41 (p0 40)))
(is (= 40 (p1 20)))
(is (= [1 2 3] (p2 3)))))
; every-pred
(deftest test-every-pred
(are [result expr] (= result expr)
;; 1 pred
true ((every-pred even?))
true ((every-pred even?) 2)
true ((every-pred even?) 2 4)
true ((every-pred even?) 2 4 6)
true ((every-pred even?) 2 4 6 8)
true ((every-pred even?) 2 4 6 8 10)
false ((every-pred odd?) 2)
false ((every-pred odd?) 2 4)
false ((every-pred odd?) 2 4 6)
false ((every-pred odd?) 2 4 6 8)
false ((every-pred odd?) 2 4 6 8 10)
;; 2 preds
true ((every-pred even? number?))
true ((every-pred even? number?) 2)
true ((every-pred even? number?) 2 4)
true ((every-pred even? number?) 2 4 6)
true ((every-pred even? number?) 2 4 6 8)
true ((every-pred even? number?) 2 4 6 8 10)
false ((every-pred number? odd?) 2)
false ((every-pred number? odd?) 2 4)
false ((every-pred number? odd?) 2 4 6)
false ((every-pred number? odd?) 2 4 6 8)
false ((every-pred number? odd?) 2 4 6 8 10)
;; 2 preds, short-circuiting
false ((every-pred number? odd?) 1 :a)
false ((every-pred number? odd?) 1 3 :a)
false ((every-pred number? odd?) 1 3 5 :a)
false ((every-pred number? odd?) 1 3 5 7 :a)
false ((every-pred number? odd?) 1 :a 3 5 7)
;; 3 preds
true ((every-pred even? number? #(> % 0)))
true ((every-pred even? number? #(> % 0)) 2)
true ((every-pred even? number? #(> % 0)) 2 4)
true ((every-pred even? number? #(> % 0)) 2 4 6)
true ((every-pred even? number? #(> % 0)) 2 4 6 8)
true ((every-pred even? number? #(> % 0)) 2 4 6 8 10)
true ((every-pred number? even? #(> % 0)) 2 4 6 8 10 12)
false ((every-pred number? odd? #(> % 0)) 2)
false ((every-pred number? odd? #(> % 0)) 2 4)
false ((every-pred number? odd? #(> % 0)) 2 4 6)
false ((every-pred number? odd? #(> % 0)) 2 4 6 8)
false ((every-pred number? odd? #(> % 0)) 2 4 6 8 10)
false ((every-pred number? odd? #(> % 0)) 2 4 6 8 -10)
;; 3 preds, short-circuiting
false ((every-pred number? odd? #(> % 0)) 1 :a)
false ((every-pred number? odd? #(> % 0)) 1 3 :a)
false ((every-pred number? odd? #(> % 0)) 1 3 5 :a)
false ((every-pred number? odd? #(> % 0)) 1 3 5 7 :a)
false ((every-pred number? odd? #(> % 0)) 1 :a 3 5 7)
;; 4 preds
true ((every-pred even? number? #(> % 0) #(<= % 12)))
true ((every-pred even? number? #(> % 0) #(<= % 12)) 2)
true ((every-pred even? number? #(> % 0) #(<= % 12)) 2 4)
true ((every-pred even? number? #(> % 0) #(<= % 12)) 2 4 6)
true ((every-pred even? number? #(> % 0) #(<= % 12)) 2 4 6 8)
true ((every-pred even? number? #(> % 0) #(<= % 12)) 2 4 6 8 10)
true ((every-pred number? even? #(> % 0) #(<= % 12)) 2 4 6 8 10 12)
false ((every-pred number? odd? #(> % 0) #(<= % 12)) 2)
false ((every-pred number? odd? #(> % 0) #(<= % 12)) 2 4)
false ((every-pred number? odd? #(> % 0) #(<= % 12)) 2 4 6)
false ((every-pred number? odd? #(> % 0) #(<= % 12)) 2 4 6 8)
false ((every-pred number? odd? #(> % 0) #(<= % 12)) 2 4 6 8 10)
false ((every-pred number? odd? #(> % 0) #(<= % 12)) 2 4 6 8 14)
;; 4 preds, short-circuiting
false ((every-pred number? odd? #(> % 0) #(<= % 12)) 1 :a)
false ((every-pred number? odd? #(> % 0) #(<= % 12)) 1 3 :a)
false ((every-pred number? odd? #(> % 0) #(<= % 12)) 1 3 5 :a)
false ((every-pred number? odd? #(> % 0) #(<= % 12)) 1 3 5 7 :a)
false ((every-pred number? odd? #(> % 0) #(<= % 12)) 1 :a 3 5 7)
;; 5 preds
true ((every-pred even? number? #(> % 0) #(<= % 12) #(zero? (rem % 2))))
true ((every-pred even? number? #(> % 0) #(<= % 12) #(zero? (rem % 2))) 2)
true ((every-pred even? number? #(> % 0) #(<= % 12) #(zero? (rem % 2))) 2 4)
true ((every-pred even? number? #(> % 0) #(<= % 12) #(zero? (rem % 2))) 2 4 6)
true ((every-pred even? number? #(> % 0) #(<= % 12) #(zero? (rem % 2))) 2 4 6 8)
true ((every-pred even? number? #(> % 0) #(<= % 12) #(zero? (rem % 2))) 2 4 6 8 10)
true ((every-pred number? even? #(> % 0) #(<= % 12) #(zero? (rem % 2))) 2 4 6 8 10 12)
false ((every-pred number? odd? #(> % 0) #(<= % 12) #(zero? (rem % 2))) 2)
false ((every-pred number? odd? #(> % 0) #(<= % 12) #(zero? (rem % 2))) 2 4)
false ((every-pred number? odd? #(> % 0) #(<= % 12) #(zero? (rem % 2))) 2 4 6)
false ((every-pred number? odd? #(> % 0) #(<= % 12) #(zero? (rem % 2))) 2 4 6 8)
false ((every-pred number? odd? #(> % 0) #(<= % 12) #(zero? (rem % 2))) 2 4 6 8 10)
false ((every-pred number? odd? #(> % 0) #(<= % 12) #(zero? (rem % 2))) 2 4 6 8 13)
;; 5 preds, short-circuiting
false ((every-pred number? odd? #(> % 0) #(<= % 12) #(zero? (rem % 2))) 1 :a)
false ((every-pred number? odd? #(> % 0) #(<= % 12) #(zero? (rem % 2))) 1 3 :a)
false ((every-pred number? odd? #(> % 0) #(<= % 12) #(zero? (rem % 2))) 1 3 5 :a)
false ((every-pred number? odd? #(> % 0) #(<= % 12) #(zero? (rem % 2))) 1 3 5 7 :a)
false ((every-pred number? odd? #(> % 0) #(<= % 12) #(zero? (rem % 2))) 1 :a 3 5 7)
;; truthiness
true (reduce #(and % %2)
(for [i (range 1 25)]
(apply (apply every-pred (repeat i identity))
(range i))))))
; some-fn
(deftest test-some-fn
(are [result] (identity result)
;; 1 pred
(not ((some-fn even?)))
((some-fn even?) 2)
((some-fn even?) 2 4)
((some-fn even?) 2 4 6)
((some-fn even?) 2 4 6 8)
((some-fn even?) 2 4 6 8 10)
(not ((some-fn odd?) 2))
(not ((some-fn odd?) 2 4))
(not ((some-fn odd?) 2 4 6))
(not ((some-fn odd?) 2 4 6 8))
(not ((some-fn odd?) 2 4 6 8 10))
;; 2 preds
(not ((some-fn even? number?)))
((some-fn even? number?) 2)
((some-fn even? number?) 2 4)
((some-fn even? number?) 2 4 6)
((some-fn even? number?) 2 4 6 8)
((some-fn even? number?) 2 4 6 8 10)
((some-fn number? odd?) 2)
((some-fn number? odd?) 2 4)
((some-fn number? odd?) 2 4 6)
((some-fn number? odd?) 2 4 6 8)
((some-fn number? odd?) 2 4 6 8 10)
;; 2 preds, short-circuiting
((some-fn number? odd?) 1 :a)
((some-fn number? odd?) 1 3 :a)
((some-fn number? odd?) 1 3 5 :a)
((some-fn number? odd?) 1 3 5 7 :a)
((some-fn number? odd?) 1 :a 3 5 7)
;; 3 preds
(not ((some-fn even? number? #(> % 0))))
((some-fn even? number? #(> % 0)) 2)
((some-fn even? number? #(> % 0)) 2 4)
((some-fn even? number? #(> % 0)) 2 4 6)
((some-fn even? number? #(> % 0)) 2 4 6 8)
((some-fn even? number? #(> % 0)) 2 4 6 8 10)
((some-fn number? even? #(> % 0)) 2 4 6 8 10 12)
((some-fn number? odd? #(> % 0)) 2)
((some-fn number? odd? #(> % 0)) 2 4)
((some-fn number? odd? #(> % 0)) 2 4 6)
((some-fn number? odd? #(> % 0)) 2 4 6 8)
((some-fn number? odd? #(> % 0)) 2 4 6 8 10)
((some-fn number? odd? #(> % 0)) 2 4 6 8 -10)
;; 3 preds, short-circuiting
((some-fn number? odd? #(> % 0)) 1 :a)
((some-fn number? odd? #(> % 0)) 1 3 :a)
((some-fn number? odd? #(> % 0)) 1 3 5 :a)
((some-fn number? odd? #(> % 0)) 1 :a 3 5 7)
;; 4 preds
(not ((some-fn even? number? #(> % 0) #(<= % 12))))
((some-fn even? number? #(> % 0) #(<= % 12)) 2)
((some-fn even? number? #(> % 0) #(<= % 12)) 2 4)
((some-fn even? number? #(> % 0) #(<= % 12)) 2 4 6)
((some-fn even? number? #(> % 0) #(<= % 12)) 2 4 6 8)
((some-fn even? number? #(> % 0) #(<= % 12)) 2 4 6 8 10)
((some-fn number? even? #(> % 0) #(<= % 12)) 2 4 6 8 10 12)
((some-fn number? odd? #(> % 0) #(<= % 12)) 2)
((some-fn number? odd? #(> % 0) #(<= % 12)) 2 4)
((some-fn number? odd? #(> % 0) #(<= % 12)) 2 4 6)
((some-fn number? odd? #(> % 0) #(<= % 12)) 2 4 6 8)
((some-fn number? odd? #(> % 0) #(<= % 12)) 2 4 6 8 10)
((some-fn number? odd? #(> % 0) #(<= % 12)) 2 4 6 8 14)
;; 4 preds, short-circuiting
((some-fn number? odd? #(> % 0) #(<= % 12)) 1 :a)
((some-fn number? odd? #(> % 0) #(<= % 12)) 1 3 :a)
((some-fn number? odd? #(> % 0) #(<= % 12)) 1 3 5 :a)
((some-fn number? odd? #(> % 0) #(<= % 12)) 1 3 5 7 :a)
((some-fn number? odd? #(> % 0) #(<= % 12)) 1 :a 3 5 7)
;; 5 preds
(not ((some-fn even? number? #(> % 0) #(<= % 12) #(zero? (rem % 2)))))
((some-fn even? number? #(> % 0) #(<= % 12) #(zero? (rem % 2))) 2)
((some-fn even? number? #(> % 0) #(<= % 12) #(zero? (rem % 2))) 2 4)
((some-fn even? number? #(> % 0) #(<= % 12) #(zero? (rem % 2))) 2 4 6)
((some-fn even? number? #(> % 0) #(<= % 12) #(zero? (rem % 2))) 2 4 6 8)
((some-fn even? number? #(> % 0) #(<= % 12) #(zero? (rem % 2))) 2 4 6 8 10)
((some-fn number? even? #(> % 0) #(<= % 12) #(zero? (rem % 2))) 2 4 6 8 10 12)
((some-fn number? odd? #(> % 0) #(<= % 12) #(zero? (rem % 2))) 2)
((some-fn number? odd? #(> % 0) #(<= % 12) #(zero? (rem % 2))) 2 4)
((some-fn number? odd? #(> % 0) #(<= % 12) #(zero? (rem % 2))) 2 4 6)
((some-fn number? odd? #(> % 0) #(<= % 12) #(zero? (rem % 2))) 2 4 6 8)
((some-fn number? odd? #(> % 0) #(<= % 12) #(zero? (rem % 2))) 2 4 6 8 10)
((some-fn number? odd? #(> % 0) #(<= % 12) #(zero? (rem % 2))) 2 4 6 8 13)
;; 5 preds, short-circuiting
((some-fn number? odd? #(> % 0) #(<= % 12) #(zero? (rem % 2))) 1 :a)
((some-fn number? odd? #(> % 0) #(<= % 12) #(zero? (rem % 2))) 1 3 :a)
((some-fn number? odd? #(> % 0) #(<= % 12) #(zero? (rem % 2))) 1 3 5 :a)
((some-fn number? odd? #(> % 0) #(<= % 12) #(zero? (rem % 2))) 1 3 5 7 :a)
((some-fn number? odd? #(> % 0) #(<= % 12) #(zero? (rem % 2))) 1 :a 3 5 7)
;; truthiness
(reduce #(or % %2)
(conj
(vec
(for [i (range 1 25)]
(apply (apply some-fn (repeat i (comp not boolean))) (range i))))
true))))
; Printing
; pr prn print println newline
; pr-str prn-str print-str println-str [with-out-str (vars.clj)]
; Regex Support
; re-matcher re-find re-matches re-groups re-seq
clojure1.6_1.6.0+dfsg.orig/test/clojure/test_clojure/parallel.clj 0000664 0000000 0000000 00000002227 12346720654 0024774 0 ustar 00root root 0000000 0000000 ; 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.
; Author: Frantisek Sodomka
(ns clojure.test-clojure.parallel
(:use clojure.test))
;; !! Tests for the parallel library will be in a separate file clojure_parallel.clj !!
; future-call
; future
; pmap
; pcalls
; pvalues
;; pmap
;;
(deftest pmap-does-its-thing
;; regression fixed in r1218; was OutOfMemoryError
(is (= '(1) (pmap inc [0]))))
(def ^:dynamic *test-value* 1)
(deftest future-fn-properly-retains-conveyed-bindings
(let [a (atom [])]
(binding [*test-value* 2]
@(future (dotimes [_ 3]
;; we need some binding to trigger binding pop
(binding [*print-dup* false]
(swap! a conj *test-value*))))
(is (= [2 2 2] @a)))))
clojure1.6_1.6.0+dfsg.orig/test/clojure/test_clojure/pprint.clj 0000664 0000000 0000000 00000001512 12346720654 0024510 0 ustar 00root root 0000000 0000000 ; 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.
;; Author: Tom Faulhaber
(ns clojure.test-clojure.pprint
(:refer-clojure :exclude [format])
(:require [clojure.string :as str])
(:use [clojure.test :only (deftest is are run-tests)]
[clojure.test-helper :only [platform-newlines]]
clojure.test-clojure.pprint.test-helper
clojure.pprint))
(load "pprint/test_cl_format")
(load "pprint/test_pretty")
clojure1.6_1.6.0+dfsg.orig/test/clojure/test_clojure/pprint/ 0000775 0000000 0000000 00000000000 12346720654 0024017 5 ustar 00root root 0000000 0000000 clojure1.6_1.6.0+dfsg.orig/test/clojure/test_clojure/pprint/test_cl_format.clj 0000664 0000000 0000000 00000112600 12346720654 0027516 0 ustar 00root root 0000000 0000000 ;;; test_cl_format.clj -- part of the pretty printer for Clojure
; 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.
;; Author: Tom Faulhaber
;; April 3, 2009
;; This test set tests the basic cl-format functionality
(in-ns 'clojure.test-clojure.pprint)
(def format cl-format)
;; TODO tests for ~A, ~D, etc.
;; TODO add tests for ~F, etc.: 0.0, 9.9999 with rounding, 9.9999E99 with rounding
(simple-tests d-tests
(cl-format nil "~D" 0) "0"
(cl-format nil "~D" 2e6) "2000000"
(cl-format nil "~D" 2000000) "2000000"
(cl-format nil "~:D" 2000000) "2,000,000"
(cl-format nil "~D" 1/2) "1/2"
(cl-format nil "~D" 'fred) "fred"
)
(simple-tests base-tests
(cl-format nil "~{~2r~^ ~}~%" (range 10))
"0 1 10 11 100 101 110 111 1000 1001\n"
(with-out-str
(dotimes [i 35]
(binding [*print-base* (+ i 2)] ;print the decimal number 40
(write 40) ;in each base from 2 to 36
(if (zero? (mod i 10)) (prn) (cl-format true " ")))))
"101000
1111 220 130 104 55 50 44 40 37 34
31 2c 2a 28 26 24 22 20 1j 1i
1h 1g 1f 1e 1d 1c 1b 1a 19 18
17 16 15 14 "
(with-out-str
(doseq [pb [2 3 8 10 16]]
(binding [*print-radix* true ;print the integer 10 and
*print-base* pb] ;the ratio 1/10 in bases 2,
(cl-format true "~&~S ~S~%" 10 1/10)))) ;3, 8, 10, 16
"#b1010 #b1/1010\n#3r101 #3r1/101\n#o12 #o1/12\n10. #10r1/10\n#xa #x1/a\n")
(simple-tests cardinal-tests
(cl-format nil "~R" 0) "zero"
(cl-format nil "~R" 4) "four"
(cl-format nil "~R" 15) "fifteen"
(cl-format nil "~R" -15) "minus fifteen"
(cl-format nil "~R" 25) "twenty-five"
(cl-format nil "~R" 20) "twenty"
(cl-format nil "~R" 200) "two hundred"
(cl-format nil "~R" 203) "two hundred three"
(cl-format nil "~R" 44879032)
"forty-four million, eight hundred seventy-nine thousand, thirty-two"
(cl-format nil "~R" -44879032)
"minus forty-four million, eight hundred seventy-nine thousand, thirty-two"
(cl-format nil "~R = ~:*~:D" 44000032)
"forty-four million, thirty-two = 44,000,032"
(cl-format nil "~R = ~:*~:D" 448790329480948209384389429384029384029842098420989842094)
"four hundred forty-eight septendecillion, seven hundred ninety sexdecillion, three hundred twenty-nine quindecillion, four hundred eighty quattuordecillion, nine hundred forty-eight tredecillion, two hundred nine duodecillion, three hundred eighty-four undecillion, three hundred eighty-nine decillion, four hundred twenty-nine nonillion, three hundred eighty-four octillion, twenty-nine septillion, three hundred eighty-four sextillion, twenty-nine quintillion, eight hundred forty-two quadrillion, ninety-eight trillion, four hundred twenty billion, nine hundred eighty-nine million, eight hundred forty-two thousand, ninety-four = 448,790,329,480,948,209,384,389,429,384,029,384,029,842,098,420,989,842,094"
(cl-format nil "~R = ~:*~:D" 448790329480948209384389429384029384029842098420989842094490320942058747587584758375847593475)
"448,790,329,480,948,209,384,389,429,384,029,384,029,842,098,420,989,842,094,490,320,942,058,747,587,584,758,375,847,593,475 = 448,790,329,480,948,209,384,389,429,384,029,384,029,842,098,420,989,842,094,490,320,942,058,747,587,584,758,375,847,593,475"
(cl-format nil "~R = ~:*~:D" 2e6)
"two million = 2,000,000"
(cl-format nil "~R = ~:*~:D" 200000200000)
"two hundred billion, two hundred thousand = 200,000,200,000")
(simple-tests ordinal-tests
(cl-format nil "~:R" 0) "zeroth"
(cl-format nil "~:R" 4) "fourth"
(cl-format nil "~:R" 15) "fifteenth"
(cl-format nil "~:R" -15) "minus fifteenth"
(cl-format nil "~:R" 25) "twenty-fifth"
(cl-format nil "~:R" 20) "twentieth"
(cl-format nil "~:R" 200) "two hundredth"
(cl-format nil "~:R" 203) "two hundred third"
(cl-format nil "~:R" 44879032)
"forty-four million, eight hundred seventy-nine thousand, thirty-second"
(cl-format nil "~:R" -44879032)
"minus forty-four million, eight hundred seventy-nine thousand, thirty-second"
(cl-format nil "~:R = ~:*~:D" 44000032)
"forty-four million, thirty-second = 44,000,032"
(cl-format nil "~:R = ~:*~:D" 448790329480948209384389429384029384029842098420989842094)
"four hundred forty-eight septendecillion, seven hundred ninety sexdecillion, three hundred twenty-nine quindecillion, four hundred eighty quattuordecillion, nine hundred forty-eight tredecillion, two hundred nine duodecillion, three hundred eighty-four undecillion, three hundred eighty-nine decillion, four hundred twenty-nine nonillion, three hundred eighty-four octillion, twenty-nine septillion, three hundred eighty-four sextillion, twenty-nine quintillion, eight hundred forty-two quadrillion, ninety-eight trillion, four hundred twenty billion, nine hundred eighty-nine million, eight hundred forty-two thousand, ninety-fourth = 448,790,329,480,948,209,384,389,429,384,029,384,029,842,098,420,989,842,094"
(cl-format nil "~:R = ~:*~:D" 448790329480948209384389429384029384029842098420989842094490320942058747587584758375847593475)
"448,790,329,480,948,209,384,389,429,384,029,384,029,842,098,420,989,842,094,490,320,942,058,747,587,584,758,375,847,593,475th = 448,790,329,480,948,209,384,389,429,384,029,384,029,842,098,420,989,842,094,490,320,942,058,747,587,584,758,375,847,593,475"
(cl-format nil "~:R = ~:*~:D" 448790329480948209384389429384029384029842098420989842094490320942058747587584758375847593471)
"448,790,329,480,948,209,384,389,429,384,029,384,029,842,098,420,989,842,094,490,320,942,058,747,587,584,758,375,847,593,471st = 448,790,329,480,948,209,384,389,429,384,029,384,029,842,098,420,989,842,094,490,320,942,058,747,587,584,758,375,847,593,471"
(cl-format nil "~:R = ~:*~:D" 2e6)
"two millionth = 2,000,000")
(simple-tests ordinal1-tests
(cl-format nil "~:R" 1) "first"
(cl-format nil "~:R" 11) "eleventh"
(cl-format nil "~:R" 21) "twenty-first"
(cl-format nil "~:R" 20) "twentieth"
(cl-format nil "~:R" 220) "two hundred twentieth"
(cl-format nil "~:R" 200) "two hundredth"
(cl-format nil "~:R" 999) "nine hundred ninety-ninth"
)
(simple-tests roman-tests
(cl-format nil "~@R" 3) "III"
(cl-format nil "~@R" 4) "IV"
(cl-format nil "~@R" 9) "IX"
(cl-format nil "~@R" 29) "XXIX"
(cl-format nil "~@R" 429) "CDXXIX"
(cl-format nil "~@:R" 429) "CCCCXXVIIII"
(cl-format nil "~@:R" 3429) "MMMCCCCXXVIIII"
(cl-format nil "~@R" 3429) "MMMCDXXIX"
(cl-format nil "~@R" 3479) "MMMCDLXXIX"
(cl-format nil "~@R" 3409) "MMMCDIX"
(cl-format nil "~@R" 300) "CCC"
(cl-format nil "~@R ~D" 300 20) "CCC 20"
(cl-format nil "~@R" 5000) "5,000"
(cl-format nil "~@R ~D" 5000 20) "5,000 20"
(cl-format nil "~@R" "the quick") "the quick")
(simple-tests c-tests
(cl-format nil "~{~c~^, ~}~%" "hello") "h, e, l, l, o\n"
(cl-format nil "~{~:c~^, ~}~%" "hello") "h, e, l, l, o\n"
(cl-format nil "~@C~%" \m) "\\m\n"
(cl-format nil "~@C~%" (char 222)) "\\Þ\n"
(cl-format nil "~@C~%" (char 8)) "\\backspace\n"
(cl-format nil "~@C~%" (char 3)) "\\\n")
(simple-tests e-tests
(cl-format nil "*~E*" 0.0) "*0.0E+0*"
(cl-format nil "*~6E*" 0.0) "*0.0E+0*"
(cl-format nil "*~6,0E*" 0.0) "* 0.E+0*"
(cl-format nil "*~7,2E*" 0.0) "*0.00E+0*"
(cl-format nil "*~5E*" 0.0) "*0.E+0*"
(cl-format nil "*~10,2,2,,'?E*" 2.8E120) "*??????????*"
(cl-format nil "*~10,2E*" 9.99999) "* 1.00E+1*"
(cl-format nil "*~10,2E*" 9.99999E99) "* 1.00E+100*"
(cl-format nil "*~10,2,2E*" 9.99999E99) "* 1.00E+100*"
(cl-format nil "*~10,2,2,,'?E*" 9.99999E99) "*??????????*"
)
(simple-tests $-tests
(cl-format nil "~$" 22.3) "22.30"
(cl-format nil "~$" 22.375) "22.38"
(cl-format nil "~3,5$" 22.375) "00022.375"
(cl-format nil "~3,5,8$" 22.375) "00022.375"
(cl-format nil "~3,5,10$" 22.375) " 00022.375"
(cl-format nil "~3,5,14@$" 22.375) " +00022.375"
(cl-format nil "~3,5,14@$" 22.375) " +00022.375"
(cl-format nil "~3,5,14@:$" 22.375) "+ 00022.375"
(cl-format nil "~3,,14@:$" 0.375) "+ 0.375"
(cl-format nil "~1,1$" -12.0) "-12.0"
(cl-format nil "~1,1$" 12.0) "12.0"
(cl-format nil "~1,1$" 12.0) "12.0"
(cl-format nil "~1,1@$" 12.0) "+12.0"
(cl-format nil "~1,1,8,' @:$" 12.0) "+ 12.0"
(cl-format nil "~1,1,8,' @$" 12.0) " +12.0"
(cl-format nil "~1,1,8,' :$" 12.0) " 12.0"
(cl-format nil "~1,1,8,' $" 12.0) " 12.0"
(cl-format nil "~1,1,8,' @:$" -12.0) "- 12.0"
(cl-format nil "~1,1,8,' @$" -12.0) " -12.0"
(cl-format nil "~1,1,8,' :$" -12.0) "- 12.0"
(cl-format nil "~1,1,8,' $" -12.0) " -12.0"
(cl-format nil "~1,1$" 0.001) "0.0"
(cl-format nil "~2,1$" 0.001) "0.00"
(cl-format nil "~1,1,6$" 0.001) " 0.0"
(cl-format nil "~1,1,6$" 0.0015) " 0.0"
(cl-format nil "~2,1,6$" 0.005) " 0.01"
(cl-format nil "~2,1,6$" 0.01) " 0.01"
(cl-format nil "~$" 0.099) "0.10"
(cl-format nil "~1$" 0.099) "0.1"
(cl-format nil "~1$" 0.1) "0.1"
(cl-format nil "~1$" 0.99) "1.0"
(cl-format nil "~1$" -0.99) "-1.0")
(simple-tests f-tests
(cl-format nil "~,1f" -12.0) "-12.0"
(cl-format nil "~,0f" 9.4) "9."
(cl-format nil "~,0f" 9.5) "10."
(cl-format nil "~,0f" -0.99) "-1."
(cl-format nil "~,1f" -0.99) "-1.0"
(cl-format nil "~,2f" -0.99) "-0.99"
(cl-format nil "~,3f" -0.99) "-0.990"
(cl-format nil "~,0f" 0.99) "1."
(cl-format nil "~,1f" 0.99) "1.0"
(cl-format nil "~,2f" 0.99) "0.99"
(cl-format nil "~,3f" 0.99) "0.990"
(cl-format nil "~,3f" -0.099) "-0.099"
(cl-format nil "~,4f" -0.099) "-0.0990"
(cl-format nil "~,5f" -0.099) "-0.09900"
(cl-format nil "~,3f" 0.099) "0.099"
(cl-format nil "~,4f" 0.099) "0.0990"
(cl-format nil "~,5f" 0.099) "0.09900"
(cl-format nil "~f" -1) "-1.0"
(cl-format nil "~2f" -1) "-1."
(cl-format nil "~3f" -1) "-1."
(cl-format nil "~4f" -1) "-1.0"
(cl-format nil "~8f" -1) " -1.0"
(cl-format nil "~2f" -0.0099) "-0."
(cl-format nil "~3f" -0.0099) "-0."
(cl-format nil "~4f" -0.0099) "-.01"
(cl-format nil "~5f" -0.0099) "-0.01"
(cl-format nil "~6f" -0.0099) "-.0099"
(cl-format nil "~1f" 0.0099) "0."
(cl-format nil "~2f" 0.0099) "0."
(cl-format nil "~3f" 0.0099) ".01"
(cl-format nil "~4f" 0.0099) "0.01"
(cl-format nil "~5f" 0.0099) ".0099"
(cl-format nil "~6f" 0.0099) "0.0099"
(cl-format nil "~1f" -0.099) "-.1"
(cl-format nil "~2f" -0.099) "-.1"
(cl-format nil "~3f" -0.099) "-.1"
(cl-format nil "~4f" -0.099) "-0.1"
(cl-format nil "~5f" -0.099) "-.099"
(cl-format nil "~6f" -0.099) "-0.099"
(cl-format nil "~1f" 0.099) ".1"
(cl-format nil "~2f" 0.099) ".1"
(cl-format nil "~3f" 0.099) "0.1"
(cl-format nil "~4f" 0.099) ".099"
(cl-format nil "~5f" 0.099) "0.099"
(cl-format nil "~1f" -0.99) "-1."
(cl-format nil "~2f" -0.99) "-1."
(cl-format nil "~3f" -0.99) "-1."
(cl-format nil "~4f" -0.99) "-.99"
(cl-format nil "~5f" -0.99) "-0.99"
(cl-format nil "~1f" 0.99) "1."
(cl-format nil "~2f" 0.99) "1."
(cl-format nil "~3f" 0.99) ".99"
(cl-format nil "~4f" 0.99) "0.99"
(cl-format nil "~1f" 111.11111) "111."
(cl-format nil "~4f" 111.11111) "111."
(cl-format nil "~5f" 111.11111) "111.1"
(cl-format nil "~1f" -111.11111) "-111."
(cl-format nil "~5f" -111.11111) "-111."
(cl-format nil "~6f" -111.11111) "-111.1"
(cl-format nil "~1f" 555.55555) "556."
(cl-format nil "~4f" 555.55555) "556."
(cl-format nil "~5f" 555.55555) "555.6"
(cl-format nil "~8f" 555.55555) "555.5556"
(cl-format nil "~1f" -555.55555) "-556."
(cl-format nil "~5f" -555.55555) "-556."
(cl-format nil "~6f" -555.55555) "-555.6"
(cl-format nil "~8f" -555.55555) "-555.556"
(cl-format nil "~1f" 999.999) "1000."
(cl-format nil "~5f" 999.999) "1000."
(cl-format nil "~6f" 999.999) "1000.0"
(cl-format nil "~7f" 999.999) "999.999"
(cl-format nil "~8f" 999.999) " 999.999"
(cl-format nil "~1f" -999.999) "-1000."
(cl-format nil "~6f" -999.999) "-1000."
(cl-format nil "~7f" -999.999) "-1000.0"
(cl-format nil "~8f" -999.999) "-999.999"
(cl-format nil "~5,2f" 111.11111) "111.11"
(cl-format nil "~3,1f" -0.0099) "-.0"
(cl-format nil "~6,4f" -0.0099) "-.0099"
(cl-format nil "~6,5f" -0.0099) "-.00990"
(cl-format nil "~6,6f" -0.0099) "-.009900"
(cl-format nil "~6,4f" 0.0099) "0.0099"
(cl-format nil "~6,5f" 0.0099) ".00990"
(cl-format nil "~6,6f" 0.0099) ".009900"
(cl-format nil "~2,1f" 0.0099) ".0"
(cl-format nil "~6,2f" -111.11111) "-111.11"
(cl-format nil "~6,3f" -111.11111) "-111.111"
(cl-format nil "~8,5f" -111.11111) "-111.11111"
(cl-format nil "~12,10f" 1.23456789014) "1.2345678901"
(cl-format nil "~12,10f" 1.23456789016) "1.2345678902"
(cl-format nil "~13,10f" -1.23456789014) "-1.2345678901"
(cl-format nil "~13,10f" -1.23456789016) "-1.2345678902"
(cl-format nil "~1,1f" 0.1) ".1")
(simple-tests ampersand-tests
(cl-format nil "The quick brown ~a jumped over ~d lazy dogs" 'elephant 5)
"The quick brown elephant jumped over 5 lazy dogs"
(cl-format nil "The quick brown ~&~a jumped over ~d lazy dogs" 'elephant 5)
"The quick brown \nelephant jumped over 5 lazy dogs"
(cl-format nil (platform-newlines "The quick brown ~&~a jumped\n~& over ~d lazy dogs") 'elephant 5)
"The quick brown \nelephant jumped\n over 5 lazy dogs"
(cl-format nil (platform-newlines "~&The quick brown ~&~a jumped\n~& over ~d lazy dogs") 'elephant 5)
"The quick brown \nelephant jumped\n over 5 lazy dogs"
(cl-format nil (platform-newlines "~3&The quick brown ~&~a jumped\n~& over ~d lazy dogs") 'elephant 5)
"\n\nThe quick brown \nelephant jumped\n over 5 lazy dogs"
(cl-format nil "~@{~&The quick brown ~a jumped over ~d lazy dogs~}" 'elephant 5 'fox 10)
"The quick brown elephant jumped over 5 lazy dogs\nThe quick brown fox jumped over 10 lazy dogs"
(cl-format nil "I ~[don't ~:;d~&o ~]have one~%" 0) "I don't have one\n"
(cl-format nil "I ~[don't ~:;d~&o ~]have one~%" 1) "I d\no have one\n")
(simple-tests t-tests
(cl-format nil "~@{~&~A~8,4T~:*~A~}"
'a 'aa 'aaa 'aaaa 'aaaaa 'aaaaaa 'aaaaaaa 'aaaaaaaa 'aaaaaaaaa 'aaaaaaaaaa)
"a a\naa aa\naaa aaa\naaaa aaaa\naaaaa aaaaa\naaaaaa aaaaaa\naaaaaaa aaaaaaa\naaaaaaaa aaaaaaaa\naaaaaaaaa aaaaaaaaa\naaaaaaaaaa aaaaaaaaaa"
(cl-format nil "~@{~&~A~,4T~:*~A~}"
'a 'aa 'aaa 'aaaa 'aaaaa 'aaaaaa 'aaaaaaa 'aaaaaaaa 'aaaaaaaaa 'aaaaaaaaaa)
"a a\naa aa\naaa aaa\naaaa aaaa\naaaaa aaaaa\naaaaaa aaaaaa\naaaaaaa aaaaaaa\naaaaaaaa aaaaaaaa\naaaaaaaaa aaaaaaaaa\naaaaaaaaaa aaaaaaaaaa"
(cl-format nil "~@{~&~A~2,6@T~:*~A~}" 'a 'aa 'aaa 'aaaa 'aaaaa 'aaaaaa 'aaaaaaa 'aaaaaaaa 'aaaaaaaaa 'aaaaaaaaaa)
"a a\naa aa\naaa aaa\naaaa aaaa\naaaaa aaaaa\naaaaaa aaaaaa\naaaaaaa aaaaaaa\naaaaaaaa aaaaaaaa\naaaaaaaaa aaaaaaaaa\naaaaaaaaaa aaaaaaaaaa"
)
(simple-tests paren-tests
(cl-format nil "~(PLEASE SPEAK QUIETLY IN HERE~)") "please speak quietly in here"
(cl-format nil "~@(PLEASE SPEAK QUIETLY IN HERE~)") "Please speak quietly in here"
(cl-format nil "~@:(but this Is imporTant~)") "BUT THIS IS IMPORTANT"
(cl-format nil "~:(the greAt gatsby~)!") "The Great Gatsby!"
;; Test cases from CLtL 18.3 - string-upcase, et al.
(cl-format nil "~@:(~A~)" "Dr. Livingstone, I presume?") "DR. LIVINGSTONE, I PRESUME?"
(cl-format nil "~(~A~)" "Dr. Livingstone, I presume?") "dr. livingstone, i presume?"
(cl-format nil "~:(~A~)" " hello ") " Hello "
(cl-format nil "~:(~A~)" "occlUDeD cASEmenTs FOreSTAll iNADVertent DEFenestraTION")
"Occluded Casements Forestall Inadvertent Defenestration"
(cl-format nil "~:(~A~)" 'kludgy-hash-search) "Kludgy-Hash-Search"
(cl-format nil "~:(~A~)" "DON'T!") "Don'T!" ;not "Don't!"
(cl-format nil "~:(~A~)" "pipe 13a, foo16c") "Pipe 13a, Foo16c"
(cl-format nil "~:(~A~)" nil) "Nil"
(cl-format nil "~:(~A~)" "") ""
)
(simple-tests square-bracket-tests
;; Tests for format without modifiers
(cl-format nil "I ~[don't ~]have one~%" 0) "I don't have one\n"
(cl-format nil "I ~[don't ~]have one~%" 1) "I have one\n"
(cl-format nil "I ~[don't ~;do ~]have one~%" 0) "I don't have one\n"
(cl-format nil "I ~[don't ~;do ~]have one~%" 1) "I do have one\n"
(cl-format nil "I ~[don't ~;do ~]have one~%" 2) "I have one\n"
(cl-format nil "I ~[don't ~:;do ~]have one~%" 0) "I don't have one\n"
(cl-format nil "I ~[don't ~:;do ~]have one~%" 1) "I do have one\n"
(cl-format nil "I ~[don't ~:;do ~]have one~%" 2) "I do have one\n"
(cl-format nil "I ~[don't ~:;do ~]have one~%" 700) "I do have one\n"
;; Tests for format with a colon
(cl-format nil "I ~:[don't ~;do ~]have one~%" true) "I do have one\n"
(cl-format nil "I ~:[don't ~;do ~]have one~%" 700) "I do have one\n"
(cl-format nil "I ~:[don't ~;do ~]have one~%" '(a b)) "I do have one\n"
(cl-format nil "I ~:[don't ~;do ~]have one~%" nil) "I don't have one\n"
(cl-format nil "I ~:[don't ~;do ~]have one~%" false) "I don't have one\n"
;; Tests for format with an at sign
(cl-format nil "We had ~D wins~@[ (out of ~D tries)~].~%" 15 nil) "We had 15 wins.\n"
(cl-format nil "We had ~D wins~@[ (out of ~D tries)~].~%" 15 17)
"We had 15 wins (out of 17 tries).\n"
;; Format tests with directives
(cl-format nil "Max ~D: ~[Blue team ~D~;Red team ~D~:;No team ~A~].~%" 15, 0, 7)
"Max 15: Blue team 7.\n"
(cl-format nil "Max ~D: ~[Blue team ~D~;Red team ~D~:;No team ~A~].~%" 15, 1, 12)
"Max 15: Red team 12.\n"
(cl-format nil "Max ~D: ~[Blue team ~D~;Red team ~D~:;No team ~A~].~%"
15, -1, "(system failure)")
"Max 15: No team (system failure).\n"
;; Nested format tests
(cl-format nil "Max ~D: ~[Blue team ~D~:[~; (complete success)~]~;Red team ~D~:;No team ~].~%"
15, 0, 7, true)
"Max 15: Blue team 7 (complete success).\n"
(cl-format nil "Max ~D: ~[Blue team ~D~:[~; (complete success)~]~;Red team ~D~:;No team ~].~%"
15, 0, 7, false)
"Max 15: Blue team 7.\n"
;; Test the selector as part of the argument
(cl-format nil "The answer is ~#[nothing~;~D~;~D out of ~D~:;something crazy~].")
"The answer is nothing."
(cl-format nil "The answer is ~#[nothing~;~D~;~D out of ~D~:;something crazy~]." 4)
"The answer is 4."
(cl-format nil "The answer is ~#[nothing~;~D~;~D out of ~D~:;something crazy~]." 7 22)
"The answer is 7 out of 22."
(cl-format nil "The answer is ~#[nothing~;~D~;~D out of ~D~:;something crazy~]." 1 2 3 4)
"The answer is something crazy."
)
(simple-tests curly-brace-plain-tests
;; Iteration from sublist
(cl-format nil "Coordinates are~{ [~D,~D]~}~%" [ 0, 1, 1, 0, 3, 5, 2, 1 ])
"Coordinates are [0,1] [1,0] [3,5] [2,1]\n"
(cl-format nil "Coordinates are~2{ [~D,~D]~}~%" [ 0, 1, 1, 0, 3, 5, 2, 1 ])
"Coordinates are [0,1] [1,0]\n"
(cl-format nil "Coordinates are~{ ~#[none~;<~D>~:;[~D,~D]~]~}~%" [ ])
"Coordinates are\n"
(cl-format nil "Coordinates are~{ ~#[none~;<~D>~:;[~D,~D]~]~:}~%" [ ])
"Coordinates are none\n"
(cl-format nil "Coordinates are~{ ~#[none~;<~D>~:;[~D,~D]~]~:}~%" [2 3 1])
"Coordinates are [2,3] <1>\n"
(cl-format nil "Coordinates are~{~:}~%" "" [])
"Coordinates are\n"
(cl-format nil "Coordinates are~{~:}~%" " ~#[none~;<~D>~:;[~D,~D]~]" [2 3 1])
"Coordinates are [2,3] <1>\n"
(cl-format nil "Coordinates are~{~:}~%" " ~#[none~;<~D>~:;[~D,~D]~]" [ ])
"Coordinates are none\n"
)
(simple-tests curly-brace-colon-tests
;; Iteration from list of sublists
(cl-format nil "Coordinates are~:{ [~D,~D]~}~%" [ [0, 1], [1, 0], [3, 5], [2, 1] ])
"Coordinates are [0,1] [1,0] [3,5] [2,1]\n"
(cl-format nil "Coordinates are~:{ [~D,~D]~}~%" [ [0, 1, 0], [1, 0, 12], [3, 5], [2, 1] ])
"Coordinates are [0,1] [1,0] [3,5] [2,1]\n"
(cl-format nil "Coordinates are~2:{ [~D,~D]~}~%" [ [0, 1], [1, 0], [3, 5], [2, 1] ])
"Coordinates are [0,1] [1,0]\n"
(cl-format nil "Coordinates are~:{ ~#[none~;<~D>~:;[~D,~D]~]~}~%" [ ])
"Coordinates are\n"
(cl-format nil "Coordinates are~:{ ~#[none~;<~D>~:;[~D,~D]~]~:}~%" [ ])
"Coordinates are none\n"
(cl-format nil "Coordinates are~:{ ~#[none~;<~D>~:;[~D,~D]~]~:}~%" [[2 3] [1]])
"Coordinates are [2,3] <1>\n"
(cl-format nil "Coordinates are~:{~:}~%" "" [])
"Coordinates are\n"
(cl-format nil "Coordinates are~:{~:}~%" " ~#[none~;<~D>~:;[~D,~D]~]" [[2 3] [1]])
"Coordinates are [2,3] <1>\n"
(cl-format nil "Coordinates are~:{~:}~%" " ~#[none~;<~D>~:;[~D,~D]~]" [ ])
"Coordinates are none\n"
)
(simple-tests curly-brace-at-tests
;; Iteration from main list
(cl-format nil "Coordinates are~@{ [~D,~D]~}~%" 0, 1, 1, 0, 3, 5, 2, 1)
"Coordinates are [0,1] [1,0] [3,5] [2,1]\n"
(cl-format nil "Coordinates are~2@{ [~D,~D]~}~%" 0, 1, 1, 0, 3, 5, 2, 1)
"Coordinates are [0,1] [1,0]\n"
(cl-format nil "Coordinates are~@{ ~#[none~;<~D>~:;[~D,~D]~]~}~%")
"Coordinates are\n"
(cl-format nil "Coordinates are~@{ ~#[none~;<~D>~:;[~D,~D]~]~:}~%")
"Coordinates are none\n"
(cl-format nil "Coordinates are~@{ ~#[none~;<~D>~:;[~D,~D]~]~:}~%" 2 3 1)
"Coordinates are [2,3] <1>\n"
(cl-format nil "Coordinates are~@{~:}~%" "")
"Coordinates are\n"
(cl-format nil "Coordinates are~@{~:}~%" " ~#[none~;<~D>~:;[~D,~D]~]" 2 3 1)
"Coordinates are [2,3] <1>\n"
(cl-format nil "Coordinates are~@{~:}~%" " ~#[none~;<~D>~:;[~D,~D]~]")
"Coordinates are none\n"
)
(simple-tests curly-brace-colon-at-tests
;; Iteration from sublists on the main arg list
(cl-format nil "Coordinates are~@:{ [~D,~D]~}~%" [0, 1], [1, 0], [3, 5], [2, 1] )
"Coordinates are [0,1] [1,0] [3,5] [2,1]\n"
(cl-format nil "Coordinates are~@:{ [~D,~D]~}~%" [0, 1, 0], [1, 0, 12], [3, 5], [2, 1] )
"Coordinates are [0,1] [1,0] [3,5] [2,1]\n"
(cl-format nil "Coordinates are~2@:{ [~D,~D]~}~%" [0, 1], [1, 0], [3, 5], [2, 1])
"Coordinates are [0,1] [1,0]\n"
(cl-format nil "Coordinates are~@:{ ~#[none~;<~D>~:;[~D,~D]~]~}~%")
"Coordinates are\n"
(cl-format nil "Coordinates are~@:{ ~#[none~;<~D>~:;[~D,~D]~]~:}~%")
"Coordinates are none\n"
(cl-format nil "Coordinates are~@:{ ~#[none~;<~D>~:;[~D,~D]~]~:}~%" [2 3] [1])
"Coordinates are [2,3] <1>\n"
(cl-format nil "Coordinates are~@:{~:}~%" "")
"Coordinates are\n"
(cl-format nil "Coordinates are~@:{~:}~%" " ~#[none~;<~D>~:;[~D,~D]~]" [2 3] [1])
"Coordinates are [2,3] <1>\n"
(cl-format nil "Coordinates are~@:{~:}~%" " ~#[none~;<~D>~:;[~D,~D]~]")
"Coordinates are none\n"
)
;; TODO tests for ~^ in ~[ constructs and other brackets
;; TODO test ~:^ generates an error when used improperly
;; TODO test ~:^ works in ~@:{...~}
(let [aseq '(a quick brown fox jumped over the lazy dog)
lseq (mapcat identity (for [x aseq] [x (.length (name x))]))]
(simple-tests up-tests
(cl-format nil "~{~a~^, ~}" aseq) "a, quick, brown, fox, jumped, over, the, lazy, dog"
(cl-format nil "~{~a~0^, ~}" aseq) "a"
(cl-format nil "~{~a~#,3^, ~}" aseq) "a, quick, brown, fox, jumped, over"
(cl-format nil "~{~a~v,3^, ~}" lseq) "a, quick, brown, fox"
(cl-format nil "~{~a~3,v,4^, ~}" lseq) "a, quick, brown, fox"
))
(simple-tests angle-bracket-tests
(cl-format nil "~") "foobarbaz"
(cl-format nil "~20") "foo bar baz"
(cl-format nil "~,,2") "foo bar baz"
(cl-format nil "~20<~A~;~A~;~A~>" "foo" "bar" "baz") "foo bar baz"
(cl-format nil "~20:<~A~;~A~;~A~>" "foo" "bar" "baz") " foo bar baz"
(cl-format nil "~20@<~A~;~A~;~A~>" "foo" "bar" "baz") "foo bar baz "
(cl-format nil "~20@:<~A~;~A~;~A~>" "foo" "bar" "baz") " foo bar baz "
(cl-format nil "~10,,2<~A~;~A~;~A~>" "foo" "bar" "baz") "foo bar baz"
(cl-format nil "~10,10,2<~A~;~A~;~A~>" "foo" "bar" "baz") "foo bar baz"
(cl-format nil "~10,10<~A~;~A~;~A~>" "foo" "bar" "baz") "foo barbaz"
(cl-format nil "~20<~A~;~^~A~;~^~A~>" "foo" "bar" "baz") "foo bar baz"
(cl-format nil "~20<~A~;~^~A~;~^~A~>" "foo" "bar") "foo bar"
(cl-format nil "~20@<~A~;~^~A~;~^~A~>" "foo") "foo "
(cl-format nil "~20:<~A~;~^~A~;~^~A~>" "foo") " foo"
)
(simple-tests angle-bracket-max-column-tests
(cl-format nil "~%;; ~{~<~%;; ~1,50:; ~A~>~}.~%" (into [] (.split "This function computes the circular thermodynamic coefficient of the thrombulator angle for use in determining the reaction distance" "\\s")))
"\n;; This function computes the circular\n;; thermodynamic coefficient of the thrombulator\n;; angle for use in determining the reaction\n;; distance.\n"
(cl-format true "~%;; ~{~<~%;; ~:; ~A~>~}.~%" (into [] (.split "This function computes the circular thermodynamic coefficient of the thrombulator angle for use in determining the reaction distance." "\\s"))))
(defn list-to-table [aseq column-width]
(let [stream (get-pretty-writer (java.io.StringWriter.))]
(binding [*out* stream]
(doseq [row aseq]
(doseq [col row]
(cl-format true "~4D~7,vT" col column-width))
(prn)))
(.flush stream)
(.toString (:base @@(:base @@stream)))))
(simple-tests column-writer-test
(list-to-table (map #(vector % (* % %) (* % % %)) (range 1 21)) 8)
" 1 1 1 \n 2 4 8 \n 3 9 27 \n 4 16 64 \n 5 25 125 \n 6 36 216 \n 7 49 343 \n 8 64 512 \n 9 81 729 \n 10 100 1000 \n 11 121 1331 \n 12 144 1728 \n 13 169 2197 \n 14 196 2744 \n 15 225 3375 \n 16 256 4096 \n 17 289 4913 \n 18 324 5832 \n 19 361 6859 \n 20 400 8000 \n")
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; The following tests are the various examples from the format
;; documentation in Common Lisp, the Language, 2nd edition, Chapter 22.3
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(defn expt [base pow] (reduce * (repeat pow base)))
(let [x 5, y "elephant", n 3]
(simple-tests cltl-intro-tests
(format nil "foo") "foo"
(format nil "The answer is ~D." x) "The answer is 5."
(format nil "The answer is ~3D." x) "The answer is 5."
(format nil "The answer is ~3,'0D." x) "The answer is 005."
(format nil "The answer is ~:D." (expt 47 x)) "The answer is 229,345,007."
(format nil "Look at the ~A!" y) "Look at the elephant!"
(format nil "Type ~:C to ~A." (char 4) "delete all your files")
"Type Control-D to delete all your files."
(format nil "~D item~:P found." n) "3 items found."
(format nil "~R dog~:[s are~; is~] here." n (= n 1)) "three dogs are here."
(format nil "~R dog~:*~[s are~; is~:;s are~] here." n) "three dogs are here."
(format nil "Here ~[are~;is~:;are~] ~:*~R pupp~:@P." n) "Here are three puppies."))
(simple-tests cltl-B-tests
;; CLtL didn't have the colons here, but the spec requires them
(format nil "~,,' ,4:B" 0xFACE) "1111 1010 1100 1110"
(format nil "~,,' ,4:B" 0x1CE) "1 1100 1110"
(format nil "~19,,' ,4:B" 0xFACE) "1111 1010 1100 1110"
;; This one was a nice idea, but nothing in the spec supports it working this way
;; (and SBCL doesn't work this way either)
;(format nil "~19,,' ,4:B" 0x1CE) "0000 0001 1100 1110")
)
(simple-tests cltl-P-tests
(format nil "~D tr~:@P/~D win~:P" 7 1) "7 tries/1 win"
(format nil "~D tr~:@P/~D win~:P" 1 0) "1 try/0 wins"
(format nil "~D tr~:@P/~D win~:P" 1 3) "1 try/3 wins")
(defn foo [x]
(format nil "~6,2F|~6,2,1,'*F|~6,2,,'?F|~6F|~,2F|~F"
x x x x x x))
;; big-pos-ratio is a ratio value that is larger than
;; Double/MAX_VALUE, and has a non-terminating decimal representation
;; if you attempt to represent it exactly.
(def big-pos-ratio (/ (* 4 (bigint (. BigDecimal valueOf Double/MAX_VALUE))) 3))
(def big-neg-ratio (- big-pos-ratio))
;; tiny-pos-ratio is a ratio between 0 and Double/MIN_VALUE.
(def tiny-pos-ratio (/ 1 (bigint (apply str (cons "1" (repeat 340 "0"))))))
(def tiny-neg-ratio (- tiny-pos-ratio))
(simple-tests cltl-F-tests
(cl-format false "~10,3f" 4/5) " 0.800"
(binding [*math-context* java.math.MathContext/DECIMAL128]
(cl-format false "~10,3f" big-pos-ratio)) "239692417981642093333333333333333300000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000.000"
(binding [*math-context* java.math.MathContext/DECIMAL128]
(cl-format false "~10,3f" big-neg-ratio)) "-239692417981642093333333333333333300000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000.000"
(binding [*math-context* java.math.MathContext/DECIMAL128]
(cl-format false "~10,3f" tiny-pos-ratio)) " 0.000"
(binding [*math-context* java.math.MathContext/DECIMAL128]
(cl-format false "~10,3f" tiny-neg-ratio)) " -0.000"
(foo 3.14159) " 3.14| 31.42| 3.14|3.1416|3.14|3.14159"
(foo 314159/100000)
" 3.14| 31.42| 3.14|3.1416|3.14|3.14159"
(foo -3.14159) " -3.14|-31.42| -3.14|-3.142|-3.14|-3.14159"
(foo 100.0) "100.00|******|100.00| 100.0|100.00|100.0"
(foo 1234.0) "1234.00|******|??????|1234.0|1234.00|1234.0"
(foo 0.006) " 0.01| 0.06| 0.01| 0.006|0.01|0.006")
(defn foo-e [x]
(format nil
"~9,2,1,,'*E|~10,3,2,2,'?,,'$E|~9,3,2,-2,'%@E|~9,2E"
x x x x))
;; Clojure doesn't support float/double differences in representation
(simple-tests cltl-E-tests
(cl-format false "~10,3e" 4/5) " 8.000E-1"
(binding [*math-context* java.math.MathContext/DECIMAL128]
(cl-format false "~10,3e" big-pos-ratio)) "2.397E+308"
(binding [*math-context* java.math.MathContext/DECIMAL128]
(cl-format false "~10,3e" big-neg-ratio)) "-2.397E+308"
(binding [*math-context* java.math.MathContext/DECIMAL128]
(cl-format false "~10,3e" tiny-pos-ratio)) "1.000E-340"
(binding [*math-context* java.math.MathContext/DECIMAL128]
(cl-format false "~10,3e" tiny-neg-ratio)) "-1.000E-340"
(foo-e 0.0314159) " 3.14E-2| 31.42$-03|+.003E+01| 3.14E-2" ; Added this one
(foo-e 314159/10000000)
" 3.14E-2| 31.42$-03|+.003E+01| 3.14E-2"
(foo-e 3.14159) " 3.14E+0| 31.42$-01|+.003E+03| 3.14E+0"
(foo-e -3.14159) " -3.14E+0|-31.42$-01|-.003E+03| -3.14E+0"
(foo-e 1100.0) " 1.10E+3| 11.00$+02|+.001E+06| 1.10E+3"
; In Clojure, this is identical to the above
; (foo-e 1100.0L0) " 1.10L+3| 11.00$+02|+.001L+06| 1.10L+3"
(foo-e 1.1E13) "*********| 11.00$+12|+.001E+16| 1.10E+13"
(foo-e 1.1E120) "*********|??????????|%%%%%%%%%|1.10E+120"
; Clojure doesn't support real numbers this large
; (foo-e 1.1L1200) "*********|??????????|%%%%%%%%%|1.10L+1200"
)
(simple-tests cltl-E-scale-tests
(map
(fn [k] (format nil "Scale factor ~2D~:*: |~13,6,2,VE|"
(- k 5) 3.14159)) ;Prints 13 lines
(range 13))
'("Scale factor -5: | 0.000003E+06|"
"Scale factor -4: | 0.000031E+05|"
"Scale factor -3: | 0.000314E+04|"
"Scale factor -2: | 0.003142E+03|"
"Scale factor -1: | 0.031416E+02|"
"Scale factor 0: | 0.314159E+01|"
"Scale factor 1: | 3.141590E+00|"
"Scale factor 2: | 31.41590E-01|"
"Scale factor 3: | 314.1590E-02|"
"Scale factor 4: | 3141.590E-03|"
"Scale factor 5: | 31415.90E-04|"
"Scale factor 6: | 314159.0E-05|"
"Scale factor 7: | 3141590.E-06|"))
(defn foo-g [x]
(format nil
"~9,2,1,,'*G|~9,3,2,3,'?,,'$G|~9,3,2,0,'%G|~9,2G"
x x x x))
;; Clojure doesn't support float/double differences in representation
(simple-tests cltl-G-tests
(cl-format false "~10,3g" 4/5) " 0.800 "
(binding [*math-context* java.math.MathContext/DECIMAL128]
(cl-format false "~10,3g" big-pos-ratio)) "2.397E+308"
(binding [*math-context* java.math.MathContext/DECIMAL128]
(cl-format false "~10,3g" big-neg-ratio)) "-2.397E+308"
(binding [*math-context* java.math.MathContext/DECIMAL128]
(cl-format false "~10,3g" tiny-pos-ratio)) "1.000E-340"
(binding [*math-context* java.math.MathContext/DECIMAL128]
(cl-format false "~10,3g" tiny-neg-ratio)) "-1.000E-340"
(foo-g 0.0314159) " 3.14E-2|314.2$-04|0.314E-01| 3.14E-2"
(foo-g 314159/10000000)
" 3.14E-2|314.2$-04|0.314E-01| 3.14E-2"
(foo-g 0.314159) " 0.31 |0.314 |0.314 | 0.31 "
(foo-g 3.14159) " 3.1 | 3.14 | 3.14 | 3.1 "
(foo-g 31.4159) " 31. | 31.4 | 31.4 | 31. "
(foo-g 314.159) " 3.14E+2| 314. | 314. | 3.14E+2"
(foo-g 3141.59) " 3.14E+3|314.2$+01|0.314E+04| 3.14E+3"
; In Clojure, this is identical to the above
; (foo-g 3141.59L0) " 3.14L+3|314.2$+01|0.314L+04| 3.14L+3"
(foo-g 3.14E12) "*********|314.0$+10|0.314E+13| 3.14E+12"
(foo-g 3.14E120) "*********|?????????|%%%%%%%%%|3.14E+120"
; Clojure doesn't support real numbers this large
; (foo-g 3.14L1200) "*********|?????????|%%%%%%%%%|3.14L+1200"
)
(defn type-clash-error [fun nargs argnum right-type wrong-type]
(format nil ;; CLtL has this format string slightly wrong
"~&Function ~S requires its ~:[~:R ~;~*~]~
argument to be of type ~S,~%but it was called ~
with an argument of type ~S.~%"
fun (= nargs 1) argnum right-type wrong-type))
(simple-tests cltl-Newline-tests
(type-clash-error 'aref nil 2 'integer 'vector)
"Function aref requires its second argument to be of type integer,
but it was called with an argument of type vector.\n"
(type-clash-error 'car 1 1 'list 'short-float)
"Function car requires its argument to be of type list,
but it was called with an argument of type short-float.\n")
(simple-tests cltl-?-tests
(format nil "~? ~D" "<~A ~D>" '("Foo" 5) 7) " 7"
(format nil "~? ~D" "<~A ~D>" '("Foo" 5 14) 7) " 7"
(format nil "~@? ~D" "<~A ~D>" "Foo" 5 7) " 7"
(format nil "~@? ~D" "<~A ~D>" "Foo" 5 14 7) " 14")
(defn f [n] (format nil "~@(~R~) error~:P detected." n))
(simple-tests cltl-paren-tests
(format nil "~@R ~(~@R~)" 14 14) "XIV xiv"
(f 0) "Zero errors detected."
(f 1) "One error detected."
(f 23) "Twenty-three errors detected.")
(let [*print-level* nil *print-length* 5]
(simple-tests cltl-bracket-tests
(format nil "~@[ print level = ~D~]~@[ print length = ~D~]"
*print-level* *print-length*)
" print length = 5"))
(let [foo "Items:~#[ none~; ~S~; ~S and ~S~
~:;~@{~#[~; and~] ~
~S~^,~}~]."]
(simple-tests cltl-bracket1-tests
(format nil foo) "Items: none."
(format nil foo 'foo) "Items: foo."
(format nil foo 'foo 'bar) "Items: foo and bar."
(format nil foo 'foo 'bar 'baz) "Items: foo, bar, and baz."
(format nil foo 'foo 'bar 'baz 'quux) "Items: foo, bar, baz, and quux."))
(simple-tests cltl-curly-bracket-tests
(format nil
"The winners are:~{ ~S~}."
'(fred harry jill))
"The winners are: fred harry jill."
(format nil "Pairs:~{ <~S,~S>~}." '(a 1 b 2 c 3))
"Pairs: ."
(format nil "Pairs:~:{ <~S,~S>~}." '((a 1) (b 2) (c 3)))
"Pairs: ."
(format nil "Pairs:~@{ <~S,~S>~}." 'a 1 'b 2 'c 3)
"Pairs: ."
(format nil "Pairs:~:@{ <~S,~S>~}." '(a 1) '(b 2) '(c 3))
"Pairs: .")
(simple-tests cltl-angle-bracket-tests
(format nil "~10") "foo bar"
(format nil "~10:") " foo bar"
(format nil "~10:@") " foo bar "
(format nil "~10") " foobar"
(format nil "~10:") " foobar"
(format nil "~10@") "foobar "
(format nil "~10:@") " foobar ")
(let [donestr "Done.~^ ~D warning~:P.~^ ~D error~:P."
tellstr "~@{~@(~@[~R~^ ~]~A~)~}."] ;; The CLtL example is a little wrong here
(simple-tests cltl-up-tests
(format nil donestr) "Done."
(format nil donestr 3) "Done. 3 warnings."
(format nil donestr 1 5) "Done. 1 warning. 5 errors."
(format nil tellstr 23) "Twenty-three."
(format nil tellstr nil "losers") "Losers."
(format nil tellstr 23 "losers") "Twenty-three losers."
(format nil "~15<~S~;~^~S~;~^~S~>" 'foo)
" foo"
(format nil "~15<~S~;~^~S~;~^~S~>" 'foo 'bar)
"foo bar"
(format nil "~15<~S~;~^~S~;~^~S~>" 'foo 'bar 'baz)
"foo bar baz"))
(simple-tests cltl-up-x3j13-tests
(format nil
"~:{/~S~^ ...~}"
'((hot dog) (hamburger) (ice cream) (french fries)))
"/hot .../hamburger/ice .../french ..."
(format nil
"~:{/~S~:^ ...~}"
'((hot dog) (hamburger) (ice cream) (french fries)))
"/hot .../hamburger .../ice .../french"
(format nil
"~:{/~S~#:^ ...~}" ;; This is wrong in CLtL
'((hot dog) (hamburger) (ice cream) (french fries)))
"/hot .../hamburger")
(simple-tests pprint-table-tests
(with-out-str
(print-table [:b :a]
[{:a 1 :b {:a 'is-a} :c ["hi" "there"]}
{:b 5 :a 7 :c "dog" :d -700}]))
"
| :b | :a |
|-----------+----|
| {:a is-a} | 1 |
| 5 | 7 |
"
(with-out-str
(print-table [:a :e :d :c]
[{:a 54.7e17 :b {:a 'is-a} :c ["hi" "there"]}
{:b 5 :a -2/3 :c "dog" :d 'panda}]))
"
| :a | :e | :d | :c |
|---------+----+-------+----------------|
| 5.47E18 | | | [\"hi\" \"there\"] |
| -2/3 | | panda | dog |
"
)
clojure1.6_1.6.0+dfsg.orig/test/clojure/test_clojure/pprint/test_helper.clj 0000664 0000000 0000000 00000002233 12346720654 0027027 0 ustar 00root root 0000000 0000000 ;;; test_helper.clj -- part of the pretty printer for Clojure
; 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.
;; Author: Tom Faulhaber
;; April 3, 2009
;; This is just a macro to make my tests a little cleaner
(ns clojure.test-clojure.pprint.test-helper
(:use [clojure.test :only (deftest is)]
[clojure.test-helper :only [platform-newlines]]))
(defn- back-match [x y] (re-matches y x))
(defmacro simple-tests [name & test-pairs]
`(deftest ~name
~@(for [[x y] (partition 2 test-pairs)]
(cond
(instance? java.util.regex.Pattern y)
`(is (#'clojure.test-clojure.pprint.test-helper/back-match ~x ~y))
(instance? java.lang.String y) `(is (= ~x (platform-newlines ~y)))
:else `(is (= ~x ~y))))))
clojure1.6_1.6.0+dfsg.orig/test/clojure/test_clojure/pprint/test_pretty.clj 0000664 0000000 0000000 00000033254 12346720654 0027106 0 ustar 00root root 0000000 0000000 ;;; test_pretty.clj -- part of the pretty printer for Clojure
; 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.
;; Author: Tom Faulhaber
;; April 3, 2009
(in-ns 'clojure.test-clojure.pprint)
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;;
;;; Unit tests for the pretty printer
;;;
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(simple-tests xp-fill-test
(binding [*print-pprint-dispatch* simple-dispatch
*print-right-margin* 38
*print-miser-width* nil]
(cl-format nil "(let ~:<~@{~:<~w ~_~w~:>~^ ~:_~}~:>~_ ...)~%"
'((x 4) (*print-length* nil) (z 2) (list nil))))
"(let ((x 4) (*print-length* nil)\n (z 2) (list nil))\n ...)\n"
(binding [*print-pprint-dispatch* simple-dispatch
*print-right-margin* 22]
(cl-format nil "(let ~:<~@{~:<~w ~_~w~:>~^ ~:_~}~:>~_ ...)~%"
'((x 4) (*print-length* nil) (z 2) (list nil))))
"(let ((x 4)\n (*print-length*\n nil)\n (z 2)\n (list nil))\n ...)\n")
(simple-tests xp-miser-test
(binding [*print-pprint-dispatch* simple-dispatch
*print-right-margin* 10, *print-miser-width* 9]
(cl-format nil "~:" '(first second third)))
"(LIST\n first\n second\n third)"
(binding [*print-pprint-dispatch* simple-dispatch
*print-right-margin* 10, *print-miser-width* 8]
(cl-format nil "~:" '(first second third)))
"(LIST first second third)")
(simple-tests mandatory-fill-test
(cl-format nil
"~%~~%
~%"
[ "hello" "gooodbye" ])
"
Usage: *hello*
*gooodbye*
")
(simple-tests prefix-suffix-test
(binding [*print-pprint-dispatch* simple-dispatch
*print-right-margin* 10, *print-miser-width* 10]
(cl-format nil "~<{~;LIST ~@_~W ~@_~W ~@_~W~;}~:>" '(first second third)))
"{LIST\n first\n second\n third}")
(simple-tests pprint-test
(binding [*print-pprint-dispatch* simple-dispatch]
(write '(defn foo [x y]
(let [result (* x y)]
(if (> result 400)
(cl-format true "That number is too big")
(cl-format true "The result of ~d x ~d is ~d" x y result))))
:stream nil))
"(defn
foo
[x y]
(let
[result (* x y)]
(if
(> result 400)
(cl-format true \"That number is too big\")
(cl-format true \"The result of ~d x ~d is ~d\" x y result))))"
(with-pprint-dispatch code-dispatch
(write '(defn foo [x y]
(let [result (* x y)]
(if (> result 400)
(cl-format true "That number is too big")
(cl-format true "The result of ~d x ~d is ~d" x y result))))
:stream nil))
"(defn foo [x y]
(let [result (* x y)]
(if (> result 400)
(cl-format true \"That number is too big\")
(cl-format true \"The result of ~d x ~d is ~d\" x y result))))"
(binding [*print-pprint-dispatch* simple-dispatch
*print-right-margin* 15]
(write '(fn (cons (car x) (cdr y))) :stream nil))
"(fn\n (cons\n (car x)\n (cdr y)))"
(with-pprint-dispatch code-dispatch
(binding [*print-right-margin* 52]
(write
'(add-to-buffer this (make-buffer-blob (str (char c)) nil))
:stream nil)))
"(add-to-buffer\n this\n (make-buffer-blob (str (char c)) nil))"
)
(simple-tests pprint-reader-macro-test
(with-pprint-dispatch code-dispatch
(write (read-string "(map #(first %) [[1 2 3] [4 5 6] [7]])")
:stream nil))
"(map #(first %) [[1 2 3] [4 5 6] [7]])"
(with-pprint-dispatch code-dispatch
(write (read-string "@@(ref (ref 1))")
:stream nil))
"@@(ref (ref 1))"
(with-pprint-dispatch code-dispatch
(write (read-string "'foo")
:stream nil))
"'foo"
)
(defmacro code-block
"Read a string then print it with code-dispatch and succeed if it comes out the same"
[test-name & blocks]
`(simple-tests ~test-name
~@(apply concat
(for [block blocks]
`[(str/split-lines
(with-out-str
(with-pprint-dispatch code-dispatch
(pprint (read-string ~block)))))
(str/split-lines ~block)]))))
(code-block code-block-tests
"(defn cl-format
\"An implementation of a Common Lisp compatible format function\"
[stream format-in & args]
(let [compiled-format (if (string? format-in)
(compile-format format-in)
format-in)
navigator (init-navigator args)]
(execute-format stream compiled-format navigator)))"
"(defn pprint-defn [writer alis]
(if (next alis)
(let [[defn-sym defn-name & stuff] alis
[doc-str stuff] (if (string? (first stuff))
[(first stuff) (next stuff)]
[nil stuff])
[attr-map stuff] (if (map? (first stuff))
[(first stuff) (next stuff)]
[nil stuff])]
(pprint-logical-block
writer
:prefix
\"(\"
:suffix
\")\"
(cl-format true \"~w ~1I~@_~w\" defn-sym defn-name)
(if doc-str (cl-format true \" ~_~w\" doc-str))
(if attr-map (cl-format true \" ~_~w\" attr-map))
(cond
(vector? (first stuff)) (single-defn
stuff
(or doc-str attr-map))
:else (multi-defn stuff (or doc-str attr-map)))))
(pprint-simple-code-list writer alis)))")
(code-block ns-macro-test
"(ns slam.hound.stitch
(:use [slam.hound.prettify :only [prettify]]))"
"(ns slam.hound.prettify
\"Format a namespace declaration using pretty print with custom dispatch.\"
(:use [clojure.pprint :only [cl-format code-dispatch formatter-out
pprint pprint-logical-block
pprint-newline with-pprint-dispatch
write-out]]))"
"(ns autodoc.build-html
\"This is the namespace that builds the HTML pages themselves.
It is implemented with a number of custom enlive templates.\"
{:skip-wiki true, :author \"Tom Faulhaber\"}
(:refer-clojure :exclude [empty complement])
(:import [java.util.jar JarFile]
[java.io File FileWriter BufferedWriter StringReader
BufferedInputStream BufferedOutputStream
ByteArrayOutputStream FileReader FileInputStream]
[java.util.regex Pattern])
(:require [clojure.string :as str])
(:use [net.cgrand.enlive-html :exclude (deftemplate)]
[clojure.java.io :only (as-file file writer)]
[clojure.java.shell :only (sh)]
[clojure.pprint :only (pprint cl-format pprint-ident
pprint-logical-block set-pprint-dispatch
get-pretty-writer fresh-line)]
[clojure.data.json :only (pprint-json)]
[autodoc.collect-info :only (contrib-info)]
[autodoc.params :only (params expand-classpath)])
(:use clojure.set clojure.java.io clojure.data clojure.java.browse
clojure.inspector clojure.zip clojure.stacktrace))")
(defn tst-pprint
"A helper function to pprint to a string with a restricted right margin"
[right-margin obj]
(binding [*print-right-margin* right-margin
*print-pretty* true]
(write obj :stream nil)))
;;; A bunch of predefined data to print
(def future-filled (future-call (fn [] 100)))
@future-filled
(def future-unfilled (future-call (fn [] (.acquire (java.util.concurrent.Semaphore. 0)))))
(def promise-filled (promise))
(deliver promise-filled '(first second third))
(def promise-unfilled (promise))
(def basic-agent (agent '(first second third)))
(def basic-atom (atom '(first second third)))
(def basic-ref (ref '(first second third)))
(def delay-forced (delay '(first second third)))
(force delay-forced)
(def delay-unforced (delay '(first second third)))
(defrecord pprint-test-rec [a b c])
(simple-tests pprint-datastructures-tests
(tst-pprint 20 future-filled) #"#"
(tst-pprint 20 future-unfilled) #"#"
(tst-pprint 20 promise-filled) #"#"
;; This hangs currently, cause we can't figure out whether a promise is filled
;;(tst-pprint 20 promise-unfilled) #"#"
(tst-pprint 20 basic-agent) #"#"
(tst-pprint 20 basic-atom) #"#"
(tst-pprint 20 basic-ref) #"#"
(tst-pprint 20 delay-forced) #"#"
;; Currently no way not to force the delay
;;(tst-pprint 20 delay-unforced) #"#"
(tst-pprint 20 (pprint-test-rec. 'first 'second 'third)) "{:a first,\n :b second,\n :c third}"
;; basic java arrays: fails owing to assembla ticket #346
;;(tst-pprint 10 (int-array (range 7))) "[0,\n 1,\n 2,\n 3,\n 4,\n 5,\n 6]"
(tst-pprint 15 (reduce conj clojure.lang.PersistentQueue/EMPTY (range 10)))
"<-(0\n 1\n 2\n 3\n 4\n 5\n 6\n 7\n 8\n 9)-<"
)
;;; Some simple tests of dispatch
(defmulti
test-dispatch
"A test dispatch method"
{:added "1.2" :arglists '[[object]]}
#(and (seq %) (not (string? %))))
(defmethod test-dispatch true [avec]
(pprint-logical-block :prefix "[" :suffix "]"
(loop [aseq (seq avec)]
(when aseq
(write-out (first aseq))
(when (next aseq)
(.write ^java.io.Writer *out* " ")
(pprint-newline :linear)
(recur (next aseq)))))))
(defmethod test-dispatch false [aval] (pr aval))
(simple-tests dispatch-tests
(with-pprint-dispatch test-dispatch
(with-out-str
(pprint '("hello" "there"))))
"[\"hello\" \"there\"]\n"
)
(simple-tests print-length-tests
(binding [*print-length* 1] (with-out-str (pprint '(a b c d e f))))
"(a ...)\n"
(binding [*print-length* 2] (with-out-str (pprint '(a b c d e f))))
"(a b ...)\n"
(binding [*print-length* 6] (with-out-str (pprint '(a b c d e f))))
"(a b c d e f)\n"
(binding [*print-length* 8] (with-out-str (pprint '(a b c d e f))))
"(a b c d e f)\n"
(binding [*print-length* 1] (with-out-str (pprint [1 2 3 4 5 6])))
"[1 ...]\n"
(binding [*print-length* 2] (with-out-str (pprint [1 2 3 4 5 6])))
"[1 2 ...]\n"
(binding [*print-length* 6] (with-out-str (pprint [1 2 3 4 5 6])))
"[1 2 3 4 5 6]\n"
(binding [*print-length* 8] (with-out-str (pprint [1 2 3 4 5 6])))
"[1 2 3 4 5 6]\n"
(binding [*print-length* 1] (with-out-str (pprint (sorted-set 1 2 3 4 5 6))))
"#{1 ...}\n"
(binding [*print-length* 2] (with-out-str (pprint (sorted-set 1 2 3 4 5 6))))
"#{1 2 ...}\n"
(binding [*print-length* 6] (with-out-str (pprint (sorted-set 1 2 3 4 5 6))))
"#{1 2 3 4 5 6}\n"
(binding [*print-length* 8] (with-out-str (pprint (sorted-set 1 2 3 4 5 6))))
"#{1 2 3 4 5 6}\n"
(binding [*print-length* 1] (with-out-str (pprint (sorted-map 1 2, 3 4, 5 6, 7 8, 9 10, 11 12))))
"{1 2, ...}\n"
(binding [*print-length* 2] (with-out-str (pprint (sorted-map 1 2, 3 4, 5 6, 7 8, 9 10, 11 12))))
"{1 2, 3 4, ...}\n"
(binding [*print-length* 6] (with-out-str (pprint (sorted-map 1 2, 3 4, 5 6, 7 8, 9 10, 11 12))))
"{1 2, 3 4, 5 6, 7 8, 9 10, 11 12}\n"
(binding [*print-length* 8] (with-out-str (pprint (sorted-map 1 2, 3 4, 5 6, 7 8, 9 10, 11 12))))
"{1 2, 3 4, 5 6, 7 8, 9 10, 11 12}\n"
(binding [*print-length* 1] (with-out-str (pprint (int-array [1 2 3 4 5 6]))))
"[1, ...]\n"
(binding [*print-length* 2] (with-out-str (pprint (int-array [1 2 3 4 5 6]))))
"[1, 2, ...]\n"
(binding [*print-length* 6] (with-out-str (pprint (int-array [1 2 3 4 5 6]))))
"[1, 2, 3, 4, 5, 6]\n"
(binding [*print-length* 8] (with-out-str (pprint (int-array [1 2 3 4 5 6]))))
"[1, 2, 3, 4, 5, 6]\n"
)
(defn- flush-alerting-writer
[o]
(let [flush-count-atom (atom 0)]
[
(proxy [java.io.BufferedWriter] [o]
(flush []
(proxy-super flush)
(swap! flush-count-atom inc)))
flush-count-atom]))
(deftest test-flush-underlying-prn
[]
(let [[out flush-count-atom] (flush-alerting-writer (java.io.StringWriter.))]
(binding [*out* out
*flush-on-newline* true]
(prn (range 50))
(prn (range 50)))
(is (= @flush-count-atom 2) "println flushes on newline")))
(deftest test-flush-underlying-pprint
[]
(let [[out flush-count-atom] (flush-alerting-writer (java.io.StringWriter.))]
(binding [*out* out
*flush-on-newline* true]
(pprint (range 50))
(pprint (range 50)))
(is (= @flush-count-atom 2) "pprint flushes on newline")))
(deftest test-noflush-underlying-prn
[]
(let [[out flush-count-atom] (flush-alerting-writer (java.io.StringWriter.))]
(binding [*out* out
*flush-on-newline* nil]
(prn (range 50))
(prn (range 50)))
(is (= @flush-count-atom 0) "println flushes on newline")))
(deftest test-noflush-underlying-pprint
[]
(let [[out flush-count-atom] (flush-alerting-writer (java.io.StringWriter.))]
(binding [*out* out
*flush-on-newline* nil]
(pprint (range 50))
(pprint (range 50)))
(is (= @flush-count-atom 0) "pprint flushes on newline")))
clojure1.6_1.6.0+dfsg.orig/test/clojure/test_clojure/predicates.clj 0000664 0000000 0000000 00000006166 12346720654 0025331 0 ustar 00root root 0000000 0000000 ; 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.
; Author: Frantisek Sodomka
;;
;; Created 1/28/2009
(ns clojure.test-clojure.predicates
(:use clojure.test))
;; *** Type predicates ***
(def myvar 42)
(def sample-data {
:nil nil
:bool-true true
:bool-false false
:byte (byte 7)
:short (short 7)
:int (int 7)
:long (long 7)
:bigint (bigint 7)
:float (float 7)
:double (double 7)
:bigdec (bigdec 7)
:ratio 2/3
:character \a
:symbol 'abc
:keyword :kw
:empty-string ""
:empty-regex #""
:empty-list ()
:empty-lazy-seq (lazy-seq nil)
:empty-vector []
:empty-map {}
:empty-set #{}
:empty-array (into-array [])
:string "abc"
:regex #"a*b"
:list '(1 2 3)
:lazy-seq (lazy-seq [1 2 3])
:vector [1 2 3]
:map {:a 1 :b 2 :c 3}
:set #{1 2 3}
:array (into-array [1 2 3])
:fn (fn [x] (* 2 x))
:class java.util.Date
:object (new java.util.Date)
:var (var myvar)
:delay (delay (+ 1 2))
})
(def type-preds {
nil? [:nil]
true? [:bool-true]
false? [:bool-false]
; boolean?
integer? [:byte :short :int :long :bigint]
float? [:float :double]
decimal? [:bigdec]
ratio? [:ratio]
rational? [:byte :short :int :long :bigint :ratio :bigdec]
number? [:byte :short :int :long :bigint :ratio :bigdec :float :double]
; character?
symbol? [:symbol]
keyword? [:keyword]
string? [:empty-string :string]
; regex?
list? [:empty-list :list]
vector? [:empty-vector :vector]
map? [:empty-map :map]
set? [:empty-set :set]
coll? [:empty-list :list
:empty-lazy-seq :lazy-seq
:empty-vector :vector
:empty-map :map
:empty-set :set]
seq? [:empty-list :list
:empty-lazy-seq :lazy-seq]
; array?
fn? [:fn]
ifn? [:fn
:empty-vector :vector :empty-map :map :empty-set :set
:keyword :symbol :var]
class? [:class]
var? [:var]
delay? [:delay]
})
;; Test all type predicates against all data types
;;
(defn- get-fn-name [f]
(str
(apply str (nthnext (first (.split (str f) "_"))
(count "clojure.core$")))
"?"))
(deftest test-type-preds
(doseq [tp type-preds]
(doseq [dt sample-data]
(if (some #(= % (first dt)) (second tp))
(is ((first tp) (second dt))
(pr-str (list (get-fn-name (first tp)) (second dt))))
(is (not ((first tp) (second dt)))
(pr-str (list 'not (list (get-fn-name (first tp)) (second dt)))))))))
;; Additional tests:
;; http://groups.google.com/group/clojure/browse_thread/thread/537761a06edb4b06/bfd4f0705b746a38
;;
(deftest test-string?-more
(are [x] (not (string? x))
(new java.lang.StringBuilder "abc")
(new java.lang.StringBuffer "xyz")))
clojure1.6_1.6.0+dfsg.orig/test/clojure/test_clojure/printer.clj 0000664 0000000 0000000 00000006544 12346720654 0024671 0 ustar 00root root 0000000 0000000 ; 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.
; Author: Stephen C. Gilardi
;; clojure.test-clojure.printer
;;
;; scgilardi (gmail)
;; Created 29 October 2008
(ns clojure.test-clojure.printer
(:use clojure.test))
(deftest print-length-empty-seq
(let [coll () val "()"]
(is (= val (binding [*print-length* 0] (print-str coll))))
(is (= val (binding [*print-length* 1] (print-str coll))))))
(deftest print-length-seq
(let [coll (range 5)
length-val '((0 "(...)")
(1 "(0 ...)")
(2 "(0 1 ...)")
(3 "(0 1 2 ...)")
(4 "(0 1 2 3 ...)")
(5 "(0 1 2 3 4)"))]
(doseq [[length val] length-val]
(binding [*print-length* length]
(is (= val (print-str coll)))))))
(deftest print-length-empty-vec
(let [coll [] val "[]"]
(is (= val (binding [*print-length* 0] (print-str coll))))
(is (= val (binding [*print-length* 1] (print-str coll))))))
(deftest print-length-vec
(let [coll [0 1 2 3 4]
length-val '((0 "[...]")
(1 "[0 ...]")
(2 "[0 1 ...]")
(3 "[0 1 2 ...]")
(4 "[0 1 2 3 ...]")
(5 "[0 1 2 3 4]"))]
(doseq [[length val] length-val]
(binding [*print-length* length]
(is (= val (print-str coll)))))))
(deftest print-level-seq
(let [coll '(0 (1 (2 (3 (4)))))
level-val '((0 "#")
(1 "(0 #)")
(2 "(0 (1 #))")
(3 "(0 (1 (2 #)))")
(4 "(0 (1 (2 (3 #))))")
(5 "(0 (1 (2 (3 (4)))))"))]
(doseq [[level val] level-val]
(binding [*print-level* level]
(is (= val (print-str coll)))))))
(deftest print-level-length-coll
(let [coll '(if (member x y) (+ (first x) 3) (foo (a b c d "Baz")))
level-length-val
'((0 1 "#")
(1 1 "(if ...)")
(1 2 "(if # ...)")
(1 3 "(if # # ...)")
(1 4 "(if # # #)")
(2 1 "(if ...)")
(2 2 "(if (member x ...) ...)")
(2 3 "(if (member x y) (+ # 3) ...)")
(3 2 "(if (member x ...) ...)")
(3 3 "(if (member x y) (+ (first x) 3) ...)")
(3 4 "(if (member x y) (+ (first x) 3) (foo (a b c d ...)))")
(3 5 "(if (member x y) (+ (first x) 3) (foo (a b c d Baz)))"))]
(doseq [[level length val] level-length-val]
(binding [*print-level* level
*print-length* length]
(is (= val (print-str coll)))))))
(deftest print-dup-expected
(are [x s] (= s (binding [*print-dup* true] (print-str x)))
1 "1"
1.0 "1.0"
1N "1N"
(java.math.BigInteger. "1") "#=(java.math.BigInteger. \"1\")"
1M "1M"
"hi" "\"hi\""))
(deftest print-dup-readable
(are [form] (let [x form]
(= x (read-string (binding [*print-dup* true] (print-str x)))))
1
1.0
1N
1M
"hi")) clojure1.6_1.6.0+dfsg.orig/test/clojure/test_clojure/protocols.clj 0000664 0000000 0000000 00000073301 12346720654 0025225 0 ustar 00root root 0000000 0000000 ; 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.
; Author: Stuart Halloway
(ns clojure.test-clojure.protocols
(:use clojure.test clojure.test-clojure.protocols.examples)
(:require [clojure.test-clojure.protocols.more-examples :as other]
[clojure.set :as set]
clojure.test-helper)
(:import [clojure.test_clojure.protocols.examples ExampleInterface]))
;; temporary hack until I decide how to cleanly reload protocol
;; this no longer works
(defn reload-example-protocols
[]
(alter-var-root #'clojure.test-clojure.protocols.examples/ExampleProtocol
assoc :impls {})
(alter-var-root #'clojure.test-clojure.protocols.more-examples/SimpleProtocol
assoc :impls {})
(require :reload
'clojure.test-clojure.protocols.examples
'clojure.test-clojure.protocols.more-examples))
(defn method-names
"return sorted list of method names on a class"
[c]
(->> (.getMethods c)
(map #(.getName %))
(sort)))
(defrecord EmptyRecord [])
(defrecord TestRecord [a b])
(defn r
([a b] (TestRecord. a b))
([a b meta ext] (TestRecord. a b meta ext)))
(defrecord MapEntry [k v]
java.util.Map$Entry
(getKey [_] k)
(getValue [_] v))
(deftest protocols-test
(testing "protocol fns have useful metadata"
(let [common-meta {:ns (find-ns 'clojure.test-clojure.protocols.examples)
:protocol #'ExampleProtocol}]
(are [m f] (= (merge (quote m) common-meta)
(meta (var f)))
{:name foo :arglists ([a]) :doc "method with one arg"} foo
{:name bar :arglists ([a b]) :doc "method with two args"} bar
{:name baz :arglists ([a] [a b]) :doc "method with multiple arities" :tag String} baz
{:name with-quux :arglists ([a]) :doc "method name with a hyphen"} with-quux)))
(testing "protocol fns throw IllegalArgumentException if no impl matches"
(is (thrown-with-msg?
IllegalArgumentException
#"No implementation of method: :foo of protocol: #'clojure.test-clojure.protocols.examples/ExampleProtocol found for class: java.lang.Long"
(foo 10))))
(testing "protocols generate a corresponding interface using _ instead of - for method names"
(is (= ["bar" "baz" "baz" "foo" "with_quux"] (method-names clojure.test_clojure.protocols.examples.ExampleProtocol))))
(testing "protocol will work with instances of its interface (use for interop, not in Clojure!)"
(let [obj (proxy [clojure.test_clojure.protocols.examples.ExampleProtocol] []
(foo [] "foo!"))]
(is (= "foo!" (.foo obj)) "call through interface")
(is (= "foo!" (foo obj)) "call through protocol")))
(testing "you can implement just part of a protocol if you want"
(let [obj (reify ExampleProtocol
(baz [a b] "two-arg baz!"))]
(is (= "two-arg baz!" (baz obj nil)))
(is (thrown? AbstractMethodError (baz obj)))))
(testing "error conditions checked when defining protocols"
(is (thrown-with-msg?
Exception
#"Definition of function m in protocol badprotdef must take at least one arg."
(eval '(defprotocol badprotdef (m [])))))
(is (thrown-with-msg?
Exception
#"Function m in protocol badprotdef was redefined. Specify all arities in single definition."
(eval '(defprotocol badprotdef (m [this arg]) (m [this arg1 arg2]))))))
(testing "you can redefine a protocol with different methods"
(eval '(defprotocol Elusive (old-method [x])))
(eval '(defprotocol Elusive (new-method [x])))
(is (= :new-method (eval '(new-method (reify Elusive (new-method [x] :new-method))))))
(is (fails-with-cause? IllegalArgumentException #"No method of interface: .*\.Elusive found for function: old-method of protocol: Elusive \(The protocol method may have been defined before and removed\.\)"
(eval '(old-method (reify Elusive (new-method [x] :new-method))))))))
(deftype HasMarkers []
ExampleProtocol
(foo [this] "foo")
MarkerProtocol
MarkerProtocol2)
(deftype WillGetMarker []
ExampleProtocol
(foo [this] "foo"))
(extend-type WillGetMarker MarkerProtocol)
(deftest marker-tests
(testing "That a marker protocol has no methods"
(is (= '() (method-names clojure.test_clojure.protocols.examples.MarkerProtocol))))
(testing "That types with markers are reportedly satifying them."
(let [hm (HasMarkers.)
wgm (WillGetMarker.)]
(is (satisfies? MarkerProtocol hm))
(is (satisfies? MarkerProtocol2 hm))
(is (satisfies? MarkerProtocol wgm)))))
(deftype ExtendTestWidget [name])
(deftype HasProtocolInline []
ExampleProtocol
(foo [this] :inline))
(deftest extend-test
(testing "you can extend a protocol to a class"
(extend String ExampleProtocol
{:foo identity})
(is (= "pow" (foo "pow"))))
(testing "you can have two methods with the same name. Just use namespaces!"
(extend String other/SimpleProtocol
{:foo (fn [s] (.toUpperCase s))})
(is (= "POW" (other/foo "pow"))))
(testing "you can extend deftype types"
(extend
ExtendTestWidget
ExampleProtocol
{:foo (fn [this] (str "widget " (.name this)))})
(is (= "widget z" (foo (ExtendTestWidget. "z"))))))
(deftest record-marker-interfaces
(testing "record? and type? return expected result for IRecord and IType"
(let [r (TestRecord. 1 2)]
(is (record? r)))))
(deftest illegal-extending
(testing "you cannot extend a protocol to a type that implements the protocol inline"
(is (fails-with-cause? IllegalArgumentException #".*HasProtocolInline already directly implements interface"
(eval '(extend clojure.test_clojure.protocols.HasProtocolInline
clojure.test-clojure.protocols.examples/ExampleProtocol
{:foo (fn [_] :extended)})))))
(testing "you cannot extend to an interface"
(is (fails-with-cause? IllegalArgumentException #"interface clojure.test_clojure.protocols.examples.ExampleProtocol is not a protocol"
(eval '(extend clojure.test_clojure.protocols.HasProtocolInline
clojure.test_clojure.protocols.examples.ExampleProtocol
{:foo (fn [_] :extended)}))))))
(deftype ExtendsTestWidget []
ExampleProtocol)
#_(deftest extends?-test
(reload-example-protocols)
(testing "returns false if a type does not implement the protocol at all"
(is (false? (extends? other/SimpleProtocol ExtendsTestWidget))))
(testing "returns true if a type implements the protocol directly" ;; semantics changed 4/15/2010
(is (true? (extends? ExampleProtocol ExtendsTestWidget))))
(testing "returns true if a type explicitly extends protocol"
(extend
ExtendsTestWidget
other/SimpleProtocol
{:foo identity})
(is (true? (extends? other/SimpleProtocol ExtendsTestWidget)))))
(deftype ExtendersTestWidget [])
#_(deftest extenders-test
(reload-example-protocols)
(testing "a fresh protocol has no extenders"
(is (nil? (extenders ExampleProtocol))))
(testing "extending with no methods doesn't count!"
(deftype Something [])
(extend ::Something ExampleProtocol)
(is (nil? (extenders ExampleProtocol))))
(testing "extending a protocol (and including an impl) adds an entry to extenders"
(extend ExtendersTestWidget ExampleProtocol {:foo identity})
(is (= [ExtendersTestWidget] (extenders ExampleProtocol)))))
(deftype SatisfiesTestWidget []
ExampleProtocol)
#_(deftest satisifies?-test
(reload-example-protocols)
(let [whatzit (SatisfiesTestWidget.)]
(testing "returns false if a type does not implement the protocol at all"
(is (false? (satisfies? other/SimpleProtocol whatzit))))
(testing "returns true if a type implements the protocol directly"
(is (true? (satisfies? ExampleProtocol whatzit))))
(testing "returns true if a type explicitly extends protocol"
(extend
SatisfiesTestWidget
other/SimpleProtocol
{:foo identity})
(is (true? (satisfies? other/SimpleProtocol whatzit))))) )
(deftype ReExtendingTestWidget [])
#_(deftest re-extending-test
(reload-example-protocols)
(extend
ReExtendingTestWidget
ExampleProtocol
{:foo (fn [_] "first foo")
:baz (fn [_] "first baz")})
(testing "if you re-extend, the old implementation is replaced (not merged!)"
(extend
ReExtendingTestWidget
ExampleProtocol
{:baz (fn [_] "second baz")
:bar (fn [_ _] "second bar")})
(let [whatzit (ReExtendingTestWidget.)]
(is (thrown? IllegalArgumentException (foo whatzit)))
(is (= "second bar" (bar whatzit nil)))
(is (= "second baz" (baz whatzit))))))
(defrecord DefrecordObjectMethodsWidgetA [a])
(defrecord DefrecordObjectMethodsWidgetB [a])
(deftest defrecord-object-methods-test
(testing "= depends on fields and type"
(is (true? (= (DefrecordObjectMethodsWidgetA. 1) (DefrecordObjectMethodsWidgetA. 1))))
(is (false? (= (DefrecordObjectMethodsWidgetA. 1) (DefrecordObjectMethodsWidgetA. 2))))
(is (false? (= (DefrecordObjectMethodsWidgetA. 1) (DefrecordObjectMethodsWidgetB. 1))))))
(deftest defrecord-acts-like-a-map
(let [rec (r 1 2)]
(is (.equals (r 1 3 {} {:c 4}) (merge rec {:b 3 :c 4})))
(is (.equals {:foo 1 :b 2} (set/rename-keys rec {:a :foo})))
(is (.equals {:a 11 :b 2 :c 10} (merge-with + rec {:a 10 :c 10})))))
(deftest degenerate-defrecord-test
(let [empty (EmptyRecord.)]
(is (nil? (seq empty)))
(is (not (.containsValue empty :a)))))
(deftest defrecord-interfaces-test
(testing "java.util.Map"
(let [rec (r 1 2)]
(is (= 2 (.size rec)))
(is (= 3 (.size (assoc rec :c 3))))
(is (not (.isEmpty rec)))
(is (.isEmpty (EmptyRecord.)))
(is (.containsKey rec :a))
(is (not (.containsKey rec :c)))
(is (.containsValue rec 1))
(is (not (.containsValue rec 3)))
(is (= 1 (.get rec :a)))
(is (thrown? UnsupportedOperationException (.put rec :a 1)))
(is (thrown? UnsupportedOperationException (.remove rec :a)))
(is (thrown? UnsupportedOperationException (.putAll rec {})))
(is (thrown? UnsupportedOperationException (.clear rec)))
(is (= #{:a :b} (.keySet rec)))
(is (= #{1 2} (set (.values rec))))
(is (= #{[:a 1] [:b 2]} (.entrySet rec)))
))
(testing "IPersistentCollection"
(testing ".cons"
(let [rec (r 1 2)]
(are [x] (= rec (.cons rec x))
nil {})
(is (= (r 1 3) (.cons rec {:b 3})))
(is (= (r 1 4) (.cons rec [:b 4])))
(is (= (r 1 5) (.cons rec (MapEntry. :b 5))))))))
(defrecord RecordWithSpecificFieldNames [this that k m o])
(deftest defrecord-with-specific-field-names
(let [rec (new RecordWithSpecificFieldNames 1 2 3 4 5)]
(is (= rec rec))
(is (= 1 (:this (with-meta rec {:foo :bar}))))
(is (= 3 (get rec :k)))
(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])
(defrecord RecordToTestHugeBasis [a b c d e f g h i j k l m n o p q r s t u v w x y z])
(defrecord TypeToTestBasis [a b c])
(defrecord TypeToTestBasisHinted [^String a ^Long b c])
(deftest test-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 records and types have a sane generated basis method"
(let [rb (clojure.test_clojure.protocols.RecordToTestBasis/getBasis)
rbh (clojure.test_clojure.protocols.RecordToTestBasisHinted/getBasis)
rhg (clojure.test_clojure.protocols.RecordToTestHugeBasis/getBasis)
tb (clojure.test_clojure.protocols.TypeToTestBasis/getBasis)
tbh (clojure.test_clojure.protocols.TypeToTestBasisHinted/getBasis)]
(is (= '[a b c] rb))
(is (= '[a b c] rb))
(is (= '[a b c d e f g h i j k l m n o p q r s t u v w x y z] rhg))
(testing "that record basis hinting looks as we expect"
(is (= (:tag (meta (rbh 0))) 'String))
(is (= (:tag (meta (rbh 1))) 'Long))
(is (nil? (:tag (meta (rbh 2))))))
(testing "that type basis hinting looks as we expect"
(is (= (:tag (meta (tbh 0))) 'String))
(is (= (:tag (meta (tbh 1))) 'Long))
(is (nil? (:tag (meta (tbh 2)))))))))
(defrecord RecordToTestFactories [a b c])
(defrecord RecordToTestHugeFactories [a b c d e f g h i j k l m n o p q r s t u v w x y z])
(deftest test-record-factory-fns
(testing "if the definition of a defrecord generates the appropriate factory functions"
(let [r (RecordToTestFactories. 1 2 3)
r-n (RecordToTestFactories. nil nil nil)
huge (RecordToTestHugeFactories. 1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26)]
(testing "that a record created with the ctor equals one by the positional factory fn"
(is (= r (->RecordToTestFactories 1 2 3)))
(is (= huge (->RecordToTestHugeFactories 1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26))))
(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 factory functions have docstrings"
;; just test non-nil to avoid overspecifiying what's in the docstring
(is (false? (-> ->RecordToTestFactories var meta :doc nil?)))
(is (false? (-> map->RecordToTestFactories var meta :doc nil?))))
(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 {})))))))
(defn compare-huge-types
[hugeL hugeR]
(and
(= (.a hugeL) (.a hugeR))
(= (.b hugeL) (.b hugeR))
(= (.c hugeL) (.c hugeR))
(= (.d hugeL) (.d hugeR))
(= (.e hugeL) (.e hugeR))
(= (.f hugeL) (.f hugeR))
(= (.g hugeL) (.g hugeR))
(= (.h hugeL) (.h hugeR))
(= (.i hugeL) (.i hugeR))
(= (.j hugeL) (.j hugeR))
(= (.k hugeL) (.k hugeR))
(= (.l hugeL) (.l hugeR))
(= (.m hugeL) (.m hugeR))
(= (.n hugeL) (.n hugeR))
(= (.o hugeL) (.o hugeR))
(= (.p hugeL) (.p hugeR))
(= (.q hugeL) (.q hugeR))
(= (.r hugeL) (.r hugeR))
(= (.s hugeL) (.s hugeR))
(= (.t hugeL) (.t hugeR))
(= (.u hugeL) (.u hugeR))
(= (.v hugeL) (.v hugeR))
(= (.w hugeL) (.w hugeR))
(= (.x hugeL) (.x hugeR))
(= (.y hugeL) (.y hugeR))
(= (.z hugeL) (.z hugeR))))
(deftype TypeToTestFactory [a])
(defrecord TypeToTestHugeFactories [a b c d e f g h i j k l m n o p q r s t u v w x y z])
(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))))
(is (compare-huge-types
(TypeToTestHugeFactories. 1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26)
(->TypeToTestHugeFactories 1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26))))
(testing "that the generated factory checks arity constraints"
(is (thrown? clojure.lang.ArityException (->TypeToTestHugeFactories 1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25)))
(is (thrown? clojure.lang.ArityException (->TypeToTestHugeFactories 1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27)))))
(deftest test-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 #clojure.test_clojure.protocols.TypeToTestFactory[42])))
(is (compare-huge-types
(TypeToTestHugeFactories. 1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26)
#clojure.test_clojure.protocols.TypeToTestHugeFactories[1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26]))))
(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 ctors can have whitespace after class name but before {"
(is (= (RecordToTestLiterals. 42)
(read-string "#clojure.test_clojure.protocols.RecordToTestLiterals {: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? 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[1, 2]"
(binding [*print-dup* true] (pr-str r))))
(is (= "#clojure.test_clojure.protocols.RecordToTestPrinting{:a 1, :b 2}"
(binding [*print-dup* true *verbose-defrecords* true] (pr-str r)))))))
(defrecord RecordToTest__ [__a ___b])
(defrecord TypeToTest__ [__a ___b])
(deftest test-record-and-type-field-names
(testing "that types and records allow names starting with double-underscore.
This is a regression test for CLJ-837."
(let [r (RecordToTest__. 1 2)
t (TypeToTest__. 3 4)]
(are [x y] (= x y)
1 (:__a r)
2 (:___b r)
3 (.__a t)
4 (.___b t)))))
(defrecord RecordToTestLongHint [^long a])
(defrecord RecordToTestByteHint [^byte a])
(defrecord RecordToTestBoolHint [^boolean a])
(defrecord RecordToTestCovariantHint [^String a]) ;; same for arrays also
(deftype TypeToTestLongHint [^long a])
(deftype TypeToTestByteHint [^byte a])
(deftest hinting-test
(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)))
(is (= (.a (TypeToTestLongHint. 42)) (.a (->TypeToTestLongHint (long 42)))))
(testing "that invalid primitive types on hinted defrecord fields fails"
(is (thrown?
ClassCastException
(read-string "#clojure.test_clojure.protocols.RecordToTestLongHint{:a \"\"}")))
(is (thrown?
IllegalArgumentException
(read-string "#clojure.test_clojure.protocols.RecordToTestLongHint[\"\"]")))
(is (thrown?
IllegalArgumentException
(read-string "#clojure.test_clojure.protocols.TypeToTestLongHint[\"\"]")))
(is (thrown?
ClassCastException
(clojure.test_clojure.protocols.RecordToTestLongHint/create {:a ""})))
(is (thrown?
ClassCastException
(map->RecordToTestLongHint {:a ""})))
(is (thrown?
ClassCastException
(->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))))
(is (= (.a (TypeToTestByteHint. 42)) (.a (->TypeToTestByteHint (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
r (reify
java.util.List
(contains [_ o] (= s o)))]
(testing "implemented methods"
(is (true? (.contains r :foo)))
(is (false? (.contains r :bar))))
(testing "unimplemented methods"
(is (thrown? AbstractMethodError (.add r :baz))))))
(testing "of two interfaces"
(let [r (reify
java.util.List
(contains [_ o] (= :foo o))
java.util.Collection
(isEmpty [_] false))]
(is (true? (.contains r :foo)))
(is (false? (.contains r :bar)))
(is (false? (.isEmpty r)))))
(testing "you can't define a method twice"
(is (thrown? Exception
(eval '(reify
java.util.List
(size [_] 10)
java.util.Collection
(size [_] 20))))))
(testing "you can't define a method not on an interface/protocol/j.l.Object"
(is (thrown? Exception
(eval '(reify java.util.List (foo [_]))))))
(testing "of a protocol"
(let [r (reify
ExampleProtocol
(bar [this o] o)
(baz [this] 1)
(baz [this o] 2))]
(= :foo (.bar r :foo))
(= 1 (.baz r))
(= 2 (.baz r nil))))
(testing "destructuring in method def"
(let [r (reify
ExampleProtocol
(bar [this [_ _ item]] item))]
(= :c (.bar r [:a :b :c]))))
(testing "methods can recur"
(let [r (reify
java.util.List
(get [_ index]
(if (zero? index)
:done
(recur (dec index)))))]
(is (= :done (.get r 0)))
(is (= :done (.get r 1)))))
(testing "disambiguating with type hints"
(testing "you must hint an overloaded method"
(is (thrown? Exception
(eval '(reify clojure.test_clojure.protocols.examples.ExampleInterface (hinted [_ o]))))))
(testing "hinting"
(let [r (reify
ExampleInterface
(hinted [_ ^int i] (inc i))
(hinted [_ ^String s] (str s s)))]
(is (= 2 (.hinted r 1)))
(is (= "xoxo" (.hinted r "xo")))))))
; see CLJ-845
(defprotocol SyntaxQuoteTestProtocol
(sqtp [p]))
(defmacro try-extend-type [c]
`(extend-type ~c
SyntaxQuoteTestProtocol
(sqtp [p#] p#)))
(defmacro try-extend-protocol [c]
`(extend-protocol SyntaxQuoteTestProtocol
~c
(sqtp [p#] p#)))
(try-extend-type String)
(try-extend-protocol clojure.lang.Keyword)
(deftest test-no-ns-capture
(is (= "foo" (sqtp "foo")))
(is (= :foo (sqtp :foo))))
(defprotocol Dasherizer
(-do-dashed [this]))
(deftype Dashed []
Dasherizer
(-do-dashed [this] 10))
(deftest test-leading-dashes
(is (= 10 (-do-dashed (Dashed.))))
(is (= [10] (map -do-dashed [(Dashed.)]))))
clojure1.6_1.6.0+dfsg.orig/test/clojure/test_clojure/protocols/ 0000775 0000000 0000000 00000000000 12346720654 0024527 5 ustar 00root root 0000000 0000000 clojure1.6_1.6.0+dfsg.orig/test/clojure/test_clojure/protocols/examples.clj 0000664 0000000 0000000 00000000717 12346720654 0027044 0 ustar 00root root 0000000 0000000 (ns clojure.test-clojure.protocols.examples)
(defprotocol ExampleProtocol
"example protocol used by clojure tests"
(foo [a] "method with one arg")
(bar [a b] "method with two args")
(^String baz [a] [a b] "method with multiple arities")
(with-quux [a] "method name with a hyphen"))
(defprotocol MarkerProtocol
"a protocol with no methods")
(defprotocol MarkerProtocol2)
(definterface ExampleInterface
(hinted [^int i])
(hinted [^String s]))
clojure1.6_1.6.0+dfsg.orig/test/clojure/test_clojure/protocols/hash_collisions.clj 0000664 0000000 0000000 00000006564 12346720654 0030415 0 ustar 00root root 0000000 0000000 (ns clojure.test-clojure.protocols.hash-collisions
(:use clojure.test))
(defprotocol TestProtocolA
(method-a [this] "Test method A"))
(defprotocol TestProtocolB
(method-b [this] "Test method B"))
(deftype TestType1 [])
(deftype TestType2 [])
(deftype TestType3 [])
(deftype TestType4 [])
(deftype TestType5 [])
(deftype TestType6 [])
(deftype TestType7 [])
(deftype TestType8 [])
(deftype TestType9 [])
(deftype TestType10 [])
(deftype TestType11 [])
(deftype TestType12 [])
(deftype TestType13 [])
(deftype TestType14 [])
(deftype TestType15 [])
(def original-hash hash)
(defn colliding-hash
"Mock hash function which returns identical hash codes for the
classes TestType1 and TestType2, normal hashes for everything else."
[x]
(if (or (= x TestType1) (= x TestType2))
999 ;; artificial hash code, to cause a collision
(original-hash x)))
(deftest protocols-with-hash-collisions
(with-redefs [hash colliding-hash]
(extend TestType1 TestProtocolA {:method-a (constantly 1)})
(extend TestType2 TestProtocolA {:method-a (constantly 2)})
(is (= 1 (method-a (TestType1.))))
(is (= 2 (method-a (TestType2.))))))
(defn no-min-hash-in-13-bits
"Mock hash function which returns hash codes for the classes
TestType1 through TestType15 such that they cannot be compressed
into a 13-bit min-hash table. Returns normal hashes for everything
else."
[x]
(cond
(= x TestType1) 1
(= x TestType2) 2
(= x TestType3) 4
(= x TestType4) 8
(= x TestType5) 16
(= x TestType6) 32
(= x TestType7) 64
(= x TestType8) 128
(= x TestType9) 256
(= x TestType10) 512
(= x TestType11) 1024
(= x TestType12) 2048
(= x TestType13) 4096
(= x TestType14) 8192
(= x TestType15) 16384
:else (original-hash x)))
(deftest protocols-with-no-min-hash-in-13-bits
(with-redefs [hash no-min-hash-in-13-bits]
(extend TestType1 TestProtocolB {:method-b (constantly 1)})
(extend TestType2 TestProtocolB {:method-b (constantly 2)})
(extend TestType3 TestProtocolB {:method-b (constantly 3)})
(extend TestType4 TestProtocolB {:method-b (constantly 4)})
(extend TestType5 TestProtocolB {:method-b (constantly 5)})
(extend TestType6 TestProtocolB {:method-b (constantly 6)})
(extend TestType7 TestProtocolB {:method-b (constantly 7)})
(extend TestType8 TestProtocolB {:method-b (constantly 8)})
(extend TestType9 TestProtocolB {:method-b (constantly 9)})
(extend TestType10 TestProtocolB {:method-b (constantly 10)})
(extend TestType11 TestProtocolB {:method-b (constantly 11)})
(extend TestType12 TestProtocolB {:method-b (constantly 12)})
(extend TestType13 TestProtocolB {:method-b (constantly 13)})
(extend TestType14 TestProtocolB {:method-b (constantly 14)})
(extend TestType15 TestProtocolB {:method-b (constantly 15)})
(is (= 1 (method-b (TestType1.))))
(is (= 2 (method-b (TestType2.))))
(is (= 3 (method-b (TestType3.))))
(is (= 4 (method-b (TestType4.))))
(is (= 5 (method-b (TestType5.))))
(is (= 6 (method-b (TestType6.))))
(is (= 7 (method-b (TestType7.))))
(is (= 8 (method-b (TestType8.))))
(is (= 9 (method-b (TestType9.))))
(is (= 10 (method-b (TestType10.))))
(is (= 11 (method-b (TestType11.))))
(is (= 12 (method-b (TestType12.))))
(is (= 13 (method-b (TestType13.))))
(is (= 14 (method-b (TestType14.))))
(is (= 15 (method-b (TestType15.))))))
clojure1.6_1.6.0+dfsg.orig/test/clojure/test_clojure/protocols/more_examples.clj 0000664 0000000 0000000 00000000305 12346720654 0030057 0 ustar 00root root 0000000 0000000 (ns clojure.test-clojure.protocols.more-examples)
(defprotocol SimpleProtocol
"example protocol used by clojure tests. Note that
foo collides with examples/ExampleProtocol."
(foo [a] ""))
clojure1.6_1.6.0+dfsg.orig/test/clojure/test_clojure/reader.clj 0000664 0000000 0000000 00000050304 12346720654 0024441 0 ustar 00root root 0000000 0000000 ; 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.
; Author: Stephen C. Gilardi
;;
;; Tests for the Clojure functions documented at the URL:
;;
;; http://clojure.org/Reader
;;
;; scgilardi (gmail)
;; Created 22 October 2008
(ns clojure.test-clojure.reader
(:use clojure.test)
(:use [clojure.instant :only [read-instant-date
read-instant-calendar
read-instant-timestamp]])
(:require clojure.walk
[clojure.test.generative :refer (defspec)]
[clojure.test-clojure.generators :as cgen])
(:import [clojure.lang BigInt Ratio]
java.io.File
java.util.TimeZone))
;; Symbols
(deftest Symbols
(is (= 'abc (symbol "abc")))
(is (= '*+!-_? (symbol "*+!-_?")))
(is (= 'abc:def:ghi (symbol "abc:def:ghi")))
(is (= 'abc/def (symbol "abc" "def")))
(is (= 'abc.def/ghi (symbol "abc.def" "ghi")))
(is (= 'abc/def.ghi (symbol "abc" "def.ghi")))
(is (= 'abc:def/ghi:jkl.mno (symbol "abc:def" "ghi:jkl.mno")))
(is (instance? clojure.lang.Symbol 'alphabet))
)
;; Literals
(deftest Literals
; 'nil 'false 'true are reserved by Clojure and are not symbols
(is (= 'nil nil))
(is (= 'false false))
(is (= 'true true)) )
;; Strings
(defn temp-file
[prefix suffix]
(doto (File/createTempFile prefix suffix)
(.deleteOnExit)))
(defn read-from
[source file form]
(if (= :string source)
(read-string form)
(do
(spit file form)
(load-file (str file)))))
(defn code-units
[s]
(and (instance? String s) (map int s)))
(deftest Strings
(is (= "abcde" (str \a \b \c \d \e)))
(is (= "abc
def" (str \a \b \c \newline \space \space \d \e \f)))
(let [f (temp-file "clojure.core-reader" "test")]
(doseq [source [:string :file]]
(testing (str "Valid string literals read from " (name source))
(are [x form] (= x (code-units
(read-from source f (str "\"" form "\""))))
[] ""
[34] "\\\""
[10] "\\n"
[0] "\\0"
[0] "\\000"
[3] "\\3"
[3] "\\03"
[3] "\\003"
[0 51] "\\0003"
[3 48] "\\0030"
[0377] "\\377"
[0 56] "\\0008"
[0] "\\u0000"
[0xd7ff] "\\ud7ff"
[0xd800] "\\ud800"
[0xdfff] "\\udfff"
[0xe000] "\\ue000"
[0xffff] "\\uffff"
[4 49] "\\u00041"))
(testing (str "Errors reading string literals from " (name source))
(are [err msg form] (thrown-with-msg? err msg
(read-from source f (str "\"" form "\"")))
Exception #"EOF while reading string" "\\"
Exception #"Unsupported escape character: \\o" "\\o"
Exception #"Octal escape sequence must be in range \[0, 377\]" "\\400"
Exception #"Invalid digit: 8" "\\8"
Exception #"Invalid digit: 8" "\\8000"
Exception #"Invalid digit: 8" "\\0800"
Exception #"Invalid digit: 8" "\\0080"
Exception #"Invalid digit: a" "\\2and"
Exception #"Invalid unicode escape: \\u" "\\u"
Exception #"Invalid unicode escape: \\ug" "\\ug"
Exception #"Invalid unicode escape: \\ug" "\\ug000"
Exception #"Invalid character length: 1, should be: 4" "\\u0"
Exception #"Invalid character length: 3, should be: 4" "\\u004"
Exception #"Invalid digit: g" "\\u004g")))))
;; Numbers
(deftest Numbers
; Read Integer
(is (instance? Long 2147483647))
(is (instance? Long +1))
(is (instance? Long 1))
(is (instance? Long +0))
(is (instance? Long 0))
(is (instance? Long -0))
(is (instance? Long -1))
(is (instance? Long -2147483648))
; Read Long
(is (instance? Long 2147483648))
(is (instance? Long -2147483649))
(is (instance? Long 9223372036854775807))
(is (instance? Long -9223372036854775808))
;; Numeric constants of different types don't wash out. Regression fixed in
;; r1157. Previously the compiler saw 0 and 0.0 as the same constant and
;; caused the sequence to be built of Doubles.
(let [x 0.0]
(let [sequence (loop [i 0 l '()]
(if (< i 5)
(recur (inc i) (conj l i))
l))]
(is (= [4 3 2 1 0] sequence))
(is (every? #(instance? Long %)
sequence))))
; Read BigInteger
(is (instance? BigInt 9223372036854775808))
(is (instance? BigInt -9223372036854775809))
(is (instance? BigInt 10000000000000000000000000000000000000000000000000))
(is (instance? BigInt -10000000000000000000000000000000000000000000000000))
; Read Double
(is (instance? Double +1.0e+1))
(is (instance? Double +1.e+1))
(is (instance? Double +1e+1))
(is (instance? Double +1.0e1))
(is (instance? Double +1.e1))
(is (instance? Double +1e1))
(is (instance? Double +1.0e-1))
(is (instance? Double +1.e-1))
(is (instance? Double +1e-1))
(is (instance? Double 1.0e+1))
(is (instance? Double 1.e+1))
(is (instance? Double 1e+1))
(is (instance? Double 1.0e1))
(is (instance? Double 1.e1))
(is (instance? Double 1e1))
(is (instance? Double 1.0e-1))
(is (instance? Double 1.e-1))
(is (instance? Double 1e-1))
(is (instance? Double -1.0e+1))
(is (instance? Double -1.e+1))
(is (instance? Double -1e+1))
(is (instance? Double -1.0e1))
(is (instance? Double -1.e1))
(is (instance? Double -1e1))
(is (instance? Double -1.0e-1))
(is (instance? Double -1.e-1))
(is (instance? Double -1e-1))
(is (instance? Double +1.0))
(is (instance? Double +1.))
(is (instance? Double 1.0))
(is (instance? Double 1.))
(is (instance? Double +0.0))
(is (instance? Double +0.))
(is (instance? Double 0.0))
(is (instance? Double 0.))
(is (instance? Double -0.0))
(is (instance? Double -0.))
(is (instance? Double -1.0))
(is (instance? Double -1.))
; Read BigDecimal
(is (instance? BigDecimal 9223372036854775808M))
(is (instance? BigDecimal -9223372036854775809M))
(is (instance? BigDecimal 2147483647M))
(is (instance? BigDecimal +1M))
(is (instance? BigDecimal 1M))
(is (instance? BigDecimal +0M))
(is (instance? BigDecimal 0M))
(is (instance? BigDecimal -0M))
(is (instance? BigDecimal -1M))
(is (instance? BigDecimal -2147483648M))
(is (instance? BigDecimal +1.0e+1M))
(is (instance? BigDecimal +1.e+1M))
(is (instance? BigDecimal +1e+1M))
(is (instance? BigDecimal +1.0e1M))
(is (instance? BigDecimal +1.e1M))
(is (instance? BigDecimal +1e1M))
(is (instance? BigDecimal +1.0e-1M))
(is (instance? BigDecimal +1.e-1M))
(is (instance? BigDecimal +1e-1M))
(is (instance? BigDecimal 1.0e+1M))
(is (instance? BigDecimal 1.e+1M))
(is (instance? BigDecimal 1e+1M))
(is (instance? BigDecimal 1.0e1M))
(is (instance? BigDecimal 1.e1M))
(is (instance? BigDecimal 1e1M))
(is (instance? BigDecimal 1.0e-1M))
(is (instance? BigDecimal 1.e-1M))
(is (instance? BigDecimal 1e-1M))
(is (instance? BigDecimal -1.0e+1M))
(is (instance? BigDecimal -1.e+1M))
(is (instance? BigDecimal -1e+1M))
(is (instance? BigDecimal -1.0e1M))
(is (instance? BigDecimal -1.e1M))
(is (instance? BigDecimal -1e1M))
(is (instance? BigDecimal -1.0e-1M))
(is (instance? BigDecimal -1.e-1M))
(is (instance? BigDecimal -1e-1M))
(is (instance? BigDecimal +1.0M))
(is (instance? BigDecimal +1.M))
(is (instance? BigDecimal 1.0M))
(is (instance? BigDecimal 1.M))
(is (instance? BigDecimal +0.0M))
(is (instance? BigDecimal +0.M))
(is (instance? BigDecimal 0.0M))
(is (instance? BigDecimal 0.M))
(is (instance? BigDecimal -0.0M))
(is (instance? BigDecimal -0.M))
(is (instance? BigDecimal -1.0M))
(is (instance? BigDecimal -1.M))
(is (instance? Ratio 1/2))
(is (instance? Ratio -1/2))
(is (instance? Ratio +1/2))
)
;; Characters
(deftest t-Characters
(let [f (temp-file "clojure.core-reader" "test")]
(doseq [source [:string :file]]
(testing (str "Valid char literals read from " (name source))
(are [x form] (= x (read-from source f form))
(first "o") "\\o"
(char 0) "\\o0"
(char 0) "\\o000"
(char 047) "\\o47"
(char 0377) "\\o377"
(first "u") "\\u"
(first "A") "\\u0041"
(char 0) "\\u0000"
(char 0xd7ff) "\\ud7ff"
(char 0xe000) "\\ue000"
(char 0xffff) "\\uffff"))
(testing (str "Errors reading char literals from " (name source))
(are [err msg form] (thrown-with-msg? err msg (read-from source f form))
Exception #"EOF while reading character" "\\"
Exception #"Unsupported character: \\00" "\\00"
Exception #"Unsupported character: \\0009" "\\0009"
Exception #"Invalid digit: 8" "\\o378"
Exception #"Octal escape sequence must be in range \[0, 377\]" "\\o400"
Exception #"Invalid digit: 8" "\\o800"
Exception #"Invalid digit: a" "\\oand"
Exception #"Invalid octal escape sequence length: 4" "\\o0470"
Exception #"Invalid unicode character: \\u0" "\\u0"
Exception #"Invalid unicode character: \\ug" "\\ug"
Exception #"Invalid unicode character: \\u000" "\\u000"
Exception #"Invalid character constant: \\ud800" "\\ud800"
Exception #"Invalid character constant: \\udfff" "\\udfff"
Exception #"Invalid unicode character: \\u004" "\\u004"
Exception #"Invalid unicode character: \\u00041" "\\u00041"
Exception #"Invalid digit: g" "\\u004g")))))
;; nil
(deftest t-nil)
;; Booleans
(deftest t-Booleans)
;; Keywords
(deftest t-Keywords
(is (= :abc (keyword "abc")))
(is (= :abc (keyword 'abc)))
(is (= :*+!-_? (keyword "*+!-_?")))
(is (= :abc:def:ghi (keyword "abc:def:ghi")))
(is (= :abc/def (keyword "abc" "def")))
(is (= :abc/def (keyword 'abc/def)))
(is (= :abc.def/ghi (keyword "abc.def" "ghi")))
(is (= :abc/def.ghi (keyword "abc" "def.ghi")))
(is (= :abc:def/ghi:jkl.mno (keyword "abc:def" "ghi:jkl.mno")))
(is (instance? clojure.lang.Keyword :alphabet))
)
(deftest reading-keywords
(are [x y] (= x (binding [*ns* (the-ns 'user)] (read-string y)))
:foo ":foo"
:foo/bar ":foo/bar"
:user/foo "::foo")
(are [err msg form] (thrown-with-msg? err msg (read-string form))
Exception #"Invalid token: foo:" "foo:"
Exception #"Invalid token: :bar/" ":bar/"
Exception #"Invalid token: ::does.not/exist" "::does.not/exist"))
;; Lists
(deftest t-Lists)
;; Vectors
(deftest t-Vectors)
;; Maps
(deftest t-Maps)
;; Sets
(deftest t-Sets)
;; Macro characters
;; Quote (')
(deftest t-Quote)
;; Character (\)
(deftest t-Character)
;; Comment (;)
(deftest t-Comment)
;; Deref (@)
(deftest t-Deref)
;; Dispatch (#)
;; #{} - see Sets above
;; Regex patterns (#"pattern")
(deftest t-Regex)
;; Metadata (^ or #^ (deprecated))
(deftest t-line-column-numbers
(let [code "(ns reader-metadata-test
(:require [clojure.java.io
:refer (resource reader)]))
(let [a 5]
^:added-metadata
(defn add-5
[x]
(reduce + x (range a))))"
stream (clojure.lang.LineNumberingPushbackReader.
(java.io.StringReader. code))
top-levels (take-while identity (repeatedly #(read stream false nil)))
expected-metadata '{ns {:line 1, :column 1}
:require {:line 2, :column 3}
resource {:line 3, :column 21}
let {:line 5, :column 1}
defn {:line 6, :column 3 :added-metadata true}
reduce {:line 9, :column 5}
range {:line 9, :column 17}}
verified-forms (atom 0)]
(doseq [form top-levels]
(clojure.walk/postwalk
#(when (list? %)
(is (= (expected-metadata (first %))
(meta %)))
(is (->> (meta %)
vals
(filter number?)
(every? (partial instance? Integer))))
(swap! verified-forms inc))
form))
;; sanity check against e.g. reading returning ()
(is (= (count expected-metadata) @verified-forms))))
(deftest t-Metadata
(is (= (meta '^:static ^:awesome ^{:static false :bar :baz} sym) {:awesome true, :bar :baz, :static true})))
;; Var-quote (#')
(deftest t-Var-quote)
;; Anonymous function literal (#())
(deftest t-Anonymouns-function-literal)
;; Syntax-quote (`, note, the "backquote" character), Unquote (~) and
;; Unquote-splicing (~@)
(deftest t-Syntax-quote
(are [x y] (= x y)
`() () ; was NPE before SVN r1337
))
;; (read)
;; (read stream)
;; (read stream eof-is-error)
;; (read stream eof-is-error eof-value)
;; (read stream eof-is-error eof-value is-recursive)
(deftest t-read)
(deftest division
(is (= clojure.core// /))
(binding [*ns* *ns*]
(eval '(do (ns foo
(:require [clojure.core :as bar])
(:use [clojure.test]))
(is (= clojure.core// bar//))))))
(deftest Instants
(testing "Instants are read as java.util.Date by default"
(is (= java.util.Date (class #inst "2010-11-12T13:14:15.666"))))
(let [s "#inst \"2010-11-12T13:14:15.666-06:00\""]
(binding [*data-readers* {'inst read-instant-date}]
(testing "read-instant-date produces java.util.Date"
(is (= java.util.Date (class (read-string s)))))
(testing "java.util.Date instants round-trips"
(is (= (-> s read-string)
(-> s read-string pr-str read-string))))
(testing "java.util.Date instants round-trip throughout the year"
(doseq [month (range 1 13) day (range 1 29) hour (range 1 23)]
(let [s (format "#inst \"2010-%02d-%02dT%02d:14:15.666-06:00\"" month day hour)]
(is (= (-> s read-string)
(-> s read-string pr-str read-string))))))
(testing "java.util.Date handling DST in time zones"
(let [dtz (TimeZone/getDefault)]
(try
;; A timezone with DST in effect during 2010-11-12
(TimeZone/setDefault (TimeZone/getTimeZone "Australia/Sydney"))
(is (= (-> s read-string)
(-> s read-string pr-str read-string)))
(finally (TimeZone/setDefault dtz)))))
(testing "java.util.Date should always print in UTC"
(let [d (read-string s)
pstr (print-str d)
len (.length pstr)]
(is (= (subs pstr (- len 7)) "-00:00\"")))))
(binding [*data-readers* {'inst read-instant-calendar}]
(testing "read-instant-calendar produces java.util.Calendar"
(is (instance? java.util.Calendar (read-string s))))
(testing "java.util.Calendar round-trips"
(is (= (-> s read-string)
(-> s read-string pr-str read-string))))
(testing "java.util.Calendar remembers timezone in literal"
(is (= "#inst \"2010-11-12T13:14:15.666-06:00\""
(-> s read-string pr-str)))
(is (= (-> s read-string)
(-> s read-string pr-str read-string))))
(testing "java.util.Calendar preserves milliseconds"
(is (= 666 (-> s read-string
(.get java.util.Calendar/MILLISECOND)))))))
(let [s "#inst \"2010-11-12T13:14:15.123456789\""
s2 "#inst \"2010-11-12T13:14:15.123\""
s3 "#inst \"2010-11-12T13:14:15.123456789123\""]
(binding [*data-readers* {'inst read-instant-timestamp}]
(testing "read-instant-timestamp produces java.sql.Timestamp"
(is (= java.sql.Timestamp (class (read-string s)))))
(testing "java.sql.Timestamp preserves nanoseconds"
(is (= 123456789 (-> s read-string .getNanos)))
(is (= 123456789 (-> s read-string pr-str read-string .getNanos)))
;; truncate at nanos for s3
(is (= 123456789 (-> s3 read-string pr-str read-string .getNanos))))
(testing "java.sql.Timestamp should compare nanos"
(is (= (read-string s) (read-string s3)))
(is (not= (read-string s) (read-string s2)))))
(binding [*data-readers* {'inst read-instant-date}]
(testing "read-instant-date should truncate at milliseconds"
(is (= (read-string s) (read-string s2)) (read-string s3)))))
(let [s "#inst \"2010-11-12T03:14:15.123+05:00\""
s2 "#inst \"2010-11-11T22:14:15.123Z\""]
(binding [*data-readers* {'inst read-instant-date}]
(testing "read-instant-date should convert to UTC"
(is (= (read-string s) (read-string s2)))))
(binding [*data-readers* {'inst read-instant-timestamp}]
(testing "read-instant-timestamp should convert to UTC"
(is (= (read-string s) (read-string s2)))))
(binding [*data-readers* {'inst read-instant-calendar}]
(testing "read-instant-calendar should preserve timezone"
(is (not= (read-string s) (read-string s2)))))))
;; UUID Literals
;; #uuid "550e8400-e29b-41d4-a716-446655440000"
(deftest UUID
(is (= java.util.UUID (class #uuid "550e8400-e29b-41d4-a716-446655440000")))
(is (.equals #uuid "550e8400-e29b-41d4-a716-446655440000"
#uuid "550e8400-e29b-41d4-a716-446655440000"))
(is (not (identical? #uuid "550e8400-e29b-41d4-a716-446655440000"
#uuid "550e8400-e29b-41d4-a716-446655440000")))
(is (= 4 (.version #uuid "550e8400-e29b-41d4-a716-446655440000")))
(is (= (print-str #uuid "550e8400-e29b-41d4-a716-446655440000")
"#uuid \"550e8400-e29b-41d4-a716-446655440000\"")))
(deftest unknown-tag
(let [my-unknown (fn [tag val] {:unknown-tag tag :value val})
throw-on-unknown (fn [tag val] (throw (RuntimeException. (str "No data reader function for tag " tag))))
my-uuid (partial my-unknown 'uuid)
u "#uuid \"550e8400-e29b-41d4-a716-446655440000\""
s "#never.heard.of/some-tag [1 2]" ]
(binding [*data-readers* {'uuid my-uuid}
*default-data-reader-fn* my-unknown]
(testing "Unknown tag"
(is (= (read-string s)
{:unknown-tag 'never.heard.of/some-tag
:value [1 2]})))
(testing "Override uuid tag"
(is (= (read-string u)
{:unknown-tag 'uuid
:value "550e8400-e29b-41d4-a716-446655440000"}))))
(binding [*default-data-reader-fn* throw-on-unknown]
(testing "Unknown tag with custom throw-on-unknown"
(are [err msg form] (thrown-with-msg? err msg (read-string form))
Exception #"No data reader function for tag foo" "#foo [1 2]"
Exception #"No data reader function for tag bar/foo" "#bar/foo [1 2]"
Exception #"No data reader function for tag bar.baz/foo" "#bar.baz/foo [1 2]")))
(testing "Unknown tag out-of-the-box behavior (like Clojure 1.4)"
(are [err msg form] (thrown-with-msg? err msg (read-string form))
Exception #"No reader function for tag foo" "#foo [1 2]"
Exception #"No reader function for tag bar/foo" "#bar/foo [1 2]"
Exception #"No reader function for tag bar.baz/foo" "#bar.baz/foo [1 2]"))))
(defn roundtrip
"Print an object and read it back. Returns rather than throws
any exceptions."
[o]
(binding [*print-length* nil
*print-dup* nil
*print-level* nil]
(try
(-> o pr-str read-string)
(catch Throwable t t))))
(defn roundtrip-dup
"Print an object with print-dup and read it back.
Returns rather than throws any exceptions."
[o]
(binding [*print-length* nil
*print-dup* true
*print-level* nil]
(try
(-> o pr-str read-string)
(catch Throwable t t))))
(defspec types-that-should-roundtrip
roundtrip
[^{:tag cgen/ednable} o]
(when-not (= o %)
(throw (ex-info "Value cannot roundtrip, see ex-data" {:printed o :read %}))))
(defspec types-that-need-dup-to-roundtrip
roundtrip-dup
[^{:tag cgen/dup-readable} o]
(when-not (= o %)
(throw (ex-info "Value cannot roundtrip, see ex-data" {:printed o :read %}))))
clojure1.6_1.6.0+dfsg.orig/test/clojure/test_clojure/reducers.clj 0000664 0000000 0000000 00000005531 12346720654 0025015 0 ustar 00root root 0000000 0000000 ; 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.
;; Author: Tassilo Horn
(ns clojure.test-clojure.reducers
(:require [clojure.core.reducers :as r]
[clojure.test.generative :refer (defspec)]
[clojure.data.generators :as gen])
(:use clojure.test))
(defmacro defequivtest
;; f is the core fn, r is the reducers equivalent, rt is the reducible ->
;; coll transformer
[name [f r rt] fns]
`(deftest ~name
(let [c# (range -100 1000)]
(doseq [fn# ~fns]
(is (= (~f fn# c#)
(~rt (~r fn# c#))))))))
(defequivtest test-map
[map r/map #(into [] %)]
[inc dec #(Math/sqrt (Math/abs %))])
(defequivtest test-mapcat
[mapcat r/mapcat #(into [] %)]
[(fn [x] [x])
(fn [x] [x (inc x)])
(fn [x] [x (inc x) x])])
(deftest test-mapcat-obeys-reduced
(is (= [1 "0" 2 "1" 3]
(->> (concat (range 100) (lazy-seq (throw (Exception. "Too eager"))))
(r/mapcat (juxt inc str))
(r/take 5)
(into [])))))
(defequivtest test-reduce
[reduce r/reduce identity]
[+' *'])
(defequivtest test-filter
[filter r/filter #(into [] %)]
[even? odd? #(< 200 %) identity])
(deftest test-sorted-maps
(let [m (into (sorted-map)
'{1 a, 2 b, 3 c, 4 d})]
(is (= "1a2b3c4d" (reduce-kv str "" m))
"Sorted maps should reduce-kv in sorted order")
(is (= 1 (reduce-kv (fn [acc k v]
(reduced (+ acc k)))
0 m))
"Sorted maps should stop reduction when asked")))
(deftest test-nil
(is (= {:k :v} (reduce-kv assoc {:k :v} nil)))
(is (= 0 (r/fold + nil))))
(defn gen-num []
(gen/uniform 0 2000))
(defn reduced-at-probe
[m p]
(reduce-kv (fn [_ k v] (when (== p k) (reduced :foo))) nil m))
(defspec reduced-always-returns
(fn [probe to-end]
(let [len (+ probe to-end 1)
nums (range len)
m (zipmap nums nums)]
(reduced-at-probe m probe)))
[^{:tag `gen-num} probe ^{:tag `gen-num} to-end]
(assert (= :foo %)))
(deftest test-fold-runtime-exception
(is (thrown? IndexOutOfBoundsException
(let [test-map-count 1234
k-fail (rand-int test-map-count)]
(r/fold (fn ([])
([ret [k v]])
([ret k v] (when (= k k-fail)
(throw (IndexOutOfBoundsException.)))))
(zipmap (range test-map-count) (repeat :dummy)))))))
clojure1.6_1.6.0+dfsg.orig/test/clojure/test_clojure/reflect.clj 0000664 0000000 0000000 00000002610 12346720654 0024620 0 ustar 00root root 0000000 0000000 (ns clojure.test-clojure.reflect
(:use clojure.data [clojure.reflect :as reflect] clojure.test clojure.pprint)
(:import [clojure.reflect AsmReflector JavaReflector]))
(defn nodiff
[x y]
(let [[x-only y-only common] (diff x y)]
(when (or x-only y-only)
(is false (with-out-str (pprint {:x-only x-only
:y-only y-only
:common common}))))))
#_(deftest compare-reflect-and-asm
(let [cl (.getContextClassLoader (Thread/currentThread))
asm-reflector (AsmReflector. cl)
java-reflector (JavaReflector. cl)]
(doseq [classname '[java.lang.Runnable
java.lang.Object
java.io.FileInputStream
clojure.lang.Compiler
clojure.lang.PersistentVector
java.lang.SuppressWarnings]]
(nodiff (type-reflect classname :reflector asm-reflector)
(type-reflect classname :reflector java-reflector)))))
(deftest field-descriptor->class-symbol-test
(are [s d] (= s (@#'reflect/field-descriptor->class-symbol d))
'clojure.asm.Type<><> "[[Lclojure/asm/Type;"
'int "I"
'java.lang.Object "Ljava.lang.Object;"))
(deftest internal-name->class-symbol-test
(are [s n] (= s (@#'reflect/internal-name->class-symbol n))
'java.lang.Exception "java/lang/Exception"))
clojure1.6_1.6.0+dfsg.orig/test/clojure/test_clojure/refs.clj 0000664 0000000 0000000 00000001250 12346720654 0024132 0 ustar 00root root 0000000 0000000 ; 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.
; Author: Frantisek Sodomka
(ns clojure.test-clojure.refs
(:use clojure.test))
; http://clojure.org/refs
; ref
; deref, @-reader-macro
; dosync io!
; ensure ref-set alter commute
; set-validator get-validator
clojure1.6_1.6.0+dfsg.orig/test/clojure/test_clojure/repl.clj 0000664 0000000 0000000 00000004075 12346720654 0024145 0 ustar 00root root 0000000 0000000 (ns clojure.test-clojure.repl
(:use clojure.test
clojure.repl
[clojure.test-helper :only [platform-newlines]]
clojure.test-clojure.repl.example)
(:require [clojure.string :as str]))
(deftest test-doc
(testing "with namespaces"
(is (= "clojure.pprint"
(second (str/split-lines (with-out-str (doc clojure.pprint))))))))
(deftest test-source
(is (= "(defn foo [])" (source-fn 'clojure.test-clojure.repl.example/foo)))
(is (= (platform-newlines "(defn foo [])\n") (with-out-str (source clojure.test-clojure.repl.example/foo))))
(is (nil? (source-fn 'non-existent-fn))))
(deftest test-source-read-eval-unknown
(is (thrown? IllegalStateException (binding [*read-eval* :unknown] (source reduce)))))
(deftest test-source-read-eval-false
(is (binding [*read-eval* false] (with-out-str (source reduce)))))
(deftest test-dir
(is (thrown? Exception (dir-fn 'non-existent-ns)))
(is (= '[bar foo] (dir-fn 'clojure.test-clojure.repl.example)))
(is (= (platform-newlines "bar\nfoo\n") (with-out-str (dir clojure.test-clojure.repl.example)))))
(deftest test-apropos
(testing "with a regular expression"
(is (= '[defmacro] (apropos #"^defmacro$")))
(is (some #{'defmacro} (apropos #"def.acr.")))
(is (= [] (apropos #"nothing-has-this-name"))))
(testing "with a string"
(is (some #{'defmacro} (apropos "defmacro")))
(is (some #{'defmacro} (apropos "efmac")))
(is (= [] (apropos "nothing-has-this-name"))))
(testing "with a symbol"
(is (some #{'defmacro} (apropos 'defmacro)))
(is (some #{'defmacro} (apropos 'efmac)))
(is (= [] (apropos 'nothing-has-this-name)))))
(defmacro call-ns
"Call ns with a unique namespace name. Return the result of calling ns"
[] `(ns a#))
(defmacro call-ns-sym
"Call ns wih a unique namespace name. Return the namespace symbol."
[] `(do (ns a#) 'a#))
(deftest test-dynamic-ns
(testing "a call to ns returns nil"
(is (= nil (call-ns))))
(testing "requiring a dynamically created ns should not throw an exception"
(is (= nil (let [a (call-ns-sym)] (require a))))))
clojure1.6_1.6.0+dfsg.orig/test/clojure/test_clojure/repl/ 0000775 0000000 0000000 00000000000 12346720654 0023445 5 ustar 00root root 0000000 0000000 clojure1.6_1.6.0+dfsg.orig/test/clojure/test_clojure/repl/example.clj 0000664 0000000 0000000 00000000200 12346720654 0025562 0 ustar 00root root 0000000 0000000 (ns clojure.test-clojure.repl.example)
;; sample namespace for repl tests, don't add anything here
(defn foo [])
(defn bar [])
clojure1.6_1.6.0+dfsg.orig/test/clojure/test_clojure/rt.clj 0000664 0000000 0000000 00000011405 12346720654 0023623 0 ustar 00root root 0000000 0000000 ; 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.
; Author: Stuart Halloway
(ns clojure.test-clojure.rt
(:require clojure.set)
(:use clojure.test clojure.test-helper))
(defn bare-rt-print
"Return string RT would print prior to print-initialize"
[x]
(with-out-str
(try
(push-thread-bindings {#'clojure.core/print-initialized false})
(clojure.lang.RT/print x *out*)
(finally
(pop-thread-bindings)))))
(deftest rt-print-prior-to-print-initialize
(testing "pattern literals"
(is (= "#\"foo\"" (bare-rt-print #"foo")))))
(deftest error-messages
(testing "binding a core var that already refers to something"
(should-print-err-message
#"WARNING: prefers already refers to: #'clojure.core/prefers in namespace: .*\r?\n"
(defn prefers [] (throw (RuntimeException. "rebound!")))))
(testing "reflection cannot resolve field"
(should-print-err-message
#"Reflection warning, .*:\d+:\d+ - reference to field blah can't be resolved\.\r?\n"
(defn foo [x] (.blah x))))
(testing "reflection cannot resolve field on known class"
(should-print-err-message
#"Reflection warning, .*:\d+:\d+ - reference to field blah on java\.lang\.String can't be resolved\.\r?\n"
(defn foo [^String x] (.blah x))))
(testing "reflection cannot resolve instance method because it is missing"
(should-print-err-message
#"Reflection warning, .*:\d+:\d+ - call to method zap on java\.lang\.String can't be resolved \(no such method\)\.\r?\n"
(defn foo [^String x] (.zap x 1))))
(testing "reflection cannot resolve instance method because it has incompatible argument types"
(should-print-err-message
#"Reflection warning, .*:\d+:\d+ - call to method getBytes on java\.lang\.String can't be resolved \(argument types: java\.util\.regex\.Pattern\)\.\r?\n"
(defn foo [^String x] (.getBytes x #"boom"))))
(testing "reflection cannot resolve instance method because it has unknown argument types"
(should-print-err-message
#"Reflection warning, .*:\d+:\d+ - call to method getBytes on java\.lang\.String can't be resolved \(argument types: unknown\)\.\r?\n"
(defn foo [^String x y] (.getBytes x y))))
(testing "reflection cannot resolve instance method because target class is unknown"
(should-print-err-message
#"Reflection warning, .*:\d+:\d+ - call to method zap can't be resolved \(target class is unknown\)\.\r?\n"
(defn foo [x] (.zap x 1))))
(testing "reflection cannot resolve static method"
(should-print-err-message
#"Reflection warning, .*:\d+:\d+ - call to static method valueOf on java\.lang\.Integer can't be resolved \(argument types: java\.util\.regex\.Pattern\)\.\r?\n"
(defn foo [] (Integer/valueOf #"boom"))))
(testing "reflection cannot resolve constructor"
(should-print-err-message
#"Reflection warning, .*:\d+:\d+ - call to java\.lang\.String ctor can't be resolved\.\r?\n"
(defn foo [] (String. 1 2 3)))))
(def example-var)
(deftest binding-root-clears-macro-metadata
(alter-meta! #'example-var assoc :macro true)
(is (contains? (meta #'example-var) :macro))
(.bindRoot #'example-var 0)
(is (not (contains? (meta #'example-var) :macro))))
(deftest last-var-wins-for-core
(testing "you can replace a core name, with warning"
(let [ns (temp-ns)
replacement (gensym)]
(with-err-string-writer (intern ns 'prefers replacement))
(is (= replacement @('prefers (ns-publics ns))))))
(testing "you can replace a name you defined before"
(let [ns (temp-ns)
s (gensym)
v1 (intern ns 'foo s)
v2 (intern ns 'bar s)]
(with-err-string-writer (.refer ns 'flatten v1))
(.refer ns 'flatten v2)
(is (= v2 (ns-resolve ns 'flatten)))))
(testing "you cannot intern over an existing non-core name"
(let [ns (temp-ns 'clojure.set)
replacement (gensym)]
(is (thrown? IllegalStateException
(intern ns 'subset? replacement)))
(is (nil? ('subset? (ns-publics ns))))
(is (= #'clojure.set/subset? ('subset? (ns-refers ns))))))
(testing "you cannot refer over an existing non-core name"
(let [ns (temp-ns 'clojure.set)
replacement (gensym)]
(is (thrown? IllegalStateException
(.refer ns 'subset? #'clojure.set/intersection)))
(is (nil? ('subset? (ns-publics ns))))
(is (= #'clojure.set/subset? ('subset? (ns-refers ns)))))))
clojure1.6_1.6.0+dfsg.orig/test/clojure/test_clojure/sequences.clj 0000664 0000000 0000000 00000070601 12346720654 0025174 0 ustar 00root root 0000000 0000000 ; 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.
; Author: Frantisek Sodomka
; Contributors: Stuart Halloway
(ns clojure.test-clojure.sequences
(:use clojure.test))
;; *** Tests ***
; TODO:
; apply, map, filter, remove
; and more...
(deftest test-reduce-from-chunked-into-unchunked
(= [1 2 \a \b] (into [] (concat [1 2] "ab"))))
(deftest test-reduce
(let [int+ (fn [a b] (+ (int a) (int b)))
arange (range 100) ;; enough to cross nodes
avec (into [] arange)
alist (into () arange)
obj-array (into-array arange)
int-array (into-array Integer/TYPE (map #(Integer. (int %)) arange))
long-array (into-array Long/TYPE arange)
float-array (into-array Float/TYPE arange)
char-array (into-array Character/TYPE (map char arange))
double-array (into-array Double/TYPE arange)
byte-array (into-array Byte/TYPE (map byte arange))
int-vec (into (vector-of :int) arange)
long-vec (into (vector-of :long) arange)
float-vec (into (vector-of :float) arange)
char-vec (into (vector-of :char) (map char arange))
double-vec (into (vector-of :double) arange)
byte-vec (into (vector-of :byte) (map byte arange))
all-true (into-array Boolean/TYPE (repeat 10 true))]
(is (== 4950
(reduce + arange)
(reduce + avec)
(reduce + alist)
(reduce + obj-array)
(reduce + int-array)
(reduce + long-array)
(reduce + float-array)
(reduce int+ char-array)
(reduce + double-array)
(reduce int+ byte-array)
(reduce + int-vec)
(reduce + long-vec)
(reduce + float-vec)
(reduce int+ char-vec)
(reduce + double-vec)
(reduce int+ byte-vec)))
(is (== 4951
(reduce + 1 arange)
(reduce + 1 avec)
(reduce + 1 alist)
(reduce + 1 obj-array)
(reduce + 1 int-array)
(reduce + 1 long-array)
(reduce + 1 float-array)
(reduce int+ 1 char-array)
(reduce + 1 double-array)
(reduce int+ 1 byte-array)
(reduce + 1 int-vec)
(reduce + 1 long-vec)
(reduce + 1 float-vec)
(reduce int+ 1 char-vec)
(reduce + 1 double-vec)
(reduce int+ 1 byte-vec)))
(is (= true
(reduce #(and %1 %2) all-true)
(reduce #(and %1 %2) true all-true)))))
(deftest test-equality
; lazy sequences
(are [x y] (= x y)
; fixed SVN 1288 - LazySeq and EmptyList equals/equiv
; http://groups.google.com/group/clojure/browse_frm/thread/286d807be9cae2a5#
(map inc nil) ()
(map inc ()) ()
(map inc []) ()
(map inc #{}) ()
(map inc {}) () ))
(deftest test-lazy-seq
(are [x] (seq? x)
(lazy-seq nil)
(lazy-seq [])
(lazy-seq [1 2]))
(are [x y] (= x y)
(lazy-seq nil) ()
(lazy-seq [nil]) '(nil)
(lazy-seq ()) ()
(lazy-seq []) ()
(lazy-seq #{}) ()
(lazy-seq {}) ()
(lazy-seq "") ()
(lazy-seq (into-array [])) ()
(lazy-seq (list 1 2)) '(1 2)
(lazy-seq [1 2]) '(1 2)
(lazy-seq (sorted-set 1 2)) '(1 2)
(lazy-seq (sorted-map :a 1 :b 2)) '([:a 1] [:b 2])
(lazy-seq "abc") '(\a \b \c)
(lazy-seq (into-array [1 2])) '(1 2) ))
(deftest test-seq
(is (not (seq? (seq []))))
(is (seq? (seq [1 2])))
(are [x y] (= x y)
(seq nil) nil
(seq [nil]) '(nil)
(seq ()) nil
(seq []) nil
(seq #{}) nil
(seq {}) nil
(seq "") nil
(seq (into-array [])) nil
(seq (list 1 2)) '(1 2)
(seq [1 2]) '(1 2)
(seq (sorted-set 1 2)) '(1 2)
(seq (sorted-map :a 1 :b 2)) '([:a 1] [:b 2])
(seq "abc") '(\a \b \c)
(seq (into-array [1 2])) '(1 2) ))
(deftest test-cons
(is (thrown? IllegalArgumentException (cons 1 2)))
(are [x y] (= x y)
(cons 1 nil) '(1)
(cons nil nil) '(nil)
(cons \a nil) '(\a)
(cons \a "") '(\a)
(cons \a "bc") '(\a \b \c)
(cons 1 ()) '(1)
(cons 1 '(2 3)) '(1 2 3)
(cons 1 []) [1]
(cons 1 [2 3]) [1 2 3]
(cons 1 #{}) '(1)
(cons 1 (sorted-set 2 3)) '(1 2 3)
(cons 1 (into-array [])) '(1)
(cons 1 (into-array [2 3])) '(1 2 3) ))
(deftest test-empty
(are [x y] (and (= (empty x) y)
(= (class (empty x)) (class y)))
nil nil
() ()
'(1 2) ()
[] []
[1 2] []
{} {}
{:a 1 :b 2} {}
(sorted-map) (sorted-map)
(sorted-map :a 1 :b 2) (sorted-map)
#{} #{}
#{1 2} #{}
(sorted-set) (sorted-set)
(sorted-set 1 2) (sorted-set)
(seq ()) nil ; (seq ()) => nil
(seq '(1 2)) ()
(seq []) nil ; (seq []) => nil
(seq [1 2]) ()
(seq "") nil ; (seq "") => nil
(seq "ab") ()
(lazy-seq ()) ()
(lazy-seq '(1 2)) ()
(lazy-seq []) ()
(lazy-seq [1 2]) ()
; non-coll, non-seq => nil
42 nil
1.2 nil
"abc" nil ))
;Tests that the comparator is preserved
;The first element should be the same in each set if preserved.
(deftest test-empty-sorted
(let [inv-compare (comp - compare)]
(are [x y] (= (first (into (empty x) x))
(first y))
(sorted-set 1 2 3) (sorted-set 1 2 3)
(sorted-set-by inv-compare 1 2 3) (sorted-set-by inv-compare 1 2 3)
(sorted-map 1 :a 2 :b 3 :c) (sorted-map 1 :a 2 :b 3 :c)
(sorted-map-by inv-compare 1 :a 2 :b 3 :c) (sorted-map-by inv-compare 1 :a 2 :b 3 :c))))
(deftest test-not-empty
; empty coll/seq => nil
(are [x] (= (not-empty x) nil)
()
[]
{}
#{}
(seq ())
(seq [])
(lazy-seq ())
(lazy-seq []) )
; non-empty coll/seq => identity
(are [x] (and (= (not-empty x) x)
(= (class (not-empty x)) (class x)))
'(1 2)
[1 2]
{:a 1}
#{1 2}
(seq '(1 2))
(seq [1 2])
(lazy-seq '(1 2))
(lazy-seq [1 2]) ))
(deftest test-first
;(is (thrown? Exception (first)))
(is (thrown? IllegalArgumentException (first true)))
(is (thrown? IllegalArgumentException (first false)))
(is (thrown? IllegalArgumentException (first 1)))
;(is (thrown? IllegalArgumentException (first 1 2)))
(is (thrown? IllegalArgumentException (first \a)))
(is (thrown? IllegalArgumentException (first 's)))
(is (thrown? IllegalArgumentException (first :k)))
(are [x y] (= x y)
(first nil) nil
; string
(first "") nil
(first "a") \a
(first "abc") \a
; list
(first ()) nil
(first '(1)) 1
(first '(1 2 3)) 1
(first '(nil)) nil
(first '(1 nil)) 1
(first '(nil 2)) nil
(first '(())) ()
(first '(() nil)) ()
(first '(() 2 nil)) ()
; vector
(first []) nil
(first [1]) 1
(first [1 2 3]) 1
(first [nil]) nil
(first [1 nil]) 1
(first [nil 2]) nil
(first [[]]) []
(first [[] nil]) []
(first [[] 2 nil]) []
; set
(first #{}) nil
(first #{1}) 1
(first (sorted-set 1 2 3)) 1
(first #{nil}) nil
(first (sorted-set 1 nil)) nil
(first (sorted-set nil 2)) nil
(first #{#{}}) #{}
(first (sorted-set #{} nil)) nil
;(first (sorted-set #{} 2 nil)) nil
; map
(first {}) nil
(first (sorted-map :a 1)) '(:a 1)
(first (sorted-map :a 1 :b 2 :c 3)) '(:a 1)
; array
(first (into-array [])) nil
(first (into-array [1])) 1
(first (into-array [1 2 3])) 1
(first (to-array [nil])) nil
(first (to-array [1 nil])) 1
(first (to-array [nil 2])) nil ))
(deftest test-next
; (is (thrown? IllegalArgumentException (next)))
(is (thrown? IllegalArgumentException (next true)))
(is (thrown? IllegalArgumentException (next false)))
(is (thrown? IllegalArgumentException (next 1)))
;(is (thrown? IllegalArgumentException (next 1 2)))
(is (thrown? IllegalArgumentException (next \a)))
(is (thrown? IllegalArgumentException (next 's)))
(is (thrown? IllegalArgumentException (next :k)))
(are [x y] (= x y)
(next nil) nil
; string
(next "") nil
(next "a") nil
(next "abc") '(\b \c)
; list
(next ()) nil
(next '(1)) nil
(next '(1 2 3)) '(2 3)
(next '(nil)) nil
(next '(1 nil)) '(nil)
(next '(1 ())) '(())
(next '(nil 2)) '(2)
(next '(())) nil
(next '(() nil)) '(nil)
(next '(() 2 nil)) '(2 nil)
; vector
(next []) nil
(next [1]) nil
(next [1 2 3]) [2 3]
(next [nil]) nil
(next [1 nil]) [nil]
(next [1 []]) [[]]
(next [nil 2]) [2]
(next [[]]) nil
(next [[] nil]) [nil]
(next [[] 2 nil]) [2 nil]
; set
(next #{}) nil
(next #{1}) nil
(next (sorted-set 1 2 3)) '(2 3)
(next #{nil}) nil
(next (sorted-set 1 nil)) '(1)
(next (sorted-set nil 2)) '(2)
(next #{#{}}) nil
(next (sorted-set #{} nil)) '(#{})
;(next (sorted-set #{} 2 nil)) #{}
; map
(next {}) nil
(next (sorted-map :a 1)) nil
(next (sorted-map :a 1 :b 2 :c 3)) '((:b 2) (:c 3))
; array
(next (into-array [])) nil
(next (into-array [1])) nil
(next (into-array [1 2 3])) '(2 3)
(next (to-array [nil])) nil
(next (to-array [1 nil])) '(nil)
;(next (to-array [1 (into-array [])])) (list (into-array []))
(next (to-array [nil 2])) '(2)
(next (to-array [(into-array [])])) nil
(next (to-array [(into-array []) nil])) '(nil)
(next (to-array [(into-array []) 2 nil])) '(2 nil) ))
(deftest test-last
(are [x y] (= x y)
(last nil) nil
; list
(last ()) nil
(last '(1)) 1
(last '(1 2 3)) 3
(last '(nil)) nil
(last '(1 nil)) nil
(last '(nil 2)) 2
(last '(())) ()
(last '(() nil)) nil
(last '(() 2 nil)) nil
; vector
(last []) nil
(last [1]) 1
(last [1 2 3]) 3
(last [nil]) nil
(last [1 nil]) nil
(last [nil 2]) 2
(last [[]]) []
(last [[] nil]) nil
(last [[] 2 nil]) nil
; set
(last #{}) nil
(last #{1}) 1
(last (sorted-set 1 2 3)) 3
(last #{nil}) nil
(last (sorted-set 1 nil)) 1
(last (sorted-set nil 2)) 2
(last #{#{}}) #{}
(last (sorted-set #{} nil)) #{}
;(last (sorted-set #{} 2 nil)) nil
; map
(last {}) nil
(last (sorted-map :a 1)) [:a 1]
(last (sorted-map :a 1 :b 2 :c 3)) [:c 3]
; string
(last "") nil
(last "a") \a
(last "abc") \c
; array
(last (into-array [])) nil
(last (into-array [1])) 1
(last (into-array [1 2 3])) 3
(last (to-array [nil])) nil
(last (to-array [1 nil])) nil
(last (to-array [nil 2])) 2 ))
;; (ffirst coll) = (first (first coll))
;;
(deftest test-ffirst
; (is (thrown? IllegalArgumentException (ffirst)))
(are [x y] (= x y)
(ffirst nil) nil
(ffirst ()) nil
(ffirst '((1 2) (3 4))) 1
(ffirst []) nil
(ffirst [[1 2] [3 4]]) 1
(ffirst {}) nil
(ffirst {:a 1}) :a
(ffirst #{}) nil
(ffirst #{[1 2]}) 1 ))
;; (fnext coll) = (first (next coll)) = (second coll)
;;
(deftest test-fnext
; (is (thrown? IllegalArgumentException (fnext)))
(are [x y] (= x y)
(fnext nil) nil
(fnext ()) nil
(fnext '(1)) nil
(fnext '(1 2 3 4)) 2
(fnext []) nil
(fnext [1]) nil
(fnext [1 2 3 4]) 2
(fnext {}) nil
(fnext (sorted-map :a 1)) nil
(fnext (sorted-map :a 1 :b 2)) [:b 2]
(fnext #{}) nil
(fnext #{1}) nil
(fnext (sorted-set 1 2 3 4)) 2 ))
;; (nfirst coll) = (next (first coll))
;;
(deftest test-nfirst
; (is (thrown? IllegalArgumentException (nfirst)))
(are [x y] (= x y)
(nfirst nil) nil
(nfirst ()) nil
(nfirst '((1 2 3) (4 5 6))) '(2 3)
(nfirst []) nil
(nfirst [[1 2 3] [4 5 6]]) '(2 3)
(nfirst {}) nil
(nfirst {:a 1}) '(1)
(nfirst #{}) nil
(nfirst #{[1 2]}) '(2) ))
;; (nnext coll) = (next (next coll))
;;
(deftest test-nnext
; (is (thrown? IllegalArgumentException (nnext)))
(are [x y] (= x y)
(nnext nil) nil
(nnext ()) nil
(nnext '(1)) nil
(nnext '(1 2)) nil
(nnext '(1 2 3 4)) '(3 4)
(nnext []) nil
(nnext [1]) nil
(nnext [1 2]) nil
(nnext [1 2 3 4]) '(3 4)
(nnext {}) nil
(nnext (sorted-map :a 1)) nil
(nnext (sorted-map :a 1 :b 2)) nil
(nnext (sorted-map :a 1 :b 2 :c 3 :d 4)) '([:c 3] [:d 4])
(nnext #{}) nil
(nnext #{1}) nil
(nnext (sorted-set 1 2)) nil
(nnext (sorted-set 1 2 3 4)) '(3 4) ))
(deftest test-nth
; maps, sets are not supported
(is (thrown? UnsupportedOperationException (nth {} 0)))
(is (thrown? UnsupportedOperationException (nth {:a 1 :b 2} 0)))
(is (thrown? UnsupportedOperationException (nth #{} 0)))
(is (thrown? UnsupportedOperationException (nth #{1 2 3} 0)))
; out of bounds
(is (thrown? IndexOutOfBoundsException (nth '() 0)))
(is (thrown? IndexOutOfBoundsException (nth '(1 2 3) 5)))
(is (thrown? IndexOutOfBoundsException (nth '() -1)))
(is (thrown? IndexOutOfBoundsException (nth '(1 2 3) -1)))
(is (thrown? IndexOutOfBoundsException (nth [] 0)))
(is (thrown? IndexOutOfBoundsException (nth [1 2 3] 5)))
(is (thrown? IndexOutOfBoundsException (nth [] -1)))
(is (thrown? IndexOutOfBoundsException (nth [1 2 3] -1))) ; ???
(is (thrown? IndexOutOfBoundsException (nth (into-array []) 0)))
(is (thrown? IndexOutOfBoundsException (nth (into-array [1 2 3]) 5)))
(is (thrown? IndexOutOfBoundsException (nth (into-array []) -1)))
(is (thrown? IndexOutOfBoundsException (nth (into-array [1 2 3]) -1)))
(is (thrown? StringIndexOutOfBoundsException (nth "" 0)))
(is (thrown? StringIndexOutOfBoundsException (nth "abc" 5)))
(is (thrown? StringIndexOutOfBoundsException (nth "" -1)))
(is (thrown? StringIndexOutOfBoundsException (nth "abc" -1)))
(is (thrown? IndexOutOfBoundsException (nth (java.util.ArrayList. []) 0)))
(is (thrown? IndexOutOfBoundsException (nth (java.util.ArrayList. [1 2 3]) 5)))
(is (thrown? IndexOutOfBoundsException (nth (java.util.ArrayList. []) -1))) ; ???
(is (thrown? IndexOutOfBoundsException (nth (java.util.ArrayList. [1 2 3]) -1))) ; ???
(are [x y] (= x y)
(nth '(1) 0) 1
(nth '(1 2 3) 0) 1
(nth '(1 2 3 4 5) 1) 2
(nth '(1 2 3 4 5) 4) 5
(nth '(1 2 3) 5 :not-found) :not-found
(nth [1] 0) 1
(nth [1 2 3] 0) 1
(nth [1 2 3 4 5] 1) 2
(nth [1 2 3 4 5] 4) 5
(nth [1 2 3] 5 :not-found) :not-found
(nth (into-array [1]) 0) 1
(nth (into-array [1 2 3]) 0) 1
(nth (into-array [1 2 3 4 5]) 1) 2
(nth (into-array [1 2 3 4 5]) 4) 5
(nth (into-array [1 2 3]) 5 :not-found) :not-found
(nth "a" 0) \a
(nth "abc" 0) \a
(nth "abcde" 1) \b
(nth "abcde" 4) \e
(nth "abc" 5 :not-found) :not-found
(nth (java.util.ArrayList. [1]) 0) 1
(nth (java.util.ArrayList. [1 2 3]) 0) 1
(nth (java.util.ArrayList. [1 2 3 4 5]) 1) 2
(nth (java.util.ArrayList. [1 2 3 4 5]) 4) 5
(nth (java.util.ArrayList. [1 2 3]) 5 :not-found) :not-found )
; regex Matchers
(let [m (re-matcher #"(a)(b)" "ababaa")]
(re-find m) ; => ["ab" "a" "b"]
(are [x y] (= x y)
(nth m 0) "ab"
(nth m 1) "a"
(nth m 2) "b"
(nth m 3 :not-found) :not-found
(nth m -1 :not-found) :not-found )
(is (thrown? IndexOutOfBoundsException (nth m 3)))
(is (thrown? IndexOutOfBoundsException (nth m -1))))
(let [m (re-matcher #"c" "ababaa")]
(re-find m) ; => nil
(are [x y] (= x y)
(nth m 0 :not-found) :not-found
(nth m 2 :not-found) :not-found
(nth m -1 :not-found) :not-found )
(is (thrown? IllegalStateException (nth m 0)))
(is (thrown? IllegalStateException (nth m 2)))
(is (thrown? IllegalStateException (nth m -1)))))
; distinct was broken for nil & false:
; fixed in rev 1278:
; http://code.google.com/p/clojure/source/detail?r=1278
;
(deftest test-distinct
(are [x y] (= x y)
(distinct ()) ()
(distinct '(1)) '(1)
(distinct '(1 2 3)) '(1 2 3)
(distinct '(1 2 3 1 1 1)) '(1 2 3)
(distinct '(1 1 1 2)) '(1 2)
(distinct '(1 2 1 2)) '(1 2)
(distinct []) ()
(distinct [1]) '(1)
(distinct [1 2 3]) '(1 2 3)
(distinct [1 2 3 1 2 2 1 1]) '(1 2 3)
(distinct [1 1 1 2]) '(1 2)
(distinct [1 2 1 2]) '(1 2)
(distinct "") ()
(distinct "a") '(\a)
(distinct "abc") '(\a \b \c)
(distinct "abcabab") '(\a \b \c)
(distinct "aaab") '(\a \b)
(distinct "abab") '(\a \b) )
(are [x] (= (distinct [x x]) [x])
nil
false true
0 42
0.0 3.14
2/3
0M 1M
\c
"" "abc"
'sym
:kw
() '(1 2)
[] [1 2]
{} {:a 1 :b 2}
#{} #{1 2} ))
(deftest test-interpose
(are [x y] (= x y)
(interpose 0 []) ()
(interpose 0 [1]) '(1)
(interpose 0 [1 2]) '(1 0 2)
(interpose 0 [1 2 3]) '(1 0 2 0 3) ))
(deftest test-interleave
(are [x y] (= x y)
(interleave [1 2] [3 4]) '(1 3 2 4)
(interleave [1] [3 4]) '(1 3)
(interleave [1 2] [3]) '(1 3)
(interleave [] [3 4]) ()
(interleave [1 2] []) ()
(interleave [] []) ()
(interleave [1]) '(1)
(interleave) () ))
(deftest test-zipmap
(are [x y] (= x y)
(zipmap [:a :b] [1 2]) {:a 1 :b 2}
(zipmap [:a] [1 2]) {:a 1}
(zipmap [:a :b] [1]) {:a 1}
(zipmap [] [1 2]) {}
(zipmap [:a :b] []) {}
(zipmap [] []) {} ))
(deftest test-concat
(are [x y] (= x y)
(concat) ()
(concat []) ()
(concat [1 2]) '(1 2)
(concat [1 2] [3 4]) '(1 2 3 4)
(concat [] [3 4]) '(3 4)
(concat [1 2] []) '(1 2)
(concat [] []) ()
(concat [1 2] [3 4] [5 6]) '(1 2 3 4 5 6) ))
(deftest test-cycle
(are [x y] (= x y)
(cycle []) ()
(take 3 (cycle [1])) '(1 1 1)
(take 5 (cycle [1 2 3])) '(1 2 3 1 2)
(take 3 (cycle [nil])) '(nil nil nil) ))
(deftest test-partition
(are [x y] (= x y)
(partition 2 [1 2 3]) '((1 2))
(partition 2 [1 2 3 4]) '((1 2) (3 4))
(partition 2 []) ()
(partition 2 3 [1 2 3 4 5 6 7]) '((1 2) (4 5))
(partition 2 3 [1 2 3 4 5 6 7 8]) '((1 2) (4 5) (7 8))
(partition 2 3 []) ()
(partition 1 []) ()
(partition 1 [1 2 3]) '((1) (2) (3))
(partition 5 [1 2 3]) ()
; (partition 0 [1 2 3]) (repeat nil) ; infinite sequence of nil
(partition -1 [1 2 3]) ()
(partition -2 [1 2 3]) () ))
(deftest test-reverse
(are [x y] (= x y)
(reverse nil) () ; since SVN 1294
(reverse []) ()
(reverse [1]) '(1)
(reverse [1 2 3]) '(3 2 1) ))
(deftest test-take
(are [x y] (= x y)
(take 1 [1 2 3 4 5]) '(1)
(take 3 [1 2 3 4 5]) '(1 2 3)
(take 5 [1 2 3 4 5]) '(1 2 3 4 5)
(take 9 [1 2 3 4 5]) '(1 2 3 4 5)
(take 0 [1 2 3 4 5]) ()
(take -1 [1 2 3 4 5]) ()
(take -2 [1 2 3 4 5]) () ))
(deftest test-drop
(are [x y] (= x y)
(drop 1 [1 2 3 4 5]) '(2 3 4 5)
(drop 3 [1 2 3 4 5]) '(4 5)
(drop 5 [1 2 3 4 5]) ()
(drop 9 [1 2 3 4 5]) ()
(drop 0 [1 2 3 4 5]) '(1 2 3 4 5)
(drop -1 [1 2 3 4 5]) '(1 2 3 4 5)
(drop -2 [1 2 3 4 5]) '(1 2 3 4 5) ))
(deftest test-take-nth
(are [x y] (= x y)
(take-nth 1 [1 2 3 4 5]) '(1 2 3 4 5)
(take-nth 2 [1 2 3 4 5]) '(1 3 5)
(take-nth 3 [1 2 3 4 5]) '(1 4)
(take-nth 4 [1 2 3 4 5]) '(1 5)
(take-nth 5 [1 2 3 4 5]) '(1)
(take-nth 9 [1 2 3 4 5]) '(1)
; infinite seq of 1s = (repeat 1)
;(take-nth 0 [1 2 3 4 5])
;(take-nth -1 [1 2 3 4 5])
;(take-nth -2 [1 2 3 4 5])
))
(deftest test-take-while
(are [x y] (= x y)
(take-while pos? []) ()
(take-while pos? [1 2 3 4]) '(1 2 3 4)
(take-while pos? [1 2 3 -1]) '(1 2 3)
(take-while pos? [1 -1 2 3]) '(1)
(take-while pos? [-1 1 2 3]) ()
(take-while pos? [-1 -2 -3]) () ))
(deftest test-drop-while
(are [x y] (= x y)
(drop-while pos? []) ()
(drop-while pos? [1 2 3 4]) ()
(drop-while pos? [1 2 3 -1]) '(-1)
(drop-while pos? [1 -1 2 3]) '(-1 2 3)
(drop-while pos? [-1 1 2 3]) '(-1 1 2 3)
(drop-while pos? [-1 -2 -3]) '(-1 -2 -3) ))
(deftest test-butlast
(are [x y] (= x y)
(butlast []) nil
(butlast [1]) nil
(butlast [1 2 3]) '(1 2) ))
(deftest test-drop-last
(are [x y] (= x y)
; as butlast
(drop-last []) ()
(drop-last [1]) ()
(drop-last [1 2 3]) '(1 2)
; as butlast, but lazy
(drop-last 1 []) ()
(drop-last 1 [1]) ()
(drop-last 1 [1 2 3]) '(1 2)
(drop-last 2 []) ()
(drop-last 2 [1]) ()
(drop-last 2 [1 2 3]) '(1)
(drop-last 5 []) ()
(drop-last 5 [1]) ()
(drop-last 5 [1 2 3]) ()
(drop-last 0 []) ()
(drop-last 0 [1]) '(1)
(drop-last 0 [1 2 3]) '(1 2 3)
(drop-last -1 []) ()
(drop-last -1 [1]) '(1)
(drop-last -1 [1 2 3]) '(1 2 3)
(drop-last -2 []) ()
(drop-last -2 [1]) '(1)
(drop-last -2 [1 2 3]) '(1 2 3) ))
(deftest test-split-at
(is (vector? (split-at 2 [])))
(is (vector? (split-at 2 [1 2 3])))
(are [x y] (= x y)
(split-at 2 []) [() ()]
(split-at 2 [1 2 3 4 5]) [(list 1 2) (list 3 4 5)]
(split-at 5 [1 2 3]) [(list 1 2 3) ()]
(split-at 0 [1 2 3]) [() (list 1 2 3)]
(split-at -1 [1 2 3]) [() (list 1 2 3)]
(split-at -5 [1 2 3]) [() (list 1 2 3)] ))
(deftest test-split-with
(is (vector? (split-with pos? [])))
(is (vector? (split-with pos? [1 2 -1 0 3 4])))
(are [x y] (= x y)
(split-with pos? []) [() ()]
(split-with pos? [1 2 -1 0 3 4]) [(list 1 2) (list -1 0 3 4)]
(split-with pos? [-1 2 3 4 5]) [() (list -1 2 3 4 5)]
(split-with number? [1 -2 "abc" \x]) [(list 1 -2) (list "abc" \x)] ))
(deftest test-repeat
;(is (thrown? IllegalArgumentException (repeat)))
; infinite sequence => use take
(are [x y] (= x y)
(take 0 (repeat 7)) ()
(take 1 (repeat 7)) '(7)
(take 2 (repeat 7)) '(7 7)
(take 5 (repeat 7)) '(7 7 7 7 7) )
; limited sequence
(are [x y] (= x y)
(repeat 0 7) ()
(repeat 1 7) '(7)
(repeat 2 7) '(7 7)
(repeat 5 7) '(7 7 7 7 7)
(repeat -1 7) ()
(repeat -3 7) () )
; test different data types
(are [x] (= (repeat 3 x) (list x x x))
nil
false true
0 42
0.0 3.14
2/3
0M 1M
\c
"" "abc"
'sym
:kw
() '(1 2)
[] [1 2]
{} {:a 1 :b 2}
#{} #{1 2} ))
(deftest test-range
(are [x y] (= x y)
(range 0) () ; exclusive end!
(range 1) '(0)
(range 5) '(0 1 2 3 4)
(range -1) ()
(range -3) ()
(range 2.5) '(0 1 2)
(range 7/3) '(0 1 2)
(range 0 3) '(0 1 2)
(range 0 1) '(0)
(range 0 0) ()
(range 0 -3) ()
(range 3 6) '(3 4 5)
(range 3 4) '(3)
(range 3 3) ()
(range 3 1) ()
(range 3 0) ()
(range 3 -2) ()
(range -2 5) '(-2 -1 0 1 2 3 4)
(range -2 0) '(-2 -1)
(range -2 -1) '(-2)
(range -2 -2) ()
(range -2 -5) ()
(take 3 (range 3 9 0)) '(3 3 3)
(take 3 (range 9 3 0)) '(9 9 9)
(range 0 0 0) ()
(range 3 9 1) '(3 4 5 6 7 8)
(range 3 9 2) '(3 5 7)
(range 3 9 3) '(3 6)
(range 3 9 10) '(3)
(range 3 9 -1) () ))
(deftest test-empty?
(are [x] (empty? x)
nil
()
(lazy-seq nil) ; => ()
[]
{}
#{}
""
(into-array []) )
(are [x] (not (empty? x))
'(1 2)
(lazy-seq [1 2])
[1 2]
{:a 1 :b 2}
#{1 2}
"abc"
(into-array [1 2]) ))
(deftest test-every?
; always true for nil or empty coll/seq
(are [x] (= (every? pos? x) true)
nil
() [] {} #{}
(lazy-seq [])
(into-array []) )
(are [x y] (= x y)
true (every? pos? [1])
true (every? pos? [1 2])
true (every? pos? [1 2 3 4 5])
false (every? pos? [-1])
false (every? pos? [-1 -2])
false (every? pos? [-1 -2 3])
false (every? pos? [-1 2])
false (every? pos? [1 -2])
false (every? pos? [1 2 -3])
false (every? pos? [1 2 -3 4]) )
(are [x y] (= x y)
true (every? #{:a} [:a :a])
;! false (every? #{:a} [:a :b]) ; Issue 68: every? returns nil instead of false
;! false (every? #{:a} [:b :b]) ; http://code.google.com/p/clojure/issues/detail?id=68
))
(deftest test-not-every?
; always false for nil or empty coll/seq
(are [x] (= (not-every? pos? x) false)
nil
() [] {} #{}
(lazy-seq [])
(into-array []) )
(are [x y] (= x y)
false (not-every? pos? [1])
false (not-every? pos? [1 2])
false (not-every? pos? [1 2 3 4 5])
true (not-every? pos? [-1])
true (not-every? pos? [-1 -2])
true (not-every? pos? [-1 -2 3])
true (not-every? pos? [-1 2])
true (not-every? pos? [1 -2])
true (not-every? pos? [1 2 -3])
true (not-every? pos? [1 2 -3 4]) )
(are [x y] (= x y)
false (not-every? #{:a} [:a :a])
true (not-every? #{:a} [:a :b])
true (not-every? #{:a} [:b :b]) ))
(deftest test-not-any?
; always true for nil or empty coll/seq
(are [x] (= (not-any? pos? x) true)
nil
() [] {} #{}
(lazy-seq [])
(into-array []) )
(are [x y] (= x y)
false (not-any? pos? [1])
false (not-any? pos? [1 2])
false (not-any? pos? [1 2 3 4 5])
true (not-any? pos? [-1])
true (not-any? pos? [-1 -2])
false (not-any? pos? [-1 -2 3])
false (not-any? pos? [-1 2])
false (not-any? pos? [1 -2])
false (not-any? pos? [1 2 -3])
false (not-any? pos? [1 2 -3 4]) )
(are [x y] (= x y)
false (not-any? #{:a} [:a :a])
false (not-any? #{:a} [:a :b])
true (not-any? #{:a} [:b :b]) ))
(deftest test-some
;; always nil for nil or empty coll/seq
(are [x] (= (some pos? x) nil)
nil
() [] {} #{}
(lazy-seq [])
(into-array []))
(are [x y] (= x y)
nil (some nil nil)
true (some pos? [1])
true (some pos? [1 2])
nil (some pos? [-1])
nil (some pos? [-1 -2])
true (some pos? [-1 2])
true (some pos? [1 -2])
:a (some #{:a} [:a :a])
:a (some #{:a} [:b :a])
nil (some #{:a} [:b :b])
:a (some #{:a} '(:a :b))
:a (some #{:a} #{:a :b})
))
(deftest test-flatten-present
(are [expected nested-val] (= (flatten nested-val) expected)
;simple literals
[] nil
[] 1
[] 'test
[] :keyword
[] 1/2
[] #"[\r\n]"
[] true
[] false
;vectors
[1 2 3 4 5] [[1 2] [3 4 [5]]]
[1 2 3 4 5] [1 2 3 4 5]
[#{1 2} 3 4 5] [#{1 2} 3 4 5]
;sets
[] #{}
[] #{#{1 2} 3 4 5}
[] #{1 2 3 4 5}
[] #{#{1 2} 3 4 5}
;lists
[] '()
[1 2 3 4 5] `(1 2 3 4 5)
;maps
[] {:a 1 :b 2}
[:a 1 :b 2] (sort-by key {:a 1 :b 2})
[] {[:a :b] 1 :c 2}
[:a :b 1 :c 2] (sort-by val {[:a :b] 1 :c 2})
[:a 1 2 :b 3] (sort-by key {:a [1 2] :b 3})
;Strings
[] "12345"
[\1 \2 \3 \4 \5] (seq "12345")
;fns
[] count
[count even? odd?] [count even? odd?]))
(deftest test-group-by
(is (= (group-by even? [1 2 3 4 5])
{false [1 3 5], true [2 4]})))
(deftest test-partition-by
(are [test-seq] (= (partition-by (comp even? count) test-seq)
[["a"] ["bb" "cccc" "dd"] ["eee" "f"] ["" "hh"]])
["a" "bb" "cccc" "dd" "eee" "f" "" "hh"]
'("a" "bb" "cccc" "dd" "eee" "f" "" "hh"))
(is (=(partition-by #{\a \e \i \o \u} "abcdefghijklm")
[[\a] [\b \c \d] [\e] [\f \g \h] [\i] [\j \k \l \m]])))
(deftest test-frequencies
(are [expected test-seq] (= (frequencies test-seq) expected)
{\p 2, \s 4, \i 4, \m 1} "mississippi"
{1 4 2 2 3 1} [1 1 1 1 2 2 3]
{1 4 2 2 3 1} '(1 1 1 1 2 2 3)))
(deftest test-reductions
(is (= (reductions + nil)
[0]))
(is (= (reductions + [1 2 3 4 5])
[1 3 6 10 15]))
(is (= (reductions + 10 [1 2 3 4 5])
[10 11 13 16 20 25])))
(deftest test-rand-nth-invariants
(let [elt (rand-nth [:a :b :c :d])]
(is (#{:a :b :c :d} elt))))
(deftest test-partition-all
(is (= (partition-all 4 [1 2 3 4 5 6 7 8 9])
[[1 2 3 4] [5 6 7 8] [9]]))
(is (= (partition-all 4 2 [1 2 3 4 5 6 7 8 9])
[[1 2 3 4] [3 4 5 6] [5 6 7 8] [7 8 9] [9]])))
(deftest test-shuffle-invariants
(is (= (count (shuffle [1 2 3 4])) 4))
(let [shuffled-seq (shuffle [1 2 3 4])]
(is (every? #{1 2 3 4} shuffled-seq))))
clojure1.6_1.6.0+dfsg.orig/test/clojure/test_clojure/serialization.clj 0000664 0000000 0000000 00000010234 12346720654 0026052 0 ustar 00root root 0000000 0000000 ; 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.
;; Author: Chas Emerick
;; cemerick@snowtide.com
(ns clojure.test-clojure.serialization
(:use clojure.test)
(:import (java.io ObjectOutputStream ObjectInputStream
ByteArrayOutputStream ByteArrayInputStream)))
(defn- serialize
"Serializes a single object, returning a byte array."
[v]
(with-open [bout (ByteArrayOutputStream.)
oos (ObjectOutputStream. bout)]
(.writeObject oos v)
(.flush oos)
(.toByteArray bout)))
(defn- deserialize
"Deserializes and returns a single object from the given byte array."
[bytes]
(with-open [ois (-> bytes ByteArrayInputStream. ObjectInputStream.)]
(.readObject ois)))
(defrecord SerializationRecord [a b c])
(defstruct SerializationStruct :a :b :c)
(defn- build-via-transient
[coll]
(persistent!
(reduce conj! (transient coll) (map vec (partition 2 (range 1000))))))
(defn- roundtrip
[v]
(let [rt (-> v serialize deserialize)
rt-seq (-> v seq serialize deserialize)]
(and (= v rt)
(= (seq v) (seq rt))
(= (seq v) rt-seq))))
(deftest sequable-serialization
(are [val] (roundtrip val)
; lists and related
(list)
(apply list (range 10))
(cons 0 nil)
(clojure.lang.Cons. 0 nil)
; vectors
[]
(into [] (range 10))
(into [] (range 25))
(into [] (range 100))
(into [] (range 500))
(into [] (range 1000))
; maps
{}
{:a 5 :b 0}
(apply array-map (range 100))
(apply hash-map (range 100))
; sets
#{}
#{'a 'b 'c}
(set (range 10))
(set (range 25))
(set (range 100))
(set (range 500))
(set (range 1000))
(sorted-set)
(sorted-set 'a 'b 'c)
(apply sorted-set (reverse (range 10)))
(apply sorted-set (reverse (range 25)))
(apply sorted-set (reverse (range 100)))
(apply sorted-set (reverse (range 500)))
(apply sorted-set (reverse (range 1000)))
; queues
clojure.lang.PersistentQueue/EMPTY
(into clojure.lang.PersistentQueue/EMPTY (range 50))
; lazy seqs
(lazy-seq nil)
(lazy-seq (range 50))
; transient / persistent! round-trip
(build-via-transient [])
(build-via-transient {})
(build-via-transient #{})
; array-seqs
(seq (make-array Object 10))
(seq (make-array Boolean/TYPE 10))
(seq (make-array Byte/TYPE 10))
(seq (make-array Character/TYPE 10))
(seq (make-array Double/TYPE 10))
(seq (make-array Float/TYPE 10))
(seq (make-array Integer/TYPE 10))
(seq (make-array Long/TYPE 10))
; "records"
(SerializationRecord. 0 :foo (range 20))
(struct SerializationStruct 0 :foo (range 20))
; misc seqs
(seq "s11n")
(range 50)
(rseq (apply sorted-set (reverse (range 100))))))
(deftest misc-serialization
(are [v] (= v (-> v serialize deserialize))
25/3
:keyword
::namespaced-keyword
'symbol))
(deftest interned-serializations
(are [v] (identical? v (-> v serialize deserialize))
clojure.lang.RT/DEFAULT_COMPARATOR
; namespaces just get deserialized back into the same-named ns in the present runtime
; (they're referred to by defrecord instances)
*ns*))
(deftest function-serialization
(let [capture 5]
(are [f] (= capture ((-> f serialize deserialize)))
(constantly 5)
(fn [] 5)
#(do 5)
(constantly capture)
(fn [] capture)
#(do capture))))
(deftest check-unserializable-objects
(are [t] (thrown? java.io.NotSerializableException (serialize t))
;; transients
(transient [])
(transient {})
(transient #{})
;; reference types
(atom nil)
(ref nil)
(agent nil)
#'+
;; stateful seqs
(enumeration-seq (java.util.Collections/enumeration (range 50)))
(iterator-seq (.iterator (range 50))))) clojure1.6_1.6.0+dfsg.orig/test/clojure/test_clojure/special.clj 0000664 0000000 0000000 00000003546 12346720654 0024625 0 ustar 00root root 0000000 0000000 ; 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.
; Author: Frantisek Sodomka
;;
;; Test special forms, macros and metadata
;;
(ns clojure.test-clojure.special
(:use clojure.test))
; http://clojure.org/special_forms
; let, letfn
; quote
; var
; fn
(deftest multiple-keys-in-destructuring
(let [foo (fn [& {:keys [x]}] x)
bar (fn [& options] (apply foo :x :b options))]
(is (= (bar) :b))
(is (= (bar :x :a) :a))))
(deftest empty-list-with-:as-destructuring
(let [{:as x} '()]
(is (= {} x))))
(deftest keywords-in-destructuring
(let [{:keys [:a :b]} {:a 1 :b 2}]
(is (= 1 a))
(is (= 2 b))))
(deftest namespaced-keywords-in-destructuring
(let [{:keys [:a/b :c/d]} {:a/b 1 :c/d 2}]
(is (= 1 b))
(is (= 2 d))))
(deftest namespaced-keys-in-destructuring
(let [{:keys [a/b c/d]} {:a/b 1 :c/d 2}]
(is (= 1 b))
(is (= 2 d))))
(deftest namespaced-syms-in-destructuring
(let [{:syms [a/b c/d]} {'a/b 1 'c/d 2}]
(is (= 1 b))
(is (= 2 d))))
(deftest keywords-not-allowed-in-let-bindings
(is (thrown-with-msg? Exception #"Unsupported binding key: :a"
(eval '(let [:a 1] a))))
(is (thrown-with-msg? Exception #"Unsupported binding key: :a/b"
(eval '(let [:a/b 1] b)))))
(require '[clojure.string :as s])
(deftest resolve-keyword-ns-alias-in-destructuring
(let [{:keys [::s/x ::s/y]} {:clojure.string/x 1 :clojure.string/y 2}]
(is (= x 1))
(is (= y 2))))
clojure1.6_1.6.0+dfsg.orig/test/clojure/test_clojure/string.clj 0000664 0000000 0000000 00000012432 12346720654 0024505 0 ustar 00root root 0000000 0000000 (ns clojure.test-clojure.string
(:require [clojure.string :as s])
(:use clojure.test))
(deftest t-split
(is (= ["a" "b"] (s/split "a-b" #"-")))
(is (= ["a" "b-c"] (s/split "a-b-c" #"-" 2)))
(is (vector? (s/split "abc" #"-"))))
(deftest t-reverse
(is (= "tab" (s/reverse "bat"))))
(deftest t-replace
(is (= "faabar" (s/replace "foobar" \o \a)))
(is (= "foobar" (s/replace "foobar" \z \a)))
(is (= "barbarbar" (s/replace "foobarfoo" "foo" "bar")))
(is (= "foobarfoo" (s/replace "foobarfoo" "baz" "bar")))
(is (= "f$$d" (s/replace "food" "o" "$")))
(is (= "f\\\\d" (s/replace "food" "o" "\\")))
(is (= "barbarbar" (s/replace "foobarfoo" #"foo" "bar")))
(is (= "foobarfoo" (s/replace "foobarfoo" #"baz" "bar")))
(is (= "f$$d" (s/replace "food" #"o" (s/re-quote-replacement "$"))))
(is (= "f\\\\d" (s/replace "food" #"o" (s/re-quote-replacement "\\"))))
(is (= "FOObarFOO" (s/replace "foobarfoo" #"foo" s/upper-case)))
(is (= "foobarfoo" (s/replace "foobarfoo" #"baz" s/upper-case)))
(is (= "OObarOO" (s/replace "foobarfoo" #"f(o+)" (fn [[m g1]] (s/upper-case g1)))))
(is (= "baz\\bang\\" (s/replace "bazslashbangslash" #"slash" (constantly "\\")))))
(deftest t-replace-first
(is (= "faobar" (s/replace-first "foobar" \o \a)))
(is (= "foobar" (s/replace-first "foobar" \z \a)))
(is (= "z.ology" (s/replace-first "zoology" \o \.)))
(is (= "barbarfoo" (s/replace-first "foobarfoo" "foo" "bar")))
(is (= "foobarfoo" (s/replace-first "foobarfoo" "baz" "bar")))
(is (= "f$od" (s/replace-first "food" "o" "$")))
(is (= "f\\od" (s/replace-first "food" "o" "\\")))
(is (= "barbarfoo" (s/replace-first "foobarfoo" #"foo" "bar")))
(is (= "foobarfoo" (s/replace-first "foobarfoo" #"baz" "bar")))
(is (= "f$od" (s/replace-first "food" #"o" (s/re-quote-replacement "$"))))
(is (= "f\\od" (s/replace-first "food" #"o" (s/re-quote-replacement "\\"))))
(is (= "FOObarfoo" (s/replace-first "foobarfoo" #"foo" s/upper-case)))
(is (= "foobarfoo" (s/replace-first "foobarfoo" #"baz" s/upper-case)))
(is (= "OObarfoo" (s/replace-first "foobarfoo" #"f(o+)" (fn [[m g1]] (s/upper-case g1)))))
(is (= "baz\\bangslash" (s/replace-first "bazslashbangslash" #"slash" (constantly "\\")))))
(deftest t-join
(are [x coll] (= x (s/join coll))
"" nil
"" []
"1" [1]
"12" [1 2])
(are [x sep coll] (= x (s/join sep coll))
"1,2,3" \, [1 2 3]
"" \, []
"1" \, [1]
"1 and-a 2 and-a 3" " and-a " [1 2 3]))
(deftest t-trim-newline
(is (= "foo" (s/trim-newline "foo\n")))
(is (= "foo" (s/trim-newline "foo\r\n")))
(is (= "foo" (s/trim-newline "foo")))
(is (= "" (s/trim-newline ""))))
(deftest t-capitalize
(is (= "Foobar" (s/capitalize "foobar")))
(is (= "Foobar" (s/capitalize "FOOBAR"))))
(deftest t-triml
(is (= "foo " (s/triml " foo ")))
(is (= "" (s/triml " ")))
(is (= "bar" (s/triml "\u2002 \tbar"))))
(deftest t-trimr
(is (= " foo" (s/trimr " foo ")))
(is (= "" (s/trimr " ")))
(is (= "bar" (s/trimr "bar\t \u2002"))))
(deftest t-trim
(is (= "foo" (s/trim " foo \r\n")))
(is (= "bar" (s/trim "\u2000bar\t \u2002"))))
(deftest t-upper-case
(is (= "FOOBAR" (s/upper-case "Foobar"))))
(deftest t-lower-case
(is (= "foobar" (s/lower-case "FooBar"))))
(deftest nil-handling
(are [f args] (thrown? NullPointerException (apply f args))
s/reverse [nil]
s/replace [nil #"foo" "bar"]
s/replace-first [nil #"foo" "bar"]
s/re-quote-replacement [nil]
s/capitalize [nil]
s/upper-case [nil]
s/lower-case [nil]
s/split [nil #"-"]
s/split [nil #"-" 1]
s/trim [nil]
s/triml [nil]
s/trimr [nil]
s/trim-newline [nil]))
(deftest char-sequence-handling
(are [result f args] (let [[^CharSequence s & more] args]
(= result (apply f (StringBuffer. s) more)))
"paz" s/reverse ["zap"]
"foo:bar" s/replace ["foo-bar" \- \:]
"ABC" s/replace ["abc" #"\w" s/upper-case]
"faa" s/replace ["foo" #"o" (StringBuffer. "a")]
"baz::quux" s/replace-first ["baz--quux" #"--" "::"]
"baz::quux" s/replace-first ["baz--quux" (StringBuffer. "--") (StringBuffer. "::")]
"zim-zam" s/replace-first ["zim zam" #" " (StringBuffer. "-")]
"\\\\ \\$" s/re-quote-replacement ["\\ $"]
"Pow" s/capitalize ["POW"]
"BOOM" s/upper-case ["boom"]
"whimper" s/lower-case ["whimPER"]
["foo" "bar"] s/split ["foo-bar" #"-"]
"calvino" s/trim [" calvino "]
"calvino " s/triml [" calvino "]
" calvino" s/trimr [" calvino "]
"the end" s/trim-newline ["the end\r\n\r\r\n"]
true s/blank? [" "]
["a" "b"] s/split-lines ["a\nb"]
"fa la la" s/escape ["fo lo lo" {\o \a}]))
(deftest t-escape
(is (= "<foo&bar>"
(s/escape "" {\& "&" \< "<" \> ">"})))
(is (= " \\\"foo\\\" "
(s/escape " \"foo\" " {\" "\\\""})))
(is (= "faabor"
(s/escape "foobar" {\a \o, \o \a}))))
(deftest t-blank
(is (s/blank? nil))
(is (s/blank? ""))
(is (s/blank? " "))
(is (s/blank? " \t \n \r "))
(is (not (s/blank? " foo "))))
(deftest t-split-lines
(let [result (s/split-lines "one\ntwo\r\nthree")]
(is (= ["one" "two" "three"] result))
(is (vector? result)))
(is (= (list "foo") (s/split-lines "foo"))))
clojure1.6_1.6.0+dfsg.orig/test/clojure/test_clojure/test.clj 0000664 0000000 0000000 00000010364 12346720654 0024160 0 ustar 00root root 0000000 0000000 ; 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.
;;; test_clojure/test.clj: unit tests for test.clj
;; by Stuart Sierra
;; January 16, 2009
;; Thanks to Chas Emerick, Allen Rohner, and Stuart Halloway for
;; contributions and suggestions.
(ns clojure.test-clojure.test
(:use clojure.test)
(:require [clojure.stacktrace :as stack]))
(deftest can-test-symbol
(let [x true]
(is x "Should pass"))
(let [x false]
(is x "Should fail")))
(deftest can-test-boolean
(is true "Should pass")
(is false "Should fail"))
(deftest can-test-nil
(is nil "Should fail"))
(deftest can-test-=
(is (= 2 (+ 1 1)) "Should pass")
(is (= 3 (+ 2 2)) "Should fail"))
(deftest can-test-instance
(is (instance? Long (+ 2 2)) "Should pass")
(is (instance? Float (+ 1 1)) "Should fail"))
(deftest can-test-thrown
(is (thrown? ArithmeticException (/ 1 0)) "Should pass")
;; No exception is thrown:
(is (thrown? Exception (+ 1 1)) "Should fail")
;; Wrong class of exception is thrown:
(is (thrown? ArithmeticException (throw (RuntimeException.))) "Should error"))
(deftest can-test-thrown-with-msg
(is (thrown-with-msg? ArithmeticException #"Divide by zero" (/ 1 0)) "Should pass")
;; Wrong message string:
(is (thrown-with-msg? ArithmeticException #"Something else" (/ 1 0)) "Should fail")
;; No exception is thrown:
(is (thrown? Exception (+ 1 1)) "Should fail")
;; Wrong class of exception is thrown:
(is (thrown-with-msg? IllegalArgumentException #"Divide by zero" (/ 1 0)) "Should error"))
(deftest can-catch-unexpected-exceptions
(is (= 1 (throw (Exception.))) "Should error"))
(deftest can-test-method-call
(is (.startsWith "abc" "a") "Should pass")
(is (.startsWith "abc" "d") "Should fail"))
(deftest can-test-anonymous-fn
(is (#(.startsWith % "a") "abc") "Should pass")
(is (#(.startsWith % "d") "abc") "Should fail"))
(deftest can-test-regexps
(is (re-matches #"^ab.*$" "abbabba") "Should pass")
(is (re-matches #"^cd.*$" "abbabba") "Should fail")
(is (re-find #"ab" "abbabba") "Should pass")
(is (re-find #"cd" "abbabba") "Should fail"))
(deftest clj-1102-empty-stack-trace-should-not-throw-exceptions
(let [empty-stack (into-array (Class/forName "java.lang.StackTraceElement")
[])
t (doto (Exception.) (.setStackTrace empty-stack))]
(is (map? (#'clojure.test/file-and-line t 0)) "Should pass")
(is (string? (with-out-str (stack/print-stack-trace t))) "Should pass")))
(deftest #^{:has-meta true} can-add-metadata-to-tests
(is (:has-meta (meta #'can-add-metadata-to-tests)) "Should pass"))
;; still have to declare the symbol before testing unbound symbols
(declare does-not-exist)
#_(deftest can-test-unbound-symbol
(is (= nil does-not-exist) "Should error"))
#_(deftest can-test-unbound-function
(is (does-not-exist) "Should error"))
;; Here, we create an alternate version of test/report, that
;; compares the event with the message, then calls the original
;; 'report' with modified arguments.
(declare ^:dynamic original-report)
(defn custom-report [data]
(let [event (:type data)
msg (:message data)
expected (:expected data)
actual (:actual data)
passed (cond
(= event :fail) (= msg "Should fail")
(= event :pass) (= msg "Should pass")
(= event :error) (= msg "Should error")
:else true)]
(if passed
(original-report {:type :pass, :message msg,
:expected expected, :actual actual})
(original-report {:type :fail, :message (str msg " but got " event)
:expected expected, :actual actual}))))
;; test-ns-hook will be used by test/test-ns to run tests in this
;; namespace.
(defn test-ns-hook []
(binding [original-report report
report custom-report]
(test-all-vars (find-ns 'clojure.test-clojure.test))))
clojure1.6_1.6.0+dfsg.orig/test/clojure/test_clojure/test_fixtures.clj 0000664 0000000 0000000 00000004306 12346720654 0026110 0 ustar 00root root 0000000 0000000 ; 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.
;
;;; test_fixtures.clj: unit tests for fixtures in test.clj
;; by Stuart Sierra
;; March 28, 2009
(ns clojure.test-clojure.test-fixtures
(:use clojure.test))
(declare ^:dynamic *a* ^:dynamic *b* ^:dynamic *c* ^:dynamic *d*)
(def ^:dynamic *n* 0)
(defn fixture-a [f]
(binding [*a* 3] (f)))
(defn fixture-b [f]
(binding [*b* 5] (f)))
(defn fixture-c [f]
(binding [*c* 7] (f)))
(defn fixture-d [f]
(binding [*d* 11] (f)))
(defn inc-n-fixture [f]
(binding [*n* (inc *n*)] (f)))
(def side-effects (atom 0))
(defn side-effecting-fixture [f]
(swap! side-effects inc)
(f))
(use-fixtures :once fixture-a fixture-b)
(use-fixtures :each fixture-c fixture-d inc-n-fixture side-effecting-fixture)
(use-fixtures :each fixture-c fixture-d inc-n-fixture side-effecting-fixture)
(deftest can-use-once-fixtures
(is (= 3 *a*))
(is (= 5 *b*)))
(deftest can-use-each-fixtures
(is (= 7 *c*))
(is (= 11 *d*)))
(deftest use-fixtures-replaces
(is (= *n* 1)))
(deftest can-run-a-single-test-with-fixtures
;; We have to use a side-effecting fixture to test that the fixtures are
;; running, in order to distinguish fixtures run because of our call to
;; test-vars below from the same fixtures running prior to this test
(let [side-effects-so-far @side-effects
reported (atom [])]
(binding [report (fn [m] (swap! reported conj (:type m)))]
(test-vars [#'can-use-each-fixtures]))
(is (= [:begin-test-var :pass :pass :end-test-var] @reported))
(is (= (inc side-effects-so-far) @side-effects))))
(defn should-not-trigger-fixtures [])
(deftest a-var-lacking-test-meta-should-not-trigger-fixtures
(let [side-effects-so-far @side-effects]
(test-vars [#'should-not-trigger-fixtures])
(is (= side-effects-so-far @side-effects))))
clojure1.6_1.6.0+dfsg.orig/test/clojure/test_clojure/transients.clj 0000664 0000000 0000000 00000003061 12346720654 0025367 0 ustar 00root root 0000000 0000000 (ns clojure.test-clojure.transients
(:use clojure.test))
(deftest popping-off
(testing "across a node boundary"
(are [n]
(let [v (-> (range n) vec)]
(= (subvec v 0 (- n 2)) (-> v transient pop! pop! persistent!)))
33 (+ 32 (inc (* 32 32))) (+ 32 (inc (* 32 32 32)))))
(testing "off the end"
(is (thrown-with-msg? IllegalStateException #"Can't pop empty vector"
(-> [] transient pop!))))
(testing "copying array from a non-editable when put in tail position")
(is (= 31 (let [pv (vec (range 34))]
(-> pv transient pop! pop! pop! (conj! 42))
(nth pv 31)))))
(defn- hash-obj [hash]
(reify Object (hashCode [this] hash)))
(deftest dissocing
(testing "dissocing colliding keys"
(is (= [0 {}] (let [ks (concat (range 7) [(hash-obj 42) (hash-obj 42)])
m (zipmap ks ks)
dm (persistent! (reduce dissoc! (transient m) (keys m)))]
[(count dm) dm])))))
(deftest test-disj!
(testing "disjoin multiple items in one call"
(is (= #{5 20} (-> #{5 10 15 20} transient (disj! 10 15) persistent!)))))
(deftest empty-transient
(is (= false (.contains (transient #{}) :bogus-key))))
(deftest persistent-assoc-on-collision
(testing "Persistent assoc on a collision node which underwent a transient dissoc"
(let [a (reify Object (hashCode [_] 42))
b (reify Object (hashCode [_] 42))]
(is (= (-> #{a b} transient (disj! a) persistent! (conj a))
(-> #{a b} transient (disj! a) persistent! (conj a)))))))
clojure1.6_1.6.0+dfsg.orig/test/clojure/test_clojure/try_catch.clj 0000664 0000000 0000000 00000002760 12346720654 0025162 0 ustar 00root root 0000000 0000000 ; 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.
; Author: Paul M Bauer
(ns clojure.test-clojure.try-catch
(:use clojure.test)
(:import [clojure.test ReflectorTryCatchFixture
ReflectorTryCatchFixture$Cookies]))
(defn- get-exception [expression]
(try (eval expression)
nil
(catch java.lang.Throwable t
t)))
(deftest catch-receives-checked-exception-from-eval
(are [expression expected-exception] (= expected-exception
(type (get-exception expression)))
"Eh, I'm pretty safe" nil
'(java.io.FileReader. "CAFEBABEx0/idonotexist") java.io.FileNotFoundException))
(defn fail [x]
(ReflectorTryCatchFixture/fail x))
(defn make-instance []
(ReflectorTryCatchFixture.))
(deftest catch-receives-checked-exception-from-reflective-call
(is (thrown-with-msg? ReflectorTryCatchFixture$Cookies #"Long" (fail 1)))
(is (thrown-with-msg? ReflectorTryCatchFixture$Cookies #"Double" (fail 1.0)))
(is (thrown-with-msg? ReflectorTryCatchFixture$Cookies #"Wrapped"
(.failWithCause (make-instance) 1.0))))
clojure1.6_1.6.0+dfsg.orig/test/clojure/test_clojure/vars.clj 0000664 0000000 0000000 00000006060 12346720654 0024152 0 ustar 00root root 0000000 0000000 ; 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.
; Author: Frantisek Sodomka, Stephen C. Gilardi
(ns clojure.test-clojure.vars
(:use clojure.test))
; http://clojure.org/vars
; def
; defn defn- defonce
; declare intern binding find-var var
(def ^:dynamic a)
(deftest test-binding
(are [x y] (= x y)
(eval `(binding [a 4] a)) 4 ; regression in Clojure SVN r1370
))
; var-get var-set alter-var-root [var? (predicates.clj)]
; with-in-str with-out-str
; with-open
(deftest test-with-local-vars
(let [factorial (fn [x]
(with-local-vars [acc 1, cnt x]
(while (> @cnt 0)
(var-set acc (* @acc @cnt))
(var-set cnt (dec @cnt)))
@acc))]
(is (= (factorial 5) 120))))
(deftest test-with-precision
(are [x y] (= x y)
(with-precision 4 (+ 3.5555555M 1)) 4.556M
(with-precision 6 (+ 3.5555555M 1)) 4.55556M
(with-precision 6 :rounding CEILING (+ 3.5555555M 1)) 4.55556M
(with-precision 6 :rounding FLOOR (+ 3.5555555M 1)) 4.55555M
(with-precision 6 :rounding HALF_UP (+ 3.5555555M 1)) 4.55556M
(with-precision 6 :rounding HALF_DOWN (+ 3.5555555M 1)) 4.55556M
(with-precision 6 :rounding HALF_EVEN (+ 3.5555555M 1)) 4.55556M
(with-precision 6 :rounding UP (+ 3.5555555M 1)) 4.55556M
(with-precision 6 :rounding DOWN (+ 3.5555555M 1)) 4.55555M
(with-precision 6 :rounding UNNECESSARY (+ 3.5555M 1)) 4.5555M))
(deftest test-settable-math-context
(is (=
(clojure.main/with-bindings
(set! *math-context* (java.math.MathContext. 8))
(+ 3.55555555555555M 1))
4.5555556M)))
; set-validator get-validator
; doc find-doc test
(def stub-me :original)
(deftest test-with-redefs-fn
(let [p (promise)]
(with-redefs-fn {#'stub-me :temp}
(fn []
(.start (Thread. #(deliver p stub-me)))
@p))
(is (= :temp @p))
(is (= :original stub-me))))
(deftest test-with-redefs
(let [p (promise)]
(with-redefs [stub-me :temp]
(.start (Thread. #(deliver p stub-me)))
@p)
(is (= :temp @p))
(is (= :original stub-me))))
(deftest test-with-redefs-throw
(let [p (promise)]
(is (thrown? Exception
(with-redefs [stub-me :temp]
(deliver p stub-me)
(throw (Exception. "simulated failure in with-redefs")))))
(is (= :temp @p))
(is (= :original stub-me))))
(def ^:dynamic dynamic-var 1)
(deftest test-with-redefs-inside-binding
(binding [dynamic-var 2]
(is (= 2 dynamic-var))
(with-redefs [dynamic-var 3]
(is (= 2 dynamic-var))))
(is (= 1 dynamic-var))) clojure1.6_1.6.0+dfsg.orig/test/clojure/test_clojure/vectors.clj 0000664 0000000 0000000 00000034533 12346720654 0024672 0 ustar 00root root 0000000 0000000 ; 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.
; Author: Stuart Halloway, Daniel Solano Gómez
(ns clojure.test-clojure.vectors
(:use clojure.test))
(deftest test-reversed-vec
(let [r (range 6)
v (into (vector-of :int) r)
reversed (.rseq v)]
(testing "returns the right impl"
(is (= clojure.lang.APersistentVector$RSeq (class reversed))))
(testing "RSeq methods"
(is (= [5 4 3 2 1 0] reversed))
(is (= 5 (.index reversed)))
(is (= 5 (.first reversed)))
(is (= [4 3 2 1 0] (.next reversed)))
(is (= [3 2 1 0] (.. reversed next next)))
(is (= 6 (.count reversed))))
(testing "clojure calling through"
(is (= 5 (first reversed)))
(is (= 5 (nth reversed 0))))
(testing "empty reverses to nil"
(is (nil? (.. v empty rseq))))))
(deftest test-vecseq
(let [r (range 100)
vs (into (vector-of :int) r)
vs-1 (next vs)
vs-32 (.chunkedNext (seq vs))]
(testing "="
(are [a b] (= a b)
vs vs
vs-1 vs-1
vs-32 vs-32)
(are [a b] (not= a b)
vs vs-1
vs-1 vs
vs vs-32
vs-32 vs))
(testing "IPersistentCollection.empty"
(are [a] (identical? clojure.lang.PersistentList/EMPTY (.empty (seq a)))
vs vs-1 vs-32))
(testing "IPersistentCollection.cons"
(are [result input] (= result (.cons input :foo))
[:foo 1] (seq (into (vector-of :int) [1]))))
(testing "IPersistentCollection.count"
(are [ct s] (= ct (.count (seq s)))
100 vs
99 vs-1
68 vs-32)
;; can't manufacture this scenario: ASeq defers to Counted, but
;; LazySeq doesn't, so Counted never gets checked on reified seq below
#_(testing "hops to counted when available"
(is (= 200
(.count (concat
(seq vs)
(reify clojure.lang.ISeq
(seq [this] this)
clojure.lang.Counted
(count [_] 100))))))))
(testing "IPersistentCollection.equiv"
(are [a b] (true? (.equiv a b))
vs vs
vs-1 vs-1
vs-32 vs-32
vs r)
(are [a b] (false? (.equiv a b))
vs vs-1
vs-1 vs
vs vs-32
vs-32 vs
vs nil))))
(deftest test-primitive-subvector-reduce
;; regression test for CLJ-1082
(is (== 60 (let [prim-vec (into (vector-of :long) (range 1000))]
(reduce + (subvec prim-vec 10 15))))))
(deftest test-vec-compare
(let [nums (range 1 100)
; randomly replaces a single item with the given value
rand-replace (fn[val]
(let [r (rand-int 99)]
(concat (take r nums) [val] (drop (inc r) nums))))
; all num sequences in map
num-seqs {:standard nums
:empty '()
; different lengths
:longer (concat nums [100])
:shorter (drop-last nums)
; greater by value
:first-greater (concat [100] (next nums))
:last-greater (concat (drop-last nums) [100])
:rand-greater-1 (rand-replace 100)
:rand-greater-2 (rand-replace 100)
:rand-greater-3 (rand-replace 100)
; lesser by value
:first-lesser (concat [0] (next nums))
:last-lesser (concat (drop-last nums) [0])
:rand-lesser-1 (rand-replace 0)
:rand-lesser-2 (rand-replace 0)
:rand-lesser-3 (rand-replace 0)}
; a way to create compare values based on num-seqs
create-vals (fn[base-val]
(zipmap (keys num-seqs)
(map #(into base-val %1) (vals num-seqs))))
; Vecs made of int primitives
int-vecs (create-vals (vector-of :int))
; Vecs made of long primitives
long-vecs (create-vals (vector-of :long))
; standard boxing vectors
regular-vecs (create-vals [])
; the standard int Vec for comparisons
int-vec (:standard int-vecs)]
(testing "compare"
(testing "identical"
(is (= 0 (compare int-vec int-vec))))
(testing "equivalent"
(are [x y] (= 0 (compare x y))
; standard
int-vec (:standard long-vecs)
(:standard long-vecs) int-vec
int-vec (:standard regular-vecs)
(:standard regular-vecs) int-vec
; empty
(:empty int-vecs) (:empty long-vecs)
(:empty long-vecs) (:empty int-vecs)))
(testing "lesser"
(are [x] (= -1 (compare int-vec x))
(:longer int-vecs)
(:longer long-vecs)
(:longer regular-vecs)
(:first-greater int-vecs)
(:first-greater long-vecs)
(:first-greater regular-vecs)
(:last-greater int-vecs)
(:last-greater long-vecs)
(:last-greater regular-vecs)
(:rand-greater-1 int-vecs)
(:rand-greater-1 long-vecs)
(:rand-greater-1 regular-vecs)
(:rand-greater-2 int-vecs)
(:rand-greater-2 long-vecs)
(:rand-greater-2 regular-vecs)
(:rand-greater-3 int-vecs)
(:rand-greater-3 long-vecs)
(:rand-greater-3 regular-vecs))
(are [x] (= -1 (compare x int-vec))
nil
(:empty int-vecs)
(:empty long-vecs)
(:empty regular-vecs)
(:shorter int-vecs)
(:shorter long-vecs)
(:shorter regular-vecs)
(:first-lesser int-vecs)
(:first-lesser long-vecs)
(:first-lesser regular-vecs)
(:last-lesser int-vecs)
(:last-lesser long-vecs)
(:last-lesser regular-vecs)
(:rand-lesser-1 int-vecs)
(:rand-lesser-1 long-vecs)
(:rand-lesser-1 regular-vecs)
(:rand-lesser-2 int-vecs)
(:rand-lesser-2 long-vecs)
(:rand-lesser-2 regular-vecs)
(:rand-lesser-3 int-vecs)
(:rand-lesser-3 long-vecs)
(:rand-lesser-3 regular-vecs)))
(testing "greater"
(are [x] (= 1 (compare int-vec x))
nil
(:empty int-vecs)
(:empty long-vecs)
(:empty regular-vecs)
(:shorter int-vecs)
(:shorter long-vecs)
(:shorter regular-vecs)
(:first-lesser int-vecs)
(:first-lesser long-vecs)
(:first-lesser regular-vecs)
(:last-lesser int-vecs)
(:last-lesser long-vecs)
(:last-lesser regular-vecs)
(:rand-lesser-1 int-vecs)
(:rand-lesser-1 long-vecs)
(:rand-lesser-1 regular-vecs)
(:rand-lesser-2 int-vecs)
(:rand-lesser-2 long-vecs)
(:rand-lesser-2 regular-vecs)
(:rand-lesser-3 int-vecs)
(:rand-lesser-3 long-vecs)
(:rand-lesser-3 regular-vecs))
(are [x] (= 1 (compare x int-vec))
(:longer int-vecs)
(:longer long-vecs)
(:longer regular-vecs)
(:first-greater int-vecs)
(:first-greater long-vecs)
(:first-greater regular-vecs)
(:last-greater int-vecs)
(:last-greater long-vecs)
(:last-greater regular-vecs)
(:rand-greater-1 int-vecs)
(:rand-greater-1 long-vecs)
(:rand-greater-1 regular-vecs)
(:rand-greater-2 int-vecs)
(:rand-greater-2 long-vecs)
(:rand-greater-2 regular-vecs)
(:rand-greater-3 int-vecs)
(:rand-greater-3 long-vecs)
(:rand-greater-3 regular-vecs))))
(testing "Comparable.compareTo"
(testing "incompatible"
(is (thrown? NullPointerException (.compareTo int-vec nil)))
(are [x] (thrown? ClassCastException (.compareTo int-vec x))
'()
{}
#{}
(sorted-set)
(sorted-map)
nums
1))
(testing "identical"
(is (= 0 (.compareTo int-vec int-vec))))
(testing "equivalent"
(are [x] (= 0 (.compareTo int-vec x))
(:standard long-vecs)
(:standard regular-vecs)))
(testing "lesser"
(are [x] (= -1 (.compareTo int-vec x))
(:longer int-vecs)
(:longer long-vecs)
(:longer regular-vecs)
(:first-greater int-vecs)
(:first-greater long-vecs)
(:first-greater regular-vecs)
(:last-greater int-vecs)
(:last-greater long-vecs)
(:last-greater regular-vecs)
(:rand-greater-1 int-vecs)
(:rand-greater-1 long-vecs)
(:rand-greater-1 regular-vecs)
(:rand-greater-2 int-vecs)
(:rand-greater-2 long-vecs)
(:rand-greater-2 regular-vecs)
(:rand-greater-3 int-vecs)
(:rand-greater-3 long-vecs)
(:rand-greater-3 regular-vecs)))
(testing "greater"
(are [x] (= 1 (.compareTo int-vec x))
(:empty int-vecs)
(:empty long-vecs)
(:empty regular-vecs)
(:shorter int-vecs)
(:shorter long-vecs)
(:shorter regular-vecs)
(:first-lesser int-vecs)
(:first-lesser long-vecs)
(:first-lesser regular-vecs)
(:last-lesser int-vecs)
(:last-lesser long-vecs)
(:last-lesser regular-vecs)
(:rand-lesser-1 int-vecs)
(:rand-lesser-1 long-vecs)
(:rand-lesser-1 regular-vecs)
(:rand-lesser-2 int-vecs)
(:rand-lesser-2 long-vecs)
(:rand-lesser-2 regular-vecs)
(:rand-lesser-3 int-vecs)
(:rand-lesser-3 long-vecs)
(:rand-lesser-3 regular-vecs))))))
(deftest test-vec-associative
(let [empty-v (vector-of :long)
v (into empty-v (range 1 6))]
(testing "Associative.containsKey"
(are [x] (.containsKey v x)
0 1 2 3 4)
(are [x] (not (.containsKey v x))
-1 -100 nil [] "" #"" #{} 5 100)
(are [x] (not (.containsKey empty-v x))
0 1))
(testing "contains?"
(are [x] (contains? v x)
0 2 4)
(are [x] (not (contains? v x))
-1 -100 nil "" 5 100)
(are [x] (not (contains? empty-v x))
0 1))
(testing "Associative.entryAt"
(are [idx val] (= (clojure.lang.MapEntry. idx val)
(.entryAt v idx))
0 1
2 3
4 5)
(are [idx] (nil? (.entryAt v idx))
-5 -1 5 10 nil "")
(are [idx] (nil? (.entryAt empty-v idx))
0 1))))
(deftest test-vec-creation
(testing "Plain (vector-of :type)"
(are [x] (and (empty? x) (instance? clojure.core.Vec x))
(vector-of :boolean)
(vector-of :byte)
(vector-of :short)
(vector-of :int)
(vector-of :long)
(vector-of :float)
(vector-of :double)
(vector-of :char))
(testing "with invalid type argument"
(are [x] (thrown? NullPointerException x)
(vector-of nil)
(vector-of Float/TYPE)
(vector-of 'int)
(vector-of ""))))
(testing "vector-like (vector-of :type x1 x2 x3 … xn)"
(are [vec gvec] (and (instance? clojure.core.Vec gvec)
(= (into (vector-of :int) vec) gvec)
(= vec gvec)
(= (hash vec) (hash gvec)))
[1] (vector-of :int 1)
[1 2] (vector-of :int 1 2)
[1 2 3] (vector-of :int 1 2 3)
[1 2 3 4] (vector-of :int 1 2 3 4)
[1 2 3 4 5] (vector-of :int 1 2 3 4 5)
[1 2 3 4 5 6] (vector-of :int 1 2 3 4 5 6)
(apply vector (range 1000)) (apply vector-of :int (range 1000))
[1 2 3] (vector-of :int 1M 2.0 3.1)
[97 98 99] (vector-of :int \a \b \c))
(testing "with null values"
(are [x] (thrown? NullPointerException x)
(vector-of :int nil)
(vector-of :int 1 nil)
(vector-of :int 1 2 nil)
(vector-of :int 1 2 3 nil)
(vector-of :int 1 2 3 4 nil)
(vector-of :int 1 2 3 4 5 nil)
(vector-of :int 1 2 3 4 5 6 nil)))
(testing "with unsupported values"
(are [x] (thrown? ClassCastException x)
(vector-of :int true)
(vector-of :int 1 2 3 4 5 false)
(vector-of :int {:a 1 :b 2})
(vector-of :int [1 2 3 4] [5 6])
(vector-of :int '(1 2 3 4))
(vector-of :int #{1 2 3 4})
(vector-of :int (sorted-set 1 2 3 4))
(vector-of :int 1 2 "3")
(vector-of :int "1" "2" "3")))))
(deftest empty-vector-equality
(let [colls [[] (vector-of :long) '()]]
(doseq [c1 colls, c2 colls]
(is (= c1 c2))
(is (.equals c1 c2)))))
(defn =vec
[expected v] (and (vector? v) (= expected v)))
(deftest test-mapv
(are [r c1] (=vec r (mapv + c1))
[1 2 3] [1 2 3])
(are [r c1 c2] (=vec r (mapv + c1 c2))
[2 3 4] [1 2 3] (repeat 1))
(are [r c1 c2 c3] (=vec r (mapv + c1 c2 c3))
[3 4 5] [1 2 3] (repeat 1) (repeat 1))
(are [r c1 c2 c3 c4] (=vec r (mapv + c1 c2 c3 c4))
[4 5 6] [1 2 3] [1 1 1] [1 1 1] [1 1 1]))
(deftest test-filterv
(are [r c1] (=vec r (filterv even? c1))
[] [1 3 5]
[2 4] [1 2 3 4 5]))
(deftest test-subvec
(let [v1 (vec (range 100))
v2 (subvec v1 50 57)]
(is (thrown? IndexOutOfBoundsException (v2 -1)))
(is (thrown? IndexOutOfBoundsException (v2 7)))
(is (= (v1 50) (v2 0)))
(is (= (v1 56) (v2 6)))))
clojure1.6_1.6.0+dfsg.orig/test/clojure/test_helper.clj 0000664 0000000 0000000 00000010171 12346720654 0023011 0 ustar 00root root 0000000 0000000 ; 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.
;
;; clojure.test-helper
;;
;; Utility functions shared by various tests in the Clojure
;; test suite
;;
;; tomfaulhaber (gmail)
;; Created 04 November 2010
(ns clojure.test-helper
(:use clojure.test))
(let [nl (System/getProperty "line.separator")]
(defn platform-newlines [s] (.replace s "\n" nl)))
(defn temp-ns
"Create and return a temporary ns, using clojure.core + uses"
[& uses]
(binding [*ns* *ns*]
(in-ns (gensym))
(apply clojure.core/use 'clojure.core uses)
*ns*))
(defmacro eval-in-temp-ns [& forms]
`(binding [*ns* *ns*]
(in-ns (gensym))
(clojure.core/use 'clojure.core)
(eval
'(do ~@forms))))
(defn causes
[^Throwable throwable]
(loop [causes []
t throwable]
(if t (recur (conj causes t) (.getCause t)) causes)))
;; this is how I wish clojure.test/thrown? worked...
;; Does body throw expected exception, anywhere in the .getCause chain?
(defmethod assert-expr 'fails-with-cause?
[msg [_ exception-class msg-re & body :as form]]
`(try
~@body
(report {:type :fail, :message ~msg, :expected '~form, :actual nil})
(catch Throwable t#
(if (some (fn [cause#]
(and
(= ~exception-class (class cause#))
(re-find ~msg-re (.getMessage cause#))))
(causes t#))
(report {:type :pass, :message ~msg,
:expected '~form, :actual t#})
(report {:type :fail, :message ~msg,
:expected '~form, :actual t#})))))
(defn get-field
"Access to private or protected field. field-name is a symbol or
keyword."
([klass field-name]
(get-field klass field-name nil))
([klass field-name inst]
(-> klass (.getDeclaredField (name field-name))
(doto (.setAccessible true))
(.get inst))))
(defn set-var-roots
[maplike]
(doseq [[var val] maplike]
(alter-var-root var (fn [_] val))))
(defn with-var-roots*
"Temporarily set var roots, run block, then put original roots back."
[root-map f & args]
(let [originals (doall (map (fn [[var _]] [var @var]) root-map))]
(set-var-roots root-map)
(try
(apply f args)
(finally
(set-var-roots originals)))))
(defmacro with-var-roots
[root-map & body]
`(with-var-roots* ~root-map (fn [] ~@body)))
(defn exception
"Use this function to ensure that execution of a program doesn't
reach certain point."
[]
(throw (new Exception "Exception which should never occur")))
(defmacro with-err-print-writer
"Evaluate with err pointing to a temporary PrintWriter, and
return err contents as a string."
[& body]
`(let [s# (java.io.StringWriter.)
p# (java.io.PrintWriter. s#)]
(binding [*err* p#]
~@body
(str s#))))
(defmacro with-err-string-writer
"Evaluate with err pointing to a temporary StringWriter, and
return err contents as a string."
[& body]
`(let [s# (java.io.StringWriter.)]
(binding [*err* s#]
~@body
(str s#))))
(defmacro should-print-err-message
"Turn on all warning flags, and test that error message prints
correctly for all semi-reasonable bindings of *err*."
[msg-re form]
`(binding [*warn-on-reflection* true]
(is (re-matches ~msg-re (with-err-string-writer (eval-in-temp-ns ~form))))
(is (re-matches ~msg-re (with-err-print-writer (eval-in-temp-ns ~form))))))
(defmacro should-not-reflect
"Turn on all warning flags, and test that reflection does not occur
(as identified by messages to *err*)."
[form]
`(binding [*warn-on-reflection* true]
(is (nil? (re-find #"^Reflection warning" (with-err-string-writer (eval-in-temp-ns ~form)))))
(is (nil? (re-find #"^Reflection warning" (with-err-print-writer (eval-in-temp-ns ~form)))))))
clojure1.6_1.6.0+dfsg.orig/test/java/ 0000775 0000000 0000000 00000000000 12346720654 0017257 5 ustar 00root root 0000000 0000000 clojure1.6_1.6.0+dfsg.orig/test/java/clojure/ 0000775 0000000 0000000 00000000000 12346720654 0020722 5 ustar 00root root 0000000 0000000 clojure1.6_1.6.0+dfsg.orig/test/java/clojure/test/ 0000775 0000000 0000000 00000000000 12346720654 0021701 5 ustar 00root root 0000000 0000000 clojure1.6_1.6.0+dfsg.orig/test/java/clojure/test/ReflectorTryCatchFixture.java 0000664 0000000 0000000 00000001051 12346720654 0027477 0 ustar 00root root 0000000 0000000 package clojure.test;
public class ReflectorTryCatchFixture {
public static void fail(Long x) throws Cookies {
throw new Cookies("Long");
}
public static void fail(Double y) throws Cookies {
throw new Cookies("Double");
}
public void failWithCause(Double y) throws Cookies {
throw new Cookies("Wrapped", new Cookies("Cause"));
}
public static class Cookies extends Exception {
public Cookies(String msg, Throwable cause) { super(msg, cause); }
public Cookies(String msg) { super(msg); }
}
}
clojure1.6_1.6.0+dfsg.orig/test/java/compilation/ 0000775 0000000 0000000 00000000000 12346720654 0021575 5 ustar 00root root 0000000 0000000 clojure1.6_1.6.0+dfsg.orig/test/java/compilation/TestDispatch.java 0000664 0000000 0000000 00000000513 12346720654 0025036 0 ustar 00root root 0000000 0000000 package compilation;
public class TestDispatch {
public static String someMethod (int a, int b) {
return "(int, int)";
}
public static String someMethod (int a, long b) {
return "(int, long)";
}
public static String someMethod (long a, long b) {
return "(long, long)";
}
}