Skip to content

HTTPS clone URL

Subversion checkout URL

You can clone with
or
.
Download ZIP
Browse files

Merge branch 'release/0.8.0-beta.1'

  • Loading branch information...
commit 8f7b11e196c2a40730ed1772eb161171372a4ac1 2 parents 5fc6288 + e46b2d1
@hugoduncan hugoduncan authored
View
6 README.md
@@ -17,7 +17,7 @@ Installation is with maven or your favourite maven repository aware build tool.
### lein/cake project.clj
```clj
-:dependencies [[org.cloudhoist/stevedore "0.7.3"]]
+:dependencies [[org.cloudhoist/stevedore "0.8.0-beta.1"]]
:repositories {"sonatype"
"http://oss.sonatype.org/content/repositories/releases"}
```
@@ -29,7 +29,7 @@ Installation is with maven or your favourite maven repository aware build tool.
<dependency>
<groupId>org.cloudhoist</groupId>
<artifactId>stevedore</artifactId>
- <version>0.7.2</version>
+ <version>0.8.0-beta.1</version>
</dependency>
<dependencies>
@@ -45,4 +45,4 @@ Installation is with maven or your favourite maven repository aware build tool.
Licensed under [EPL](http://www.eclipse.org/legal/epl-v10.html)
-Copyright 2010, 2011, 2012 Hugo Duncan.
+Copyright 2010, 2011, 2012, 2013 Hugo Duncan.
View
15 ReleaseNotes.md
@@ -1,6 +1,19 @@
# Stevedore Release Notes
-The latest release is 0.7.3.
+The latest stable release is 0.7.3.
+
+## 0.8.0-beta.1
+
+- Change groupID to com.palletops
+
+- Use leiningen instead of maven
+
+- Symbols in argument position are resolved
+ This removes the need to deref script functions. Script functions are
+ now regular functions, with a custom dispatch mechanism. Plain clojure
+ functions can now be used as script functions.
+
+ Fixes #22.
## 0.8.0-alpha.1
View
3  dev-resources/logback-test.xml
@@ -3,6 +3,9 @@
<encoder>
<pattern>[%thread] %logger{10} %msg%n</pattern>
</encoder>
+ <filter class="ch.qos.logback.classic.filter.ThresholdFilter">
+ <level>INFO</level>
+ </filter>
</appender>
<appender name="PALLETFILE" class="ch.qos.logback.core.rolling.RollingFileAppender">
View
81 pom.xml
@@ -1,81 +0,0 @@
-<?xml version="1.0" encoding="UTF-8"?>
-<project xmlns="http://maven.apache.org/POM/4.0.0" xmlns:xsi="http://www.w3.org/2001/XMLSchema-instance" xsi:schemaLocation="http://maven.apache.org/POM/4.0.0 http://maven.apache.org/maven-v4_0_0.xsd">
- <modelVersion>4.0.0</modelVersion>
- <parent>
- <groupId>org.cloudhoist</groupId>
- <artifactId>parent-pom</artifactId>
- <version>0.1.3</version>
- </parent>
- <groupId>org.cloudhoist</groupId>
- <artifactId>stevedore</artifactId>
- <version>0.8.0-SNAPSHOT</version>
- <packaging>jar</packaging>
- <name>stevedore</name>
- <description>
- Stevedore - embed shell script in clojure
- </description>
- <url>http://palletops.com</url>
- <inceptionYear>2010</inceptionYear>
-
- <scm>
- <connection>scm:git:git://github.com/pallet/stevedore.git</connection>
- <developerConnection>scm:git:ssh://git@github.com/pallet/stevedore.git</developerConnection>
- <url>https://github.com/pallet/stevedore</url>
- </scm>
-
- <build>
- <sourceDirectory>src</sourceDirectory>
- <testSourceDirectory>test</testSourceDirectory>
- <resources>
- <resource>
- <directory>resources</directory>
- </resource>
- </resources>
- <testResources>
- <testResource>
- <directory>dev-resources</directory>
- </testResource>
- </testResources>
- <plugins>
- <plugin>
- <groupId>org.cloudhoist.plugin</groupId>
- <artifactId>zi</artifactId>
- <configuration>
- <codoxTargetDirectory>doc/api/${stevedore.doc.version}</codoxTargetDirectory>
- <codoxApiVersion>${stevedore.doc.version}</codoxApiVersion>
- <codoxWriter>codox-md.writer/write-docs</codoxWriter>
- <marginaliaTargetDirectory>doc</marginaliaTargetDirectory>
- </configuration>
- </plugin>
- </plugins>
- </build>
-
- <dependencies>
- <dependency>
- <groupId>org.clojure</groupId>
- <artifactId>clojure</artifactId>
- <version>${clojure.version}</version>
- </dependency>
- <dependency>
- <groupId>org.clojure</groupId>
- <artifactId>tools.logging</artifactId>
- <version>0.2.0</version>
- </dependency>
- <dependency>
- <groupId>org.cloudhoist</groupId>
- <artifactId>pallet-common</artifactId>
- <version>0.3.1</version>
- </dependency>
- <dependency>
- <groupId>ch.qos.logback</groupId>
- <artifactId>logback-classic</artifactId>
- <version>1.0.9</version>
- <scope>test</scope>
- </dependency>
- </dependencies>
-
- <properties>
- <clojure.version>1.4.0</clojure.version>
- <stevedore.doc.version>0.7</stevedore.doc.version>
- </properties>
-</project>
View
14 profiles.clj
@@ -0,0 +1,14 @@
+{:dev {:dependencies [[ch.qos.logback/logback-classic "1.0.9"]]}
+ :doc {:dependencies [[codox-md "0.2.0"]]
+ :codox {:writer codox-md.writer/write-docs
+ :output-dir "doc/api/0.8"
+ :src-dir-uri "https://github.com/pallet/stevedore/blob/develop"
+ :src-linenum-anchor-prefix "L"}
+ :aliases {"marg" ["marg" "-d" "doc/"]
+ "codox" ["doc"]
+ "doc" ["do" "codox," "marg"]}}
+ :release
+ {:plugins [[lein-set-version "0.2.1"]]
+ :set-version
+ {:updates [{:path "README.md" :no-snapshot true}]}}
+ :clojure-1.5.0 {:dependencies [[org.clojure/clojure "1.5.0-RC15"]]}}
View
12 project.clj
@@ -0,0 +1,12 @@
+(defproject com.palletops/stevedore "0.8.0-beta.1"
+ :description "Embeds shell script in clojure"
+ :url "http://palletops.com"
+ :license {:name "Eclipse Public License"
+ :url "http://www.eclipse.org/legal/epl-v10.html"}
+ :scm {:url "git@github.com:pallet/stevedore.git"}
+
+ :dependencies [[org.clojure/clojure "1.4.0"]
+ [org.clojure/tools.logging "0.2.0"]
+ [org.cloudhoist/pallet-common "0.3.1"]]
+ :profiles
+ {:dev {:dependencies [[ch.qos.logback/logback-classic "1.0.9"]]}})
View
44 release.sh
@@ -1,14 +1,48 @@
#!/bin/bash
-# start the release
+# release stevedore
-if [[ $# -lt 2 ]]; then
- echo "usage: $(basename $0) previous-version new-version" >&2
+if [[ $# -lt 3 ]]; then
+ echo "usage: $(basename $0) previous-version new-version next-version" >&2
exit 1
fi
previous_version=$1
version=$2
+next_version=$3
-$(dirname $0)/start-release.sh $previous_version $version
-$(dirname $0)/finish-release.sh $version
+echo ""
+echo "Start release of $version, previous version is $previous_version"
+echo ""
+echo ""
+
+lein do clean, with-profile default:+clojure-1.5.0 test && \
+git flow release start $version || exit 1
+
+lein with-profile +release set-version ${version} :previous-version ${previous_version} \
+ || { echo "set version failed" >2 ; exit 1; }
+
+echo ""
+echo ""
+echo "Changes since $previous_version"
+git --no-pager log --pretty=changelog stevedore-$previous_version..
+echo ""
+echo ""
+echo "Now edit project.clj, ReleaseNotes and README"
+
+$EDITOR project.clj
+$EDITOR ReleaseNotes.md
+$EDITOR README.md
+
+echo -n "commiting project.clj, release notes and readme. enter to continue:" \
+&& read x \
+&& git add project.clj ReleaseNotes.md README.md \
+&& git commit -m "Updated project.clj, release notes and readme for $version" \
+&& echo -n "Peform release. enter to continue:" && read x \
+&& lein do clean, with-profile default:+clojure-1.5.0 test, deploy clojars \
+&& git flow release finish $version \
+&& echo "Now push to github. Don't forget the tags!" \
+&& lein with-profile +doc doc \
+&& lein with-profile +release set-version ${next_version} \
+&& git add project.clj \
+&& git commit -m "Updated version for next release cycle"
View
62 src/pallet/script.clj
@@ -131,41 +131,40 @@
:line line
})))))
-(defn invoke
- "Invoke `script` with the given `args`. The implementations of `script` is
- found based on the current `*script-context*` value. If no matching
- implementation is found, then nil is returned."
- ([script args]
- (invoke script args nil nil))
- ([script args file line]
- {:pre [(::script-fn script)]}
- (logging/tracef
- "invoke-target [%s:%s] %s %s"
- file line (or (:kw script) (::script-kw script))
- (print-args args))
- (when-let [f (best-match @(:methods script))]
- (logging/tracef
- "Found implementation for %s - %s invoking with %s empty? %s"
- (:fn-name script) f (print-args args) (empty? args))
- (apply f args))))
-
(defn script-fn*
"Define an abstract script function, that can be implemented differently for
different operating systems. Calls to functions defined by `script-fn*` are
dispatched based on the `*script-context*` vector."
[fn-name args]
- `(with-meta
- {::script-fn true
- :fn-name ~(keyword (name fn-name))
- :methods (atom {})}
- {:arglists ~(list 'quote (list (vec args)))}))
+ (let [;; replace any destructuring with simple vars
+ arglist (map #(if (symbol? %) % (gensym "arg")) args)
+ ;; if we're passed vargs, then we name the vargs, so we don't
+ ;; have to interpret any destructuring in the actual vararg
+ ;; argument in args.
+ is-vargs? (some #{'&} arglist)
+ varg (when is-vargs? (gensym "varg"))
+ arglist (if is-vargs?
+ (concat (butlast arglist) [varg])
+ arglist)
+ fwdargs (if is-vargs?
+ `(concat [~@(butlast (butlast arglist))] ~varg)
+ (vec arglist))]
+ `(let [m# (with-meta
+ {::script-fn true
+ :fn-name ~(keyword (name fn-name))
+ :methods (atom {})}
+ {:arglists ~(list 'quote (list (vec args)))})]
+ (with-meta
+ (fn ~fn-name [~@arglist]
+ (dispatch m# ~fwdargs))
+ m#))))
(defmacro script-fn
"Define an abstract script function, that can be implemented differently for
different operating systems. Calls to functions defined by `script-fn` are
dispatched based on the `*script-context*` vector."
([[& args]]
- (script-fn* :anonymous args))
+ (script-fn* 'anonymous args))
([fn-name [& args]]
(script-fn* fn-name args)))
@@ -189,10 +188,8 @@
indication whether the implementation is a match for the `*script-context*`
passed as the function's first argument."
[script specialisers f]
- {:pre [(::script-fn script)]}
- (swap! (:methods script) assoc specialisers f))
-
-;;; Dispatch mechanisms for stevedore
+ {:pre [(::script-fn (meta script))]}
+ (swap! (:methods (meta script)) assoc specialisers f))
(defmacro defimpl
"Define a script function implementation for the given `specialisers`.
@@ -213,12 +210,3 @@
`(implement
~script ~specialisers
(fn [~@args] (stevedore/script ~@body))))
-
-(defn script-fn-dispatch
- "Optional dispatching of script functions"
- [script-fn args ns file line]
- (dispatch script-fn args file line))
-
-;;; Link stevedore to the dispatch mechanism
-
-(stevedore/script-fn-dispatch! script-fn-dispatch)
View
103 src/pallet/stevedore.clj
@@ -7,6 +7,7 @@
The result of a `script` form is a string."
(:require
[clojure.java.io :as io]
+ [clojure.set :refer [union]]
[clojure.string :as string]
[clojure.tools.logging :refer [tracef]]
[clojure.walk :as walk]
@@ -67,6 +68,27 @@
[& forms]
`(with-source-line-comments nil (emit-script (quasiquote ~forms))))
+;;; * Keyword and Operator Classes
+(def
+ ^{:doc
+ "Special forms are handled explcitly by an implementation of
+ `emit-special`."
+ :internal true}
+ special-forms
+ #{'if 'if-not 'when 'when-not 'case 'aget 'aset 'get 'defn 'return 'set!
+ 'var 'defvar 'let 'local 'literally 'deref 'do 'str 'quoted 'apply
+ 'file-exists? 'directory? 'symlink? 'readable? 'writeable? 'empty?
+ 'not 'println 'print 'group 'pipe 'chain-or
+ 'chain-and 'while 'doseq 'merge! 'assoc! 'alias})
+
+(def ^:internal operators
+ "Operators that should not be resolved."
+ #{'+ '- '/ '* '% '== '= '< '> '<= '>= '!= '<< '>> '<<< '>>> '& '| '&& '||
+ 'and 'or})
+
+(def ^:internal unresolved
+ "Set of symbols that should not be resolved."
+ (union special-forms operators))
;;; Public script combiners
;;;
@@ -77,7 +99,6 @@
;;; => (script
;;; (ls)
;;; (ls))
-
(defmulti do-script
"Concatenate multiple scripts."
(fn [& scripts] *script-language*))
@@ -215,10 +236,12 @@
*script-file* ~file]
~@body))
+(def ^:dynamic *apply-form-meta* true)
+
(defn- form-meta
[new-form form ]
(tracef "form-meta %s %s" form (meta form))
- (if-let [m (meta form)]
+ (if-let [m (and *apply-form-meta* (meta form))]
(if (number? new-form)
new-form
`(with-meta ~new-form ~(merge {:file *file*} (meta form))))
@@ -278,6 +301,7 @@
(defn- handle-unquote-splicing [form]
(form-meta (list `splice (second form)) form))
+(def resolve-script-fns true)
;; These functions are used for an initial scan over stevedore forms
;; resolving escaping to Clojure and quoting symbols to stop namespace
@@ -292,27 +316,31 @@
[inner outer form]
(tracef "walk %s %s" form (meta form))
(cond
- (list? form) (outer (form-meta (apply list (map inner form)) form))
+ (list? form) (outer (with-meta
+ (if (and resolve-script-fns
+ (symbol? (first form))
+ (not (unresolved (first form))))
+ (list* (first form) (map inner (rest form)))
+ (list* (map inner form)))
+ (meta form)))
(instance? clojure.lang.IMapEntry form) (outer (vec (map inner form)))
- (seq? form) (outer (form-meta (doall (map inner form)) form))
- (coll? form) (outer (form-meta (into (empty form) (map inner form)) form))
+ (seq? form) (outer (with-meta (doall (map inner form)) (meta form)))
+ (coll? form) (outer (with-meta
+ (into (empty form) (map inner form))
+ (meta form)))
:else (outer form)))
(declare inner-walk outer-walk)
-(defmacro quasiquote
- [form]
- (tracef "quasiquote %s %s" form (meta form))
- (let [post-form (walk inner-walk outer-walk form)]
- (tracef "quasiquote return %s" post-form)
- (form-meta post-form form)))
-
(defn- inner-walk [form]
(tracef "inner-walk %s %s" form (meta form))
(cond
- (unquote? form) (form-meta (handle-unquote form) form)
+ (unquote? form) (handle-unquote form)
(unquote-splicing? form) (handle-unquote-splicing form)
- :else (form-meta (walk/walk inner-walk outer-walk form) form)))
+ (instance? clojure.lang.IObj form) (with-meta
+ (walk inner-walk outer-walk form)
+ (meta form))
+ :else (walk inner-walk outer-walk form)))
(defn- outer-walk [form]
(tracef "outer-walk %s %s" form (meta form))
@@ -321,14 +349,19 @@
(seq? form)
(do
(tracef "outer-walk %s %s" form (meta form))
- (form-meta (list* 'list form) form))
+ (form-meta (list* `list form) form))
:else form))
+(defn quasiquote*
+ [form]
+ (tracef "quasiquote* %s %s" form (meta form))
+ (let [post-form (walk inner-walk outer-walk form)]
+ (tracef "quasiquote return %s" post-form)
+ post-form))
- ;; (let [s (first form)]
- ;; (clojure.tools.logging/info "outer-walk %s" form)
- ;; (if (symbol? s) (list 'quote s) s))
- ;; (rest form)
+(defmacro quasiquote
+ [form]
+ (quasiquote* form))
;;; High level string generation functions
(def statement-separator "\n")
@@ -381,12 +414,6 @@
s)))))]
code))
-
-
-
-
-
-
;;; Script argument helpers
;;; TODO eliminate the need for this to be public by supporting literal maps for
;;; expansion
@@ -417,29 +444,3 @@
underscore (:underscore m)]
(map-to-arg-string
(dissoc m :assign :underscore) :assign assign :underscore underscore)))
-
-
-;; Dispatch functions for script functions
-
-(defn script-fn-dispatch-none
- "Script function dispatch. This implementation does nothing."
- [name args ns file line]
- nil)
-
-(def ^{:doc "Script function dispatch." :dynamic true}
- *script-fn-dispatch* script-fn-dispatch-none)
-
-(defn script-fn-dispatch!
- "Set the script-fn dispatch function"
- [f]
- (alter-var-root #'*script-fn-dispatch* (fn [_] f)))
-
-(defmacro with-no-script-fn-dispatch
- [& body]
- `(binding [*script-fn-dispatch* script-fn-dispatch-none]
- ~@body))
-
-(defmacro with-script-fn-dispatch
- [f & body]
- `(binding [*script-fn-dispatch* ~f]
- ~@body))
View
7 src/pallet/stevedore/bash.clj
@@ -6,8 +6,7 @@
(:use
[pallet.stevedore.common]
[pallet.stevedore
- :only [emit emit-do *script-fn-dispatch* empty-splice
- with-source-line-comments]]
+ :only [emit emit-do empty-splice special-forms with-source-line-comments]]
[pallet.common.string :only [quoted substring underscore]]))
(derive ::bash :pallet.stevedore.common/common-impl)
@@ -219,10 +218,10 @@
(common-string/quoted (emit arg)))
(defmethod emit-special [::bash 'println] [type [println & args]]
- (str "echo " (emit args)))
+ (str "echo " (string/join " " (map emit args))))
(defmethod emit-special [::bash 'print] [type [println & args]]
- (str "echo -n " (emit args)))
+ (str "echo -n " (string/join " " (map emit args))))
(defonce
View
2  src/pallet/stevedore/batch.clj
@@ -81,7 +81,7 @@
(apply clojure.core/str (map emit args)))
(defmethod emit-special [::batch 'println] [type [println & args]]
- (str "echo " (emit args)))
+ (str "echo " (string/join " " (map emit args))))
(defmethod emit-special [::batch 'deref]
[type [deref expr]]
View
85 src/pallet/stevedore/common.clj
@@ -5,7 +5,7 @@
[clojure.tools.logging :refer [tracef]]
[pallet.stevedore
:refer [chain-commands checked-commands do-script emit empty-splice
- filter-empty-splice *script-fn-dispatch* *script-language*
+ filter-empty-splice *script-language* special-forms
*src-line-comments* with-script-language
with-source-line-comments]]))
@@ -72,22 +72,6 @@
should implement it's own multimethod."
(fn [expr] *script-language*))
-
-
-;;; * Keyword and Operator Classes
-(def
- ^{:doc
- "Special forms are handled explcitly by an implementation of
- `emit-special`."
- :private true}
- special-forms
- #{'if 'if-not 'when 'when-not 'case 'aget 'aset 'get 'defn 'return 'set!
- 'var 'defvar 'let 'local 'literally 'deref 'do 'str 'quoted 'apply
- 'file-exists? 'directory? 'symlink? 'readable? 'writeable? 'empty?
- 'not 'println 'print 'group 'pipe 'chain-or
- 'chain-and 'while 'doseq 'merge! 'assoc! 'alias})
-
-
;;; Predicates for keyword/operator classes
(defn special-form?
"Predicate to check if expr is a special form"
@@ -125,44 +109,41 @@
;;; Common implementation
(defn- ex-location [m]
- (str "(" (.getName (file (:file m))) ":" (:line m) ")"))
+ (str "(" (or (and (:file m) (.getName (file (:file m)))) "UNKNOWN")
+ ":" (:line m) ")"))
(defmethod emit-special [::common-impl 'invoke]
[type form]
(let [[fn-name-or-map & args] form]
(tracef "INVOKE %s %s" fn-name-or-map args)
(tracef "INVOKE %s" (meta form))
- (if (map? fn-name-or-map)
- (let [m (meta form)]
- (try
- (*script-fn-dispatch*
- fn-name-or-map
- (with-source-line-comments false
- (vec (filter-empty-splice args)))
- (:ns m) (or (:file m) *file*) (:line m))
- (catch clojure.lang.ArityException e
- ;; Add the script location to the error message, and use the
- ;; unmangled script function name.
- (throw
- (ex-info
- (str "Wrong number of args (" (.actual e) ") passed to: "
- (name (:fn-name fn-name-or-map)) " " (ex-location m))
- (merge
- m
- {:actual (.actual e)
- :script-fn (:fn-name fn-name-or-map)})
- e)))
- (catch Exception e
- ;; Add the script location and script function name to the error
- ;; message
- (throw
- (ex-info
- (str (.getMessage e) " in call to "
- (name (:fn-name fn-name-or-map)) " " (ex-location m))
- (merge
- m
- {:script-fn (:fn-name fn-name-or-map)})
- e)))))
+ (if (fn? fn-name-or-map)
+ (try
+ (apply fn-name-or-map args)
+ (catch clojure.lang.ArityException e
+ ;; Add the script location to the error message, and use the
+ ;; unmangled script function name.
+ (throw
+ (ex-info
+ (str "Wrong number of args (" (.actual e) ") passed to: "
+ (name (:fn-name (meta fn-name-or-map))) " "
+ (ex-location (meta form)))
+ (merge
+ (meta fn-name-or-map)
+ {:actual (.actual e)
+ :script-fn (:fn-name (meta fn-name-or-map))})
+ e)))
+ (catch Exception e
+ ;; Add the script location and script function name to the error
+ ;; message
+ (throw
+ (ex-info
+ (str (.getMessage e) " in call to "
+ (:fn-name (meta fn-name-or-map)) " " (ex-location form))
+ (merge
+ (meta fn-name-or-map)
+ {:script-fn (:fn-name (meta fn-name-or-map))})
+ e))))
(let [argseq (with-source-line-comments false
(->>
args
@@ -182,11 +163,7 @@
(special-form? head) (emit-special head expr1)
(infix-operator? head) (emit-infix head expr1)
:else (emit-special 'invoke expr)))
- (if (map? (first expr))
- (emit-special 'invoke expr)
- (when (seq expr)
- (string/join
- " " (filter (complement string/blank?) (map emit expr)))))))
+ (emit-special 'invoke expr)))
(defn- spread
[arglist]
View
87 test/pallet/script_test.clj
@@ -1,6 +1,7 @@
(ns pallet.script-test
(:use
[pallet.stevedore :only [with-script-language]]
+ pallet.stevedore.bash
pallet.stevedore.test-common
pallet.script
clojure.test))
@@ -26,20 +27,25 @@
(deftest script-fn-test
(testing "no varargs"
(let [f (script-fn [a b])]
- (is (= :anonymous (:fn-name f)))
+ (is (= :anonymous (:fn-name (meta f))))
(with-script-context [:a]
- (is (thrown? clojure.lang.ExceptionInfo (dispatch f [1 1])))
+ (is (thrown? clojure.lang.ExceptionInfo (dispatch (meta f) [1 1])))
(implement f :default (fn [a b] b))
- (is (= 2 (dispatch f [1 2]))))))
+ (is (= 2 (dispatch (meta f) [1 2]))))))
(testing "varargs"
(let [f (script-fn [a b & c])]
(with-script-context [:a]
- (is (thrown? clojure.lang.ExceptionInfo (dispatch f [1 1 2 3])))
+ (is (thrown? clojure.lang.ExceptionInfo (dispatch (meta f) [1 1 2 3])))
(implement f :default (fn [a b & c] c))
- (is (= [2 3] (dispatch f [1 1 2 3]))))))
+ (is (= [2 3] (dispatch (meta f) [1 1 2 3]))))))
+ (testing "map varargs"
+ (let [f (script-fn [a & {:keys [c] :as m}])]
+ (with-script-context [:a]
+ (implement f :default (fn [a & {:keys [c d] :as m}] [c d]))
+ (is (= [3 true] (dispatch (meta f) [1 :c 3 :d true]))))))
(testing "named"
- (let [f (script-fn :fn1 [a b])]
- (is (= :fn1 (:fn-name f))))))
+ (let [f (script-fn fn1 [a b])]
+ (is (= :fn1 (:fn-name (meta f)))))))
(deftest best-match-test
(let [s (script-fn [])
@@ -48,11 +54,11 @@
(implement s :default f1)
(implement s [:os-x] f2)
(with-script-context [:centos :yum]
- (is (= f1 (#'pallet.script/best-match @(:methods s))))
- (is (= 1 (invoke s []))))
+ (is (= f1 (#'pallet.script/best-match @(:methods (meta s)))))
+ (is (= 1 (dispatch (meta s) []))))
(with-script-context [:os-x :brew]
- (is (= f2 (#'pallet.script/best-match @(:methods s))))
- (is (= 2 (invoke s []))))))
+ (is (= f2 (#'pallet.script/best-match @(:methods (meta s)))))
+ (is (= 2 (dispatch (meta s) []))))))
(deftest defscript-test
(with-script-context [:a]
@@ -61,44 +67,69 @@
(is (nil? (:doc (meta script1a))))
(is (= '([a b]) (:arglists (meta #'script1a))))
(implement script1a :default (fn [a b] b))
- (is (= 2 (dispatch script1a [1 2]))))
+ (is (= 2 (dispatch (meta script1a) [1 2]))))
(testing "varargs"
(defscript script2 "doc" [a b & c])
(is (= "doc" (:doc (meta #'script2))))
(is (= '([a b & c]) (:arglists (meta #'script2))))
(implement script2 :default (fn [a b & c] c))
- (is (= [2 3] (dispatch script2 [1 1 2 3]))))))
+ (is (= [2 3] (dispatch (meta script2) [1 1 2 3]))))))
+
+(alter-var-root #'pallet.stevedore/resolve-script-fns (constantly false))
(deftest dispatch-test
(with-script-language :pallet.stevedore.bash/bash
(let [x (script-fn test-script [a])]
(testing "with no implementation"
(testing "should raise"
- (pallet.stevedore/with-script-fn-dispatch
- script-fn-dispatch
+ (with-script-context [:ubuntu]
+ (is (thrown-with-msg?
+ clojure.lang.ExceptionInfo #"No implementation.*"
+ (pallet.stevedore/script (~x 2)))))))
+ (testing "with an implementation"
+ (defimpl x :default [a] (str "x" ~a 1))
+ (testing "and mandatory dispatch"
+ (with-script-context [:ubuntu]
+ (is (script= "x21" (pallet.stevedore/script (~x 2))))
+ (is (script= "x 2" (pallet.stevedore/script (x 2)))))))
+ (testing "with incorrect arguments"
+ (defimpl x :default [a] (str "x" ~a 1))
+ (with-script-context [:ubuntu]
+ (is (thrown-with-msg? clojure.lang.ExceptionInfo
+ (re-pattern
+ (str "Wrong number of args.*test-script.*script_test.clj:"
+ (inc (current-line))))
+ (pallet.stevedore/script (~x 1 2)))
+ "Exception contains script function name, file and line"))))))
+
+(alter-var-root #'pallet.stevedore/resolve-script-fns (constantly true))
+
+(deftest dispatch-resolve-test
+ (with-script-language :pallet.stevedore.bash/bash
+ (let [x (script-fn test-script [a])]
+ (testing "with no implementation"
+ (testing "should raise"
+ (pallet.stevedore/with-script-language :pallet.stevedore.bash/bash
(with-script-context [:ubuntu]
- (is (thrown-with-msg? clojure.lang.ExceptionInfo #"No implementation.*"
- (pallet.stevedore/script (~x 2))))
- (try
- (pallet.stevedore/script (~x 2))
- (catch clojure.lang.ExceptionInfo e
- (let [info (ex-data e)]
- (is (:line info)))))))))
+ (is (thrown-with-msg?
+ clojure.lang.ExceptionInfo #"No implementation.*"
+ (pallet.stevedore/script (~x 2))))))))
(testing "with an implementation"
(defimpl x :default [a] (str "x" ~a 1))
(testing "and mandatory dispatch"
- (pallet.stevedore/with-script-fn-dispatch
- script-fn-dispatch
+ (pallet.stevedore/with-script-language :pallet.stevedore.bash/bash
(with-script-context [:ubuntu]
- (is (script= "x21" (pallet.stevedore/script (~x 2))))))))
+ (is (script= "x21" (pallet.stevedore/script (~x 2))))
+ (is (script= "x21" (pallet.stevedore/script (x 2))))))))
(testing "with incorrect arguments"
(defimpl x :default [a] (str "x" ~a 1))
- (pallet.stevedore/with-script-fn-dispatch
- script-fn-dispatch
+ (pallet.stevedore/with-script-language :pallet.stevedore.bash/bash
(with-script-context [:ubuntu]
(is (thrown-with-msg? clojure.lang.ExceptionInfo
(re-pattern
(str "Wrong number of args.*test-script.*script_test.clj:"
(inc (current-line))))
(pallet.stevedore/script (~x 1 2)))
- "Exception contains script function name, file name and line")))))))
+ "Exception contains script function name, file and line")))))))
+
+(alter-var-root #'pallet.stevedore/resolve-script-fns (constantly false))
View
32 test/pallet/stevedore/bash_test.clj
@@ -1,18 +1,17 @@
(ns pallet.stevedore.bash-test
- (:use
- [pallet.common.string :only [quoted]]
- pallet.stevedore
- clojure.test)
(:require
[clojure.string :as string]
- [pallet.script :as script]
- [pallet.stevedore.common]
- pallet.stevedore.test-common
- [pallet.stevedore.bash]
+ [clojure.test :refer [is testing]]
+ [clojure.tools.logging :as logging]
[pallet.common.filesystem :as filesystem]
[pallet.common.logging.logutils :as logutils]
[pallet.common.shell :as shell]
- [clojure.tools.logging :as logging]))
+ [pallet.common.string :refer [quoted]]
+ [pallet.script :as script]
+ [pallet.stevedore :refer :all]
+ [pallet.stevedore.bash :refer :all]
+ [pallet.stevedore.common]
+ [pallet.stevedore.test-common]))
(defmacro current-line [] (-> &form meta :line))
@@ -47,16 +46,11 @@
(.replaceAll "[ ]+" " ")
.trim))
-(with-script-language :pallet.stevedore.bash/bash
- (script
- (.dot-method balh "lbha" "alsd")))
-
-(defn with-bash
- [f]
- (with-script-language :pallet.stevedore.bash/bash
- (f)))
-
-(use-fixtures :once with-bash)
+;;; We define a macro rather than a fixture so we can run individual tests
+(defmacro deftest [name & body]
+ `(clojure.test/deftest ~name
+ (with-script-language :pallet.stevedore.bash/bash
+ ~@body)))
(deftest number-literal
(is (= "42" (script 42)))
View
24 test/pallet/stevedore/batch_test.clj
@@ -1,19 +1,17 @@
(ns pallet.stevedore.batch-test
- (:use
- [pallet.common.string :only [quoted]]
- pallet.stevedore
- pallet.stevedore.batch
- clojure.test)
(:require
- [pallet.stevedore.common :as common]
- pallet.stevedore.test-common))
+ [clojure.test :refer [is testing]]
+ [pallet.common.string :refer [quoted]]
+ [pallet.stevedore :refer :all]
+ [pallet.stevedore.batch :refer :all]
+ [pallet.stevedore.common]
+ [pallet.stevedore.test-common]))
-(defn with-batch
- [f]
- (with-script-language :pallet.stevedore.batch/batch
- (f)))
-
-(use-fixtures :once with-batch)
+;;; We define a macro rather than a fixture so we can run individual tests
+(defmacro deftest [name & body]
+ `(clojure.test/deftest ~name
+ (with-script-language :pallet.stevedore.batch/batch
+ ~@body)))
;; (deftest implementation-coverage-test
;; (testing "complete `emit-special` coverage"
View
54 test/pallet/stevedore_test.clj
@@ -1,19 +1,53 @@
(ns pallet.stevedore-test
- (:use
- clojure.test
- pallet.stevedore))
+ (:require
+ [clojure.test :refer :all]
+ [pallet.script :refer [defscript]]
+ [pallet.stevedore :refer :all]))
-(defmacro current-line [] (:line (meta &form)))
+(defmacro line [] (:line (meta &form)))
+(defmacro file [] *file*)
(deftest quasiquote-test
- (is (= '((var a b)) (quasiquote [(var a b)])))
- (is (= '((var 1 b)) (let [a 1] (quasiquote [(var ~a b)])))))
+ (binding [*apply-form-meta* false]
+ (is (= `[(list '~'var '~'a '~'b)] (quasiquote* '[(var a b)])))
+ (is (= `((list '~'var ~'a '~'b)) (let [a 1] (quasiquote* '[(var ~a b)]))))
+ (is (= `((list '~'a 1)) (quasiquote* '[(a 1)])))))
(deftest metadata-test
(testing "metadata"
- (is (= (current-line) (:line (meta (quasiquote (var a b))))))
- (is (= (current-line) (:line (meta (first (quasiquote [(var a b)]))))))))
+ (is (= (line) (:line (meta (quasiquote (var a b))))))
+ (is (= (line) (:line (meta (first (quasiquote [(var a b)]))))))))
(deftest quasiquote-symboltest
- (is (= '((defn [a] a)) (quasiquote [(defn [a] a)])))
- (is (= (current-line) (:line (meta (quasiquote (defn [a] a)))))))
+ (binding [*apply-form-meta* false]
+ (is (= `((list '~'defn ['~'a] '~'a)) (quasiquote* '[(defn [a] a)]))))
+ (is (= (line) (:line (meta (quasiquote (defn [a] a)))))))
+
+(deftest quasiquote-unquote-test
+ (binding [*apply-form-meta* false]
+ (with-redefs [resolve-script-fns false]
+ (let [a (fn [x] (str "a" x))]
+ (testing "unquote resolves first symbol"
+ (is (= `((list ~'a 1))
+ (quasiquote* '[(~a 1)]))))
+ (testing "first symbol is quoted"
+ (is (= `((list '~'a 1))
+ (quasiquote* '[(a 1)]))))))))
+
+(defscript test-script [x])
+
+(deftest quasiquote-resolve-test
+ (binding [*apply-form-meta* false]
+ (with-redefs [resolve-script-fns true]
+ (with-script-language ::x
+ (testing "first symbol is resolved"
+ (let [a (fn [x] (str "a" x))]
+ (is (= `((list ~'a 1))
+ (quasiquote* '[(a 1)])))))
+ (testing "qualified symbol is resolved"
+ (let [a (fn [x] (str "a" x))]
+ (is (= `((list ~'pallet.stevedore-test/test-script 1))
+ (quasiquote* '[(pallet.stevedore-test/test-script 1)])))))
+ (testing "special-forms are quoted"
+ (is (= `((list '~'str 1))
+ (quasiquote* '[(str 1)]))))))))
Please sign in to comment.
Something went wrong with that request. Please try again.