diff --git a/.build/bb.edn b/.build/bb.edn index 97a32e3b..b68f2790 100644 --- a/.build/bb.edn +++ b/.build/bb.edn @@ -2,5 +2,5 @@ :deps {borkdude/gh-release-artifact #_{:local/root "../gh-release-artifact"} {:git/url "https://github.com/borkdude/gh-release-artifact" - :sha "2f8898d84126a4e922c490f8614211a8b0cf67cd"}} + :sha "f34f3e382e6a0ef7f52748b2f27eb681f799a822"}} :tasks {release-artifact babashka.release-artifact/release}} diff --git a/.circleci/config.yml b/.circleci/config.yml index 577cea0f..aac22a89 100644 --- a/.circleci/config.yml +++ b/.circleci/config.yml @@ -55,11 +55,10 @@ jobs: VERSION=$(cat resources/BABASHKA_VERSION) jar=target/babashka-$VERSION-standalone.jar cp $jar /tmp/release - java -jar $jar script/reflection.clj reflection="babashka-$VERSION-reflection.json" - BABASHKA_EDN=".build/bb.edn" java -jar "$jar" release-artifact "$jar" - BABASHKA_EDN=".build/bb.edn" java -jar "$jar" release-artifact "$reflection" + java -jar "$jar" --config .build/bb.edn --deps-root . release-artifact "$jar" + java -jar "$jar" --config .build/bb.edn --deps-root . release-artifact "$reflection" - store_artifacts: path: /tmp/release destination: release @@ -73,8 +72,8 @@ jobs: working_directory: ~/repo environment: LEIN_ROOT: "true" - GRAALVM_VERSION: "21.3.0" - GRAALVM_HOME: /home/circleci/graalvm-ce-java11-21.3.0 + GRAALVM_VERSION: "22.0.0.2" + GRAALVM_HOME: /home/circleci/graalvm-ce-java11-22.0.0.2 BABASHKA_PLATFORM: linux # used in release script BABASHKA_TEST_ENV: native BABASHKA_XMX: "-J-Xmx6500m" @@ -124,7 +123,7 @@ jobs: - save_cache: paths: - ~/.m2 - - ~/graalvm-ce-java11-21.3.0 + - ~/graalvm-ce-java11-22.0.0.2 key: linux-{{ checksum "project.clj" }}-{{ checksum ".circleci/config.yml" }} - store_artifacts: path: /tmp/release @@ -139,8 +138,8 @@ jobs: working_directory: ~/repo environment: LEIN_ROOT: "true" - GRAALVM_VERSION: "21.3.0" - GRAALVM_HOME: /home/circleci/graalvm-ce-java11-21.3.0 + GRAALVM_VERSION: "22.0.0.2" + GRAALVM_HOME: /home/circleci/graalvm-ce-java11-22.0.0.2 BABASHKA_PLATFORM: linux # used in release script BABASHKA_TEST_ENV: native BABASHKA_STATIC: "true" @@ -203,7 +202,7 @@ jobs: - save_cache: paths: - ~/.m2 - - ~/graalvm-ce-java11-21.3.0 + - ~/graalvm-ce-java11-22.0.0.2 key: linux-{{ checksum "project.clj" }}-{{ checksum ".circleci/config.yml" }} - store_artifacts: path: /tmp/release @@ -220,8 +219,8 @@ jobs: working_directory: ~/repo environment: LEIN_ROOT: "true" - GRAALVM_VERSION: "21.3.0" - GRAALVM_HOME: /home/circleci/graalvm-ce-java11-21.3.0 + GRAALVM_VERSION: "22.0.0.2" + GRAALVM_HOME: /home/circleci/graalvm-ce-java11-22.0.0.2 BABASHKA_PLATFORM: linux # used in release script BABASHKA_ARCH: aarch64 BABASHKA_TEST_ENV: native @@ -271,7 +270,7 @@ jobs: - save_cache: paths: - ~/.m2 - - ~/graalvm-ce-java11-21.3.0 + - ~/graalvm-ce-java11-22.0.0.2 key: linux-aarch64-{{ checksum "project.clj" }}-{{ checksum ".circleci/config.yml" }} - store_artifacts: path: /tmp/release @@ -288,8 +287,8 @@ jobs: working_directory: ~/repo environment: LEIN_ROOT: "true" - GRAALVM_VERSION: "21.3.0" - GRAALVM_HOME: /home/circleci/graalvm-ce-java11-21.3.0 + GRAALVM_VERSION: "22.0.0.2" + GRAALVM_HOME: /home/circleci/graalvm-ce-java11-22.0.0.2 BABASHKA_PLATFORM: linux # used in release script BABASHKA_ARCH: aarch64 BABASHKA_TEST_ENV: native @@ -349,7 +348,7 @@ jobs: - save_cache: paths: - ~/.m2 - - ~/graalvm-ce-java11-21.3.0 + - ~/graalvm-ce-java11-22.0.0.2 key: linux-aarch64-{{ checksum "project.clj" }}-{{ checksum ".circleci/config.yml" }} - store_artifacts: path: /tmp/release @@ -363,8 +362,8 @@ jobs: xcode: "12.0.0" environment: MACOSX_DEPLOYMENT_TARGET: 10.13 # 10.12 is EOL - GRAALVM_VERSION: "21.3.0" - GRAALVM_HOME: /Users/distiller/graalvm-ce-java11-21.3.0/Contents/Home + GRAALVM_VERSION: "22.0.0.2" + GRAALVM_HOME: /Users/distiller/graalvm-ce-java11-22.0.0.2/Contents/Home BABASHKA_PLATFORM: macos # used in release script BABASHKA_TEST_ENV: native BABASHKA_XMX: "-J-Xmx6500m" @@ -411,7 +410,7 @@ jobs: - save_cache: paths: - ~/.m2 - - ~/graalvm-ce-java11-21.3.0/Contents/Home + - ~/graalvm-ce-java11-22.0.0.2/Contents/Home key: mac-{{ checksum "project.clj" }}-{{ checksum ".circleci/config.yml" }} - store_artifacts: path: /tmp/release @@ -479,7 +478,7 @@ workflows: - docker: filters: branches: - only: + only: - master requires: - linux diff --git a/.circleci/script/docker b/.circleci/script/docker index d9996c8c..f16447b6 100755 --- a/.circleci/script/docker +++ b/.circleci/script/docker @@ -6,6 +6,15 @@ image_name="babashka/babashka" image_tag=$(cat resources/BABASHKA_VERSION) platform=${PLATFORM:-"linux/amd64"} latest_tag="latest" +label_args=("--label" "'org.opencontainers.image.description=Native, fast starting Clojure interpreter for scripting'" + "--label" "org.opencontainers.image.title=Babashka" + "--label" "org.opencontainers.image.created=$(date -Iseconds)" + "--label" "org.opencontainers.image.url=${CIRCLE_REPOSITORY_URL}" + "--label" "org.opencontainers.image.documentation=${CIRCLE_REPOSITORY_URL}" + "--label" "org.opencontainers.image.source=${CIRCLE_REPOSITORY_URL}" + "--label" "org.opencontainers.image.revision=${CIRCLE_SHA1}" + "--label" "org.opencontainers.image.ref.name=${CIRCLE_TAG}:${CIRCLE_BRANCH}" + "--label" "org.opencontainers.image.version=${image_tag}") if [[ $image_tag =~ SNAPSHOT$ ]]; then echo "This is a snapshot version" @@ -24,28 +33,26 @@ if [ -z "$CIRCLE_PULL_REQUEST" ] && [ "$CIRCLE_BRANCH" = "master" ]; then if [[ $tarball_platform == "linux-arm64" ]]; then tarball_platform="linux-aarch64"; fi mkdir -p $p tar zxvf "/tmp/release/babashka-${image_tag}-${tarball_platform}.tar.gz" -C $p + # this overwrites, but this is to work around having built the uberjar/metabom multiple times + cp "/tmp/release/${tarball_platform}-metabom.jar" ./metabom.jar done - docker buildx build -t "$image_name:$image_tag" --platform "$platform" --push -f Dockerfile.ci . + docker buildx build -t "$image_name:$image_tag" --platform "$platform" "${label_args[@]}" --push -f Dockerfile.ci . if [[ $snapshot == "false" ]]; then echo "Building & pushing $platform Docker image(s) $image_name:$latest_tag" - docker buildx build -t "$image_name:$latest_tag" --platform "$platform" --push -f Dockerfile.ci . + docker buildx build -t "$image_name:$latest_tag" --platform "$platform" "${label_args[@]}" --push -f Dockerfile.ci . fi for p in "${platforms[@]}"; do rm -rf $p done - # alpine doesn't provide upstream arm64 images yet - if [[ $platform == "linux-amd64" ]]; then - tar zxvf "/tmp/release/babashka-${image_tag}-${platform}-static.tar.gz" - docker build -t "$image_name:alpine" -f Dockerfile.alpine . - rm -f bb - docker tag "$image_name:alpine" "$image_name:$image_tag-alpine" - echo "Pushing image $image_name:$image_tag-alpine" - docker push "$image_name:$image_tag-alpine" - if [[ $snapshot == "false" ]]; then - echo "Pushing image $image_name:alpine" - docker push "$image_name:alpine" - fi + # build alpine image for linux-amd64 only (no upstream arm64 support yet) + tar zxvf "/tmp/release/babashka-${image_tag}-linux-amd64-static.tar.gz" + echo "Building & pushing Docker image $image_name:$image_tag-alpine" + docker buildx build -t "$image_name:$image_tag-alpine" --platform=linux/amd64 "${label_args[@]}" --push -f Dockerfile.alpine . + + if [[ $snapshot == "false" ]]; then + echo "Building & pushing Docker image $image_name:alpine" + docker buildx build -t "$image_name:alpine" --platform=linux/amd64 "${label_args[@]}" --push -f Dockerfile.alpine . fi else echo "Not publishing Docker image" diff --git a/.circleci/script/release b/.circleci/script/release index b4a142e6..05f90205 100755 --- a/.circleci/script/release +++ b/.circleci/script/release @@ -6,9 +6,7 @@ cp bb /tmp/release VERSION=$(cat resources/BABASHKA_VERSION) -cd /tmp/release -mkdir -p /tmp/bb_size -./bb '(spit "/tmp/bb_size/size" (.length (io/file "bb")))' + ## release binary as tar.gz archive @@ -18,13 +16,20 @@ if [ "$BABASHKA_STATIC" = "true" ]; then arch="$arch-static" fi +# because circle won't allow the same file to be saved/restored in the same workspace concurrently +cp metabom.jar "/tmp/release/$BABASHKA_PLATFORM-$arch-metabom.jar" + +cd /tmp/release +mkdir -p /tmp/bb_size +./bb '(spit "/tmp/bb_size/size" (.length (io/file "bb")))' + archive="babashka-$VERSION-$BABASHKA_PLATFORM-$arch.tar.gz" tar zcvf "$archive" bb # bbk cd - -BABASHKA_EDN=".build/bb.edn" ./bb release-artifact "/tmp/release/$archive" +./bb --config .build/bb.edn --deps-root . release-artifact "/tmp/release/$archive" ## cleanup diff --git a/.clj-kondo/babashka/fs/config.edn b/.clj-kondo/babashka/fs/config.edn new file mode 100644 index 00000000..23f36094 --- /dev/null +++ b/.clj-kondo/babashka/fs/config.edn @@ -0,0 +1 @@ +{:lint-as {babashka.fs/with-temp-dir clojure.core/let}} diff --git a/.dir-locals.el b/.dir-locals.el new file mode 100644 index 00000000..9671ce52 --- /dev/null +++ b/.dir-locals.el @@ -0,0 +1,2 @@ +((clojure-mode + (cider-clojure-cli-aliases . "test"))) diff --git a/.github/workflows/build.yml b/.github/workflows/build.yml index 48767194..57b20f95 100644 --- a/.github/workflows/build.yml +++ b/.github/workflows/build.yml @@ -45,17 +45,17 @@ jobs: uses: actions/cache@v1 id: cache-graalvm with: - path: ~/graalvm-ce-java11-21.3.0 - key: ${{ runner.os }}-graalvm-21.3.0 + path: ~/graalvm-ce-java11-22.0.0.2 + key: ${{ runner.os }}-graalvm-22.0.0.2 restore-keys: | - ${{ runner.os }}-graalvm-21.3.0 + ${{ runner.os }}-graalvm-22.0.0.2 - name: Download GraalVM run: | cd ~ - if ! [ -d graalvm-ce-java11-21.3.0 ]; then - curl -O -sL https://github.com/graalvm/graalvm-ce-builds/releases/download/vm-21.3.0/graalvm-ce-java11-linux-amd64-21.3.0.tar.gz - tar xzf graalvm-ce-java11-linux-amd64-21.3.0.tar.gz + if ! [ -d graalvm-ce-java11-22.0.0.2 ]; then + curl -O -sL https://github.com/graalvm/graalvm-ce-builds/releases/download/vm-22.0.0.2/graalvm-ce-java11-linux-amd64-22.0.0.2.tar.gz + tar xzf graalvm-ce-java11-linux-amd64-22.0.0.2.tar.gz fi - name: Fetch deps @@ -65,18 +65,18 @@ jobs: - name: Run tests run: | - export GRAALVM_HOME="$HOME/graalvm-ce-java11-21.3.0" + export GRAALVM_HOME="$HOME/graalvm-ce-java11-22.0.0.2" script/test - name: Test libraries run: | - export GRAALVM_HOME="$HOME/graalvm-ce-java11-21.3.0" + export GRAALVM_HOME="$HOME/graalvm-ce-java11-22.0.0.2" sudo script/install-clojure script/run_lib_tests - name: Build uberjar run: | - export GRAALVM_HOME="$HOME/graalvm-ce-java11-21.3.0" + export GRAALVM_HOME="$HOME/graalvm-ce-java11-22.0.0.2" script/uberjar - name: Babashka version @@ -119,17 +119,17 @@ jobs: uses: actions/cache@v1 id: cache-graalvm with: - path: ~/graalvm-ce-java11-21.3.0 - key: ${{ runner.os }}-graalvm-21.3.0 + path: ~/graalvm-ce-java11-22.0.0.2 + key: ${{ runner.os }}-graalvm-22.0.0.2 restore-keys: | - ${{ runner.os }}-graalvm-21.3.0 + ${{ runner.os }}-graalvm-22.0.0.2 - name: Download GraalVM run: | cd ~ - if ! [ -d graalvm-ce-java11-21.3.0 ]; then - curl -O -sL https://github.com/graalvm/graalvm-ce-builds/releases/download/vm-21.3.0/graalvm-ce-java11-linux-amd64-21.3.0.tar.gz - tar xzf graalvm-ce-java11-linux-amd64-21.3.0.tar.gz + if ! [ -d graalvm-ce-java11-22.0.0.2 ]; then + curl -O -sL https://github.com/graalvm/graalvm-ce-builds/releases/download/vm-22.0.0.2/graalvm-ce-java11-linux-amd64-22.0.0.2.tar.gz + tar xzf graalvm-ce-java11-linux-amd64-22.0.0.2.tar.gz fi - name: Babashka version @@ -142,12 +142,12 @@ jobs: run: | export BABASHKA_JAR=babashka-${{ steps.babashka-version.outputs.version }}-standalone.jar export BABASHKA_XMX="-J-Xmx6g" - export GRAALVM_HOME="$HOME/graalvm-ce-java11-21.3.0" + export GRAALVM_HOME="$HOME/graalvm-ce-java11-22.0.0.2" script/compile - name: Test binary run: | - export GRAALVM_HOME="$HOME/graalvm-ce-java11-21.3.0" + export GRAALVM_HOME="$HOME/graalvm-ce-java11-22.0.0.2" BABASHKA_TEST_ENV=native script/test - name: Install clojure @@ -156,7 +156,7 @@ jobs: - name: Test libraries run: | - export GRAALVM_HOME="$HOME/graalvm-ce-java11-21.3.0" + export GRAALVM_HOME="$HOME/graalvm-ce-java11-22.0.0.2" BABASHKA_TEST_ENV=native script/run_lib_tests - name: Upload artifact @@ -194,17 +194,17 @@ jobs: uses: actions/cache@v1 id: cache-graalvm with: - path: ~/graalvm-ce-java11-21.3.0 - key: ${{ runner.os }}-graalvm-21.3.0 + path: ~/graalvm-ce-java11-22.0.0.2 + key: ${{ runner.os }}-graalvm-22.0.0.2 restore-keys: | - ${{ runner.os }}-graalvm-21.3.0 + ${{ runner.os }}-graalvm-22.0.0.2 - name: Download GraalVM run: | cd ~ - if ! [ -d graalvm-ce-java11-21.3.0 ]; then - curl -O -sL https://github.com/graalvm/graalvm-ce-builds/releases/download/vm-21.3.0/graalvm-ce-java11-linux-amd64-21.3.0.tar.gz - tar xzf graalvm-ce-java11-linux-amd64-21.3.0.tar.gz + if ! [ -d graalvm-ce-java11-22.0.0.2 ]; then + curl -O -sL https://github.com/graalvm/graalvm-ce-builds/releases/download/vm-22.0.0.2/graalvm-ce-java11-linux-amd64-22.0.0.2.tar.gz + tar xzf graalvm-ce-java11-linux-amd64-22.0.0.2.tar.gz fi - name: Babashka version @@ -217,14 +217,14 @@ jobs: run: | export BABASHKA_JAR=babashka-${{ steps.babashka-version.outputs.version }}-standalone.jar export BABASHKA_XMX="-J-Xmx6g" - export GRAALVM_HOME="$HOME/graalvm-ce-java11-21.3.0" + export GRAALVM_HOME="$HOME/graalvm-ce-java11-22.0.0.2" export BABASHKA_STATIC=true script/compile - name: Test binary run: | ./bb '(+ 1 2 3)' - export GRAALVM_HOME="$HOME/graalvm-ce-java11-21.3.0" + export GRAALVM_HOME="$HOME/graalvm-ce-java11-22.0.0.2" BABASHKA_TEST_ENV=native script/test - name: Install clojure @@ -233,7 +233,7 @@ jobs: - name: Test libraries run: | - export GRAALVM_HOME="$HOME/graalvm-ce-java11-21.3.0" + export GRAALVM_HOME="$HOME/graalvm-ce-java11-22.0.0.2" BABASHKA_TEST_ENV=native script/run_lib_tests - name: Upload artifact @@ -262,17 +262,17 @@ jobs: uses: actions/cache@v1 id: cache-graalvm with: - path: ~/graalvm-ce-java11-21.3.0 - key: ${{ runner.os }}-graalvm-21.3.0 + path: ~/graalvm-ce-java11-22.0.0.2 + key: ${{ runner.os }}-graalvm-22.0.0.2 restore-keys: | - ${{ runner.os }}-graalvm-21.3.0 + ${{ runner.os }}-graalvm-22.0.0.2 - name: Download GraalVM run: | cd ~ - if ! [ -d graalvm-ce-java11-21.3.0 ]; then - curl -O -sL https://github.com/graalvm/graalvm-ce-builds/releases/download/vm-21.3.0/graalvm-ce-java11-darwin-amd64-21.3.0.tar.gz - tar xzf graalvm-ce-java11-darwin-amd64-21.3.0.tar.gz + if ! [ -d graalvm-ce-java11-22.0.0.2 ]; then + curl -O -sL https://github.com/graalvm/graalvm-ce-builds/releases/download/vm-22.0.0.2/graalvm-ce-java11-darwin-amd64-22.0.0.2.tar.gz + tar xzf graalvm-ce-java11-darwin-amd64-22.0.0.2.tar.gz fi - name: Babashka version @@ -285,18 +285,18 @@ jobs: run: | export BABASHKA_JAR=babashka-${{ steps.babashka-version.outputs.version }}-standalone.jar export BABASHKA_XMX="-J-Xmx6g" - export GRAALVM_HOME="$HOME/graalvm-ce-java11-21.3.0/Contents/Home" + export GRAALVM_HOME="$HOME/graalvm-ce-java11-22.0.0.2/Contents/Home" script/compile - name: Test binary run: | - export GRAALVM_HOME="$HOME/graalvm-ce-java11-21.3.0/Contents/Home" + export GRAALVM_HOME="$HOME/graalvm-ce-java11-22.0.0.2/Contents/Home" sudo script/install-leiningen BABASHKA_TEST_ENV=native script/test - name: Test libraries run: | - export GRAALVM_HOME="$HOME/graalvm-ce-java11-21.3.0/Contents/Home" + export GRAALVM_HOME="$HOME/graalvm-ce-java11-22.0.0.2/Contents/Home" sudo script/install-clojure BABASHKA_TEST_ENV=native script/run_lib_tests diff --git a/CHANGELOG.md b/CHANGELOG.md index 43e30d53..2a2d4db8 100644 --- a/CHANGELOG.md +++ b/CHANGELOG.md @@ -4,11 +4,50 @@ For a list of breaking changes, check [here](#breaking-changes). ## Unreleased +- Fix [#1170](https://github.com/babashka/babashka/issues/1170): defmacro with a defrecord inside fails to resolve classname + +## 0.7.4 (2022-01-25) + +Please leave some feedback about babashka [here](https://forms.gle/ko3NjDg2SwXeEoNQ9). + +- Add new namespace from clojure 1.11: `clojure.math` +- Add new vars from clojure 1.11: `abs`, `iteration` +- Add compatibility with `org.clojure/algo.monads` +- SCI: support `:as-alias` +- SCI: add `pop!` ([@kbaba1001](https://github.com/kbaba1001)) +- `deps.clj`: update to clojure CLI 1.10.3.1058 +- Add metabom jar to docker images [#1133](https://github.com/babashka/babashka/issues/1133) ([@kipz](https://github.com/kipz), [@lispyclouds](https://github.com/lispyclouds)) +- Add opencontainers annotations to docker image [#1134](https://github.com/babashka/babashka/issues/1134) ([@kipz](https://github.com/kipz), [@lispyclouds](https://github.com/lispyclouds)) +- Fix Alpine Linux Docker images in CI script [#1140](https://github.com/babashka/babashka/issues/1140) ([@kipz](https://github.com/kipz), [@lispyclouds](https://github.com/lispyclouds)) +- `babashka.fs`: create dirs in `copy-tree` ([@duzunov](https://github.com/duzunov)) +- SCI: fix order of metadata evaluation ([@erdos](https://github.com/erdos)) +- Fix: cannot take value of macro of `->` +- Fix [#1144](https://github.com/babashka/babashka/issues/1144): cannot create multidimensional arrays +- Fix [#1143](https://github.com/babashka/babashka/issues/1143): allow optional (ignored) `--` when using using `--main` ([@grzm](https://github.com/grzm)) +- SCI: throw when `recur` is used from non-tail position +- Add more libraries to CI lib tests ([@cljwalker](https://github.com/cljwalker)) +- Upgrade several built-in deps: `org.clojure/clojure`, `cheshire`, `core.async`, `test.check` + +## 0.7.3 (2021-12-30) + +- Do not require java for bb tasks without deps [#1123](https://github.com/babashka/babashka/issues/1123), [#1124](https://github.com/babashka/babashka/issues/1124) + +## 0.7.2 (2021-12-29) + - Add `spy` macro from `taoensso.timbre` [#1087](https://github.com/babashka/babashka/issues/1087) - Better error for higher order fn arity mismatch - Check `shasum` / `sha256sum` in `PATH` on install script ([@thiagokokada](https://github.com/thiagokokada)) - Build arm64 docker image in CI [#1099](https://github.com/babashka/babashka/issues/1099) ([@cap10morgan](https://github.com/cap10morgan)) - Upgrade to `edamame` v0.0.19 +- Load tasks and deps from other bb.edn file using `--config` and `--deps-root` options [#1110](https://github.com/babashka/babashka/issues/1110) +- Uberscript improvements [#584](https://github.com/babashka/babashka/issues/584), [#1037](https://github.com/babashka/babashka/issues/1037) +- Include native elements in printed stacktrace [#1105](https://github.com/babashka/babashka/issues/1105) +- Missing error message when exception happens in REPL print [#1116](https://github.com/babashka/babashka/issues/1116) +- Undeprecate `$` in babashka.process +- Add lots of library tests to CI ([@cldwalker](https://github.com/cldwalker)) +- Release SNAPSHOT builds to + [babashka-dev-builds](https://github.com/babashka/babashka-dev-builds/releases) + (use only for testing) ## 0.7.0 (2021-12-10) diff --git a/Dockerfile b/Dockerfile index 23dfad9d..8ffb784f 100644 --- a/Dockerfile +++ b/Dockerfile @@ -5,7 +5,7 @@ RUN apt update RUN apt install --no-install-recommends -yy build-essential zlib1g-dev WORKDIR "/opt" -ENV GRAALVM_VERSION="21.3.0" +ENV GRAALVM_VERSION="22.0.0.2" ARG TARGETARCH ENV BABASHKA_ARCH=${TARGETARCH} ENV GRAALVM_ARCH=${TARGETARCH} @@ -73,5 +73,6 @@ RUN ./script/compile FROM ubuntu:latest RUN apt-get update && apt-get install -y curl \ && mkdir -p /usr/local/bin +COPY --from=BASE /opt/target/metabom.jar /opt/babashka-metabom.jar COPY --from=BASE /opt/bb /usr/local/bin/bb CMD ["bb"] diff --git a/Dockerfile.alpine b/Dockerfile.alpine index 2d931ad0..091f6654 100644 --- a/Dockerfile.alpine +++ b/Dockerfile.alpine @@ -24,6 +24,7 @@ RUN apk --no-cache add curl ca-certificates tar && \ apk add --allow-untrusted /tmp/glibc-2.28-r0.apk RUN echo 'hosts: files mdns4_minimal [NOTFOUND=return] dns mdns4' >> /etc/nsswitch.conf +COPY metabom.jar /opt/babashka-metabom.jar COPY --from=tester /bin/bb /bin/bb CMD ["bb"] diff --git a/Dockerfile.ci b/Dockerfile.ci index b5e7a85f..6d8c454b 100644 --- a/Dockerfile.ci +++ b/Dockerfile.ci @@ -7,6 +7,7 @@ RUN apt-get update \ ARG TARGETARCH ARG TARGETOS +COPY metabom.jar /opt/babashka-metabom.jar COPY ${TARGETOS}/${TARGETARCH}/bb /usr/local/bin/bb RUN chmod +x /usr/local/bin/bb diff --git a/README.md b/README.md index d26be425..1c447d6f 100644 --- a/README.md +++ b/README.md @@ -147,6 +147,11 @@ Install: brew install borkdude/brew/babashka +On macOS with an M1 processor: + + softwareupdate --install-rosetta + arch -x86_64 brew install borkdude/brew/babashka + Upgrade: brew upgrade babashka diff --git a/appveyor.yml b/appveyor.yml index 56e2df13..b9e771c4 100644 --- a/appveyor.yml +++ b/appveyor.yml @@ -7,8 +7,8 @@ image: Visual Studio 2017 clone_folder: C:\projects\babashka environment: - GRAALVM_HOME: C:\projects\babashka\graalvm\graalvm-ce-java11-21.3.0 - JAVA_HOME: C:\projects\babashka\graalvm\graalvm-ce-java11-21.3.0 + GRAALVM_HOME: C:\projects\babashka\graalvm\graalvm-ce-java11-22.0.0.2 + JAVA_HOME: C:\projects\babashka\graalvm\graalvm-ce-java11-22.0.0.2 BABASHKA_XMX: "-J-Xmx5g" cache: @@ -33,7 +33,7 @@ clone_script: build_script: - cmd: >- - powershell -Command "if (Test-Path('graalvm')) { return } else { (New-Object Net.WebClient).DownloadFile('https://github.com/graalvm/graalvm-ce-builds/releases/download/vm-21.3.0/graalvm-ce-java11-windows-amd64-21.3.0.zip', 'graalvm.zip') }" + powershell -Command "if (Test-Path('graalvm')) { return } else { (New-Object Net.WebClient).DownloadFile('https://github.com/graalvm/graalvm-ce-builds/releases/download/vm-22.0.0.2/graalvm-ce-java11-windows-amd64-22.0.0.2.zip', 'graalvm.zip') }" powershell -Command "if (Test-Path('graalvm')) { return } else { Expand-Archive graalvm.zip graalvm }" @@ -62,11 +62,7 @@ build_script: jar -cMf %zip% bb.exe - set BABASHKA_EDN=.build/bb.edn - - bb release-artifact %zip% - - set BABASHKA_EDN= + bb --config .build/bb.edn --deps-root . release-artifact %zip% set BABASHKA_CLASSPATH= diff --git a/deps.clj b/deps.clj index 6f51f783..e4a47f6b 160000 --- a/deps.clj +++ b/deps.clj @@ -1 +1 @@ -Subproject commit 6f51f783a91b0cfab2663b55607b45e9e342bcb6 +Subproject commit e4a47f6ba6ea91c898c68fcea0358260deea7a4d diff --git a/deps.edn b/deps.edn index d45a9704..0812f2b8 100644 --- a/deps.edn +++ b/deps.edn @@ -14,20 +14,20 @@ "depstar/src" "process/src" "deps.clj/src" "deps.clj/resources" "resources" "sci/resources"], - :deps {org.clojure/clojure {:mvn/version "1.11.0-alpha3"}, + :deps {org.clojure/clojure {:mvn/version "1.11.0-beta1"}, borkdude/sci {:local/root "sci"} babashka/babashka.curl {:local/root "babashka.curl"} babashka/fs {:local/root "fs"} babashka/babashka.core {:local/root "babashka.core"} borkdude/graal.locking {:mvn/version "0.0.2"}, - org.clojure/core.async {:mvn/version "1.4.627"}, + org.clojure/core.async {:mvn/version "1.5.648"}, org.clojure/tools.cli {:mvn/version "1.0.206"}, org.clojure/data.csv {:mvn/version "1.0.0"}, - cheshire/cheshire {:mvn/version "5.10.1"} + cheshire/cheshire {:mvn/version "5.10.2"} org.clojure/data.xml {:mvn/version "0.2.0-alpha6"} clj-commons/clj-yaml {:mvn/version "0.7.107"} - com.cognitect/transit-clj {:mvn/version "1.0.324"} - org.clojure/test.check {:mvn/version "1.1.0"} + com.cognitect/transit-clj {:mvn/version "1.0.329"} + org.clojure/test.check {:mvn/version "1.1.1"} nrepl/bencode {:mvn/version "1.1.0"} seancorfield/next.jdbc {:mvn/version "1.1.610"} org.postgresql/postgresql {:mvn/version "42.2.18"} @@ -55,10 +55,7 @@ :extra-deps {org.clj-commons/clj-http-lite {:mvn/version "0.4.392"} org.babashka/spec.alpha {:git/url "https://github.com/babashka/spec.alpha" :sha "0dec1f88cbde74a0470b454396f09a03adb4ae39"} - lambdaisland/regal {:git/url "https://github.com/lambdaisland/regal" - :sha "f902d2c43121f9e1c48603d6eb99f5900eb6a9f6"} - weavejester/medley {:git/url "https://github.com/weavejester/medley" - :sha "a4e5fb5383f5c0d83cb2d005181a35b76d8a136d"} + lambdaisland/regal {:mvn/version "0.0.143"} cprop/cprop {:mvn/version "0.1.16"} comb/comb {:mvn/version "0.1.1"} mvxcvi/arrangement {:mvn/version "2.0.0"} @@ -69,16 +66,16 @@ henryw374/cljc.java-time {:git/url "https://github.com/henryw374/cljc.java-time.git" :sha "e3d184b78e933322b3fcaa6ca66cbb8f42a6b35c"} - camel-snake-kebab/camel-snake-kebab {:mvn/version "0.4.1"} + camel-snake-kebab/camel-snake-kebab {:mvn/version "0.4.2"} aero/aero {:mvn/version "1.1.6"} org.clojure/data.generators {:mvn/version "1.0.0"} - honeysql/honeysql {:mvn/version "1.0.444"} - com.github.seancorfield/honeysql {:mvn/version "2.0.0-rc2"} - minimallist/minimallist {:mvn/version "0.0.6"} - circleci/bond {:mvn/version "0.4.0"} - version-clj/version-clj {:mvn/version "2.0.1"} + honeysql/honeysql {:mvn/version "1.0.461"} + com.github.seancorfield/honeysql {:mvn/version "2.2.840"} + minimallist/minimallist {:mvn/version "0.0.10"} + circleci/bond {:mvn/version "0.6.0"} + version-clj/version-clj {:mvn/version "2.0.2"} gaka/gaka {:mvn/version "0.3.0"} - failjure/failjure {:mvn/version "2.1.1"} + failjure/failjure {:mvn/version "2.2.0"} io.helins/binf {:mvn/version "1.1.0-beta0"} rm-hull/jasentaa {:mvn/version "0.2.5"} slingshot/slingshot {:mvn/version "0.12.2"} @@ -104,7 +101,28 @@ listora/again {:mvn/version "1.0.0"} org.clojure/tools.gitlibs {:mvn/version "2.4.172"} environ/environ {:mvn/version "1.2.0"} - table/table {:git/url "https://github.com/cldwalker/table", :sha "55aef3d5fced682942af811bf5d642f79fb87688"}} + table/table {:git/url "https://github.com/cldwalker/table", :sha "f6293c5f3dac1dd6f525a80fc80930f8ccdf16b7"} + markdown-clj/markdown-clj {:mvn/version "1.10.8"} + org.clojure/tools.namespace {:git/url "https://github.com/babashka/tools.namespace", :sha "a13b037215e21a2e71aa34b27e1dd52c801a2a7b"} + medley/medley {:mvn/version "1.3.0"} + io.github.cognitect-labs/test-runner {:git/tag "v0.5.0", :git/sha "b3fd0d2"} + borkdude/missing.test.assertions {:git/url "https://github.com/borkdude/missing.test.assertions", :sha "603cb01bee72fb17addacc53c34c85612684ad70"} + dev.nubank/docopt {:mvn/version "0.6.1-fix7"} + testdoc/testdoc {:mvn/version "1.4.1"} + org.clojars.lispyclouds/contajners {:mvn/version "0.0.4"} + borkdude/rewrite-edn {:mvn/version "0.1.0"} + clojure-term-colors/clojure-term-colors {:mvn/version "0.1.0"} + io.aviso/pretty {:mvn/version "1.1.1"} + progrock/progrock {:mvn/version "0.1.2"} + djblue/portal {:mvn/version "0.19.0"} + com.wsscode/cljc-misc {:mvn/version "2021.10.16"} + edn-query-language/eql {:mvn/version "2021.07.18"} + meta-merge/meta-merge {:mvn/version "1.0.0"} + com.exoscale/lingo {:mvn/version "1.0.0-alpha14"} + io.github.swirrl/dogstatsd {:mvn/version "0.1.39"} + org.clojure/algo.monads {:mvn/version "0.1.6"} + io.lambdaforge/datalog-parser {:mvn/version "0.1.9"} + clj-stacktrace/clj-stacktrace {:mvn/version "0.2.8"}} :classpath-overrides {org.clojure/clojure nil org.clojure/spec.alpha nil}} :clj-nvd diff --git a/doc/build.md b/doc/build.md index a5f83235..62f0ed43 100644 --- a/doc/build.md +++ b/doc/build.md @@ -3,24 +3,24 @@ ## Prerequisites - Install [lein](https://leiningen.org/) for producing uberjars -- Download [GraalVM](https://www.graalvm.org/downloads/). Currently we use *java11-21.3.0*. +- Download [GraalVM](https://www.graalvm.org/downloads/). Currently we use *java11-22.0.0.2*. - For Windows, installing Visual Studio 2019 with the "Desktop development with C++" workload is recommended. - Set `$GRAALVM_HOME` to the GraalVM distribution directory. On macOS this can look like: ``` shell - export GRAALVM_HOME=~/Downloads/graalvm-ce-java11-21.3.0/Contents/Home + export GRAALVM_HOME=~/Downloads/graalvm-ce-java11-22.0.0.2/Contents/Home ``` On linux: ``` shell - export GRAALVM_HOME=~/Downloads/graalvm-ce-java11-21.3.0 + export GRAALVM_HOME=~/Downloads/graalvm-ce-java11-22.0.0.2 ``` On Windows, from the [Visual Studio 2019 x64 Native Tools Command Prompt](https://github.com/oracle/graal/issues/2116#issuecomment-590470806) or `cmd.exe` (not Powershell): ``` - set GRAALVM_HOME=%USERPROFILE%\Downloads\graalvm-ce-java11-21.3.0 + set GRAALVM_HOME=%USERPROFILE%\Downloads\graalvm-ce-java11-22.0.0.2 ``` If you are not running from the x64 Native Tools Command Prompt, you will need to set additional environment variables using: ``` diff --git a/doc/companies.md b/doc/companies.md index 30dc58bc..ea76a3eb 100644 --- a/doc/companies.md +++ b/doc/companies.md @@ -26,10 +26,22 @@ Sponsoring via [Cognitect](https://www.cognitect.com/). +### [ATA](https://ata-llc.com) - [hiring](https://www.ziprecruiter.com/c/ATA-LLC/Jobs) + +Screen Shot 2022-01-07 at 21 21 00 + +### [Cognician](https://www.cognician.com) + + + ### [Fluent](https://fluent.to) +### [180seg](https://www.180s.com.br) + + + ### [Dr. Evidence](https://www.drevidence.com/) diff --git a/doc/dev.md b/doc/dev.md index c059a9a8..7d4155f7 100644 --- a/doc/dev.md +++ b/doc/dev.md @@ -37,7 +37,7 @@ reasons: ## Requirements -You need [lein](https://leiningen.org/) for running JVM tests and/or producing uberjars. For building binaries you need GraalVM. Currently we use java11-21.3.0. +You need [lein](https://leiningen.org/) for running JVM tests and/or producing uberjars. For building binaries you need GraalVM. Currently we use java11-22.0.0.2. ## Clone repository @@ -81,19 +81,29 @@ Test the native version: ## Tests for Libraries Babashka runs tests of libraries that are compatible with it through -`script/run_lib_tests`. To add tests for a new library that has a git repository -and run them, use the script `add-libtest.clj` e.g. `script/add-libtest.clj -'{listora/again {:mvn/version "1.0.0"}}' https://github.com/liwp/again --test`. +`script/run_lib_tests`. The script `add-libtest.clj` makes adding new libraries +fairly easy. Some examples: -If the library you want to add doesn't work with the script, you can manually do the following: +```sh +# To add tests for a new library on clojars +script/add-libtest.clj com.exoscale/lingo -t + +# To add tests for a new library that is git based only +script/add-libtest.clj '{borkdude/carve {:git/url "https://github.com/borkdude/carve" :sha "df552797a198b6701fb2d92390fce7c59205ea77"}}' -t + +# There are a number of options for specifying how to copy tests +script/add-libtest.clj -h +``` + +If the library you want to add doesn't work automatically, you can manually do the following: * Add an entry for the library in `deps.edn` under the `:lib-tests` alias. * Create a directory for the library in `test-resources/lib_tests/` and copy its tests to there. -* Add an entry in `run_all_libtests.clj` to run the added test namespaces. +* Add a manual lib entry using `add-libtest.clj` e.g. `script/add-libtest.clj http-kit/http-kit -m '{:test-namespaces [httpkit.client-test]}'`. * Run the tests `script/lib_tests/run_all_libtests NS1 NS2` -Note: If you have to modify a test to have it work with bb, add an inline -comment with prefix "BB-TEST-PATCH:" explaining what you did. +Note: If you have to modify any test file or configuration to have it work with +bb, add an inline comment with prefix `BB-TEST-PATCH:` explaining what you did. ## Build @@ -149,7 +159,7 @@ Some of these design decisions were formed in [these discussions](https://github - Tasks do not allow passing arguments to dependent tasks, other than by rebinding `*command-line-args*` (see discussion). - Does the list of dependencies need to be dynamic? No, see discussion (same reason as args) -- bb is resolved as file > task > bb subcommand. Shadowing future subcommand is a problem that a user can solve by renaming a task or file. (same as lein aliases). Also see Conflicts. +- bb <foo> is resolved as file > task > bb subcommand. Shadowing future subcommand is a problem that a user can solve by renaming a task or file. (same as lein aliases). Also see Conflicts. - It is a feature that tasks are defined as top-level vars (instead of local let-bound symbols). This plays well with the Gilardi scenario, e.g. here: https://github.com/babashka/babashka.github.io/blob/ad276625f6c41f269d19450f236cb54cab2591e1/bb.edn#L7. - The parallel option trickles down into run calls. People who use parallel will be confused if it’s dropped magically, people who don’t use parallel won’t notice anything either way so it doesn’t matter diff --git a/doc/libraries.csv b/doc/libraries.csv new file mode 100644 index 00000000..eb9a9417 --- /dev/null +++ b/doc/libraries.csv @@ -0,0 +1,81 @@ +maven-name,git-url +aero/aero,http://github.com/juxt/aero +amperity/vault-clj,https://github.com/amperity/vault-clj +babashka/babashka.curl,https://github.com/babashka/babashka.curl +better-cond/better-cond,https://github.com/Engelberg/better-cond +borkdude/deps,https://github.com/borkdude/deps.clj +borkdude/missing.test.assertions,https://github.com/borkdude/missing.test.assertions +borkdude/rewrite-edn,https://github.com/borkdude/rewrite-edn +camel-snake-kebab/camel-snake-kebab,https://github.com/clj-commons/camel-snake-kebab +circleci/bond,https://github.com/circleci/bond +clj-commons/clj-yaml,https://github.com/clj-commons/clj-yaml +clj-commons/multigrep,https://github.com/clj-commons/multigrep +clj-stacktrace/clj-stacktrace,https://github.com/mmcgrana/clj-stacktrace +clojure-csv/clojure-csv,https://github.com/davidsantiago/clojure-csv +clojure-term-colors/clojure-term-colors,https://github.com/trhura/clojure-term-colors +com.exoscale/lingo,https://github.com/exoscale/lingo +com.github.seancorfield/honeysql,https://github.com/seancorfield/honeysql +com.grammarly/omniconf,https://github.com/grammarly/omniconf +com.stuartsierra/component,https://github.com/stuartsierra/component +com.stuartsierra/dependency,https://github.com/stuartsierra/dependency +com.wsscode/cljc-misc,https://github.com/wilkerlucio/cljc-misc +comb/comb,https://github.com/weavejester/comb +cprop/cprop,https://github.com/tolitius/cprop +crispin/crispin,https://github.com/dunaj-project/crispin +dev.nubank/docopt,https://github.com/nubank/docopt.clj +djblue/portal,https://github.com/djblue/portal +doric/doric,https://github.com/joegallo/doric +douglass/clj-psql,https://github.com/DarinDouglass/clj-psql +edn-query-language/eql,https://github.com/edn-query-language/eql +environ/environ,https://github.com/weavejester/environ +exoscale/coax,https://github.com/exoscale/coax +expound/expound,https://github.com/bhb/expound +failjure/failjure,https://github.com/adambard/failjure +ffclj/ffclj,https://github.com/luissantos/ffclj +gaka/gaka,https://github.com/cdaddr/gaka +hato/hato,https://github.com/gnarroway/hato +henryw374/cljc.java-time,https://github.com/henryw374/cljc.java-time +hiccup/hiccup,http://github.com/weavejester/hiccup +honeysql/honeysql,https://github.com/seancorfield/honeysql +http-kit/http-kit,https://github.com/http-kit/http-kit +integrant/integrant,https://github.com/weavejester/integrant +io.aviso/pretty,https://github.com/AvisoNovate/pretty +io.github.cognitect-labs/test-runner,https://github.com/cognitect-labs/test-runner +io.github.swirrl/dogstatsd,https://github.com/swirrl/dogstatsd +io.github.technomancy/limit-break,https://github.com/technomancy/limit-break +io.helins/binf,https://github.com/helins/binf.cljc +io.lambdaforge/datalog-parser,https://github.com/lambdaforge/datalog-parser +io.replikativ/hasch,https://github.com/replikativ/hasch +java-http-clj/java-http-clj,http://www.github.com/schmee/java-http-clj +lambdaisland/regal,https://github.com/lambdaisland/regal +listora/again,https://github.com/liwp/again +markdown-clj/markdown-clj,https://github.com/yogthos/markdown-clj +medley/medley,https://github.com/weavejester/medley +meta-merge/meta-merge,https://github.com/weavejester/meta-merge +minimallist/minimallist,https://github.com/green-coder/minimallist +mvxcvi/arrangement,https://github.com/greglook/clj-arrangement +orchestra/orchestra,https://github.com/jeaye/orchestra +org.babashka/spec.alpha,https://github.com/babashka/spec.alpha +org.clj-commons/clj-http-lite,https://github.com/clj-commons/clj-http-lite +org.clj-commons/digest,https://github.com/clj-commons/clj-digest +org.clojars.askonomm/ruuter,https://github.com/askonomm/ruuter +org.clojars.lispyclouds/contajners,https://github.com/lispyclouds/contajners +org.clojure/algo.monads,https://github.com/clojure/algo.monads +org.clojure/core.match,https://github.com/clojure/core.match +org.clojure/data.csv,https://github.com/clojure/data.csv +org.clojure/data.generators,https://github.com/clojure/data.generators +org.clojure/data.json,https://github.com/clojure/data.json +org.clojure/data.zip,https://github.com/clojure/data.zip +org.clojure/math.combinatorics,https://github.com/clojure/math.combinatorics +org.clojure/test.check,https://github.com/clojure/test.check +org.clojure/tools.gitlibs,https://github.com/clojure/tools.gitlibs +org.clojure/tools.namespace,https://github.com/babashka/tools.namespace +progrock/progrock,https://github.com/weavejester/progrock +reifyhealth/specmonstah,https://github.com/reifyhealth/specmonstah +rewrite-clj/rewrite-clj,https://github.com/clj-commons/rewrite-clj +rm-hull/jasentaa,https://github.com/rm-hull/jasentaa +selmer/selmer,https://github.com/yogthos/Selmer +slingshot/slingshot,https://github.com/scgilardi/slingshot +table/table,https://github.com/cldwalker/table +testdoc/testdoc,https://github.com/liquidz/testdoc +version-clj/version-clj,https://github.com/xsc/version-clj diff --git a/doc/news.md b/doc/news.md index 564a08b2..bfd3b531 100644 --- a/doc/news.md +++ b/doc/news.md @@ -5,6 +5,53 @@ you have anything to add. Also see [#babashka](https://twitter.com/hashtag/babashka?src=hashtag_click&f=live) on Twitter. +## 2021-12 + +- Releases: [0.6.8 - 0.7.3](https://github.com/babashka/babashka/blob/master/CHANGELOG.md). +- [Scripting with Babashka on Alfred](https://blog.wsscode.com/babashka-and-alfred/) by Wilker Lucio +- [babashka/spec.alpha](https://github.com/babashka/spec.alpha): a fork of spec.alpha that works with babashka. +- Several people are doing [Advent of Code puzzles with babashka](https://twitter.com/search?q=%23babashka%20%20%23AdventOfCode&src=typed_query&f=live) +- Compatibility with a [fork of tools.namespace](https://github.com/babashka/tools.namespace). This allows + running the Cognitect [test-runner](https://github.com/cognitect-labs/test-runner) (Cognitest) from source. +- [bb-components](https://github.com/vedang/bb-scripts#bb-components): A script to find all the components that you should deploy your code to. +- [Babashka workshop at JavaLand](https://github.com/ijug-ev/JavaLand/tree/main/Community-Aktivit%C3%A4ten#bash-war-gestern-shell-scripting-mit-babashka-clojure-ug-d%C3%BCsseldorf-christian-meter-rheinjug-jens-bendisposto) +- Install babashka [dev builds](https://twitter.com/borkdude/status/1475234968146227203) +- [Combine babashka and PHP](https://gist.github.com/borkdude/843548cba14ae9d283191e31bc483959) +- [System wide babashka tasks](https://twitter.com/borkdude/status/1476656022282551300) +- [Run an http file server as a babashka task](https://twitter.com/borkdude/status/1476870516233445377) + +## 2021-11 + +- Releases: [0.6.5 - 0.6.7](https://github.com/babashka/babashka/blob/master/CHANGELOG.md). +- [Contajners](https://github.com/lispyclouds/contajners): An idiomatic, + data-driven, REPL friendly clojure client for OCI container engines. +- [deps-modules](https://github.com/exoscale/deps-modules#babashka): a clojure "tool" that attempts to solve one of the "multi module" project problems with tools.deps in a minimalistic way. +- [Moldable Emacs: a Clojure Playground with Babashka](https://ag91.github.io/blog/2021/11/05/moldable-emacs-a-clojure-playground-with-babashka/) +- [aws pod 0.1.0](https://twitter.com/borkdude/status/1459117378441261056) +- [tools.bbuild](https://github.com/babashka/tools.bbuild): a fork of tools.build that runs with babashka and [tools-deps-native](https://github.com/babashka/tools-deps-native) +- [Making markdown-clj babashka compatible](https://blog.michielborkent.nl/markdown-clj-babashka-compatible.html) by Michiel Borkent +- [radiale](https://github.com/xlfe/radiale): radiale: home automation project written using #babashka and Python +- [Writing a Clojure shell script with Babashka](https://www.youtube.com/watch?v=D-_Mz7rz1po), a video by Max Weber +- [makejack](https://github.com/hugoduncan/makejack): A clojure CLI build tool, and build library which can run with babashka. +- [I wrote myself a static site generator](https://freeston.me/posts/2021-11-29-new-site-generator/) (in babashka) by Dominic Freeston. +- [bipe](https://gist.github.com/borkdude/82dcdd36a1e61ef36f19221876e7b1b6): vipe for babashka + + +## 2021-10 +- Releases: [0.6.2-0.6.4](https://github.com/babashka/babashka/blob/master/CHANGELOG.md). +- Babashka on the [Thoughtworks Technology Radar](https://www.thoughtworks.com/radar/platforms/babashka) +- [ruuter](https://github.com/askonomm/ruuter#setting-up-with-babashka) is a + routing library compatible with babashka. +- A list of [companies](https://github.com/babashka/babashka/blob/master/doc/companies.md) using babashka +- Ilshat Sultanov shares his [babashka tasks](https://twitter.com/just_sultanov/status/1446118161258987534) +- [Slack the music](https://github.com/javahippie/slack-the-music), a babashka script to update your slack status with your current Apple Music track by Tim Zöller. +- [Finding my inner Wes Anderson](https://javahippie.net/clojure/2021/10/18/finding-my-inner-wes-anderson.html) by Tim Zöller. +- [Run a local babashka script in a remote server](https://twitter.com/borkdude/status/1451110414062870528) +- [Replacing my Octopress blog with 200 lines of Babashka](https://blog.michielborkent.nl/migrating-octopress-to-babashka.html) by Michiel Borkent +- The babashka wiki now has a [GNU Emacs](https://github.com/babashka/babashka/wiki/GNU-Emacs) section +- Invoke babashka tasks in a [monorepo](https://github.com/babashka/babashka/discussions/1044#discussioncomment-1544956) +- [Speeding up builds with fs/modified-since](https://blog.michielborkent.nl/speeding-up-builds-fs-modified-since.html) by Michiel Borkent + ## 2021-09 - New babashka 0.6.0 released. Highlight: support for `java.net.http` which @@ -13,6 +60,13 @@ Twitter. http related scripting towards `java.net.http` in favor of the other two solutions currently available in `bb`: `babashka.curl` and `org.httpkit.client`. +- [rss-saver](https://github.com/adam-james-v/rss-saver): Simple Clojure (Babashka) script that saves articles from world.hey.com RSS feeds. +- [babashka-docker-action-example](https://github.com/borkdude/babashka-docker-action-example) +- [script](https://gist.github.com/rutenkolk/dbd970d03a0d012b671db38434ccbfa7) to upgrade zig lang to the latest dev release +- [Cursive](https://twitter.com/CursiveIDE/status/1439022267187433472) adds support for babashka in 1.11.0 +- How to filter tail output with babashka on [StackOverflow](https://stackoverflow.com/questions/69241046/how-to-filter-output-of-tail-with-babashka/69241911?stw=2#69241911) +- [Awesome Babashka: Parse & produce HTML and SQLite](https://blog.jakubholy.net/2021/awesome-babashka-dash/) by Jakub Holy +- [neil](https://github.com/babashka/neil): an installable babashka script to add common aliases and features to deps.edn-based projects. ## 2021-08 diff --git a/doc/projects.md b/doc/projects.md index 0a55b0b1..31d84540 100644 --- a/doc/projects.md +++ b/doc/projects.md @@ -2,93 +2,98 @@ The following libraries and projects are known to work with babashka. -- [Libraries](#libraries) - - [tools.namespace](#toolsnamespace) - - [test-runner](#test-runner) - - [spec.alpha](#specalpha) - - [tools.bbuild](#toolsbbuild) - - [clj-http-lite](#clj-http-lite) - - [spartan.spec](#spartanspec) - - [missing.test.assertions](#missingtestassertions) - - [medley](#medley) - - [limit-break](#limit-break) - - [clojure-csv](#clojure-csv) - - [regal](#regal) - - [cprop](#cprop) - - [comb](#comb) - - [nubank/docopt](#nubankdocopt) - - [arrangement](#arrangement) - - [clojure.math.combinatorics](#clojuremathcombinatorics) - - [testdoc](#testdoc) - - [doric](#doric) - - [clojure.data.zip](#clojuredatazip) - - [clj-psql](#clj-psql) - - [camel-snake-kebab](#camel-snake-kebab) - - [aero](#aero) - - [clojure.data.generators](#clojuredatagenerators) - - [honeysql](#honeysql) - - [bond](#bond) - - [portal](#portal) - - [version-clj](#version-clj) - - [matchete](#matchete) - - [progrock](#progrock) - - [clj-commons/fs](#clj-commonsfs) - - [cljc.java-time](#cljcjava-time) - - [environ](#environ) - - [gaka](#gaka) - - [failjure](#failjure) - - [pretty](#pretty) - - [clojure-term-colors](#clojure-term-colors) - - [binf](#binf) - - [rewrite-edn](#rewrite-edn) - - [expound](#expound) - - [omniconf](#omniconf) - - [slingshot](#slingshot) - - [hasch](#hasch) - - [crispin](#crispin) - - [ffclj](#ffclj) - - [multigrep](#multigrep) - - [java-http-clj](#java-http-clj) - - [component](#component) - - [minimallist](#minimallist) - - [ruuter](#ruuter) - - [clj-commons.digest](#clj-commonsdigest) - - [contajners](#contajners) - - [dependency](#dependency) - - [specmonstah](#specmonstah) -- [Pods](#pods) -- [Projects](#projects-1) - - [babashka-test-action](#babashka-test-action) - - [deps.clj](#depsclj) - - [4bb](#4bb) - - [babashka lambda layer](#babashka-lambda-layer) - - [Release on push Github action](#release-on-push-github-action) - - [justone/bb-scripts](#justonebb-scripts) - - [nativity](#nativity) - - [cldwalker/bb-clis](#cldwalkerbb-clis) - - [krell template](#krell-template) - - [wee-httpd](#wee-httpd) - - [covid19-babashka](#covid19-babashka) - - [bb-spotify](#bb-spotify) - - [lambdaisland/open-source](#lambdaislandopen-source) - - [dharrigan/spotifyd-notification](#dharriganspotifyd-notification) - - [nextjournal/ssh-github-auth](#nextjournalssh-github-auth) - - [turtlequeue/setup-babashka](#turtlequeuesetup-babashka) - - [interdep](#interdep) - - [sha-words](#sha-words) - - [adam-james-v/scripts](#adam-james-vscripts) - - [oidc-client](#oidc-client) - - [jirazzz](#jirazzz) - - [Babashka + scittle guestbook](#babashka--scittle-guestbook) - - [bb htmx todo app](#bb-htmx-todo-app) +- [Projects](#projects) + - [Libraries](#libraries) + - [tools.namespace](#toolsnamespace) + - [test-runner](#test-runner) + - [spec.alpha](#specalpha) + - [tools.bbuild](#toolsbbuild) + - [clj-http-lite](#clj-http-lite) + - [spartan.spec](#spartanspec) + - [missing.test.assertions](#missingtestassertions) + - [medley](#medley) + - [limit-break](#limit-break) + - [clojure-csv](#clojure-csv) + - [regal](#regal) + - [cprop](#cprop) + - [comb](#comb) + - [nubank/docopt](#nubankdocopt) + - [arrangement](#arrangement) + - [clojure.math.combinatorics](#clojuremathcombinatorics) + - [testdoc](#testdoc) + - [doric](#doric) + - [clojure.data.zip](#clojuredatazip) + - [clj-psql](#clj-psql) + - [camel-snake-kebab](#camel-snake-kebab) + - [aero](#aero) + - [clojure.data.generators](#clojuredatagenerators) + - [honeysql](#honeysql) + - [bond](#bond) + - [portal](#portal) + - [version-clj](#version-clj) + - [matchete](#matchete) + - [progrock](#progrock) + - [clj-commons/fs](#clj-commonsfs) + - [cljc.java-time](#cljcjava-time) + - [environ](#environ) + - [gaka](#gaka) + - [failjure](#failjure) + - [pretty](#pretty) + - [clojure-term-colors](#clojure-term-colors) + - [binf](#binf) + - [rewrite-edn](#rewrite-edn) + - [expound](#expound) + - [omniconf](#omniconf) + - [slingshot](#slingshot) + - [hasch](#hasch) + - [crispin](#crispin) + - [ffclj](#ffclj) + - [multigrep](#multigrep) + - [java-http-clj](#java-http-clj) + - [component](#component) + - [minimallist](#minimallist) + - [ruuter](#ruuter) + - [clj-commons.digest](#clj-commonsdigest) + - [contajners](#contajners) + - [dependency](#dependency) + - [specmonstah](#specmonstah) + - [markdown-clj](#markdown-clj) + - [algo.monads](#algomonads) + - [Pods](#pods) + - [Projects](#projects-1) + - [babashka-test-action](#babashka-test-action) + - [deps.clj](#depsclj) + - [4bb](#4bb) + - [babashka lambda layer](#babashka-lambda-layer) + - [Release on push Github action](#release-on-push-github-action) + - [justone/bb-scripts](#justonebb-scripts) + - [nativity](#nativity) + - [cldwalker/bb-clis](#cldwalkerbb-clis) + - [krell template](#krell-template) + - [wee-httpd](#wee-httpd) + - [covid19-babashka](#covid19-babashka) + - [bb-spotify](#bb-spotify) + - [lambdaisland/open-source](#lambdaislandopen-source) + - [dharrigan/spotifyd-notification](#dharriganspotifyd-notification) + - [nextjournal/ssh-github-auth](#nextjournalssh-github-auth) + - [turtlequeue/setup-babashka](#turtlequeuesetup-babashka) + - [interdep](#interdep) + - [sha-words](#sha-words) + - [adam-james-v/scripts](#adam-james-vscripts) + - [oidc-client](#oidc-client) + - [jirazzz](#jirazzz) + - [Babashka + scittle guestbook](#babashka--scittle-guestbook) + - [bb htmx todo app](#bb-htmx-todo-app) + - [bb aws lambda runtime](#bb-aws-lambda-runtime) -For more supported libraries, see [this test -file](../test-resources/lib_tests/babashka/run_all_libtests.clj ). Also keep an eye -on the [news](news.md) page for new projects, gists and other developments -around babashka. +Also keep an eye on the [news](news.md) page for new projects, gists and other +developments around babashka. ## Libraries +For a full list of libraries, see [libraries.csv](./libraries.csv). To add a +library, see [these instructions](./dev.md#tests-for-libraries). + ### [tools.namespace](https://github.com/babashka/tools.namespace) A fork of `tools.namespace`. This is used by other libraries and enables them to @@ -110,12 +115,12 @@ instrumentation! Its readme also contains instructions on how to use A fork of `tools.build`. -### [clj-http-lite](https://github.com/babashka/clj-http-lite) +### [clj-http-lite](https://github.com/clj-commons/clj-http-lite) -A fork of a fork of `clj-http-lite`. Example: +Example: ``` shell -$ export BABASHKA_CLASSPATH="$(clojure -Sdeps '{:deps {clj-http-lite {:git/url "https://github.com/babashka/clj-http-lite" :sha "f44ebe45446f0f44f2b73761d102af3da6d0a13e"}}}' -Spath)" +$ export BABASHKA_CLASSPATH="$(clojure -Sdeps '{:deps {org.clj-commons/clj-http-lite {:mvn/version "0.4.392"}}}' -Spath)" $ bb "(require '[clj-http.lite.client :as client]) (:status (client/get \"https://www.clojure.org\"))" 200 @@ -145,16 +150,10 @@ Ran 1 tests containing 0 assertions. ### [medley](https://github.com/weavejester/medley/) -Requires `bb` >= v0.0.71. Latest coordinates checked with with bb: - -``` clojure -{:git/url "https://github.com/weavejester/medley" :sha "a4e5fb5383f5c0d83cb2d005181a35b76d8a136d"} -``` - Example: ``` shell -$ export BABASHKA_CLASSPATH=$(clojure -Spath -Sdeps '{:deps {medley {:git/url "https://github.com/weavejester/medley" :sha "a4e5fb5383f5c0d83cb2d005181a35b76d8a136d"}}}') +$ export BABASHKA_CLASSPATH=$(clojure -Spath -Sdeps '{:deps {medley/medley {:mvn/version "1.3.0"}}}') $ bb -e "(require '[medley.core :as m]) (m/index-by :id [{:id 1} {:id 2}])" {1 {:id 1}, 2 {:id 2}} @@ -201,16 +200,10 @@ export BABASHKA_CLASSPATH="$(clojure -Sdeps '{:deps {clojure-csv {:mvn/version " ### [regal](https://github.com/lambdaisland/regal) -Requires `bb` >= v0.0.71. Latest coordinates checked with with bb: - -``` clojure -{:git/url "https://github.com/lambdaisland/regal" :sha "d4e25e186f7b9705ebb3df6b21c90714d278efb7"} -``` - Example: ``` shell -$ export BABASHKA_CLASSPATH=$(clojure -Spath -Sdeps '{:deps {regal {:git/url "https://github.com/lambdaisland/regal" :sha "d4e25e186f7b9705ebb3df6b21c90714d278efb7"}}}') +$ export BABASHKA_CLASSPATH=$(clojure -Spath -Sdeps '{:deps {lambdaisland/regal {:mvn/version "0.0.143"}}}') $ bb -e "(require '[lambdaisland.regal :as regal]) (regal/regex [:* \"ab\"])" #"(?:\Qab\E)*" @@ -792,6 +785,14 @@ Represent dependency graphs as a directed acylic graph. Write concise, maintainable test fixtures with clojure.spec.alpha. +### [markdown-clj](https://github.com/yogthos/markdown-clj) + +Markdown parser that translates markdown to html. + +### [algo.monads](https://github.com/clojure/algo.monads) + +Macros for defining monads, and definition of the most common monads. + ## Pods [Babashka pods](https://github.com/babashka/babashka.pods) are programs that can diff --git a/examples/README.md b/examples/README.md index 22fd6d97..0f851994 100644 --- a/examples/README.md +++ b/examples/README.md @@ -549,3 +549,9 @@ $ bb db_who.clj | fred@192.168.1.2 | workbench | | jane@192.168.1.3 | Toad for mySQL | ``` +## Single page application with Babashka + htmx + +Example of a todo list SPA using Babashka and htmx +See [htmx_todoapp.clj](htmx_todoapp.clj) + +Contributed by [@prestancedesign](https://github.com/prestancedesign). diff --git a/examples/htmx_todoapp.clj b/examples/htmx_todoapp.clj new file mode 100644 index 00000000..35c5004f --- /dev/null +++ b/examples/htmx_todoapp.clj @@ -0,0 +1,240 @@ +#!/usr/bin/env bb +;; Source: https://github.com/prestancedesign/babashka-htmx-todoapp + +(require '[org.httpkit.server :as srv] + '[clojure.java.browse :as browse] + '[clojure.core.match :refer [match]] + '[clojure.pprint :refer [cl-format]] + '[clojure.string :as str] + '[hiccup.core :as h]) + +(import '[java.net URLDecoder]) + +;;;;;;;;;;;;;;;;;;;;;;;;;; +;; Config +;;;;;;;;;;;;;;;;;;;;;;;;;; + +(def port 3000) + +;;;;;;;;;;;;;;;;;;;;;;;;;; +;; Mimic DB (in-memory) +;;;;;;;;;;;;;;;;;;;;;;;;;; + +(def todos (atom (sorted-map 1 {:id 1 :name "Taste htmx with Babashka" :done true} + 2 {:id 2 :name "Buy a unicorn" :done false}))) + +(def todos-id (atom (count @todos))) + +;;;;;;;;;;;;;;;;;;;;;;;;;; +;; "DB" queries +;;;;;;;;;;;;;;;;;;;;;;;;;; + +(defn add-todo! [name] + (let [id (swap! todos-id inc)] + (swap! todos assoc id {:id id :name name :done false}))) + +(defn toggle-todo! [id] + (swap! todos update-in [(Integer. id) :done] not)) + +(defn remove-todo! [id] + (swap! todos dissoc (Integer. id))) + +(defn filtered-todo [filter-name todos] + (case filter-name + "active" (remove #(:done (val %)) todos) + "completed" (filter #(:done (val %)) todos) + "all" todos + todos)) + +(defn get-items-left [] + (count (remove #(:done (val %)) @todos))) + +(defn todos-completed [] + (count (filter #(:done (val %)) @todos))) + +(defn remove-all-completed-todo [] + (reset! todos (into {} (remove #(:done (val %)) @todos)))) + +;;;;;;;;;;;;;;;;;;;;;;;;;; +;; Template and components +;;;;;;;;;;;;;;;;;;;;;;;;;; + +(defn todo-item [{:keys [id name done]}] + [:li {:id (str "todo-" id) + :class (when done "completed")} + [:div.view + [:input.toggle {:hx-patch (str "/todos/" id) + :type "checkbox" + :checked done + :hx-target (str "#todo-" id) + :hx-swap "outerHTML"}] + [:label {:hx-get (str "/todos/edit/" id) + :hx-target (str "#todo-" id) + :hx-swap "outerHTML"} name] + [:button.destroy {:hx-delete (str "/todos/" id) + :_ (str "on htmx:afterOnLoad remove #todo-" id)}]]]) + +(defn todo-list [todos] + (for [todo todos] + (todo-item (val todo)))) + +(defn todo-edit [id name] + [:form {:hx-post (str "/todos/update/" id)} + [:input.edit {:type "text" + :name "name" + :value name}]]) + +(defn item-count [] + (let [items-left (get-items-left)] + [:span#todo-count.todo-count {:hx-swap-oob "true"} + [:strong items-left] (cl-format nil " item~p " items-left) "left"])) + +(defn todo-filters [filter] + [:ul#filters.filters {:hx-swap-oob "true"} + [:li [:a {:hx-get "/?filter=all" + :hx-push-url "true" + :hx-target "#todo-list" + :class (when (= filter "all") "selected")} "All"]] + [:li [:a {:hx-get "/?filter=active" + :hx-push-url "true" + :hx-target "#todo-list" + :class (when (= filter "active") "selected")} "Active"]] + [:li [:a {:hx-get "/?filter=completed" + :hx-push-url "true" + :hx-target "#todo-list" + :class (when (= filter "completed") "selected")} "Completed"]]]) + +(defn clear-completed-button [] + [:button#clear-completed.clear-completed + {:hx-delete "/todos" + :hx-target "#todo-list" + :hx-swap-oob "true" + :hx-push-url "/" + :class (when-not (pos? (todos-completed)) "hidden")} + "Clear completed"]) + +(defn template [filter] + (str + "" + (h/html + [:head + [:meta {:charset "UTF-8"}] + [:title "Htmx + Babashka"] + [:link {:href "https://unpkg.com/todomvc-app-css@2.4.1/index.css" :rel "stylesheet"}] + [:script {:src "https://unpkg.com/htmx.org@1.5.0/dist/htmx.min.js" :defer true}] + [:script {:src "https://unpkg.com/hyperscript.org@0.8.1/dist/_hyperscript.min.js" :defer true}]] + [:body + [:section.todoapp + [:header.header + [:h1 "todos"] + [:form + {:hx-post "/todos" + :hx-target "#todo-list" + :hx-swap "beforeend" + :_ "on htmx:afterOnLoad set #txtTodo.value to ''"} + [:input#txtTodo.new-todo + {:name "todo" + :placeholder "What needs to be done?" + :autofocus ""}]]] + [:section.main + [:input#toggle-all.toggle-all {:type "checkbox"}] + [:label {:for "toggle-all"} "Mark all as complete"]] + [:ul#todo-list.todo-list + (todo-list (filtered-todo filter @todos))] + [:footer.footer + (item-count) + (todo-filters filter) + (clear-completed-button)]] + [:footer.info + [:p "Click to edit a todo"] + [:p "Created by " + [:a {:href "https://twitter.com/PrestanceDesign"} "Michaël Sλlihi"]] + [:p "Part of " + [:a {:href "http://todomvc.com"} "TodoMVC"]]]]))) + +;;;;;;;;;;;;;;;;;;;;;;;;;; +;; Helpers +;;;;;;;;;;;;;;;;;;;;;;;;;; + +(defn parse-body [body] + (-> body + slurp + (str/split #"=") + second + URLDecoder/decode)) + +(defn parse-query-string [query-string] + (when query-string + (-> query-string + (str/split #"=") + second))) + +;;;;;;;;;;;;;;;;;;;;;;;;;; +;; Handlers +;;;;;;;;;;;;;;;;;;;;;;;;;; + +(defn app-index [{:keys [query-string headers]}] + (let [filter (parse-query-string query-string) + ajax-request? (get headers "hx-request")] + (if (and filter ajax-request?) + (h/html (todo-list (filtered-todo filter @todos)) + (todo-filters filter)) + (template filter)))) + +(defn add-item [{body :body}] + (let [name (parse-body body) + todo (add-todo! name)] + (h/html (todo-item (val (last todo))) + (item-count)))) + +(defn edit-item [id] + (let [{:keys [id name]} (get @todos (Integer. id))] + (h/html (todo-edit id name)))) + +(defn update-item [{body :body} id] + (let [name (parse-body body) + todo (swap! todos assoc-in [(Integer. id) :name] name)] + (h/html (todo-item (get todo (Integer. id)))))) + +(defn patch-item [id] + (let [todo (toggle-todo! id)] + (h/html (todo-item (get todo (Integer. id))) + (item-count) + (clear-completed-button)))) + +(defn delete-item [id] + (remove-todo! id) + (h/html (item-count))) + +(defn clear-completed [] + (remove-all-completed-todo) + (h/html (todo-list @todos) + (item-count) + (clear-completed-button))) + +;;;;;;;;;;;;;;;;;;;;;;;;;; +;; Routes +;;;;;;;;;;;;;;;;;;;;;;;;;; + +(defn routes [{:keys [request-method uri] :as req}] + (let [path (vec (rest (str/split uri #"/")))] + (match [request-method path] + [:get []] {:body (app-index req)} + [:get ["todos" "edit" id]] {:body (edit-item id)} + [:post ["todos"]] {:body (add-item req)} + [:post ["todos" "update" id]] {:body (update-item req id)} + [:patch ["todos" id]] {:body (patch-item id)} + [:delete ["todos" id]] {:body (delete-item id)} + [:delete ["todos"]] {:body (clear-completed)} + :else {:status 404 :body "Error 404: Page not found"}))) + +;;;;;;;;;;;;;;;;;;;;;;;;;; +;; Server +;;;;;;;;;;;;;;;;;;;;;;;;;; + +(when (= *file* (System/getProperty "babashka.file")) + (let [url (str "http://localhost:" port "/")] + (srv/run-server #'routes {:port port}) + (println "serving" url) + (browse/browse-url url) + @(promise))) diff --git a/examples/http-server.clj b/examples/http-server.clj index 9a47f63d..fc8ac6cb 100755 --- a/examples/http-server.clj +++ b/examples/http-server.clj @@ -2,7 +2,7 @@ #_" -*- mode: clojure; -*-" ;; Source: https://gist.github.com/holyjak/36c6284c047ffb7573e8a34399de27d8 -;; Based on https://github.com/babashka/babashka/blob/master/examples/image_viewer.clj +;; Based on https://github.com/babashka/babashka/blob/master/examples/image-viewer.clj (ns http-server (:require [babashka.fs :as fs] [clojure.java.browse :as browse] diff --git a/fs b/fs index 6019ec9c..a151ca0e 160000 --- a/fs +++ b/fs @@ -1 +1 @@ -Subproject commit 6019ec9cb09632fdf84e4bc5879fd47ed57a35eb +Subproject commit a151ca0ef45dd4126a26d82737cc2c4434f38e71 diff --git a/install b/install index 318b8f60..50a07309 100755 --- a/install +++ b/install @@ -88,7 +88,7 @@ case "$(uname -m)" in esac # Ugly ugly conversion of version to a comparable number -IFS='.' read -ra VER <<< "$version" +IFS='.' read -ra VER <<< "${version//-SNAPSHOT/}" vernum=$(printf "%03d%03d%03d" "${VER[0]}" "${VER[1]}" "${VER[2]}") if [[ 10#$vernum -le 10#000002013 ]]; then @@ -109,7 +109,14 @@ case "$platform-$static_binary" in ;; esac -download_url="https://github.com/babashka/babashka/releases/download/v$version/$filename" +if [[ "$version" == *-SNAPSHOT ]] +then + repo="babashka-dev-builds" +else + repo="babashka" +fi + +download_url="https://github.com/babashka/$repo/releases/download/v$version/$filename" # macOS only have shasum available by default # Some Linux distros (RHEL-like) only have sha256sum avaiable by default (others have both) diff --git a/process b/process index cc298e4a..927935a9 160000 --- a/process +++ b/process @@ -1 +1 @@ -Subproject commit cc298e4a75e307f1265dcce11c629ea088423a9e +Subproject commit 927935a9684804692a745f038ec75c56a867c6fb diff --git a/project.clj b/project.clj index fcc877b2..6923083c 100644 --- a/project.clj +++ b/project.clj @@ -17,17 +17,19 @@ :resource-paths ["resources" "sci/resources"] :test-selectors {:default (complement :windows-only) :windows (complement :skip-windows)} - :dependencies [[org.clojure/clojure "1.11.0-alpha3"] + :dependencies [[org.clojure/clojure "1.11.0-beta1"] [borkdude/edamame "0.0.19"] [borkdude/graal.locking "0.0.2"] [org.clojure/tools.cli "1.0.206"] - [cheshire "5.10.1"] + [cheshire "5.10.2"] [nrepl/bencode "1.1.0"] [borkdude/sci.impl.reflector "0.0.1"] - [org.clojure/core.async "1.4.627"] - [org.clojure/test.check "1.1.0"] + [org.clojure/core.async "1.5.648"] + [org.clojure/test.check "1.1.1"] [com.github.clj-easy/graal-build-time "0.1.0"] [rewrite-clj/rewrite-clj "1.0.699-alpha"]] + :plugins [[org.kipz/lein-meta-bom "0.1.1"]] + :metabom {:jar-name "metabom.jar"} :profiles {:feature/xml {:source-paths ["feature-xml"] :dependencies [[org.clojure/data.xml "0.2.0-alpha6"]]} :feature/yaml {:source-paths ["feature-yaml"] @@ -42,7 +44,7 @@ :feature/csv {:source-paths ["feature-csv"] :dependencies [[org.clojure/data.csv "1.0.0"]]} :feature/transit {:source-paths ["feature-transit"] - :dependencies [[com.cognitect/transit-clj "1.0.324"]]} + :dependencies [[com.cognitect/transit-clj "1.0.329"]]} :feature/datascript {:source-paths ["feature-datascript"] :dependencies [[datascript "1.0.1"]]} :feature/httpkit-client {:source-paths ["feature-httpkit-client"] diff --git a/resources/BABASHKA_RELEASED_VERSION b/resources/BABASHKA_RELEASED_VERSION index faef31a4..ef090a6c 100644 --- a/resources/BABASHKA_RELEASED_VERSION +++ b/resources/BABASHKA_RELEASED_VERSION @@ -1 +1 @@ -0.7.0 +0.7.4 \ No newline at end of file diff --git a/resources/BABASHKA_VERSION b/resources/BABASHKA_VERSION index 17060e92..de462158 100644 --- a/resources/BABASHKA_VERSION +++ b/resources/BABASHKA_VERSION @@ -1 +1 @@ -0.7.1-SNAPSHOT \ No newline at end of file +0.7.5-SNAPSHOT \ No newline at end of file diff --git a/resources/META-INF/babashka/deps.edn b/resources/META-INF/babashka/deps.edn index d45a9704..9c8324f5 100644 --- a/resources/META-INF/babashka/deps.edn +++ b/resources/META-INF/babashka/deps.edn @@ -14,20 +14,20 @@ "depstar/src" "process/src" "deps.clj/src" "deps.clj/resources" "resources" "sci/resources"], - :deps {org.clojure/clojure {:mvn/version "1.11.0-alpha3"}, + :deps {org.clojure/clojure {:mvn/version "1.11.0-beta1"}, borkdude/sci {:local/root "sci"} babashka/babashka.curl {:local/root "babashka.curl"} babashka/fs {:local/root "fs"} babashka/babashka.core {:local/root "babashka.core"} borkdude/graal.locking {:mvn/version "0.0.2"}, - org.clojure/core.async {:mvn/version "1.4.627"}, + org.clojure/core.async {:mvn/version "1.5.648"}, org.clojure/tools.cli {:mvn/version "1.0.206"}, org.clojure/data.csv {:mvn/version "1.0.0"}, - cheshire/cheshire {:mvn/version "5.10.1"} + cheshire/cheshire {:mvn/version "5.10.2"} org.clojure/data.xml {:mvn/version "0.2.0-alpha6"} clj-commons/clj-yaml {:mvn/version "0.7.107"} - com.cognitect/transit-clj {:mvn/version "1.0.324"} - org.clojure/test.check {:mvn/version "1.1.0"} + com.cognitect/transit-clj {:mvn/version "1.0.329"} + org.clojure/test.check {:mvn/version "1.1.1"} nrepl/bencode {:mvn/version "1.1.0"} seancorfield/next.jdbc {:mvn/version "1.1.610"} org.postgresql/postgresql {:mvn/version "42.2.18"} @@ -55,8 +55,7 @@ :extra-deps {org.clj-commons/clj-http-lite {:mvn/version "0.4.392"} org.babashka/spec.alpha {:git/url "https://github.com/babashka/spec.alpha" :sha "0dec1f88cbde74a0470b454396f09a03adb4ae39"} - lambdaisland/regal {:git/url "https://github.com/lambdaisland/regal" - :sha "f902d2c43121f9e1c48603d6eb99f5900eb6a9f6"} + lambdaisland/regal {:mvn/version "0.0.143"} weavejester/medley {:git/url "https://github.com/weavejester/medley" :sha "a4e5fb5383f5c0d83cb2d005181a35b76d8a136d"} cprop/cprop {:mvn/version "0.1.16"} @@ -69,16 +68,16 @@ henryw374/cljc.java-time {:git/url "https://github.com/henryw374/cljc.java-time.git" :sha "e3d184b78e933322b3fcaa6ca66cbb8f42a6b35c"} - camel-snake-kebab/camel-snake-kebab {:mvn/version "0.4.1"} + camel-snake-kebab/camel-snake-kebab {:mvn/version "0.4.2"} aero/aero {:mvn/version "1.1.6"} org.clojure/data.generators {:mvn/version "1.0.0"} - honeysql/honeysql {:mvn/version "1.0.444"} - com.github.seancorfield/honeysql {:mvn/version "2.0.0-rc2"} - minimallist/minimallist {:mvn/version "0.0.6"} - circleci/bond {:mvn/version "0.4.0"} - version-clj/version-clj {:mvn/version "2.0.1"} + honeysql/honeysql {:mvn/version "1.0.461"} + com.github.seancorfield/honeysql {:mvn/version "2.2.840"} + minimallist/minimallist {:mvn/version "0.0.10"} + circleci/bond {:mvn/version "0.6.0"} + version-clj/version-clj {:mvn/version "2.0.2"} gaka/gaka {:mvn/version "0.3.0"} - failjure/failjure {:mvn/version "2.1.1"} + failjure/failjure {:mvn/version "2.2.0"} io.helins/binf {:mvn/version "1.1.0-beta0"} rm-hull/jasentaa {:mvn/version "0.2.5"} slingshot/slingshot {:mvn/version "0.12.2"} @@ -104,7 +103,30 @@ listora/again {:mvn/version "1.0.0"} org.clojure/tools.gitlibs {:mvn/version "2.4.172"} environ/environ {:mvn/version "1.2.0"} +<<<<<<< HEAD table/table {:git/url "https://github.com/cldwalker/table", :sha "55aef3d5fced682942af811bf5d642f79fb87688"}} +======= + table/table {:git/url "https://github.com/cldwalker/table", :sha "f6293c5f3dac1dd6f525a80fc80930f8ccdf16b7"} + markdown-clj/markdown-clj {:mvn/version "1.10.8"} + org.clojure/tools.namespace {:git/url "https://github.com/babashka/tools.namespace", :sha "a13b037215e21a2e71aa34b27e1dd52c801a2a7b"} + medley/medley {:mvn/version "1.3.0"} + io.github.cognitect-labs/test-runner {:git/tag "v0.5.0", :git/sha "b3fd0d2"} + borkdude/missing.test.assertions {:git/url "https://github.com/borkdude/missing.test.assertions", :sha "603cb01bee72fb17addacc53c34c85612684ad70"} + dev.nubank/docopt {:mvn/version "0.6.1-fix7"} + testdoc/testdoc {:mvn/version "1.4.1"} + org.clojars.lispyclouds/contajners {:mvn/version "0.0.4"} + borkdude/rewrite-edn {:mvn/version "0.1.0"} + clojure-term-colors/clojure-term-colors {:mvn/version "0.1.0"} + io.aviso/pretty {:mvn/version "1.1.1"} + progrock/progrock {:mvn/version "0.1.2"} + djblue/portal {:mvn/version "0.19.0"} + com.wsscode/cljc-misc {:mvn/version "2021.10.16"} + edn-query-language/eql {:mvn/version "2021.07.18"} + meta-merge/meta-merge {:mvn/version "1.0.0"} + com.exoscale/lingo {:mvn/version "1.0.0-alpha14"} + io.github.swirrl/dogstatsd {:mvn/version "0.1.39"} + org.clojure/algo.monads {:mvn/version "0.1.6"}} +>>>>>>> array-play :classpath-overrides {org.clojure/clojure nil org.clojure/spec.alpha nil}} :clj-nvd diff --git a/sci b/sci index 6ad100c7..dd4a1f31 160000 --- a/sci +++ b/sci @@ -1 +1 @@ -Subproject commit 6ad100c7376bfac0f58ac12576caa805e2026d33 +Subproject commit dd4a1f31e725ee1d2d1e95d3c0cf107925e8f9ce diff --git a/script/add-libtest.clj b/script/add-libtest.clj index d44e549e..9eeea5f2 100755 --- a/script/add-libtest.clj +++ b/script/add-libtest.clj @@ -1,21 +1,29 @@ #!/usr/bin/env bb -;; Adds a library to bb-tested-libs.edn to be tested given a library version and -;; git repository. Optionally takes a --test to then test the added library. +;; Adds a library to bb-tested-libs.edn and libraries.csv and optionally run its +;; tests. There are two modes to this script - automatic (default) and manual. +;; The script defaults to automatically copying tests as this normally works. +;; There are several options to specify where the library is including +;; --git-url, --dir and --test-directories. See --help for more. In manual mode, +;; tests are manually added outside of the script and the script is run to add +;; the library to library lists. (ns add-libtest (:require [babashka.deps :as deps] [babashka.fs :as fs] [babashka.tasks :refer [shell]] + [org.httpkit.client :as http] [clojure.string :as str] [clojure.java.io :as io] [clojure.tools.cli :as cli] [clojure.edn :as edn])) (deps/add-deps '{:deps {org.clojure/tools.gitlibs {:mvn/version "2.4.172"} - borkdude/rewrite-edn {:mvn/version "0.1.0"}}}) + borkdude/rewrite-edn {:mvn/version "0.1.0"} + org.clojure/data.csv {:mvn/version "1.0.0"}}}) (require '[clojure.tools.gitlibs :as gl]) (require '[borkdude.rewrite-edn :as r]) +(require '[clojure.data.csv :as csv]) ;; CLI Utils ;; ========= @@ -53,48 +61,67 @@ (let [nodes (-> "deps.edn" slurp r/parse-string)] (spit "deps.edn" (str (r/assoc-in nodes - [:aliases :lib-tests :extra-deps (symbol lib-name)] + [:aliases :lib-tests :extra-deps lib-name] lib-coordinate))))) +(defn- default-test-dir + [lib-root-dir] + (some #(when (fs/exists? (fs/file lib-root-dir %)) + (str (fs/file lib-root-dir %))) + ;; Most common test dir + ["test" + ;; official clojure repos like https://github.com/clojure/tools.gitlibs + "src/test/clojure"])) + (defn- copy-tests - [git-url lib-name {:keys [directory branch]}] + [git-url lib-name {:keys [directory branch test-directories]}] (let [lib-dir (if branch (gl/procure git-url lib-name branch) (or (gl/procure git-url lib-name "master") - (gl/procure git-url lib-name "main"))) - lib-root-dir (if directory - (fs/file lib-dir directory) lib-dir) - test-dir (some #(when (fs/exists? (fs/file lib-root-dir %)) - (str (fs/file lib-root-dir %))) - ;; Search common test dirs - ["test" - ;; official clojure repos like https://github.com/clojure/tools.gitlibs - "src/test/clojure"])] - (when-not test-dir - (error "No test dir found")) - (shell "cp -R" (str test-dir fs/file-separator) "test-resources/lib_tests/") + (gl/procure git-url lib-name "main") + (throw (ex-info "Unable to clone git-url" {})))) + _ (println "Git clone is at" lib-dir) + lib-root-dir (if directory (fs/file lib-dir directory) lib-dir) + test-dirs (if test-directories + (map #(when (fs/exists? (fs/file lib-root-dir %)) + (str (fs/file lib-root-dir %))) + test-directories) + (some-> (default-test-dir lib-root-dir) vector))] + (when (empty? test-dirs) + (error "No test directories found")) + (doseq [test-dir test-dirs] + (shell "cp -R" (str test-dir fs/file-separator) "test-resources/lib_tests/")) {:lib-dir lib-dir - :test-dir test-dir})) + :test-dirs test-dirs})) + +(defn- default-test-namespaces + [test-dir] + (let [relative-test-files (map #(str (fs/relativize test-dir %)) + (fs/glob test-dir "**/*.{clj,cljc}"))] + (when (empty? relative-test-files) + (error (str "No test files found in " test-dir))) + (map #(-> % + (str/replace fs/file-separator ".") + (str/replace "_" "-") + (str/replace-first #"\.clj(c?)$" "") + symbol) + relative-test-files))) (defn- add-lib-to-tested-libs - [lib-name git-url {:keys [lib-dir test-dir]} options] - (let [git-sha (fs/file-name lib-dir) - relative-test-files (map #(str (fs/relativize test-dir %)) - (fs/glob test-dir "**/*.{clj,cljc}")) - _ (when (empty? relative-test-files) - (error "No test files found")) - namespaces (map #(-> % - (str/replace fs/file-separator ".") - (str/replace "_" "-") - (str/replace-first #"\.clj(c?)$" "") - symbol) - relative-test-files) - lib (merge - {:git-sha git-sha - :git-url git-url - :test-namespaces namespaces} - ;; Options needed to update libs - (select-keys options [:branch :directory])) + [lib-name git-url {:keys [lib-dir test-dirs]} options] + (let [namespaces (or (get-in options [:manually-added :test-namespaces]) + (mapcat default-test-namespaces test-dirs)) + default-lib (merge + {:git-url git-url + :test-namespaces namespaces} + ;; Options needed to update libs + (select-keys options [:branch :directory :test-directories])) + lib (if (:manually-added options) + (-> default-lib + (merge (:manually-added options)) + (assoc :manually-added true)) + (assoc default-lib + :git-sha (fs/file-name lib-dir))) nodes (-> "test-resources/lib_tests/bb-tested-libs.edn" slurp r/parse-string)] (spit "test-resources/lib_tests/bb-tested-libs.edn" (str (r/assoc-in nodes @@ -102,25 +129,63 @@ lib))) namespaces)) +(defn- fetch-artifact + "Using the clojars api to get a library's git url doesn't always work. A + possibly more reliable data source could be the scm urls in this POM feed - + https://github.com/clojars/clojars-web/wiki/Data#useful-extracts-from-the-poms" + [artifact] + (let [url (str "https://clojars.org/api/artifacts/" artifact) + _ (println "GET" url "...") + resp @(http/get url {:headers {"Accept" "application/edn"}})] + (if (= 200 (:status resp)) + (-> resp :body slurp edn/read-string) + (error (str "Response failed and returned " (pr-str resp)))))) + +(defn- get-lib-map + [deps-string options] + ;; if deps-string is artifact name + (if (re-matches #"\S+/\S+" deps-string) + (let [artifact-edn (fetch-artifact deps-string)] + {:lib-name (symbol deps-string) + :lib-coordinate {:mvn/version (:latest_version artifact-edn)} + :git-url (or (:git-url options) (:homepage artifact-edn))}) + (let [deps-map (edn/read-string deps-string) + _ (when (or (not (map? deps-map)) (not= 1 (count deps-map))) + (error "Deps map must have one key")) + lib-coordinate (-> deps-map vals first)] + {:lib-name (ffirst deps-map) + :lib-coordinate lib-coordinate + :git-url (or (:git/url lib-coordinate) (:git-url options))}))) + +(defn- write-lib-to-csv + "Updates libraries.csv with latest bb-tested-libs.edn" + [] + (let [libs (-> "test-resources/lib_tests/bb-tested-libs.edn" slurp edn/read-string) + rows (sort-by first + (map (fn [[name {:keys [git-url]}]] + [name git-url]) libs))] + (with-open [w (io/writer "doc/libraries.csv")] + (csv/write-csv w (into [["maven-name" "git-url"]] rows))))) + (defn- add-libtest* [args options] - (let [[deps-string git-url] args - deps-map (edn/read-string deps-string) - _ (when (not= 1 (count deps-map)) - (error "Deps map must have one key")) - lib-name (ffirst deps-map) - lib-coordinate (deps-map lib-name) - _ (add-lib-to-deps lib-name lib-coordinate) - dirs (copy-tests git-url lib-name options) + (let [[artifact-or-deps-string] args + {:keys [lib-name lib-coordinate git-url]} + (get-lib-map artifact-or-deps-string options) + _ (when (nil? git-url) + (error "git-url is required. Please specify with --git-url")) + _ (when-not (:manually-added options) (add-lib-to-deps lib-name lib-coordinate)) + dirs (when-not (:manually-added options) (copy-tests git-url lib-name options)) namespaces (add-lib-to-tested-libs lib-name git-url dirs options)] (println "Added lib" lib-name "which tests the following namespaces:" namespaces) + (write-lib-to-csv) (when (:test options) (apply shell "script/lib_tests/run_all_libtests" namespaces)))) (defn add-libtest [{:keys [arguments options summary]}] - (if (or (< (count arguments) 2) (:help options)) - (print-summary "DEPS-MAP GIT-URL " summary) + (if (or (< (count arguments) 1) (:help options)) + (print-summary "ARTIFACT-OR-DEPS-MAP " summary) (add-libtest* arguments options))) (def cli-options @@ -129,7 +194,13 @@ ;; https://github.com/weavejester/environ/tree/master/environ used this option ["-d" "--directory DIRECTORY" "Directory where library is located"] ;; https://github.com/reifyhealth/specmonstah used this option - ["-b" "--branch BRANCH" "Default branch for git url"]]) + ["-b" "--branch BRANCH" "Default branch for git url"] + ["-g" "--git-url GITURL" "Git url for artifact. Defaults to homepage on clojars"] + ["-m" "--manually-added LIB-MAP" "Only add library to edn file with LIB-MAP merged into library entry" + :parse-fn edn/read-string :validate-fn map?] + ;; https://github.com/jeaye/orchestra used this option + ["-T" "--test-directories TEST-DIRECTORY" "Directories where library tests are located" + :multi true :update-fn conj]]) (when (= *file* (System/getProperty "babashka.file")) (run-command add-libtest *command-line-args* cli-options)) diff --git a/script/babashka/release_artifact.clj b/script/babashka/release_artifact.clj index 3132d9df..b88a1e20 100644 --- a/script/babashka/release_artifact.clj +++ b/script/babashka/release_artifact.clj @@ -12,16 +12,26 @@ str/trim))) (defn release [& args] - (let [current-version (-> (slurp "resources/BABASHKA_VERSION") - str/trim) - ght (System/getenv "GITHUB_TOKEN") + (let [ght (System/getenv "GITHUB_TOKEN") file (first args) - branch (current-branch)] + branch (current-branch) + current-version + (-> (slurp "resources/BABASHKA_VERSION") + str/trim)] (if (and ght (contains? #{"master" "main"} branch)) (do (assert file "File name must be provided") (ghr/overwrite-asset {:org "babashka" :repo "babashka" :file file - :tag (str "v" current-version)})) + :tag (str "v" current-version) + :draft true}) + (ghr/overwrite-asset {:org "babashka" + :repo "babashka-dev-builds" + :file file + :tag (str "v" current-version) + ;; do not set, because we are posting to another repo + :target-commitish false + :draft false + :prerelease true})) (println "Skipping release artifact (no GITHUB_TOKEN or not on main branch)")) nil)) diff --git a/script/bump_graal_version.clj b/script/bump_graal_version.clj index 0e0a6865..29fa58f6 100755 --- a/script/bump_graal_version.clj +++ b/script/bump_graal_version.clj @@ -51,9 +51,9 @@ ;; OR ;; ;; We could have them as environment variables -(def current-graal-version "21.2.0") +(def current-graal-version "21.3.0") (def current-java-version "java11") -(def valid-graal-bumps ["19.3.2" "20.1.0" "20.2.0" "20.3.0" "21.0.0" "21.1.0" "21.2.0" "21.3.0"]) +(def valid-graal-bumps ["19.3.2" "20.1.0" "20.2.0" "20.3.0" "21.0.0" "21.1.0" "21.2.0" "21.3.0" "22.0.0.2"]) (def valid-java-bumps ["java8" "java11"]) (def cl-options diff --git a/script/compile b/script/compile index 3a586daf..f56d0c83 100755 --- a/script/compile +++ b/script/compile @@ -33,10 +33,13 @@ rm -rf resources/*.class # "$GRAALVM_HOME/bin/javac" -cp "$SVM_JAR" resources/CutOffMisc.java if [ -z "$BABASHKA_JAR" ]; then lein with-profiles +reflection,+native-image "do" run - lein "do" clean, uberjar + lein "do" clean, uberjar, metabom BABASHKA_JAR=${BABASHKA_JAR:-"target/babashka-$BABASHKA_VERSION-standalone.jar"} fi +# because script/test cleans target during ci before the jar can we saved +cp target/metabom.jar . + BABASHKA_BINARY=${BABASHKA_BINARY:-"bb"} args=("-jar" "$BABASHKA_JAR" diff --git a/script/install-clojure b/script/install-clojure index 138e483f..40b096a7 100755 --- a/script/install-clojure +++ b/script/install-clojure @@ -2,7 +2,7 @@ set -euo pipefail -CLOJURE_TOOLS_VERSION="1.10.1.447" +CLOJURE_TOOLS_VERSION="1.10.3.1040" install_dir="${1:-/usr/local}" mkdir -p "$install_dir" diff --git a/script/lib_tests/run_all_libtests.bat b/script/lib_tests/run_all_libtests.bat index 831d9020..6c36ba62 100644 --- a/script/lib_tests/run_all_libtests.bat +++ b/script/lib_tests/run_all_libtests.bat @@ -4,8 +4,4 @@ set EDN=lib_tests.edn .\bb -f script/lib_tests/bb_edn_from_deps.clj %EDN% -set BABASHKA_EDN=%EDN% - -%BB_CMD% -f test-resources/lib_tests/babashka/run_all_libtests.clj %* - -set BABASHKA_EDN= +%BB_CMD% --config %EDN% --deps-root . -f test-resources/lib_tests/babashka/run_all_libtests.clj %* diff --git a/script/uberjar b/script/uberjar index f595aef8..126e659b 100755 --- a/script/uberjar +++ b/script/uberjar @@ -165,5 +165,5 @@ cp deps.edn resources/META-INF/babashka/deps.edn if [ -z "$BABASHKA_JAR" ]; then lein with-profiles "$BABASHKA_LEIN_PROFILES,+reflection,-uberjar" do run - lein with-profiles "$BABASHKA_LEIN_PROFILES" do clean, uberjar + lein with-profiles "$BABASHKA_LEIN_PROFILES" do clean, uberjar, metabom fi diff --git a/src/babashka/impl/classes.clj b/src/babashka/impl/classes.clj index e9eaefa9..a1a2a75a 100644 --- a/src/babashka/impl/classes.clj +++ b/src/babashka/impl/classes.clj @@ -73,12 +73,15 @@ {:name "toURI"}]} java.util.Arrays {:methods [{:name "copyOf"} - {:name "copyOfRange"}]} + {:name "copyOfRange"} + {:name "equals"}]} ;; this fixes clojure.lang.Reflector for Java 11 java.lang.reflect.AccessibleObject {:methods [{:name "canAccess"}]} java.lang.reflect.Method {:methods [{:name "getName"}]} + java.lang.reflect.Array + {:methods [{:name "newInstance"}]} java.net.Inet4Address {:methods [{:name "getHostAddress"}]} java.net.Inet6Address @@ -91,7 +94,9 @@ clojure.lang.RT {:methods [{:name "aget"} {:name "aset"} - {:name "aclone"}]}}) + {:name "aclone"}]} + clojure.lang.Compiler + {:fields [{:name "specials"}]}}) (def custom-map (cond-> @@ -116,6 +121,10 @@ java.io.ByteArrayOutputStream java.io.Closeable java.io.Console + java.io.DataInput + java.io.DataInputStream + java.io.DataOutput + java.io.DataOutputStream java.io.File java.io.FileFilter java.io.FilenameFilter @@ -392,6 +401,7 @@ ;; visible in the native image. :instance-checks [clojure.lang.AMapEntry ;; for proxy clojure.lang.APersistentMap ;; for proxy + clojure.lang.APersistentSet clojure.lang.AReference clojure.lang.Associative clojure.lang.Atom diff --git a/src/babashka/impl/clojure/core.clj b/src/babashka/impl/clojure/core.clj index 42e9ae27..d24596a7 100644 --- a/src/babashka/impl/clojure/core.clj +++ b/src/babashka/impl/clojure/core.clj @@ -1,7 +1,7 @@ (ns babashka.impl.clojure.core {:no-doc true} (:refer-clojure :exclude [future read+string clojure-version with-precision - send-via send send-off sync]) + send-via send send-off sync into-array]) (:require [babashka.impl.common :as common] [borkdude.graal.locking :as locking] [clojure.core :as c] @@ -142,6 +142,21 @@ [_flags-ignored-for-now & body] `(clojure.core/-run-in-transaction (fn [] ~@body))) +(defn into-array + "Returns an array with components set to the values in aseq. The array's + component type is type if provided, or the type of the first value in + aseq if present, or Object. All values in aseq must be compatible with + the component type. Class objects for the primitive types can be obtained + using, e.g., Integer/TYPE." + {:added "1.0" + :static true} + ([aseq] + (try (clojure.lang.RT/seqToTypedArray (seq aseq)) + (catch IllegalArgumentException _ + (clojure.lang.RT/seqToTypedArray Object (seq aseq))))) + ([type aseq] + (clojure.lang.RT/seqToTypedArray type (seq aseq)))) + (def core-extras {;; agents 'agent (copy-core-var agent) @@ -201,6 +216,9 @@ 'random-uuid (sci/copy-var random-uuid clojure-core-ns) 'NaN? (sci/copy-var NaN? clojure-core-ns) 'infinite? (sci/copy-var infinite? clojure-core-ns) + 'iteration (sci/copy-var iteration clojure-core-ns) + 'abs (sci/copy-var abs clojure-core-ns) 'StackTraceElement->vec (sci/copy-var StackTraceElement->vec clojure-core-ns) - 'memfn (sci/copy-var memfn clojure-core-ns)} + 'memfn (sci/copy-var memfn clojure-core-ns) + 'into-array (sci/copy-var into-array clojure-core-ns)} ) diff --git a/src/babashka/impl/clojure/main.clj b/src/babashka/impl/clojure/main.clj index aea9726e..83f0c38a 100644 --- a/src/babashka/impl/clojure/main.clj +++ b/src/babashka/impl/clojure/main.clj @@ -104,10 +104,12 @@ by default when a new command-line REPL is started."} repl-requires (set! *3 *2) (set! *2 *1) (set! *1 value) - (try - (print value) - (catch Throwable e - (throw (ex-info nil {:clojure.error/phase :print-eval-result} e))))))) + (try (print value) + (catch Throwable e + (throw (ex-info (ex-message e) + (assoc (meta input) + :file "" + :type :sci/error) e))))))) (catch Throwable e (caught e) (set! *e e))))] diff --git a/src/babashka/impl/clojure/math.clj b/src/babashka/impl/clojure/math.clj new file mode 100644 index 00000000..579ec9c1 --- /dev/null +++ b/src/babashka/impl/clojure/math.clj @@ -0,0 +1,6 @@ +(ns babashka.impl.clojure.math + (:require [clojure.math] + [sci.core :as sci])) + +(def mns (sci/create-ns 'clojure.math nil)) +(def math-namespace (sci/copy-ns clojure.math mns)) diff --git a/src/babashka/impl/deps.clj b/src/babashka/impl/deps.clj index 815d1930..735ec477 100644 --- a/src/babashka/impl/deps.clj +++ b/src/babashka/impl/deps.clj @@ -1,6 +1,8 @@ (ns babashka.impl.deps (:require [babashka.deps :as bdeps] + [babashka.fs :as fs] [babashka.impl.classpath :as cp] + [babashka.impl.common :refer [bb-edn]] [borkdude.deps :as deps] [clojure.string :as str] [sci.core :as sci])) @@ -42,8 +44,8 @@ paths))) #_(merge-default-deps '{:deps {medley/medley nil} - :aliases {:foo {medley/medley nil}}} - '{medley/medley {:mvn/version "1.3.0"}}) + :aliases {:foo {medley/medley nil}}} + '{medley/medley {:mvn/version "1.3.0"}}) ;;;; end merge edn files @@ -58,28 +60,41 @@ ([deps-map] (add-deps deps-map nil)) ([deps-map {:keys [:aliases :env :extra-env :force]}] (when-let [paths (:paths deps-map)] - (cp/add-classpath (str/join cp/path-sep paths))) - (when-let [deps-map (not-empty (dissoc deps-map :paths :tasks :raw :min-bb-version))] - (binding [*print-namespace-maps* false] - (let [deps-map (assoc-in deps-map [:aliases :org.babashka/defaults] - {:replace-paths [] ;; babashka sets paths manually - :classpath-overrides (cond-> - '{org.clojure/clojure "" - org.clojure/spec.alpha ""} - ;; only remove core specs when they are not mentioned in deps map - (not (str/includes? (str deps-map) "org.clojure/core.specs.alpha")) - (assoc 'org.clojure/core.specs.alpha ""))}) - args (list "-Srepro" ;; do not include deps.edn from user config - "-Spath" "-Sdeps" (str deps-map) - "-Sdeps-file" "") ;; we reset deps file so the local deps.edn isn't used - args (if force (cons "-Sforce" args) args) - args (concat args [(str "-A:" (str/join ":" (cons ":org.babashka/defaults" aliases)))]) - cp (with-out-str (binding [deps/*env* env - deps/*extra-env* extra-env] - (apply deps/-main args))) - cp (str/trim cp) - cp (str/replace cp (re-pattern (str cp/path-sep "+$")) "")] - (cp/add-classpath cp)))))) + (let [paths (if-let [deps-root (:deps-root @bb-edn)] + (let [deps-root (fs/absolutize deps-root) + paths (mapv #(str (fs/file deps-root %)) paths)] + paths) + paths)] + (cp/add-classpath (str/join cp/path-sep paths)))) + (let [need-deps? (or (:deps deps-map) + (and (:aliases deps-map) + aliases))] + (when need-deps? + (let [deps-map (dissoc deps-map + ;; paths are added manually above + ;; extra-paths are added as :paths in tasks + :paths :tasks :raw :file :deps-root + :min-bb-version)] + (binding [*print-namespace-maps* false] + (let [deps-map (assoc-in deps-map [:aliases :org.babashka/defaults] + {:replace-paths [] ;; babashka sets paths manually + :classpath-overrides (cond-> + '{org.clojure/clojure "" + org.clojure/spec.alpha ""} + ;; only remove core specs when they are not mentioned in deps map + (not (str/includes? (str deps-map) "org.clojure/core.specs.alpha")) + (assoc 'org.clojure/core.specs.alpha ""))}) + args (list "-Srepro" ;; do not include deps.edn from user config + "-Spath" "-Sdeps" (str deps-map) + "-Sdeps-file" "") ;; we reset deps file so the local deps.edn isn't used + args (if force (cons "-Sforce" args) args) + args (concat args [(str "-A:" (str/join ":" (cons ":org.babashka/defaults" aliases)))]) + cp (with-out-str (binding [deps/*env* env + deps/*extra-env* extra-env] + (apply deps/-main args))) + cp (str/trim cp) + cp (str/replace cp (re-pattern (str cp/path-sep "+$")) "")] + (cp/add-classpath cp)))))))) (def deps-namespace {'add-deps (sci/copy-var add-deps dns) diff --git a/src/babashka/impl/error_handler.clj b/src/babashka/impl/error_handler.clj index f741c6b3..b48adb76 100644 --- a/src/babashka/impl/error_handler.clj +++ b/src/babashka/impl/error_handler.clj @@ -139,10 +139,6 @@ (ruler "Context") (println ec) (println)) - (when-let [locals (and (:debug opts) (not-empty (:locals d)))] - (ruler "Locals") - (print-locals locals) - (println)) (when sci-error? (when-let [st (let [st (with-out-str diff --git a/src/babashka/impl/tasks.clj b/src/babashka/impl/tasks.clj index d6cfd13a..7cdef088 100644 --- a/src/babashka/impl/tasks.clj +++ b/src/babashka/impl/tasks.clj @@ -229,8 +229,7 @@ (defn format-task [init extra-paths extra-deps requires prog] (format " -%s ;; extra-paths -%s ;; extra-deps +%s ;; deps (ns %s %s) (require '[babashka.tasks]) @@ -251,12 +250,12 @@ %s " - (if (seq extra-paths) - (format "(babashka.classpath/add-classpath \"%s\")" (str/join cp/path-sep extra-paths)) - "") - (if (seq extra-deps) - (format "(babashka.deps/add-deps '%s)" (pr-str {:deps extra-deps})) - "") + (let [deps (cond-> {} + (seq extra-deps) (assoc :deps extra-deps) + (seq extra-paths) (assoc :paths extra-paths))] + (if (seq deps) + (format "(babashka.deps/add-deps '%s)" (pr-str deps)) + "")) @rand-ns (if (seq requires) (format "(:require %s)" (str/join " " requires)) @@ -271,13 +270,13 @@ depends (:depends task)] (when (contains? processing task-name) (throw (ex-info (str "Cyclic task: " task-name) {}))) - (loop [deps (seq depends)] - (let [deps (remove #(contains? @processed %) deps) - order (vec (mapcat #(target-order tasks % processed (conj processing task-name)) deps))] - (if-not (contains? @processed task-name) - (do (vswap! processed conj task-name) - (conj order task-name)) - order)))))) + (let [deps (seq depends) + deps (remove #(contains? @processed %) deps) + order (vec (mapcat #(target-order tasks % processed (conj processing task-name)) deps))] + (if-not (contains? @processed task-name) + (do (vswap! processed conj task-name) + (conj order task-name)) + order))))) #_(defn tasks->dependees [task-names tasks] (let [tasks->depends (zipmap task-names (map #(:depends (get tasks %)) task-names))] diff --git a/src/babashka/impl/uberscript.clj b/src/babashka/impl/uberscript.clj new file mode 100644 index 00000000..332f88b0 --- /dev/null +++ b/src/babashka/impl/uberscript.clj @@ -0,0 +1,105 @@ +(ns babashka.impl.uberscript + (:require [sci.core :as sci])) + +(defn decompose-clause [clause] + (if (symbol? clause) + {:ns clause} + (when (seqable? clause) + (let [clause (if (= 'quote (first clause)) + (second clause) + clause) + [ns & tail] clause] + (loop [parsed {:ns ns} + tail (seq tail)] + (if tail + (let [ftail (first tail)] + (case ftail + :as (recur (assoc parsed :as (second tail)) + (nnext tail)) + :refer + (let [refer (second tail)] + (if (seqable? refer) + (recur (assoc parsed :refer (second tail)) + (nnext tail)) + (recur parsed (nnext tail)))) + ;; default + (recur parsed + (nnext tail)))) + parsed)))))) + +(defn recompose-clause [{:keys [:ns :as]}] + [ns :as as]) + +(defn process-ns + [_ctx ns] + (keep (fn [x] + (if (seqable? x) + (let [fx (first x)] + (when (identical? :require fx) + (let [decomposed (keep decompose-clause (rest x)) + recomposed (map recompose-clause decomposed)] + (list* :require recomposed)))) + x)) + ns)) + +(defn keep-quoted [clauses] + (keep (fn [clause] + (when (and (seq? clause) (= 'quote (first clause))) + (second clause))) + clauses)) + +(defn process-require [_ctx req] + (let [quoted (keep-quoted (rest req)) + decomposed (map decompose-clause quoted)] + (list* 'require (map (fn [clause] + (list 'quote (recompose-clause clause))) + decomposed)))) + +(defn process-in-ns [_ctx req] + (let [quoted (keep-quoted (rest req)) + quoted (map (fn [ns] + (list 'quote ns)) + quoted)] + (when (clojure.core/seq quoted) + (list* 'in-ns quoted)))) + +(defn loc [rdr] + (str (when-let [f @sci/file] + (str f ":")) + (sci/get-line-number rdr) + ":" + (sci/get-column-number rdr))) + +(defn uberscript [{:keys [ctx expressions]}] + (let [ctx (assoc ctx :reload-all true)] + (sci/binding [sci/file @sci/file] + (doseq [expr expressions] + (let [rdr (sci/reader expr)] + (loop [] + (let [next-val + (try (sci/parse-next ctx rdr) + ;; swallow reader error + (catch Exception _e + (binding [*out* *err*] + (println "[babashka]" "Ignoring read error while assembling uberscript near" + (loc rdr)))))] + ;; (.println System/err (pr-str next-val)) + (when-not (= ::sci/eof next-val) + (if (seq? next-val) + (let [fst (first next-val) + expr (cond (= 'ns fst) + (process-ns ctx next-val) + (= 'require fst) + (process-require ctx next-val) + (= 'in-ns fst) + (process-in-ns ctx next-val))] + (when expr + (try + (sci/eval-form ctx expr) + ;; swallow exception and continue + (catch Exception _e + (binding [*out* *err*] + (println "[babashka]" "Ignoring expression while assembling uberscript:" + expr "near" (loc rdr)))))) + (recur)) + (recur)))))))))) diff --git a/src/babashka/main.clj b/src/babashka/main.clj index 2a1ed381..6e8ef883 100644 --- a/src/babashka/main.clj +++ b/src/babashka/main.clj @@ -16,6 +16,7 @@ [babashka.impl.clojure.java.io :refer [io-namespace]] [babashka.impl.clojure.java.shell :refer [shell-namespace]] [babashka.impl.clojure.main :as clojure-main :refer [demunge]] + [babashka.impl.clojure.math :refer [math-namespace]] [babashka.impl.clojure.stacktrace :refer [stacktrace-namespace]] [babashka.impl.clojure.zip :refer [zip-namespace]] [babashka.impl.common :as common] @@ -41,6 +42,7 @@ [babashka.impl.tasks :as tasks :refer [tasks-namespace]] [babashka.impl.test :as t] [babashka.impl.tools.cli :refer [tools-cli-namespace]] + [babashka.impl.uberscript :as uberscript] [babashka.nrepl.server :as nrepl-server] [babashka.wait :refer [wait-namespace]] [clojure.edn :as edn] @@ -136,6 +138,8 @@ Global opts: --debug Print debug information and internal stacktrace in case of exception. --force Passes -Sforce to deps.clj, forcing recalculation of the classpath. --init Load file after any preloads and prior to evaluation/subcommands. + --config Replacing bb.edn with file. Relative paths are resolved relative to file. + --deps-root Treat dir as root of relative paths in config. Help: @@ -272,8 +276,8 @@ Use bb run --help to show this help output. (let [f (io/file file)] (if (.exists f) (as-> (slurp file) x - ;; remove shebang - (str/replace x #"^#!.*" "")) + ;; remove shebang + (str/replace x #"^#!.*" "")) (throw (Exception. (str "File does not exist: " file)))))) (defn load-file* [f] @@ -350,6 +354,7 @@ Use bb run --help to show this help output. (let [opts (apply hash-map opts)] (repl/start-repl! @common/ctx opts))) {:ns clojure-main-ns})} 'clojure.test t/clojure-test-namespace + 'clojure.math math-namespace 'babashka.classpath classpath-namespace 'clojure.pprint pprint-namespace 'babashka.curl curl-namespace @@ -598,7 +603,9 @@ Use bb run --help to show this help output. ("--main", "-m",) (let [options (next options)] (assoc opts-map :main (first options) - :command-line-args (rest options))) + :command-line-args (if (= "--" (second options)) + (nthrest options 2) + (rest options)))) ("--run") (parse-run-opts opts-map (next options)) ("--tasks") @@ -631,21 +638,27 @@ Use bb run --help to show this help output. (if options (case (first options) ("--classpath" "-cp") (recur (nnext options) (assoc opts-map :classpath (second options))) + ("--debug" - "--verbose" ;; renamed to --debug - ) (recur (next options) (assoc opts-map :debug true)) + "--verbose") + ;; renamed to --debug + (recur (next options) (assoc opts-map :debug true)) + ("--init") (recur (nnext options) (assoc opts-map :init (second options))) + + ("--config") + (recur (nnext options) (assoc opts-map :config (second options))) + + ("--deps-root") + (recur (nnext options) (assoc opts-map :deps-root (second options))) [options opts-map]) [options opts-map]))) (defn parse-opts ([options] (parse-opts options nil)) ([options opts-map] - (let [[options opts-map] (if opts-map - [options opts-map] - (parse-global-opts options)) - opt (first options) + (let [opt (first options) tasks (into #{} (map str) (keys (:tasks @common/bb-edn)))] (if-not opt opts-map ;; FILE > TASK > SUBCOMMAND @@ -727,9 +740,13 @@ Use bb run --help to show this help output. (or (contains? namespaces namespace) (contains? sci-namespaces/namespaces namespace))) "" - (let [res (cp/source-for-namespace loader namespace nil)] - (when uberscript (swap! uberscript-sources conj (:source res))) - res))) + (when-let [res (cp/source-for-namespace loader namespace nil)] + (if uberscript + (do (swap! uberscript-sources conj (:source res)) + (uberscript/uberscript {:ctx @common/ctx + :expressions [(:source res)]}) + {}) + res)))) (case namespace clojure.spec.alpha (binding [*out* *err*] @@ -833,7 +850,12 @@ Use bb run --help to show this help output. uberjar [nil 0] list-tasks [(tasks/list-tasks sci-ctx) 0] print-deps [(print-deps/print-deps (:print-deps-format cli-opts)) 0] + uberscript + [nil (do (uberscript/uberscript {:ctx sci-ctx + :expressions expressions}) + 0)] expressions + ;; execute code (sci/binding [sci/file abs-path] (try ; when evaluating expression(s), add in repl-requires so things like @@ -871,7 +893,6 @@ Use bb run --help to show this help output. clojure [nil (if-let [proc (bdeps/clojure command-line-args)] (-> @proc :exit) 0)] - uberscript [nil 0] :else [(repl/start-repl! sci-ctx) 0])) 1)] (flush) @@ -902,23 +923,28 @@ Use bb run --help to show this help output. (>= patch-current patch-min))))))) (defn main [& args] - (let [bb-edn-file (or (System/getenv "BABASHKA_EDN") + (let [[args global-opts] (parse-global-opts args) + config (:config global-opts) + bb-edn-file (or config "bb.edn") - bb-edn (or (when (fs/exists? bb-edn-file) - (let [raw-string (slurp bb-edn-file) - edn (edn/read-string raw-string) - edn (assoc edn :raw raw-string)] - (vreset! common/bb-edn edn))) - ;; tests may have modified bb-edn - @common/bb-edn) + bb-edn (when (fs/exists? bb-edn-file) + (let [raw-string (slurp bb-edn-file) + edn (edn/read-string raw-string) + edn (assoc edn + :raw raw-string + :file bb-edn-file) + edn (if-let [deps-root (or (:deps-root global-opts) + (some-> config fs/parent))] + (assoc edn :deps-root deps-root) + edn)] + (vreset! common/bb-edn edn))) min-bb-version (:min-bb-version bb-edn)] (when min-bb-version (when-not (satisfies-min-version? min-bb-version) (binding [*out* *err*] (println (str "WARNING: this project requires babashka " - min-bb-version " or newer, but you have: " version)))))) - (let [opts (parse-opts args)] - (exec opts))) + min-bb-version " or newer, but you have: " version))))) + (exec (parse-opts args global-opts)))) (def musl? "Captured at compile time, to know if we are running inside a diff --git a/test-resources/babashka/uberscript/src/my/impl1.clj b/test-resources/babashka/uberscript/src/my/impl1.clj index 36aff679..d51ca942 100644 --- a/test-resources/babashka/uberscript/src/my/impl1.clj +++ b/test-resources/babashka/uberscript/src/my/impl1.clj @@ -1,5 +1,18 @@ (ns my.impl1 - (:require [clojure.string])) + (:require [babashka.pods :as pods] + [clojure.string :as str])) + +;; uberscript parser can parse and skip this +(prn ::str/foo) +str/join + +(alias 'a 'clojure.string) +::a/foo ;; no error either + +(pods/load-pod 'clj-kondo/clj-kondo "2021.10.19") +(require '[pod.borkdude.clj-kondo :as clj-kondo]) + +(prn (some? clj-kondo/run!)) (defn impl-fn "identity" diff --git a/test-resources/lib_tests/aero/core_test.cljc b/test-resources/lib_tests/aero/core_test.cljc index aabbae06..62b552d8 100644 --- a/test-resources/lib_tests/aero/core_test.cljc +++ b/test-resources/lib_tests/aero/core_test.cljc @@ -13,7 +13,7 @@ goog.string.format [cljs.tools.reader.reader-types :refer [source-logging-push-back-reader]]])) - ;; TODO: + ;; BB-TEST-PATCH #_#?(:clj (:import [aero.core Deferred]))) (defn env [s] @@ -38,6 +38,8 @@ (if (= value :favorite) :chocolate :vanilla)) (deftest basic-test + ;; BB-TEST-PATCH: This and several other test files were changed to work with + ;; our dir structure (let [config (read-config "test-resources/lib_tests/aero/config.edn")] (is (= "Hello World!" (:greeting config)))) (testing "Reading empty config returns nil" diff --git a/test-resources/lib_tests/aero/lumo_test.cljs b/test-resources/lib_tests/aero/lumo_test.cljs new file mode 100644 index 00000000..365e61c9 --- /dev/null +++ b/test-resources/lib_tests/aero/lumo_test.cljs @@ -0,0 +1,23 @@ +(ns aero.lumo-test + (:require + aero.core-test + [cljs.test :refer-macros [deftest is testing run-tests]])) + +(def resolve-p (atom nil)) + +(def p (new js/Promise (fn [resolve reject] + (reset! resolve-p resolve)))) + +(defmethod cljs.test/report [:cljs.test/default :end-run-tests] + [m] + (@resolve-p m)) + +(defn -main [& argv] + (println "Testing with lumo") + (run-tests 'aero.core-test) + (-> p + (.then (fn [m] + (.exit (js/require "process") + (if (cljs.test/successful? m) + 0 + 1)))))) diff --git a/test-resources/lib_tests/babashka/lambdaisland/regal_test.clj b/test-resources/lib_tests/babashka/lambdaisland/regal_test.clj deleted file mode 100644 index 7f2fcf60..00000000 --- a/test-resources/lib_tests/babashka/lambdaisland/regal_test.clj +++ /dev/null @@ -1,15 +0,0 @@ -(ns babashka.lambdaisland.regal-test - (:require [clojure.test :as t :refer [deftest is]])) - -(prn :requiring :lambdaisland) -(require '[lambdaisland.regal :as regal]) -(prn ::done :requiring :lambdaisland) - -(def r [:cat - [:+ [:class [\a \z]]] - "=" - [:+ [:not \=]]]) - -(deftest regal-test - (is (= "[a-z]+=[^=]+" (str (regal/regex r)))) - (is (= "foo=bar" (re-matches (regal/regex r) "foo=bar")))) diff --git a/test-resources/lib_tests/babashka/run_all_libtests.clj b/test-resources/lib_tests/babashka/run_all_libtests.clj index a3511e78..5736d1f1 100644 --- a/test-resources/lib_tests/babashka/run_all_libtests.clj +++ b/test-resources/lib_tests/babashka/run_all_libtests.clj @@ -1,10 +1,16 @@ (ns babashka.run-all-libtests - (:require [clojure.java.io :as io] - [clojure.string :as str] + (:require [babashka.core :refer [windows?]] [clojure.edn :as edn] - [clojure.test :as t])) + [clojure.java.io :as io] + [clojure.test :as t :refer [*report-counters*]])) -#_(require 'clojure.spec.alpha) +(defmethod clojure.test/report :end-test-var [_m] + (when-let [rc *report-counters*] + (let [{:keys [:fail :error]} @rc] + (when (and (= "true" (System/getenv "BABASHKA_FAIL_FAST")) + (or (pos? fail) (pos? error))) + (println "=== Failing fast") + (System/exit 1))))) (def ns-args (set (map symbol *command-line-args*))) @@ -23,86 +29,13 @@ (swap! status (fn [status] (merge-with + status (dissoc m :type)))))))) -(def windows? (-> (System/getProperty "os.name") - (str/lower-case) - (str/includes? "win"))) +;; Standard test-runner for libtests +(let [lib-tests (edn/read-string (slurp (io/resource "bb-tested-libs.edn")))] + (doseq [{tns :test-namespaces skip-windows :skip-windows} (vals lib-tests)] + (when-not (and skip-windows (windows?)) + (apply test-namespaces tns)))) -;;;; clj-http-lite - -(test-namespaces 'clj-http.lite.client-test) - -;; ;;;; clojure.spec - -(test-namespaces 'clojure.test-clojure.spec - 'clojure.test-clojure.instr - 'clojure.test-clojure.multi-spec) - -;;;; regal - -(test-namespaces 'babashka.lambdaisland.regal-test) - -;;;; medley - -(require '[medley.core :refer [index-by random-uuid]]) -(prn (index-by :id [{:id 1} {:id 2}])) -(prn (random-uuid)) - -;;;; babashka.curl -; skip tests on Windows because of the :compressed thing -(when-not windows? (test-namespaces 'babashka.curl-test)) - -;;;; cprop - -;; TODO: port to test-namespaces - -(require '[cprop.core]) -(require '[cprop.source :refer [from-env]]) -(println (:cprop-env (from-env))) - -;;;; clj-yaml - -(test-namespaces 'clj-yaml.core-test) - -;;;; clojure.data.zip - -;; TODO: port to test-namespaces - -(require '[clojure.data.xml :as xml]) -(require '[clojure.zip :as zip]) -(require '[clojure.data.zip.xml :refer [attr attr= xml1->]]) - -(def data (str "" - " " - " " - "")) - -;; TODO: convert to test -(let [xml (zip/xml-zip (xml/parse (java.io.StringReader. data)))] - ;(prn :xml xml) - (prn :alice-is-a (xml1-> xml :character [(attr= :name "alice")] (attr :type))) - (prn :animal-is-called (xml1-> xml :character [(attr= :type "animal")] (attr :name)))) - -;;;; clojure.data.csv - -(test-namespaces 'clojure.data.csv-test) - -;;;; clojure.math.combinatorics - -(test-namespaces 'clojure.math.test-combinatorics) - -;;;; deps.clj - -;; TODO: port to test-namespaces - -(require '[babashka.curl :as curl]) -(spit "deps_test.clj" - (:body (curl/get "https://raw.githubusercontent.com/borkdude/deps.clj/master/deps.clj" - (if windows? {:compressed false} {})))) - -(binding [*command-line-args* ["-Sdescribe"]] - (load-file "deps_test.clj")) - -(.delete (io/file "deps_test.clj")) +;; Non-standard tests - These are tests with unusual setup around test-namespaces ;;;; doric @@ -112,48 +45,10 @@ ((resolve 'doric.core/table) [:a :b] [{:a 1 :b 2}])) (when (test-namespace? 'doric.test.core) - (test-doric-cyclic-dep-problem) - (test-namespaces 'doric.test.core)) - -;;;; cljc-java-time - -(test-namespaces 'cljc.java-time-test) - -;;;; camel-snake-kebab - -(test-namespaces 'camel-snake-kebab.core-test) - -;;;; aero - -(test-namespaces 'aero.core-test) - -;;;; clojure.data.generators - -(test-namespaces 'clojure.data.generators-test) - -;;;; honeysql - -(test-namespaces 'honeysql.core-test 'honeysql.format-test) - -;;;; minimallist - -(test-namespaces 'minimallist.core-test) - -;;;; bond -(test-namespaces 'bond.test.james) - -;;;; version-clj -(test-namespaces 'version-clj.compare-test - 'version-clj.core-test - 'version-clj.split-test - 'version-clj.via-use-test) - -;;;; httpkit client - -(test-namespaces 'httpkit.client-test) + (test-doric-cyclic-dep-problem)) ;;;; babashka.process -(when-not windows? +(when-not (windows?) ;; test built-in babashka.process (test-namespaces 'babashka.process-test) @@ -161,79 +56,6 @@ (require '[babashka.process] :reload) (test-namespaces 'babashka.process-test)) -(test-namespaces 'core-match.core-tests) - -(test-namespaces 'hiccup.core-test) -(test-namespaces 'hiccup2.core-test) - -(test-namespaces 'test-check.smoke-test) - -(test-namespaces 'gaka.core-test) - -(test-namespaces 'failjure.test-core) - -(test-namespaces 'rewrite-clj.parser-test - 'rewrite-clj.node-test - 'rewrite-clj.zip-test - 'rewrite-clj.paredit-test - 'rewrite-clj.zip.subedit-test - 'rewrite-clj.node.coercer-test) - -(test-namespaces 'helins.binf.test) - -(test-namespaces 'selmer.core-test) -(test-namespaces 'selmer.our-test) - -(test-namespaces 'jasentaa.position-test - 'jasentaa.worked-example-1 - 'jasentaa.worked-example-2 - 'jasentaa.collections-test - 'jasentaa.parser.basic-test - 'jasentaa.parser.combinators-test) - -(test-namespaces 'honey.sql-test - 'honey.sql.helpers-test - 'honey.sql.postgres-test) - -(test-namespaces 'slingshot.slingshot-test - 'slingshot.support-test - ;; TODO: - ;; 'slingshot.test-test - ) - -(test-namespaces 'omniconf.core-test) - -(test-namespaces 'crispin.core-test) - -(test-namespaces 'multigrep.core-test) - -(test-namespaces - ;; TODO: env tests don't work because envoy lib isn't compatible with bb - #_'vault.env-test - 'vault.lease-test - 'vault.client.http-test - ;; TODO: - ;; failing tests in the following namespaces: - #_'vault.client.mock-test - #_'vault.secrets.kvv1-test - #_'vault.secrets.kvv2-test) - -;; we don't really run any tests for java-http-clj yet, but we require the -;; namespaces to see if they at least load correctly -(test-namespaces 'java-http-clj.smoke-test) - -(test-namespaces 'component.component-test) - -(test-namespaces 'clj-commons.digest-test) - -(test-namespaces 'hato.client-test) - -(test-namespaces 'orchestra.core-test 'orchestra.expound-test 'orchestra.many-fns 'orchestra.reload-test) - -(let [lib-tests (edn/read-string (slurp (io/resource "bb-tested-libs.edn")))] - (doseq [{tns :test-namespaces} (vals lib-tests)] - (apply test-namespaces tns))) - ;;;; final exit code (let [{:keys [:test :fail :error] :as m} @status] diff --git a/test-resources/lib_tests/bb-tested-libs.edn b/test-resources/lib_tests/bb-tested-libs.edn index cbc276be..a6310591 100644 --- a/test-resources/lib_tests/bb-tested-libs.edn +++ b/test-resources/lib_tests/bb-tested-libs.edn @@ -8,7 +8,7 @@ mvxcvi/arrangement {:git-sha "360d29e7ae81abbf986b5a8e272f2086227d038d", :git-url "https://github.com/greglook/clj-arrangement", :test-namespaces (arrangement.core-test)} clojure-csv/clojure-csv {:git-sha "b6bb882a3a9ac1f82e06eb2262ae7c8141935228", :git-url "https://github.com/davidsantiago/clojure-csv", :test-namespaces (clojure-csv.test.utils clojure-csv.test.core)} environ/environ {:git-sha "aa90997b38bb8070d94dc4a00a14e656eb5fc9ae", :git-url "https://github.com/weavejester/environ", :test-namespaces (environ.core-test), :directory "environ"} - table/table {:git-sha "55aef3d5fced682942af811bf5d642f79fb87688", :git-url "https://github.com/cldwalker/table", :test-namespaces (table.width-test table.core-test)} + table/table {:git-sha "f6293c5f3dac1dd6f525a80fc80930f8ccdf16b7", :git-url "https://github.com/cldwalker/table", :test-namespaces (table.width-test table.core-test)} com.stuartsierra/dependency {:git-sha "3a467918cd0e5b6ab775d344cfb2a80b56daad6d", :git-url "https://github.com/stuartsierra/dependency", :test-namespaces (com.stuartsierra.dependency-test)} reifyhealth/specmonstah {:git-sha "a2b357009a3aa99a0c2d2361f3bbcd0b0e36505e", :git-url "https://github.com/reifyhealth/specmonstah", :test-namespaces (reifyhealth.specmonstah.spec-gen-test reifyhealth.specmonstah.test-data reifyhealth.specmonstah.core-test), :branch "develop"} exoscale/coax {:git-sha "0d4212af7c07e4f05f74186f05df8a97777b43fe", :git-url "https://github.com/exoscale/coax", :test-namespaces (exoscale.coax-test)} @@ -16,4 +16,93 @@ org.clojars.askonomm/ruuter {:git-sha "78659212f95cac827efc816dfbdab8181c25fc3d", :git-url "https://github.com/askonomm/ruuter", :test-namespaces (ruuter.core-test)} ;; clojure.data.json-gen-test ommitted from test-namespaces b/c it hangs on stest/check org.clojure/data.json {:git-sha "9f1c9ccf3fd3e5a39cfb7289d3d456e842ddf442", :git-url "https://github.com/clojure/data.json", :test-namespaces (clojure.data.json-test clojure.data.json-test-suite-test clojure.data.json-compat-0-1-test)} - io.replikativ/hasch {:git-sha "04d9c0bd34d86bad79502d8a6963eb2525a22b15", :git-url "https://github.com/replikativ/hasch", :test-namespaces (hasch.test)}} + io.replikativ/hasch {:git-sha "04d9c0bd34d86bad79502d8a6963eb2525a22b15", :git-url "https://github.com/replikativ/hasch", :test-namespaces (hasch.test)} + ;; BB-TEST-PATCH: Removed markdown.md-file-test b/c tests hardcode path to test + ;; files. Removed markdown.benchmark b/c it depends on criterium which isn't bb compatible + markdown-clj/markdown-clj {:git-sha "ac245d3049afa25a6d41fcb5ba5a268f52c610e4", :git-url "https://github.com/yogthos/markdown-clj", :test-namespaces (markdown.md-test)} + ;; BB-TEST-PATCH: Removed clojure.tools.namespace.dir-test as it fails on windows + org.clojure/tools.namespace {:git-sha "a13b037215e21a2e71aa34b27e1dd52c801a2a7b", :git-url "https://github.com/babashka/tools.namespace", :test-namespaces (clojure.tools.namespace.test-helpers clojure.tools.namespace.dependency-test clojure.tools.namespace.find-test clojure.tools.namespace.move-test clojure.tools.namespace.parse-test), :branch "babashka"} + com.stuartsierra/component {:git-sha "9f9653d1d95644e3c30beadf8c8811f86758ea23", :git-url "https://github.com/stuartsierra/component", :test-namespaces (com.stuartsierra.component-test)} + slingshot/slingshot {:git-sha "6961ab0593ab9633c15b7697ffd43823090720be", :git-url "https://github.com/scgilardi/slingshot", :test-namespaces (slingshot.slingshot-test slingshot.support-test slingshot.test-test)} + rm-hull/jasentaa {:git-sha "f52a0e75cbdf1d2b72d9604232db264ff6473f12", :git-url "https://github.com/rm-hull/jasentaa", :test-namespaces (jasentaa.position-test jasentaa.worked-example-2 jasentaa.collections-test jasentaa.parser.basic-test jasentaa.parser.combinators-test jasentaa.test-helpers jasentaa.worked-example-1)} + failjure/failjure {:git-sha "c6e528c1eda6ad5eaab0f1fb2a97e766bf41fdd5", :git-url "https://github.com/adambard/failjure", :test-namespaces (failjure.test-core)} + gaka/gaka {:git-sha "2f264758881d6dc586b948ca8757134675f542a7", :git-url "https://github.com/cdaddr/gaka", :test-namespaces (gaka.core-test)} + version-clj/version-clj {:git-sha "9d86cd870f7e435fd6d593cb689790a22d8040a6", :git-url "https://github.com/xsc/version-clj", :test-namespaces (version-clj.compare-test version-clj.split-test version-clj.core-test version-clj.via-use-test)} + circleci/bond {:git-sha "0d389cfb4628341824bddbe8bf102f15ad25ad0d", :git-url "https://github.com/circleci/bond", :test-namespaces (bond.assertions-test bond.james-test bond.target-data)} + ;; BB-TEST-PATCH: minimallist.generator-test excluded because generator ns can't be required + minimallist/minimallist {:git-sha "f10ebbd3c2b93e7579295618a7ed1e870c489bc4", :git-url "https://github.com/green-coder/minimallist", :test-namespaces (minimallist.util-test minimallist.core-test), :branch "all-work-and-no-play"} + aero/aero {:git-sha "743e9bc495425b4a4a7c780f5e4b09f6680b4e7a", :git-url "http://github.com/juxt/aero", :test-namespaces (aero.core-test)} + org.clojure/data.generators {:git-sha "bf65f99aa9dcabed7de7c09b74d71db208cf61ee", :git-url "https://github.com/clojure/data.generators", :test-namespaces (clojure.data.generators-test)} + camel-snake-kebab/camel-snake-kebab {:git-sha "d072c7fd242ab0becd4bb265622ded415f2a4b68", :git-url "https://github.com/clj-commons/camel-snake-kebab", :test-namespaces (camel-snake-kebab.internals.string-separator-test camel-snake-kebab.extras-test camel-snake-kebab.core-test)} + ;; BB-TEST-PATCH: Deleted cljs-test-opts.edn + henryw374/cljc.java-time {:git-sha "b9da12ea25e80a0e284a5bffd88ebcbf18fc3bf7", :git-url "https://github.com/henryw374/cljc.java-time", :test-namespaces (cljc.java-time-test)} + org.babashka/spec.alpha {:git-sha "6c4aed643daaf55c6f898d4915275704db683aa2", :git-url "https://github.com/babashka/spec.alpha", :test-namespaces (clojure.test-clojure.instr clojure.test-clojure.spec)} + ;; BB-TEST-PATCH: Don't have 4 tests namespaces because they depend on + ;; additional libs that aren't bb compatible e.g. instaparse and malli + lambdaisland/regal {:git-sha "d13f26dfdf37186ee86016ed144fc823c5b24c11", :git-url "https://github.com/lambdaisland/regal", :test-namespaces (lambdaisland.regal.test-util lambdaisland.regal-test)} + medley/medley {:git-sha "d723afcb18e1fae27f3b68a25c7a151569159a9e", :git-url "https://github.com/weavejester/medley", :test-namespaces (medley.core-test)} + clj-commons/clj-yaml {:git-sha "9c2d602ec6ab33da061575f52e3de1aff41f67f5", :git-url "https://github.com/clj-commons/clj-yaml", :test-namespaces (clj-yaml.core-test)} + org.clojure/data.csv {:git-sha "aa9b3bdd3a1d3f6a7fe12eaab76b45ef3f197ad5", :git-url "https://github.com/clojure/data.csv", :test-namespaces (clojure.data.csv-test)} + org.clojure/math.combinatorics {:git-sha "e555a45b5802cf5e8c43b4377628ef34a634554b", :git-url "https://github.com/clojure/math.combinatorics", :test-namespaces (clojure.math.test-combinatorics)} + doric/doric {:git-sha "8747fdce565187a5c368c575cf4ca794084b0a5c", :git-url "https://github.com/joegallo/doric", :test-namespaces (doric.test.core doric.test.readme doric.test.doctest)} + com.github.seancorfield/honeysql {:git-sha "6e4e1f6928450788353c181f32474d930d6afe84", :git-url "https://github.com/seancorfield/honeysql", :test-namespaces (honey.sql-test honey.sql.helpers-test honey.sql.postgres-test), :branch "develop"} + honeysql/honeysql {:git-sha "1137dd12350afdc30ad4976c3718279581390b36", :git-url "https://github.com/seancorfield/honeysql", :test-namespaces (honeysql.format-test honeysql.core-test), :branch "v1"} + ; skip tests on Windows because of the :compressed thing + babashka/babashka.curl {:git-url "https://github.com/babashka/babashka.curl", :test-namespaces [babashka.curl-test], :skip-windows true, :manually-added true} + http-kit/http-kit {:git-url "https://github.com/http-kit/http-kit", :test-namespaces [httpkit.client-test], :manually-added true} + org.clojure/core.match {:git-url "https://github.com/clojure/core.match", :test-namespaces [core-match.core-tests], :manually-added true} + hiccup/hiccup {:git-url "http://github.com/weavejester/hiccup", :test-namespaces [hiccup.core-test hiccup2.core-test], :manually-added true} + org.clojure/test.check {:git-url "https://github.com/clojure/test.check", :test-namespaces [test-check.smoke-test], :manually-added true} + io.helins/binf {:git-url "https://github.com/helins/binf.cljc", :test-namespaces [helins.binf.test], :manually-added true} + selmer/selmer {:git-url "https://github.com/yogthos/Selmer", :test-namespaces [selmer.core-test selmer.our-test], :manually-added true} + com.grammarly/omniconf {:git-url "https://github.com/grammarly/omniconf", :test-namespaces [omniconf.core-test], :manually-added true} + crispin/crispin {:git-url "https://github.com/dunaj-project/crispin", :test-namespaces [crispin.core-test], :manually-added true} + clj-commons/multigrep {:git-url "https://github.com/clj-commons/multigrep", :test-namespaces [multigrep.core-test], :manually-added true} + org.clj-commons/digest {:git-url "https://github.com/clj-commons/clj-digest", :test-namespaces [clj-commons.digest-test], :manually-added true} + hato/hato {:git-url "https://github.com/gnarroway/hato", :test-namespaces [hato.client-test], :manually-added true} + java-http-clj/java-http-clj {:git-url "http://www.github.com/schmee/java-http-clj", :test-namespaces [java-http-clj.smoke-test], :manually-added true} + rewrite-clj/rewrite-clj {:git-url "https://github.com/clj-commons/rewrite-clj", :test-namespaces [rewrite-clj.parser-test rewrite-clj.node-test rewrite-clj.zip-test rewrite-clj.paredit-test rewrite-clj.zip.subedit-test rewrite-clj.node.coercer-test], :manually-added true} + ;; TODO: env tests don't work because envoy lib isn't compatible with bb + ;; TODO: failing tests in the following namespaces: vault.client.mock-test, vault.secrets.kvv1-test vault.secrets.kvv2-test + amperity/vault-clj {:git-url "https://github.com/amperity/vault-clj", :test-namespaces [vault.lease-test vault.client.http-test], :manually-added true} + orchestra/orchestra {:git-url "https://github.com/jeaye/orchestra", :test-namespaces (orchestra.make-fns orchestra.many-fns orchestra.expound-test orchestra.core-test orchestra.reload-test), :test-directories ("test/cljc" "test/clj"), :git-sha "81e5181f7b42e5e2763a2b37db17954f3be0314e"} + ;; BB-TEST-PATCH: Deleted tasks.clj + org.clj-commons/clj-http-lite {:git-url "https://github.com/clj-commons/clj-http-lite", :test-namespaces (clj-http.lite.test-runner clj-http.lite.client-test), :test-directories ("bb"), :git-sha "6b53000df55ac05c4ff8e5047a5323fc08a52e8b"} + cprop/cprop {:git-url "https://github.com/tolitius/cprop", :test-namespaces [cprop.smoke-test], :manually-added true} + org.clojure/data.zip {:git-url "https://github.com/clojure/data.zip", :test-namespaces [clojure.data.zip-test], :manually-added true} + borkdude/deps {:git-url "https://github.com/borkdude/deps.clj", :test-namespaces [borkdude.deps.smoke-test], :manually-added true} + io.github.cognitect-labs/test-runner {:git-url "https://github.com/cognitect-labs/test-runner", :test-namespaces (cognitect.test-runner.samples-test cognitect.test-runner.sample-property-test cognitect.test-runner-test), :git-sha "cc75980b43011773162b485f46f939dc5fba91e4"} + borkdude/missing.test.assertions {:git-url "https://github.com/borkdude/missing.test.assertions", :test-namespaces (missing.test.assertions-test missing.test.old-methods), :git-sha "603cb01bee72fb17addacc53c34c85612684ad70"} + ;; No tests to run + io.github.technomancy/limit-break {:git-url "https://github.com/technomancy/limit-break", :test-namespaces [], :manually-added true} + dev.nubank/docopt {:git-url "https://github.com/nubank/docopt.clj", :test-namespaces (docopt.core-test), :git-sha "2794195a7288002e8d8a44f7bc37180c9cca8971"} + ;; BB-TEST-PATCH: Deleted unused resources/ + testdoc/testdoc {:git-url "https://github.com/liquidz/testdoc", :test-namespaces (testdoc.style.repl-test testdoc.style.code-first-test testdoc.core-test), :git-sha "6b995ef25f3cc6450a1ce30f72baed371476f6eb"} + ;; BB-TEST-PATCH: Remove contajners.core-test as it fails + org.clojars.lispyclouds/contajners {:git-url "https://github.com/lispyclouds/contajners", :test-namespaces (contajners.impl-test), :git-sha "d163637ff36d79995516d6705da1e9afc7b44764"} + ;; Don't run tests b/c they depend on `psql` + douglass/clj-psql {:git-url "https://github.com/DarinDouglass/clj-psql", :test-namespaces [], :manually-added true} + ;; Don't run tests b/c they depend on `ffmpeg` + ffclj/ffclj {:git-url "https://github.com/luissantos/ffclj", :test-namespaces [], :manually-added true} + ;; BB-TEST-PATCH: Can't load deps for tests - expound.alpha-test, expound.spell-spec-test, expound.paths-test. Skip expound.printer-test as most tests fail + ;; BB-TEST-PATCH: Deleted cljs_test.cljs and *.txt + expound/expound {:git-url "https://github.com/bhb/expound", :test-namespaces (expound.specs-test expound.print-length-test expound.test-utils expound.spec-gen expound.problems-test), :git-sha "589a7f69323dc0423197b346c75808e48e771427"} + ;; BB-TEST-PATCH: Removed borkdude.rewrite-edn-test because it fails + borkdude/rewrite-edn {:git-url "https://github.com/borkdude/rewrite-edn", :test-namespaces [], :branch "63f09048a3ebbd48f86fa9626076e7e540cfb7ee", :git-sha "63f09048a3ebbd48f86fa9626076e7e540cfb7ee"} + clojure-term-colors/clojure-term-colors {:git-url "https://github.com/trhura/clojure-term-colors", :test-namespaces (clojure.term.colors-test), :git-sha "71620a5e121d51afe28c50c0aa14ceb4cbff7981"} + ;; BB-TEST-PATCH: Removed io.aviso.exception-test because it can't load ns with clojure.lang.Compiler. + ;; BB-TEST-PATCH: Deleted demo*.clj + ;; BB-TEST-PATCH: Don't run on windows as most binary tests fail + io.aviso/pretty {:git-url "https://github.com/AvisoNovate/pretty", :test-namespaces (io.aviso.binary-test), :git-sha "155926f991f94addaf6f5c8621748924ab144988" :skip-windows true} + progrock/progrock {:git-url "https://github.com/weavejester/progrock", :test-namespaces (progrock.core-test), :git-sha "9c277a3244c52bfde19c21add327d6e20b94fdf5"} + ;; Don't run portal.jvm-test as it depends on headless chrome + djblue/portal {:git-url "https://github.com/djblue/portal", :test-namespaces (portal.test-runner portal.runtime.cson-test portal.runtime.fs-test portal.e2e portal.bench), :git-sha "64e4624bcf3bee2dd47e3d8e47982c709738eb11"} + integrant/integrant {:git-url "https://github.com/weavejester/integrant", :test-namespaces (integrant.test.foo integrant.test.quz integrant.test.bar integrant.test.baz integrant.core-test), :git-sha "32a46f5dca8a6b563a6dddf88bec887be3201b08"} + com.wsscode/cljc-misc {:git-url "https://github.com/wilkerlucio/cljc-misc", :test-namespaces (com.wsscode.misc.uuid-test com.wsscode.misc.macros-test com.wsscode.misc.math-test com.wsscode.misc.coll-test com.wsscode.misc.refs-test), :git-sha "dc8e31a200f9cacf86af10b63e40fcb448c259f4"} + edn-query-language/eql {:git-url "https://github.com/edn-query-language/eql", :test-namespaces (edn-query-language.core-test), :git-sha "0d4f9745d98c3d20b81bb4bdce3e8e15db7fd094"} + meta-merge/meta-merge {:git-url "https://github.com/weavejester/meta-merge", :test-namespaces (meta-merge.core-test), :git-sha "c968c38baccd4219fe0ba592d89af37ea8e426bf"} + com.exoscale/lingo {:git-url "https://github.com/exoscale/lingo", :test-namespaces (exoscale.lingo.test.core-test), :git-sha "30b5084fab28d24c99ec683e21535366910d9f2f" :skip-windows true} + io.github.swirrl/dogstatsd {:git-url "https://github.com/swirrl/dogstatsd", :test-namespaces (swirrl.dogstatsd-test), :git-sha "e110caae452cd1185e65e389a359b69502076d61"} + org.clojure/algo.monads {:git-url "https://github.com/clojure/algo.monads", :test-namespaces (clojure.algo.test-monads), :git-sha "3a985b0b099110b1654d568fecf597bc9c8d1ff5"} + io.lambdaforge/datalog-parser {:git-url "https://github.com/lambdaforge/datalog-parser", :test-namespaces (datalog.parser.pull-test datalog.parser.test.util datalog.parser.impl-test datalog.parser-test datalog.unparser-test), :git-sha "02d193f397afc3f93da704e7c6c850b194f0e797"} + clj-stacktrace/clj-stacktrace {:git-url "https://github.com/mmcgrana/clj-stacktrace", :test-namespaces (clj-stacktrace.repl-test clj-stacktrace.core-test), :git-sha "94dc2dd748710e79800e94b713e167e5dc525717"}} diff --git a/test-resources/lib_tests/bond/assertions_test.clj b/test-resources/lib_tests/bond/assertions_test.clj new file mode 100644 index 00000000..1969600a --- /dev/null +++ b/test-resources/lib_tests/bond/assertions_test.clj @@ -0,0 +1,121 @@ +(ns bond.assertions-test + (:require [clojure.test :refer (deftest is testing)] + [bond.assertions :as assertions] + [bond.james :as bond :include-macros true] + [bond.target-data :as target])) + +(deftest called?-works + (testing "a spy was called directly" + (bond/with-spy [target/foo] + (target/foo 1) + (is (assertions/called? target/foo)))) + + (testing "a spy was called indirectly" + (bond/with-spy [target/foo] + (target/foo-caller 1) + (is (assertions/called? target/foo)))) + + (testing "a spy was not called" + (bond/with-spy [target/foo] + (is (not (assertions/called? target/foo))))) + + (testing "called? fails when its argument is not spied" + (is (thrown? IllegalArgumentException + (assertions/called? target/foo))))) + +(deftest called-times?-works + (testing "the number of times a spy was called" + (bond/with-spy [target/foo] + (target/foo-caller 1) + (is (assertions/called-times? target/foo 1)) + (target/foo 2) + (is (assertions/called-times? target/foo 2)))) + + (testing "the number of times a spy was not called" + (bond/with-spy [target/foo] + (target/foo-caller 1) + (is (not (assertions/called-times? target/foo 2))) + (target/foo-caller 2) + (is (not (assertions/called-times? target/foo 1))))) + + (testing "called-times? fails when its argument is not spied" + (is (thrown? IllegalArgumentException + (assertions/called-times? target/foo 0))))) + +(deftest called-with-args?-works + (testing "an assertion for calling a spy with args" + (bond/with-spy [target/foo + target/bar] + (target/foo-caller 1) + (is (assertions/called-with-args? target/foo [[1]])) + (is (not (assertions/called-with-args? target/foo [[2]]))) + (is (not (assertions/called-with-args? target/bar [[1]]))) + (is (not (assertions/called-with-args? target/foo [[1 2]]))))) + + (testing "an assertion for calling a spy multiple times with args" + (bond/with-spy [target/foo] + (target/foo-caller 1) + (target/foo-caller 2) + (is (assertions/called-with-args? target/foo [[1] [2]])))) + + (testing "called-with-args? fails when its argument is not spied" + (is (thrown? IllegalArgumentException + (assertions/called-with-args? target/foo []))))) + +(deftest called-once-with-args?-works + (testing "an assertion for calling a spy once with args" + (bond/with-spy [target/foo] + (target/foo 1) + (is (assertions/called-once-with-args? target/foo [1])) + (is (not (assertions/called-once-with-args? target/foo [2]))))) + + (testing "an assertion for calling a spy twice with args" + (bond/with-spy [target/foo] + (target/foo 1) + (target/foo 2) + (is (not (assertions/called-once-with-args? target/foo [1]))) + (is (not (assertions/called-once-with-args? target/foo [2]))))) + + (testing "an assertion for calling a spy indirectly once with args" + (bond/with-spy [target/foo] + (target/foo-caller 1) + (is (assertions/called-once-with-args? target/foo [1])) + (is (not (assertions/called-once-with-args? target/foo [2]))))) + + (testing "an assertion for a spy that was not called" + (bond/with-spy [target/foo] + (is (not (assertions/called-once-with-args? target/foo []))))) + + (testing "called-once-with-args? fails when its argument is not spied" + (is (thrown? IllegalArgumentException + (assertions/called-once-with-args? target/foo []))))) + +(deftest called-at-least-once-with-args?-works + (testing "an assertion for calling a spy multiple times" + (bond/with-spy [target/foo] + (target/foo 1) + (target/foo 2) + (is (assertions/called-at-least-once-with-args? target/foo [1])) + (is (assertions/called-at-least-once-with-args? target/foo [2])) + (is (not (assertions/called-at-least-once-with-args? target/foo [3]))))) + + (testing "an assertion for calling a spy multiple times with the same value" + (bond/with-spy [target/foo] + (target/foo 1) + (target/foo 1) + (is (assertions/called-at-least-once-with-args? target/foo [1])) + (is (not (assertions/called-at-least-once-with-args? target/foo [2]))))) + + (testing "an assertion for calling a spy once" + (bond/with-spy [target/foo] + (target/foo 1) + (is (assertions/called-at-least-once-with-args? target/foo [1])) + (is (not (assertions/called-at-least-once-with-args? target/foo [2]))))) + + (testing "an assertion for a spy that was not called" + (bond/with-spy [target/foo] + (is (not (assertions/called-at-least-once-with-args? target/foo []))))) + + (testing "called-at-least-once-with-args? fails when its argument is not spied" + (is (thrown? IllegalArgumentException + (assertions/called-at-least-once-with-args? target/foo []))))) diff --git a/test-resources/lib_tests/bond/james_test.clj b/test-resources/lib_tests/bond/james_test.clj new file mode 100644 index 00000000..f6a5696f --- /dev/null +++ b/test-resources/lib_tests/bond/james_test.clj @@ -0,0 +1,109 @@ +(ns bond.james-test + {:clj-kondo/config {:linters {:private-call {:level :off} + :invalid-arity {:level :off}}}} + (:require [clojure.test :refer (deftest is testing)] + [bond.james :as bond :include-macros true] + [bond.target-data :as target])) + +(deftest spy-logs-args-and-results + (bond/with-spy [target/foo] + (is (= 2 (target/foo 1))) + (is (= 4 (target/foo 2))) + (is (= [{:args [1] :return 2} + {:args [2] :return 4}] + (bond/calls target/foo))) + (let [exception (is (thrown? clojure.lang.ArityException (target/foo 3 4)))] + (is (= {:args [3 4] :throw exception} + (-> target/foo bond/calls last)))))) + +(deftest calls-fails-on-unspied-fns + (is (thrown? IllegalArgumentException + (bond/calls target/foo)))) + +(deftest spy-can-spy-private-fns + (bond/with-spy [target/private-foo] + (is (= 4 (#'target/private-foo 2))) + (is (= 6 (#'target/private-foo 3))) + (is (= [{:args [2] :return 4} + {:args [3] :return 6}] + (bond/calls #'target/private-foo))))) + +(deftest stub-works + (is (= "" + (with-out-str + (bond/with-stub [target/bar] + (target/bar 3)))))) + +(deftest stub-works-with-private-fn + (testing "without replacement" + (bond/with-stub [target/private-foo] + (is (nil? (#'target/private-foo 3))) + (is (= [3] (-> #'target/private-foo bond/calls first :args))))) + (testing "with replacement" + (bond/with-stub [[target/private-foo (fn [x] (* x x))]] + (is (= 9 (#'target/private-foo 3))) + (is (= [3] (-> #'target/private-foo bond/calls first :args)))))) + +(deftest stub-with-replacement-works + (bond/with-stub [target/foo + [target/bar #(str "arg is " %)]] + (testing "stubbing works" + (is (nil? (target/foo 4))) + (is (= "arg is 3" (target/bar 3)))) + (testing "spying works" + (is (= [4] (-> target/foo bond/calls first :args))) + (is (= [3] (-> target/bar bond/calls first :args)))))) + + +(deftest iterator-style-stubbing-works + (bond/with-stub [target/foo + [target/bar [#(str "first arg is " %) + #(str "second arg is " %) + #(str "third arg is " %)]]] + (testing "stubbing works" + (is (nil? (target/foo 4))) + (is (= "first arg is 3" (target/bar 3))) + (is (= "second arg is 4" (target/bar 4))) + (is (= "third arg is 5" (target/bar 5)))) + (testing "spying works" + (is (= [4] (-> target/foo bond/calls first :args))) + (is (= [3] (-> target/bar bond/calls first :args))) + (is (= [4] (-> target/bar bond/calls second :args))) + (is (= [5] (-> target/bar bond/calls last :args)))))) + +(deftest stub!-complains-loudly-if-there-is-no-arglists + (is (thrown? IllegalArgumentException + (bond/with-stub! [[target/without-arglists (constantly 42)]] + (throw (Exception. "shouldn't get here")))))) + +(deftest stub!-throws-arity-exception + (bond/with-stub! [[target/foo (constantly 9)]] + (is (= 9 (target/foo 12))) + (is (= [{:args [12] :return 9}] (bond/calls target/foo)))) + (bond/with-stub! [target/bar + target/quuk + [target/quux (fn [_ _ & x] x)]] + (is (thrown? clojure.lang.ArityException + (target/bar 1 2))) + (is (thrown? clojure.lang.ArityException + (target/quuk 1))) + (is (= [6 5] (target/quux 8 7 6 5))))) + +(deftest spying-entire-namespaces-works + (bond/with-spy-ns [bond.target-data] + (target/foo 1) + (target/foo 2) + (is (= [{:args [1] :return 2} + {:args [2] :return 4}] + (bond/calls target/foo))) + (is (= 0 (-> target/bar bond/calls count))))) + +(deftest stubbing-entire-namespaces-works + (testing "without replacements" + (bond/with-stub-ns [bond.target-data] + (is (nil? (target/foo 10))) + (is (= [10] (-> target/foo bond/calls first :args))))) + (testing "with replacements" + (bond/with-stub-ns [[bond.target-data (constantly 3)]] + (is (= 3 (target/foo 10))) + (is (= [10] (-> target/foo bond/calls first :args)))))) diff --git a/test-resources/lib_tests/bond/target_data.clj b/test-resources/lib_tests/bond/target_data.clj new file mode 100644 index 00000000..986a06de --- /dev/null +++ b/test-resources/lib_tests/bond/target_data.clj @@ -0,0 +1,35 @@ +(ns bond.target-data + "Reference def targets for bond to test against." + {:clj-kondo/config {:linters {:unused-binding {:level :off} + :unused-private-var {:level :off}}}}) + +(defn foo + [x] + (* 2 x)) + +(defn- private-foo + [x] + (* 2 x)) + +(defn foo-caller [x] + (foo x)) + +(defn bar + [x] + (println "bar!") (* 2 x)) + +(defn quux + [a b & c] + c) + +(defn quuk + [a b & c] + c) + +(defmacro baz + [x] + `(* ~x 2)) + +(def without-arglists + (fn [x] + (* 2 x))) diff --git a/test-resources/lib_tests/borkdude/deps/smoke_test.clj b/test-resources/lib_tests/borkdude/deps/smoke_test.clj new file mode 100644 index 00000000..50781333 --- /dev/null +++ b/test-resources/lib_tests/borkdude/deps/smoke_test.clj @@ -0,0 +1,20 @@ +(ns borkdude.deps.smoke-test + (:require [clojure.test :as t :refer [deftest is]] + [clojure.java.io :as io] + [clojure.string :as str] + [babashka.curl :as curl])) + + +(def windows? (-> (System/getProperty "os.name") + (str/lower-case) + (str/includes? "win"))) + +(deftest basic-test + (spit "deps_test.clj" + (:body (curl/get "https://raw.githubusercontent.com/borkdude/deps.clj/master/deps.clj" + (if windows? {:compressed false} {})))) + + (binding [*command-line-args* ["-Sdescribe"]] + (load-file "deps_test.clj")) + + (.delete (io/file "deps_test.clj"))) diff --git a/test-resources/lib_tests/borkdude/rewrite_edn_test.cljc b/test-resources/lib_tests/borkdude/rewrite_edn_test.cljc new file mode 100644 index 00000000..b5eb4074 --- /dev/null +++ b/test-resources/lib_tests/borkdude/rewrite_edn_test.cljc @@ -0,0 +1,133 @@ +(ns borkdude.rewrite-edn-test + (:require [borkdude.rewrite-edn :as r] + [clojure.test :as t :refer [deftest testing is]])) + +(deftest assoc-test + (testing "Base case" + (is (= "{:a 1}" + (str (r/assoc + (r/parse-string "{}") + :a 1))))) + (testing "When there's only one existing, keys are added on a new line" + (is (= " +{:a 1 + :b 1}" + (str (r/assoc + (r/parse-string " +{:a 1}") + :b 1))))) + (testing "Unless there are already keys on the same line" + (is (= "{:a 1 :b 2 :c 3}" + (str (r/assoc + (r/parse-string "{:a 1 :b 2}") + :c 3))))) + (testing "when map is already multi-line, new keys are added on new line" + (is (= " +{:a 1 + :b 2} +;; this is a cool map" + (str (r/assoc + (r/parse-string " +{:a 1} +;; this is a cool map") + :b 2))))) + (testing "Updating existing val" + (is (= "{:a 2}" + (str (r/assoc + (r/parse-string "{:a 1}") + :a 2))))) + (testing "Something between key and val" + (is (= "{:a #_:something 2}" + (str (r/assoc + (r/parse-string "{:a #_:something 1}") + :a 2))))) + (testing "Comment at the end" + (is (= "{:a 2} ;; this is a cool map" + (str (r/assoc + (r/parse-string "{:a 1} ;; this is a cool map") + :a 2))))) + (testing "Vector index assoc" + (is (= "[9 8 99 7] ;; this is a cool vector" + (str (r/assoc + (r/parse-string "[9 8 3 7] ;; this is a cool vector") + 2 99))))) + (testing "Vector last index assoc" + (is (= "[9 8 3 99] ;; this is a cool vector" + (str (r/assoc + (r/parse-string "[9 8 3 7] ;; this is a cool vector") + 3 99))))) + (testing "Vector assoc out of bounds" + (is (try + (r/assoc (r/parse-string "[9 8 3 7] ;; this is a cool vector") 9 99) + false + (catch java.lang.IndexOutOfBoundsException _ true)))) + (testing "Vector assoc out of bounds with ignored" + (is (try + (r/assoc (r/parse-string "[9 8 3 #_99 #_213 7] ;; this is a cool vector") 4 99) + false + (catch java.lang.IndexOutOfBoundsException _ true))))) + +(deftest update-test + (is (= "{:a #_:foo 2}" + (str (r/update + (r/parse-string "{:a #_:foo 1}") + :a (fn [node] + (inc (r/sexpr node)))))))) + +(defn qualify-sym-node [sym-node] + (let [sym (r/sexpr sym-node)] + (if (or (not (symbol? sym)) + (qualified-symbol? sym)) + sym-node + (symbol (str sym) (str sym))))) + +(deftest map-keys-test + (is (= " +{foo/foo 1 + bar/bar 2}" + (str (r/map-keys qualify-sym-node + (r/parse-string " +{foo 1 + bar 2}")))))) + +(deftest update-deps-test + (is (= "{:deps {foo/foo {:mvn/version \"0.1.0\"}}}" + (str (r/update (r/parse-string "{:deps {foo {:mvn/version \"0.1.0\"}}}") + :deps + (fn [deps-map-node] + (r/map-keys qualify-sym-node deps-map-node))))))) + +(deftest assoc-in-test + (is (= "{:a {:b {:c 2}}}" + (str (r/assoc-in (r/parse-string "{}") + [:a :b :c] 2)))) + (is (= "{:a {:b {:c 2}}}" + (str (r/assoc-in (r/parse-string "nil") + [:a :b :c] 2)))) + (is (= "{:deps {foo/foo {:mvn/version \"0.2.0\"}}}" + (str (r/assoc-in (r/parse-string "{:deps {foo/foo {:mvn/version \"0.1.0\"}}}") + [:deps 'foo/foo :mvn/version] + "0.2.0")))) + (is (= "{:a 1 :b {:c 1}}" + (str (r/assoc-in (r/parse-string "{:a 1}") [:b :c] 1))))) + +(deftest update-in-test + (is (= "{:deps {foo/foo {:mvn/version \"0.2.0\"}}}" + (str (r/update-in (r/parse-string "{:deps {foo/foo {:mvn/version \"0.1.0\"}}}") + [:deps 'foo/foo] + #(r/assoc % :mvn/version "0.2.0"))))) + (is (= "{:a {:b {:c 1}}}" + (str (r/update-in (r/parse-string "{}") + [:a :b :c] + (comp (fnil inc 0) r/sexpr))))) + (is (= "{:a {:b {:c 1}}}" + (str (r/update-in (r/parse-string "nil") + [:a :b :c] + (comp (fnil inc 0) r/sexpr)))))) + +(deftest dissoc-test + (is (= "{}" (str (r/dissoc (r/parse-string "{:a 1}") :a)))) + (is (= "{:a 1}" (str (r/dissoc (r/parse-string "{:a 1 \n\n:b 2}") :b)))) + (is (= "{:a 1\n:c 3}" (str (r/dissoc (r/parse-string "{:a 1\n:b 2\n:c 3}") :b)))) + (is (= "{:deps {foo/bar {}}}" (str (r/update (r/parse-string "{:deps {foo/bar {} foo/baz {}}}") + :deps #(r/dissoc % 'foo/baz)))))) diff --git a/test-resources/lib_tests/camel_snake_kebab/core_test.cljc b/test-resources/lib_tests/camel_snake_kebab/core_test.cljc index ab65cb53..cf426706 100644 --- a/test-resources/lib_tests/camel_snake_kebab/core_test.cljc +++ b/test-resources/lib_tests/camel_snake_kebab/core_test.cljc @@ -47,7 +47,11 @@ (testing "handling of blank input string" (is (= "" (csk/->kebab-case ""))) - (is (= "" (csk/->kebab-case " "))))) + (is (= "" (csk/->kebab-case " ")))) + + (testing "handling of input consisting of only separator(s)" + (is (= "" (csk/->kebab-case "a" :separator \a))) + (is (= "" (csk/->kebab-case "aa" :separator \a))))) (deftest http-header-case-test (are [x y] (= x (csk/->HTTP-Header-Case y)) diff --git a/test-resources/lib_tests/camel_snake_kebab/extras_test.cljc b/test-resources/lib_tests/camel_snake_kebab/extras_test.cljc new file mode 100644 index 00000000..81d0c08f --- /dev/null +++ b/test-resources/lib_tests/camel_snake_kebab/extras_test.cljc @@ -0,0 +1,16 @@ +(ns camel-snake-kebab.extras-test + (:require [camel-snake-kebab.core :as csk] + [camel-snake-kebab.extras :refer [transform-keys]] + #?(:clj [clojure.test :refer :all] + :cljs [cljs.test :refer-macros [deftest testing is are]]))) + +(deftest transform-keys-test + (are [x y] (= x (transform-keys csk/->kebab-case-keyword y)) + nil nil + {} {} + [] [] + {:total-books 0 :all-books []} {'total_books 0 "allBooks" []} + [{:the-author "Dr. Seuss" :the-title "Green Eggs and Ham"}] + [{'the-Author "Dr. Seuss" "The_Title" "Green Eggs and Ham"}] + {:total-books 1 :all-books [{:the-author "Dr. Seuss" :the-title "Green Eggs and Ham"}]} + {'total_books 1 "allBooks" [{'THE_AUTHOR "Dr. Seuss" "the_Title" "Green Eggs and Ham"}]})) diff --git a/test-resources/lib_tests/camel_snake_kebab/internals/string_separator_test.cljc b/test-resources/lib_tests/camel_snake_kebab/internals/string_separator_test.cljc new file mode 100644 index 00000000..31a5704a --- /dev/null +++ b/test-resources/lib_tests/camel_snake_kebab/internals/string_separator_test.cljc @@ -0,0 +1,41 @@ +(ns camel-snake-kebab.internals.string-separator-test + (:require [camel-snake-kebab.internals.string-separator :refer [split generic-separator]] + #?(:clj [clojure.test :refer :all] + :cljs [cljs.test :refer-macros [deftest testing is are]]))) + +(deftest split-test + (testing "regex, string and character separators" + (are [sep] + (and (= ["foo" "bar"] (split sep "foo.bar")) + (= [""] (split sep ""))) + #"\." "." \.)) + + (testing "input consisting of separator(s)" + (is (empty? (split "x" "x"))) + (is (empty? (split "x" "xx")))) + + (testing "generic separator" + (are [x y] + (= x (split generic-separator y)) + + [""] "" + [""] " " + ["x"] " x " + + ["foo" "bar"] "foo bar" + ["foo" "bar"] "foo\n\tbar" + ["foo" "bar"] "foo-bar" + ["foo" "Bar"] "fooBar" + ["Foo" "Bar"] "FooBar" + ["foo" "bar"] "foo_bar" + ["FOO" "BAR"] "FOO_BAR" + + ["räksmörgås"] "räksmörgås" + + ["IP" "Address"] "IPAddress" + + ["Adler" "32"] "Adler32" + ["Inet" "4" "Address"] "Inet4Address" + ["Arc" "2" "D"] "Arc2D" + ["a" "123b"] "a123b" + ["A" "123" "B"] "A123B"))) diff --git a/test-resources/lib_tests/camel_snake_kebab/test_runner.cljs b/test-resources/lib_tests/camel_snake_kebab/test_runner.cljs new file mode 100644 index 00000000..20b094bd --- /dev/null +++ b/test-resources/lib_tests/camel_snake_kebab/test_runner.cljs @@ -0,0 +1,10 @@ +(ns camel-snake-kebab.test-runner + (:require [cljs.test :as test] + [doo.runner :refer-macros [doo-all-tests doo-tests]] + [camel-snake-kebab.core-test] + [camel-snake-kebab.extras-test] + [camel-snake-kebab.internals.string-separator-test])) + +(doo-tests 'camel-snake-kebab.core-test + 'camel-snake-kebab.extras-test + 'camel-snake-kebab.internals.string-separator-test) diff --git a/test-resources/lib_tests/clj_http/lite/client_test.clj b/test-resources/lib_tests/clj_http/lite/client_test.clj index d6a2ba89..86407b69 100644 --- a/test-resources/lib_tests/clj_http/lite/client_test.clj +++ b/test-resources/lib_tests/clj_http/lite/client_test.clj @@ -24,11 +24,12 @@ :accept :json :throw-exceptions false}))))) -(deftest insecure-test - (is (= 200 (:status (client/get "https://self-signed.badssl.com/" {:insecure? true}))))) - (deftest exception-test (try (client/get "https://site.com/broken") (is false "should not reach here") (catch Exception e (is (:headers (ex-data e)))))) + +;; BB-TEST-PATCH: Added test +(deftest insecure-test + (is (= 200 (:status (client/get "https://self-signed.badssl.com/" {:insecure? true}))))) diff --git a/test-resources/lib_tests/clj_http/lite/test_runner.clj b/test-resources/lib_tests/clj_http/lite/test_runner.clj new file mode 100644 index 00000000..b793c578 --- /dev/null +++ b/test-resources/lib_tests/clj_http/lite/test_runner.clj @@ -0,0 +1,10 @@ +(ns clj-http.lite.test-runner + (:require [clj-http.lite.client-test] + [clojure.test :as t])) + +(defn -main [& _] + (let [{:keys [fail error]} (t/run-tests 'clj-http.lite.client-test)] + (System/exit (if (or (pos? fail) + (pos? error)) + 1 0)))) + diff --git a/test-resources/lib_tests/clj_stacktrace/core_test.clj b/test-resources/lib_tests/clj_stacktrace/core_test.clj new file mode 100644 index 00000000..b93a31a5 --- /dev/null +++ b/test-resources/lib_tests/clj_stacktrace/core_test.clj @@ -0,0 +1,83 @@ +(ns clj-stacktrace.core-test + (:use clojure.test) + (:use clj-stacktrace.core) + (:use clj-stacktrace.utils)) + +(def cases + [["foo.bar$biz__123" "invoke" "bar.clj" 456 + {:clojure true :ns "foo.bar" :fn "biz" + :file "bar.clj" :line 456 :anon-fn false}] + + ["foo.bar$biz_bat__123" "invoke" "bar.clj" 456 + {:clojure true :ns "foo.bar" :fn "biz-bat" + :file "bar.clj" :line 456 :anon-fn false}] + + ["foo.bar$biz_bat_QMARK___448" "invoke" "bar.clj" 456 + {:clojure true :ns "foo.bar" :fn "biz-bat?" + :file "bar.clj" :line 456 :anon-fn false}] + + ["foo.bar$biz_bat_QMARK___448$fn__456" "invoke" "bar.clj" 456 + {:clojure true :ns "foo.bar" :fn "biz-bat?" + :file "bar.clj" :line 456 :anon-fn true}] + + ["foo.bar$repl$fn__5629.invoke" "invoke" "bar.clj" 456 + {:clojure true :ns "foo.bar" :fn "repl" + :file "bar.clj" :line 456 :anon-fn true}] + + ["foo.bar$repl$read_eval_print__5624" "invoke" "bar.clj" 456 + {:clojure true :ns "foo.bar" :fn "repl" + :file "bar.clj" :line 456 :anon-fn true}] + + ["foo.bar$biz__123$fn__456" "invoke" "bar.clj" 789 + {:clojure true :ns "foo.bar" :fn "biz" + :file "bar.clj" :line 789 :anon-fn true}] + + ["foo.bar_bat$biz__123" "invoke" "bar.clj" 456 + {:clojure true :ns "foo.bar-bat" :fn "biz" + :file "bar.clj" :line 456 :anon-fn false}] + + ["user$eval__345" "invoke" nil -1 + {:clojure true :ns "user" :fn "eval" + :file nil :line nil :anon-fn false}] + + ["lamina.core.observable.ConstantObservable" "message" "observable.clj" 198 + {:clojure true :ns "lamina.core.observable" + :fn "lamina.core.observable.ConstantObservable" + :file "observable.clj" :line 198 :anon-fn false}] + + ["clojure.lang.Var" "invoke" "Var.java" 123 + {:java true :class "clojure.lang.Var" :method "invoke" + :file "Var.java" :line 123}] + + ["clojure.proxy.space.SomeClass" "someMethod" "SomeClass.java" 123 + {:java true :class "clojure.proxy.space.SomeClass" :method "someMethod" + :file "SomeClass.java" :line 123}] + + ["some.space.SomeClass" "someMethod" "SomeClass.java" 123 + {:java true :class "some.space.SomeClass" :method "someMethod" + :file "SomeClass.java" :line 123}] + + ["some.space.SomeClass$SomeInner" "someMethod" "SomeClass.java" 123 + {:java true :class "some.space.SomeClass$SomeInner" :method "someMethod" + :file "SomeClass.java" :line 123}] + + ["some.space.SomeClass" "someMethod" nil -1 + {:java true :class "some.space.SomeClass" :method "someMethod" + :file nil :line nil}]]) + +(deftest test-parse-trace-elem + (doseq [[class method file line parsed] cases + :let [elem (StackTraceElement. class method file line)]] + (is (= parsed (parse-trace-elem elem))))) + +(deftest test-trim-redundant + (let [trim-fn (resolve 'clj-stacktrace.core/trim-redundant)] + (is (= '(d c) (trim-fn '(d c b a) '(f e b a)))) + (is (= '(c) (trim-fn '(c b a) '(f e b a)))) + (is (= '(d c) (trim-fn '(d c b a) '(e b a)))))) + +(deftest test-parse-exception + (try + (eval '(/)) + (catch Exception e + (is (parse-exception e))))) diff --git a/test-resources/lib_tests/clj_stacktrace/repl_test.clj b/test-resources/lib_tests/clj_stacktrace/repl_test.clj new file mode 100644 index 00000000..83d6a46f --- /dev/null +++ b/test-resources/lib_tests/clj_stacktrace/repl_test.clj @@ -0,0 +1,31 @@ +(ns clj-stacktrace.repl-test + (:use clojure.test) + (:use clj-stacktrace.utils) + (:use clj-stacktrace.repl)) + +(defmacro with-cascading-exception + "Execute body in the context of a variable bound to an exception instance + that includes a caused-by cascade." + [binding-sym & body] + `(try (first (lazy-seq (cons (/) nil))) + (catch Exception e# + (let [~binding-sym e#] + ~@body)))) + +(deftest test-pst + (with-cascading-exception e + (is (with-out-str (pst e))) + (binding [*e e] + (is (with-out-str (pst)))))) + +(deftest test-pst-str + (with-cascading-exception e + (is (pst-str e)) + (binding [*e e] + (is (pst-str))))) + +(deftest test-pst+ + (with-cascading-exception e + (is (with-out-str (pst+ e))) + (binding [*e e] + (is (with-out-str (pst+)))))) diff --git a/test-resources/lib_tests/clj_yaml/core_test.clj b/test-resources/lib_tests/clj_yaml/core_test.clj index 0e75a4d6..cf705ece 100644 --- a/test-resources/lib_tests/clj_yaml/core_test.clj +++ b/test-resources/lib_tests/clj_yaml/core_test.clj @@ -1,8 +1,15 @@ (ns clj-yaml.core-test (:require [clojure.test :refer (deftest testing is)] [clojure.string :as string] - [clj-yaml.core :refer [parse-string unmark generate-string]]) - (:import [java.util Date])) + [clojure.java.io :as io] + [clj-yaml.core :refer [parse-string unmark generate-string + parse-stream generate-stream]]) + (:import [java.util Date] + (java.io ByteArrayOutputStream OutputStreamWriter ByteArrayInputStream) + java.nio.charset.StandardCharsets + (org.yaml.snakeyaml.error YAMLException) + ;; BB-TEST-PATCH: bb doesn't have these classes + #_(org.yaml.snakeyaml.constructor DuplicateKeyException))) (def nested-hash-yaml "root:\n childa: a\n childb: \n grandchild: \n greatgrandchild: bar\n") @@ -27,7 +34,7 @@ items: ") (def inline-list-yaml -"--- # Shopping list + "--- # Shopping list [milk, pumpkin pie, eggs, juice] ") @@ -160,8 +167,8 @@ the-bin: !!binary 0101") ;; This test ensures that generate-string uses the older behavior by default, for the sake ;; of stability, i.e. backwards compatibility. (is - (= "{description: Big-picture diagram showing how our top-level systems and stakeholders interact}\n" - (generate-string data)))))) + (= "{description: Big-picture diagram showing how our top-level systems and stakeholders interact}\n" + (generate-string data)))))) (deftest dump-opts (let [data [{:age 33 :name "jon"} {:age 44 :name "boo"}]] @@ -170,9 +177,7 @@ the-bin: !!binary 0101") (is (= "[{age: 33, name: jon}, {age: 44, name: boo}]\n" (generate-string data :dumper-options {:flow-style :flow}))))) -;; TODO: this test is failing in GraalVM -;; Could be related to https://github.com/oracle/graal/issues/2234 -#_(deftest parse-time +(deftest parse-time (testing "clj-time parses timestamps with more than millisecond precision correctly." (let [timestamp "2001-11-23 15:02:31.123456 -04:00" expected 1006542151123] @@ -182,7 +187,7 @@ the-bin: !!binary 0101") (let [parsed (parse-string hashes-lists-yaml) [first second] (:items parsed)] (is (= (keys first) '(:part_no :descrip :price :quantity))) - (is (= (keys second)'(:part_no :descrip :price :quantity :owners))))) + (is (= (keys second) '(:part_no :descrip :price :quantity :owners))))) (deftest nulls-are-fine @@ -201,3 +206,90 @@ the-bin: !!binary 0101") (testing "emoji in comments are OK too" (let [yaml "# 💣 emoji in a comment\n42"] (is (= 42 (parse-string yaml)))))) + +(def too-many-aliases + (->> (range 51) + (map #(str "b" % ": *a")) + (cons "a: &a [\"a\",\"a\"]") + (string/join "\n"))) + +(deftest max-aliases-for-collections-works + (is (thrown-with-msg? YAMLException #"Number of aliases" (parse-string too-many-aliases))) + (is (parse-string too-many-aliases :max-aliases-for-collections 51))) + +(def recursive-yaml " +--- +&A +- *A: *A +") + +(deftest allow-recursive-works + (is (thrown-with-msg? YAMLException #"Recursive" (parse-string recursive-yaml))) + (is (parse-string recursive-yaml :allow-recursive-keys true))) + +(def duplicate-keys-yaml " +a: 1 +a: 1 +") + +#_(deftest duplicate-keys-works + (is (parse-string duplicate-keys-yaml)) + (is (thrown-with-msg? DuplicateKeyException #"found duplicate key" (parse-string duplicate-keys-yaml :allow-duplicate-keys false)))) + +(def namespaced-keys-yaml " +foo/bar: 42 +") + +(deftest namespaced-keys-works + (testing "namespaced keys in yaml can round trip through parse and generate" + (is (= {:foo/bar 42} (-> namespaced-keys-yaml + parse-string + generate-string + parse-string))))) + +(defn to-bytes + "Converts a string to a byte array." + [data] + (.getBytes ^String data StandardCharsets/UTF_8)) + +(defn roundtrip + "Testing roundtrip of string and stream parser, and checking their equivalence." + [data-as-string] + (let [data (parse-string data-as-string) + data-stream (parse-stream (io/reader (ByteArrayInputStream. (to-bytes data-as-string)))) + output-stream (ByteArrayOutputStream.) + writer (OutputStreamWriter. output-stream) + _ (generate-stream writer data) + reader (ByteArrayInputStream. (.toByteArray output-stream))] + (= data ;; string -> edn + (parse-string (generate-string data)) ;; edn -> string -> edn + (parse-stream (io/reader reader)) ;; edn -> stream -> edn + ;; stream -> edn + data-stream))) + +(deftest roundtrip-test + (testing "Roundtrip test" + (is (roundtrip duplicate-keys-yaml)) + (is (roundtrip hashes-of-lists-yaml)) + (is (roundtrip inline-hash-yaml)) + (is (roundtrip inline-list-yaml)) + (is (roundtrip list-of-hashes-yaml)) + (is (roundtrip list-yaml)) + (is (roundtrip nested-hash-yaml)))) + +(def indented-yaml "todo: + - name: Fix issue + responsible: + name: Rita +") + +;; BB-TEST-PATCH - bb generates different indents +#_(deftest indentation-test + (testing "Can use indicator-indent and indent to achieve desired indentation" + (is (not= indented-yaml (generate-string (parse-string indented-yaml) + :dumper-options {:flow-style :block}))) + (is (= indented-yaml + (generate-string (parse-string indented-yaml) + :dumper-options {:indent 5 + :indicator-indent 2 + :flow-style :block}))))) diff --git a/test-resources/lib_tests/clojure/algo/test_monads.clj b/test-resources/lib_tests/clojure/algo/test_monads.clj new file mode 100644 index 00000000..61ea98ef --- /dev/null +++ b/test-resources/lib_tests/clojure/algo/test_monads.clj @@ -0,0 +1,229 @@ +;; Test routines for clojure.algo.monads + +;; Copyright (c) Konrad Hinsen, 2011. 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.algo.test-monads + (:use [clojure.test :only (deftest is are run-tests)] + [clojure.algo.monads + :only (with-monad domonad m-lift m-seq m-chain writer-m write + sequence-m maybe-m state-m maybe-t sequence-t + reader-m ask asks local)])) + + +(deftest domonad-if-then + (let [monad-value (domonad maybe-m + [ a 5 + :let [c 7] + :if (and (= a 5) (= c 7)) + :then [ + b 6 + ] + :else [ + b nil + ]] + [a b])] + (is (= monad-value [5 6])))) + +(deftest domonad-nested-if-then + (let [monad-value (domonad maybe-m + [ a 5 + :if (= a 5) + :then [ + b 6 + :if (= b 6) + :then [ + c 7 + ] + :else [ + c nil + ] + ] + :else [ + b nil + c nil + ]] + [a b c])] + (is (= monad-value [5 6 7])))) + +(deftest domonad-if-then-with-when + (let [monad-value (domonad maybe-m + [ a 5 + :when (= a 5) + :if (= a 1) + :then [ + b 6] + :else [ + b nil]] + [a b])] + (is (= monad-value nil)))) + +(deftest domonad-cond + (let [monad-value (domonad maybe-m + [ a 5 + :when (= a 5) + :cond + [(< a 1) + [result "less than one"] + (< a 3) + [result "less than three"] + (< a 6) + [result "less than six"] + :else + [result "arbitrary number"]] + b 7 + :let [some-val 12345]] + [result b some-val])] + (is (= monad-value ["less than six" 7 12345])))) + +(deftest sequence-monad + (with-monad sequence-m + (are [a b] (= a b) + (domonad [x (range 3) y (range 2)] (+ x y)) + '(0 1 1 2 2 3) + (domonad [x (range 5) y (range (+ 1 x)) :when (= (+ x y) 2)] (list x y)) + '((1 1) (2 0)) + ((m-lift 2 #(list %1 %2)) (range 3) (range 2)) + '((0 0) (0 1) (1 0) (1 1) (2 0) (2 1)) + (m-seq (repeat 3 (range 2))) + '((0 0 0) (0 0 1) (0 1 0) (0 1 1) (1 0 0) (1 0 1) (1 1 0) (1 1 1)) + ((m-chain (repeat 3 range)) 5) + '(0 0 0 1 0 0 1 0 1 2) + (m-plus (range 3) (range 2)) + '(0 1 2 0 1)))) + +(deftest maybe-monad + (with-monad maybe-m + (let [m+ (m-lift 2 +) + mdiv (fn [x y] (domonad [a x b y :when (not (zero? b))] (/ a b)))] + (are [a b] (= a b) + (m+ (m-result 1) (m-result 3)) + (m-result 4) + (mdiv (m-result 1) (m-result 3)) + (m-result (/ 1 3)) + (m+ 1 (mdiv (m-result 1) (m-result 0))) + m-zero + (m-plus m-zero (m-result 1) m-zero (m-result 2)) + (m-result 1))))) + +(deftest writer-monad + (is (= (domonad (writer-m "") + [x (m-result 1) + _ (write "first step\n") + y (m-result 2) + _ (write "second step\n")] + (+ x y)) + [3 "first step\nsecond step\n"])) + (is (= (domonad (writer-m []) + [_ (write :a) + a (m-result 1) + _ (write :b) + b (m-result 2)] + (+ a b)) + [3 [:a :b]])) + (is (= (domonad (writer-m ()) + [_ (write :a) + a (m-result 1) + _ (write :b) + b (m-result 2)] + (+ a b)) + [3 '(:a :b)])) + (is (= (domonad (writer-m (list)) + [_ (write :a) + a (m-result 1) + _ (write :b) + b (m-result 2)] + (+ a b)) + [3 (list :a :b)])) + (is (= (domonad (writer-m #{}) + [_ (write :a) + a (m-result 1) + _ (write :a) + b (m-result 2)] + (+ a b)) + [3 #{:a}])) + (is (= (domonad (writer-m ()) + [_ (domonad + [_ (write "foo")] + nil) + _ (write "bar")] + 1) + [1 '("foo" "bar")]))) + +(deftest reader-monad + (let [monad-value (domonad reader-m + [x (asks :number)] + (* x 2))] + (is (= (monad-value {:number 3}) + 6))) + + (let [monad-value (domonad reader-m + [env (ask)] + env)] + (is (= (monad-value "env") + "env"))) + + (let [monad-value (domonad reader-m + [numbers (ask) + sum (m-result (reduce + numbers)) + mean (m-result (/ sum (count numbers)))] + mean)] + (is (= (monad-value (range 1 10)) + 5))) + + (let [monad-value (domonad reader-m + [a (ask) + b (local inc (ask))] + (* a b))] + (is (= (monad-value 10) + 110))) + + + (let [mult-a-b (fn [] + (domonad reader-m + [a (asks :a) + b (asks :b)] + (* a b))) + monad-value (domonad reader-m + [a (asks :a) + b (asks :b) + a* (local #(update-in % [:a] inc) (asks :a)) + c (local #(assoc % :b 5) (mult-a-b))] + [a b a* c])] + (= (monad-value {:a 10}) + [10 nil 11 50]))) + +(deftest seq-maybe-monad + (with-monad (maybe-t sequence-m) + (letfn [(pairs [xs] ((m-lift 2 #(list %1 %2)) xs xs))] + (are [a b] (= a b) + ((m-lift 1 inc) (for [n (range 10)] (when (odd? n) n))) + '(nil 2 nil 4 nil 6 nil 8 nil 10) + (pairs (for [n (range 5)] (when (odd? n) n))) + '(nil nil (1 1) nil (1 3) nil nil nil (3 1) nil (3 3) nil nil))))) + +(deftest state-maybe-monad + (with-monad (maybe-t state-m) + (is (= (for [[a b c d] (list [1 2 3 4] [nil 2 3 4] [ 1 nil 3 4] + [nil nil 3 4] [1 2 nil nil])] + (let [f (domonad + [x (m-plus (m-result a) (m-result b)) + y (m-plus (m-result c) (m-result d))] + (+ x y))] + (f :state))) + (list [4 :state] [5 :state] [4 :state] [nil :state] [nil :state]))))) + +(deftest state-seq-monad + (with-monad (sequence-t state-m) + (is (= (let [[a b c d] [1 2 10 20] + f (domonad + [x (m-plus (m-result a) (m-result b)) + y (m-plus (m-result c) (m-result d))] + (+ x y))] + (f :state))) + (list [(list 11 21 12 22) :state])))) diff --git a/test-resources/lib_tests/clojure/data/generators_test.clj b/test-resources/lib_tests/clojure/data/generators_test.clj index 8fa89e88..00628d83 100644 --- a/test-resources/lib_tests/clojure/data/generators_test.clj +++ b/test-resources/lib_tests/clojure/data/generators_test.clj @@ -32,4 +32,4 @@ (gen/reservoir-sample 10 coll)) sample-2 (binding [gen/*rnd* (java.util.Random. n)] (gen/reservoir-sample 10 coll))] - (is (= sample-1 sample-2))))) \ No newline at end of file + (is (= sample-1 sample-2))))) diff --git a/test-resources/lib_tests/clojure/data/json_test.clj b/test-resources/lib_tests/clojure/data/json_test.clj index f07f5105..0bed8eb4 100644 --- a/test-resources/lib_tests/clojure/data/json_test.clj +++ b/test-resources/lib_tests/clojure/data/json_test.clj @@ -414,7 +414,8 @@ (is (= x (json/read-str (with-out-str (json/pprint x))))))) (deftest pretty-print-nonescaped-unicode - (is (= "\"\u1234\u4567\"\n" + ;; BB-TEST-PATCH: Windows compatability + (is (= (str "\"\u1234\u4567\"" (System/lineSeparator)) (with-out-str (json/pprint "\u1234\u4567" :escape-unicode false))))) diff --git a/test-resources/lib_tests/clojure/data/zip_test.clj b/test-resources/lib_tests/clojure/data/zip_test.clj new file mode 100644 index 00000000..7b494678 --- /dev/null +++ b/test-resources/lib_tests/clojure/data/zip_test.clj @@ -0,0 +1,17 @@ +(ns clojure.data.zip-test + (:require [clojure.test :as t :refer [deftest is]] + [clojure.data.xml :as xml] + [clojure.zip :as zip] + [clojure.data.zip.xml :refer [attr attr= xml1->]])) + +(def data (str "" + " " + " " + "")) + +(deftest xml1-test + (let [xml (zip/xml-zip (xml/parse (java.io.StringReader. data)))] + (is (= "person" + (xml1-> xml :character [(attr= :name "alice")] (attr :type)))) + (is (= "march hare" + (xml1-> xml :character [(attr= :type "animal")] (attr :name)))))) diff --git a/test-resources/lib_tests/clojure/term/colors_test.clj b/test-resources/lib_tests/clojure/term/colors_test.clj new file mode 100644 index 00000000..863f3f15 --- /dev/null +++ b/test-resources/lib_tests/clojure/term/colors_test.clj @@ -0,0 +1,29 @@ +(ns clojure.term.colors-test + (:require [clojure.test :refer :all] + [clojure.term.colors :refer :all])) + +(defn get-fn + "get function from symbol in clojure.term.colors package" + [fname] + (ns-resolve (the-ns 'clojure.term.colors) + (-> fname name symbol))) + +(defn test-colors-from-map + "test print colors from a color map" + [colormap & more] + (eval + `(do ~@(map (fn [[color _]] + `(println ((get-fn ~color) + (name ~color) (str ~@more)))) + colormap)))) + +(deftest color-test + (testing "Testing colors." + (test-colors-from-map *colors* " foreground.") + (test-colors-from-map *highlights* " background.") + (test-colors-from-map *attributes* " attributes.")) + + (testing "Testing disable colors." + (binding [*disable-colors* true] + (println \newline "When disabled-colors is set ...") + (test-colors-from-map *colors* " foreground.")))) diff --git a/test-resources/lib_tests/clojure/test_clojure/instr.clj b/test-resources/lib_tests/clojure/test_clojure/instr.clj index e6b1e238..670a1e3c 100644 --- a/test-resources/lib_tests/clojure/test_clojure/instr.clj +++ b/test-resources/lib_tests/clojure/test_clojure/instr.clj @@ -95,6 +95,7 @@ (is (thrown-with-msg? clojure.lang.ExceptionInfo #"did not conform to spec" (no-kwargs-fn 1 :not-num))) (is (thrown-with-msg? clojure.lang.ExceptionInfo #"did not conform to spec" (no-kwargs-fn 1 2 :not-num 3))) + ;; BB-TEST-PATCH: bb gets sci internals instead #_(testing "that the ex-info data looks correct" (try (fail-no-kwargs 1 :not-num) (catch Exception ei @@ -151,14 +152,15 @@ (is (thrown-with-msg? clojure.lang.ExceptionInfo #"did not conform to spec" (kwargs-fn 1 :not-num))) (is (thrown-with-msg? clojure.lang.ExceptionInfo #"did not conform to spec" (kwargs-fn 1 2 :a 1 {:b :not-num}))) + ;; BB-TEST-PATCH: bb gets sci internals instead #_(testing "that the ex-info data looks correct" - (try (fail-kwargs 1 :not-num) - (catch Exception ei - (is (= 'clojure.test-clojure.instr/fail-kwargs (-> ei ex-data :clojure.spec.test.alpha/caller :var-scope))))) + (try (fail-kwargs 1 :not-num) + (catch Exception ei + (is (= 'clojure.test-clojure.instr/fail-kwargs (-> ei ex-data :clojure.spec.test.alpha/caller :var-scope))))) - (try (fail-kwargs 1 2 :a 1 {:b :not-num}) - (catch Exception ei - (is (= 'clojure.test-clojure.instr/fail-kwargs (-> ei ex-data :clojure.spec.test.alpha/caller :var-scope))))))) + (try (fail-kwargs 1 2 :a 1 {:b :not-num}) + (catch Exception ei + (is (= 'clojure.test-clojure.instr/fail-kwargs (-> ei ex-data :clojure.spec.test.alpha/caller :var-scope))))))) (testing "that the uninstrumented kwargs function operates as the raw function" (stest/unstrument `kwargs-fn) diff --git a/test-resources/lib_tests/clojure/test_clojure/spec.clj b/test-resources/lib_tests/clojure/test_clojure/spec.clj index 290ad43d..8c6fb7e6 100644 --- a/test-resources/lib_tests/clojure/test_clojure/spec.clj +++ b/test-resources/lib_tests/clojure/test_clojure/spec.clj @@ -1,11 +1,3 @@ -; 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.spec (:require [clojure.spec.alpha :as s] [clojure.spec.gen.alpha :as gen] @@ -167,6 +159,7 @@ (is (= (s/describe odd?) 'odd?)) (is (= (s/form odd?) 'clojure.core/odd?)) + ;; BB-TEST-PATCH: Returns sci internal #_(is (= (s/describe #(odd? %)) ::s/unknown)) #_(is (= (s/form #(odd? %)) ::s/unknown))) diff --git a/test-resources/lib_tests/clojure/tools/namespace/dependency_test.clj b/test-resources/lib_tests/clojure/tools/namespace/dependency_test.clj new file mode 100644 index 00000000..5aedb27f --- /dev/null +++ b/test-resources/lib_tests/clojure/tools/namespace/dependency_test.clj @@ -0,0 +1,315 @@ +(ns clojure.tools.namespace.dependency-test + (:use clojure.test + clojure.tools.namespace.dependency)) + +;; building a graph like: +;; +;; :a +;; / | +;; :b | +;; \ | +;; :c +;; | +;; :d +;; +(def g1 (-> (graph) + (depend :b :a) ; "B depends on A" + (depend :c :b) ; "C depends on B" + (depend :c :a) ; "C depends on A" + (depend :d :c))) ; "D depends on C" + +;; 'one 'five +;; | | +;; 'two | +;; / \ | +;; / \ | +;; / \ / +;; 'three 'four +;; | / +;; 'six / +;; | / +;; | / +;; | / +;; 'seven +;; +(def g2 (-> (graph) + (depend 'two 'one) + (depend 'three 'two) + (depend 'four 'two) + (depend 'four 'five) + (depend 'six 'three) + (depend 'seven 'six) + (depend 'seven 'four))) + +;; :level0 +;; / | | \ +;; ----- | | ----- +;; / | | \ +;; :level1a :level1b :level1c :level1d +;; \ | | / +;; ----- | | ----- +;; \ | | / +;; :level2 +;; / | | \ +;; ----- | | ----- +;; / | | \ +;; :level3a :level3b :level3c :level3d +;; \ | | / +;; ----- | | ----- +;; \ | | / +;; :level4 +;; +;; ... and so on in a repeating pattern like that, up to :level26 + +(def g3 (-> (graph) + (depend :level1a :level0) + (depend :level1b :level0) + (depend :level1c :level0) + (depend :level1d :level0) + (depend :level2 :level1a) + (depend :level2 :level1b) + (depend :level2 :level1c) + (depend :level2 :level1d) + + (depend :level3a :level2) + (depend :level3b :level2) + (depend :level3c :level2) + (depend :level3d :level2) + (depend :level4 :level3a) + (depend :level4 :level3b) + (depend :level4 :level3c) + (depend :level4 :level3d) + + (depend :level5a :level4) + (depend :level5b :level4) + (depend :level5c :level4) + (depend :level5d :level4) + (depend :level6 :level5a) + (depend :level6 :level5b) + (depend :level6 :level5c) + (depend :level6 :level5d) + + (depend :level7a :level6) + (depend :level7b :level6) + (depend :level7c :level6) + (depend :level7d :level6) + (depend :level8 :level7a) + (depend :level8 :level7b) + (depend :level8 :level7c) + (depend :level8 :level7d) + + (depend :level9a :level8) + (depend :level9b :level8) + (depend :level9c :level8) + (depend :level9d :level8) + (depend :level10 :level9a) + (depend :level10 :level9b) + (depend :level10 :level9c) + (depend :level10 :level9d) + + (depend :level11a :level10) + (depend :level11b :level10) + (depend :level11c :level10) + (depend :level11d :level10) + (depend :level12 :level11a) + (depend :level12 :level11b) + (depend :level12 :level11c) + (depend :level12 :level11d) + + (depend :level13a :level12) + (depend :level13b :level12) + (depend :level13c :level12) + (depend :level13d :level12) + (depend :level14 :level13a) + (depend :level14 :level13b) + (depend :level14 :level13c) + (depend :level14 :level13d) + + (depend :level15a :level14) + (depend :level15b :level14) + (depend :level15c :level14) + (depend :level15d :level14) + (depend :level16 :level15a) + (depend :level16 :level15b) + (depend :level16 :level15c) + (depend :level16 :level15d) + + (depend :level17a :level16) + (depend :level17b :level16) + (depend :level17c :level16) + (depend :level17d :level16) + (depend :level18 :level17a) + (depend :level18 :level17b) + (depend :level18 :level17c) + (depend :level18 :level17d) + + (depend :level19a :level18) + (depend :level19b :level18) + (depend :level19c :level18) + (depend :level19d :level18) + (depend :level20 :level19a) + (depend :level20 :level19b) + (depend :level20 :level19c) + (depend :level20 :level19d) + + (depend :level21a :level20) + (depend :level21b :level20) + (depend :level21c :level20) + (depend :level21d :level20) + (depend :level22 :level21a) + (depend :level22 :level21b) + (depend :level22 :level21c) + (depend :level22 :level21d) + + (depend :level23a :level22) + (depend :level23b :level22) + (depend :level23c :level22) + (depend :level23d :level22) + (depend :level24 :level23a) + (depend :level24 :level23b) + (depend :level24 :level23c) + (depend :level24 :level23d) + + (depend :level25a :level24) + (depend :level25b :level24) + (depend :level25c :level24) + (depend :level25d :level24) + (depend :level26 :level25a) + (depend :level26 :level25b) + (depend :level26 :level25c) + (depend :level26 :level25d))) + +(deftest t-transitive-dependencies + (is (= #{:a :c :b} + (transitive-dependencies g1 :d))) + (is (= '#{two four six one five three} + (transitive-dependencies g2 'seven)))) + +(deftest t-transitive-dependencies-deep + (is (= #{:level0 + :level1a :level1b :level1c :level1d + :level2 + :level3a :level3b :level3c :level3d + :level4 + :level5a :level5b :level5c :level5d + :level6 + :level7a :level7b :level7c :level7d + :level8 + :level9a :level9b :level9c :level9d + :level10 + :level11a :level11b :level11c :level11d + :level12 + :level13a :level13b :level13c :level13d + :level14 + :level15a :level15b :level15c :level15d + :level16 + :level17a :level17b :level17c :level17d + :level18 + :level19a :level19b :level19c :level19d + :level20 + :level21a :level21b :level21c :level21d + :level22 + :level23a :level23b :level23c :level23d} + (transitive-dependencies g3 :level24))) + (is (= #{:level0 + :level1a :level1b :level1c :level1d + :level2 + :level3a :level3b :level3c :level3d + :level4 + :level5a :level5b :level5c :level5d + :level6 + :level7a :level7b :level7c :level7d + :level8 + :level9a :level9b :level9c :level9d + :level10 + :level11a :level11b :level11c :level11d + :level12 + :level13a :level13b :level13c :level13d + :level14 + :level15a :level15b :level15c :level15d + :level16 + :level17a :level17b :level17c :level17d + :level18 + :level19a :level19b :level19c :level19d + :level20 + :level21a :level21b :level21c :level21d + :level22 + :level23a :level23b :level23c :level23d + :level24 + :level25a :level25b :level25c :level25d} + (transitive-dependencies g3 :level26)))) + + +(deftest t-transitive-dependents + (is (= '#{four seven} + (transitive-dependents g2 'five))) + (is (= '#{four seven six three} + (transitive-dependents g2 'two)))) + +(defn- before? + "True if x comes before y in an ordered collection." + [coll x y] + (loop [[item & more] (seq coll)] + (cond (nil? item) true ; end of the seq + (= x item) true ; x comes first + (= y item) false + :else (recur more)))) + +(deftest t-before + (is (true? (before? [:a :b :c :d] :a :b))) + (is (true? (before? [:a :b :c :d] :b :c))) + (is (false? (before? [:a :b :c :d] :d :c))) + (is (false? (before? [:a :b :c :d] :c :a)))) + +(deftest t-topo-comparator-1 + (let [sorted (sort (topo-comparator g1) [:d :a :b :foo])] + (are [x y] (before? sorted x y) + :a :b + :a :d + :a :foo + :b :d + :b :foo + :d :foo))) + +(deftest t-topo-comparator-2 + (let [sorted (sort (topo-comparator g2) '[three seven nine eight five])] + (are [x y] (before? sorted x y) + 'three 'seven + 'three 'eight + 'three 'nine + 'five 'eight + 'five 'nine + 'seven 'eight + 'seven 'nine))) + +(deftest t-topo-sort + (let [sorted (topo-sort g2)] + (are [x y] (before? sorted x y) + 'one 'two + 'one 'three + 'one 'four + 'one 'six + 'one 'seven + 'two 'three + 'two 'four + 'two 'six + 'two 'seven + 'three 'six + 'three 'seven + 'four 'seven + 'five 'four + 'five 'seven + 'six 'seven))) + +(deftest t-no-cycles + (is (thrown? Exception + (-> (graph) + (depend :a :b) + (depend :b :c) + (depend :c :a))))) + +(deftest t-no-self-cycles + (is (thrown? Exception + (-> (graph) + (depend :a :b) + (depend :a :a))))) diff --git a/test-resources/lib_tests/clojure/tools/namespace/dir_test.clj b/test-resources/lib_tests/clojure/tools/namespace/dir_test.clj new file mode 100644 index 00000000..60e56427 --- /dev/null +++ b/test-resources/lib_tests/clojure/tools/namespace/dir_test.clj @@ -0,0 +1,20 @@ +(ns clojure.tools.namespace.dir-test + (:require [clojure.test :refer [deftest is]] + [clojure.tools.namespace.test-helpers :as help] + [clojure.tools.namespace.dir :as dir]) + (:import + (java.io File))) + +;; Only run this test on Java 1.7+, where java.nio.file.Files is available. +(when (try (Class/forName "java.nio.file.Files") + (catch ClassNotFoundException _ false)) + (deftest t-scan-by-canonical-path + (let [dir (help/create-temp-dir "t-scan-by-canonical-path") + main-clj (help/create-source dir 'example.main :clj '[example.one]) + one-cljc (help/create-source dir 'example.one :clj) + other-dir (help/create-temp-dir "t-scan-by-canonical-path-other") + link (File. other-dir "link")] + (java.nio.file.Files/createSymbolicLink (.toPath link) (.toPath dir) + (make-array java.nio.file.attribute.FileAttribute 0)) + (is (= (::dir/files (dir/scan-dirs {} [dir])) + (::dir/files (dir/scan-dirs {} [link]))))))) diff --git a/test-resources/lib_tests/clojure/tools/namespace/find_test.clj b/test-resources/lib_tests/clojure/tools/namespace/find_test.clj new file mode 100644 index 00000000..d081e84a --- /dev/null +++ b/test-resources/lib_tests/clojure/tools/namespace/find_test.clj @@ -0,0 +1,29 @@ +(ns clojure.tools.namespace.find-test + (:require [clojure.test :refer [deftest is]] + [clojure.tools.namespace.test-helpers :as help] + [clojure.tools.namespace.find :as find]) + (:import (java.io File))) + +(deftest t-find-clj-and-cljc-files + "main.clj depends on one.cljc which depends on two.clj. + two.cljs also exists but should not be returned" + (let [dir (help/create-temp-dir "t-find-clj-and-cljc-files") + main-clj (help/create-source dir 'example.main :clj '[example.one]) + one-cljc (help/create-source dir 'example.one :cljc '[example.two]) + two-clj (help/create-source dir 'example.two :clj) + two-cljs (help/create-source dir 'example.two :cljs)] + (is (help/same-files? + [main-clj one-cljc two-clj] + (find/find-sources-in-dir dir))))) + +(deftest t-find-cljs-and-cljc-files + "main.cljs depends on one.cljc which depends on two.cljs. + two.clj also exists but should not be returned" + (let [dir (help/create-temp-dir "t-find-cljs-and-cljc-files") + main-cljs (help/create-source dir 'example.main :cljs '[example.one]) + one-cljc (help/create-source dir 'example.one :cljc '[example.two]) + two-clj (help/create-source dir 'example.two :clj) + two-cljs (help/create-source dir 'example.two :cljs)] + (is (help/same-files? + [main-cljs one-cljc two-cljs] + (find/find-sources-in-dir dir find/cljs))))) diff --git a/test-resources/lib_tests/clojure/tools/namespace/move_test.clj b/test-resources/lib_tests/clojure/tools/namespace/move_test.clj new file mode 100644 index 00000000..47de7ac4 --- /dev/null +++ b/test-resources/lib_tests/clojure/tools/namespace/move_test.clj @@ -0,0 +1,52 @@ +(ns clojure.tools.namespace.move-test + (:require [clojure.java.io :as io] + [clojure.test :refer [deftest is]] + [clojure.tools.namespace.move :refer [move-ns]] + [clojure.tools.namespace.test-helpers :as help]) + (:import (java.io File))) + +(defn- create-file-one [dir] + (help/create-source dir 'example.one :clj + '[example.two example.three] + '[(defn foo [] + (example.a.four/foo))])) + +(defn- create-file-two [dir] + (help/create-source dir 'example.two :clj + '[example.three example.a.four])) + +(defn- create-file-three [dir] + (help/create-source dir 'example.three :clj + '[example.five])) + +(defn- create-file-four [dir] + (help/create-source dir 'example.a.four :clj)) + +(deftest t-move-ns + (let [temp-dir (help/create-temp-dir "tools-namespace-t-move-ns") + src-dir (io/file temp-dir "src") + example-dir (io/file temp-dir "src" "example") + file-one (create-file-one src-dir) + file-two (create-file-two src-dir) + file-three (create-file-three src-dir) + old-file-four (create-file-four src-dir) + new-file-four (io/file example-dir "b" "four.clj")] + + (let [file-three-last-modified (.lastModified file-three)] + + (Thread/sleep 1500) ;; ensure file timestamps are different + + (move-ns 'example.a.four 'example.b.four src-dir [src-dir]) + + (is (.exists new-file-four) + "new file should exist") + (is (not (.exists old-file-four)) + "old file should not exist") + (is (not (.exists (.getParentFile old-file-four))) + "old empty directory should not exist") + (is (= file-three-last-modified (.lastModified file-three)) + "unaffected file should not have been modified") + (is (not-any? #(.contains (slurp %) "example.a.four") + [file-one file-two file-three new-file-four])) + (is (every? #(.contains (slurp %) "example.b.four") + [file-one file-two new-file-four]))))) diff --git a/test-resources/lib_tests/clojure/tools/namespace/parse_test.clj b/test-resources/lib_tests/clojure/tools/namespace/parse_test.clj new file mode 100644 index 00000000..b6ac6aaa --- /dev/null +++ b/test-resources/lib_tests/clojure/tools/namespace/parse_test.clj @@ -0,0 +1,210 @@ +(ns clojure.tools.namespace.parse-test + (:use [clojure.test :only (deftest is)] + [clojure.tools.namespace.parse :only (deps-from-ns-decl + read-ns-decl)])) + +(def ns-decl-prefix-list + '(ns com.example.one + (:require (com.example two + [three :as three] + [four :refer (a b)]) + (com.example.sub [five :as five] + six)) + (:use (com.example seven + [eight :as eight] + (nine :only (c d)) + [ten])))) + +;; Some people like to write prefix lists as vectors, not lists. The +;; use/require functions accept this form. +(def ns-decl-prefix-list-as-vector + '(ns com.example.one + (:require [com.example + two + [three :as three] + [four :refer (a b)]] + [com.example.sub + [five :as five] + six]) + (:use [com.example + seven + [eight :as eight] + (nine :only (c d)) + [ten]]))) + +(def ns-decl-prefix-list-clauses-as-vectors + "Sometimes people even write the clauses inside ns as vectors, which + clojure.core/ns allows. See TNS-21." + '(ns com.example.one + [:require [com.example + two + [three :as three] + [four :refer (a b)]] + [com.example.sub + [five :as five] + six]] + [:use [com.example + seven + [eight :as eight] + (nine :only (c d)) + [ten]]])) + +(def deps-from-prefix-list + '#{com.example.two + com.example.three + com.example.four + com.example.sub.five + com.example.sub.six + com.example.seven + com.example.eight + com.example.nine + com.example.ten}) + +(deftest t-prefix-list + (is (= deps-from-prefix-list + (deps-from-ns-decl ns-decl-prefix-list)))) + +(deftest t-prefix-list-as-vector + (is (= deps-from-prefix-list + (deps-from-ns-decl ns-decl-prefix-list-as-vector)))) + +(deftest t-prefix-list-clauses-as-vectors + (is (= deps-from-prefix-list + (deps-from-ns-decl ns-decl-prefix-list-clauses-as-vectors)))) + +(deftest t-no-deps-returns-empty-set + (is (= #{} (deps-from-ns-decl '(ns com.example.one))))) + +(def multiple-ns-decls + '((ns one) + (ns two (:require one)) + (ns three (:require [one :as o] [two :as t])))) + +(def multiple-ns-decls-string +" (println \"Code before first ns\") + (ns one) + (println \"Some code\") + (defn hello-world [] \"Hello, World!\") + (ns two (:require one)) + (println \"Some more code\") + (ns three (:require [one :as o] [two :as t]))") + +(deftest t-read-multiple-ns-decls + (with-open [rdr (clojure.lang.LineNumberingPushbackReader. + (java.io.PushbackReader. + (java.io.StringReader. multiple-ns-decls-string)))] + (is (= multiple-ns-decls + (take-while identity (repeatedly #(read-ns-decl rdr))))))) + +(def ns-docstring-example + "The example ns declaration used in the docstring of clojure.core/ns" + '(ns foo.bar + (:refer-clojure :exclude [ancestors printf]) + (:require (clojure.contrib sql combinatorics)) + (:use (my.lib this that)) + (:import (java.util Date Timer Random) + (java.sql Connection Statement)))) + +(def deps-from-ns-docstring-example + '#{clojure.contrib.sql + clojure.contrib.combinatorics + my.lib.this + my.lib.that}) + +(deftest t-ns-docstring-example + (is (= deps-from-ns-docstring-example + (deps-from-ns-decl ns-docstring-example)))) + +(def require-docstring-example + "The example ns declaration used in the docstring of + clojure.core/require" + '(ns (:require (clojure zip [set :as s])))) + +(def deps-from-require-docstring-example + '#{clojure.zip + clojure.set}) + +(deftest t-require-docstring-example + (is (= deps-from-require-docstring-example + (deps-from-ns-decl require-docstring-example)))) + +(def multiple-clauses + "Example showing more than one :require or :use clause in one ns + declaration, which clojure.core/ns allows." + '(ns foo.bar + (:require com.example.one) + (:import java.io.File) + (:require (com.example two three)) + (:use (com.example [four :only [x]])) + (:use (com.example (five :only [x]))))) + +(def deps-from-multiple-clauses + '#{com.example.one + com.example.two + com.example.three + com.example.four + com.example.five}) + +(deftest t-deps-from-multiple-clauses + (is (= deps-from-multiple-clauses + (deps-from-ns-decl multiple-clauses)))) + +(def clauses-without-keywords + "Example of require/use clauses with symbols instead of keywords, + which clojure.core/ns allows." + '(ns foo.bar + (require com.example.one) + (import java.io.File) + (use (com.example (prefixes (two :only [x]) + three))))) + +(def deps-from-clauses-without-keywords + '#{com.example.one + com.example.prefixes.two + com.example.prefixes.three}) + +(deftest t-clauses-without-keywords + (is (= deps-from-clauses-without-keywords + (deps-from-ns-decl clauses-without-keywords)))) + +(def reader-conditionals-string + "(ns com.examples.one + (:require #?(:clj clojure.string + :cljs goog.string)))") + +(deftest t-reader-conditionals + ;; TODO: the predicate wasn't added to bb yet, will come in version after 0.6.7 + (when true #_(resolve 'clojure.core/reader-conditional?) + (let [actual (-> reader-conditionals-string + java.io.StringReader. + java.io.PushbackReader. + clojure.lang.LineNumberingPushbackReader. + read-ns-decl + deps-from-ns-decl)] + (is (= #{'clojure.string} actual))))) + +(def ns-with-npm-dependency + "(ns com.examples.one + (:require [\"foobar\"] [baz]))") + +(deftest npm-dependency + (let [actual (-> ns-with-npm-dependency + java.io.StringReader. + java.io.PushbackReader. + clojure.lang.LineNumberingPushbackReader. + read-ns-decl + deps-from-ns-decl)] + (is (= #{'baz} actual)))) + +(def ns-with-require-macros + "(ns com.examples.one + (:require-macros [foo :refer [bar]]))") + +(deftest require-macros + (let [actual (-> ns-with-require-macros + java.io.StringReader. + java.io.PushbackReader. + clojure.lang.LineNumberingPushbackReader. + read-ns-decl + deps-from-ns-decl)] + (is (= #{'foo} actual)))) diff --git a/test-resources/lib_tests/clojure/tools/namespace/test_helpers.clj b/test-resources/lib_tests/clojure/tools/namespace/test_helpers.clj new file mode 100644 index 00000000..62679e69 --- /dev/null +++ b/test-resources/lib_tests/clojure/tools/namespace/test_helpers.clj @@ -0,0 +1,82 @@ +(ns clojure.tools.namespace.test-helpers + "Utilities to help with testing files and namespaces." + (:require [clojure.java.io :as io] + [clojure.string :as string]) + (:import (java.io Closeable File Writer PrintWriter))) + +(defn create-temp-dir + "Creates and returns a new temporary directory java.io.File." + [name] + (let [temp-file (File/createTempFile name nil)] + (.delete temp-file) + (.mkdirs temp-file) + (println "Temporary directory" (.getAbsolutePath temp-file)) + temp-file)) + +(defn- write-contents + "Writes contents into writer. Strings are written as-is via println, + other types written as by prn." + [^Writer writer contents] + {:pre [(sequential? contents)]} + (binding [*out* (PrintWriter. writer)] + (doseq [content contents] + (if (string? content) + (println content) + (prn content)) + (newline)))) + +(defn create-file + "Creates a file from a vector of path elements. Writes contents into + the file. Elements of contents may be data, written via prn, or + strings, written directly." + [path contents] + {:pre [(vector? path)]} + (let [^File file (apply io/file path)] + (when-let [parent (.getParentFile file)] + (.mkdirs parent)) + (with-open [wtr (io/writer file)] + (write-contents wtr contents)) + file)) + +(defn- sym->path + "Converts a symbol name into a vector of path parts, not including + file extension." + [symbol] + {:pre [(symbol? symbol)] + :post [(vector? %)]} + (-> (name symbol) + (string/replace \- \_) + (string/split #"\."))) + +(defn- source-path + "Returns a vector of path components for namespace named sym, + with given file extension (keyword)." + [sym extension] + (let [path (sym->path sym) + basename (peek path) + filename (str basename \. (name extension))] + (conj (pop path) filename))) + +(defn create-source + "Creates a file at the correct path under base-dir for a namespace + named sym, with file extension (keyword), containing a ns + declaration which :require's the dependencies (symbols). Optional + contents written after the ns declaration as by write-contents." + ([base-dir sym extension] + (create-source base-dir sym extension nil nil)) + ([base-dir sym extension dependencies] + (create-source base-dir sym extension dependencies nil)) + ([base-dir sym extension dependencies contents] + (let [full-path (into [base-dir] (source-path sym extension)) + ns-decl (if (seq dependencies) + (list 'ns sym (list* :require dependencies)) + (list 'ns sym))] + (create-file full-path (into [ns-decl] contents))))) + +(defn same-files? + "True if files-a and files-b contain the same canonical File's, + regardless of order." + [files-a files-b] + (= (sort (map #(.getCanonicalPath ^File %) files-a)) + (sort (map #(.getCanonicalPath ^File %) files-b)))) + diff --git a/test-resources/lib_tests/cognitect/test_runner/sample_property_test.clj b/test-resources/lib_tests/cognitect/test_runner/sample_property_test.clj new file mode 100644 index 00000000..1792beae --- /dev/null +++ b/test-resources/lib_tests/cognitect/test_runner/sample_property_test.clj @@ -0,0 +1,10 @@ +(ns cognitect.test-runner.sample-property-test + (:require [clojure.test.check :as tc] + [clojure.test.check.generators :as gen] + [clojure.test.check.properties :as prop] + [clojure.test.check.clojure-test :refer [defspec]])) + +(defspec first-element-is-min-after-sorting 100 + (prop/for-all [v (gen/not-empty (gen/vector gen/int))] + (= (apply min v) + (first (sort v))))) diff --git a/test-resources/lib_tests/cognitect/test_runner/samples_test.clj b/test-resources/lib_tests/cognitect/test_runner/samples_test.clj new file mode 100644 index 00000000..e4ec385c --- /dev/null +++ b/test-resources/lib_tests/cognitect/test_runner/samples_test.clj @@ -0,0 +1,14 @@ +(ns cognitect.test-runner.samples-test + (:require [clojure.test :as t :refer [deftest is testing]])) + +(deftest math-works + (testing "basic addition and subtraction" + (is (= 42 (+ 40 2))) + (is (= 42 (- 44 2))))) + +(deftest ^:integration test-i + (is (= 1 1))) + + + + diff --git a/test-resources/lib_tests/cognitect/test_runner_test.clj b/test-resources/lib_tests/cognitect/test_runner_test.clj new file mode 100644 index 00000000..e1ea8deb --- /dev/null +++ b/test-resources/lib_tests/cognitect/test_runner_test.clj @@ -0,0 +1,23 @@ +(ns cognitect.test-runner-test + (:require + [clojure.test :refer :all] + [cognitect.test-runner :as tr])) + +(deftest ns-filters + (are [ns-names ns-regexes available selected] + (= selected (filter (#'tr/ns-filter {:namespace ns-names :namespace-regex ns-regexes}) available)) + + ;; default settings (no -n / -r, use default for -r) + nil nil nil [] + nil nil '[ns1-test ns2-test] '[ns1-test ns2-test] + nil nil '[ns1-test ns2-test ns3 ns4 ns5] '[ns1-test ns2-test] + + ;; specific namespaces + '#{ns3} nil '[ns1-test ns2-test] '[] + '#{ns3 ns4} nil '[ns1-test ns2-test ns3 ns4 ns5] '[ns3 ns4] + + ;; regexes + nil #{#"ns1.*" #"ns3"} '[ns1-test ns2-test ns3 ns4] '[ns1-test ns3] + + ;; both + '#{ns3} '#{#"ns1.*"} '[ns1-test ns2-test ns3 ns4] '[ns1-test ns3])) \ No newline at end of file diff --git a/test-resources/lib_tests/com/stuartsierra/component_test.clj b/test-resources/lib_tests/com/stuartsierra/component_test.clj new file mode 100644 index 00000000..00602462 --- /dev/null +++ b/test-resources/lib_tests/com/stuartsierra/component_test.clj @@ -0,0 +1,307 @@ +(ns com.stuartsierra.component-test + (:require [clojure.test :refer (deftest is are)] + [clojure.set :refer (map-invert)] + [com.stuartsierra.component :as component])) + +(def ^:dynamic *log* nil) + +(defn- log [& args] + (when (thread-bound? #'*log*) + (set! *log* (conj *log* args)))) + +(defn- ordering + "Given an ordered collection of messages, returns a map from the + head of each message to its index position in the collection." + [log] + (into {} (map-indexed (fn [i [message & _]] [message i]) log))) + +(defn before? + "In the collection of messages, does the message beginning with + symbol a come before the message begging with symbol b?" + [log sym-a sym-b] + (let [order (ordering log)] + (< (get order sym-a) (get order sym-b)))) + +(defn started? [component] + (true? (::started? component))) + +(defn stopped? [component] + (false? (::started? component))) + +(defrecord ComponentA [state] + component/Lifecycle + (start [this] + (log 'ComponentA.start this) + (assoc this ::started? true)) + (stop [this] + (log 'ComponentA.stop this) + (assoc this ::started? false))) + +(defn component-a [] + (->ComponentA (rand-int Integer/MAX_VALUE))) + +(defrecord ComponentB [state a] + component/Lifecycle + (start [this] + (log 'ComponentB.start this) + (assert (started? a)) + (assoc this ::started? true)) + (stop [this] + (log 'ComponentB.stop this) + (assert (started? a)) + (assoc this ::started? false))) + +(defn component-b [] + (component/using + (map->ComponentB {:state (rand-int Integer/MAX_VALUE)}) + [:a])) + +(defrecord ComponentC [state a b] + component/Lifecycle + (start [this] + (log 'ComponentC.start this) + (assert (started? a)) + (assert (started? b)) + (assoc this ::started? true)) + (stop [this] + (log 'ComponentC.stop this) + (assert (started? a)) + (assert (started? b)) + (assoc this ::started? false))) + +(defn component-c [] + (component/using + (map->ComponentC {:state (rand-int Integer/MAX_VALUE)}) + [:a :b])) + +(defrecord ComponentD [state my-c b] + component/Lifecycle + (start [this] + (log 'ComponentD.start this) + (assert (started? b)) + (assert (started? my-c)) + (assoc this ::started? true)) + (stop [this] + (log 'ComponentD.stop this) + (assert (started? b)) + (assert (started? my-c)) + (assoc this ::started? false))) + +(defn component-d [] + (map->ComponentD {:state (rand-int Integer/MAX_VALUE)})) + +(defrecord ComponentE [state] + component/Lifecycle + (start [this] + (log 'ComponentE.start this) + (assoc this ::started? true)) + (stop [this] + (log 'ComponentE.stop this) + (assoc this ::started? false))) + +(defn component-e [] + (map->ComponentE {:state (rand-int Integer/MAX_VALUE)})) + +(defrecord System1 [d a e c b] ; deliberately scrambled order + component/Lifecycle + (start [this] + (log 'System1.start this) + (component/start-system this)) + (stop [this] + (log 'System1.stop this) + (component/stop-system this))) + +(defn system-1 [] + (map->System1 {:a (component-a) + :b (component-b) + :c (component-c) + :d (component/using (component-d) + {:b :b + :my-c :c}) + :e (component-e)})) + +(defmacro with-log [& body] + `(binding [*log* []] + ~@body + *log*)) + +(deftest components-start-in-order + (let [log (with-log (component/start (system-1)))] + (are [k1 k2] (before? log k1 k2) + 'ComponentA.start 'ComponentB.start + 'ComponentA.start 'ComponentC.start + 'ComponentB.start 'ComponentC.start + 'ComponentC.start 'ComponentD.start + 'ComponentB.start 'ComponentD.start))) + +(deftest all-components-started + (let [system (component/start (system-1))] + (doseq [component (vals system)] + (is (started? component))))) + +(deftest all-components-stopped + (let [system (component/stop (component/start (system-1)))] + (doseq [component (vals system)] + (is (stopped? component))))) + +(deftest dependencies-satisfied + (let [system (component/start (component/start (system-1)))] + (are [keys] (started? (get-in system keys)) + [:b :a] + [:c :a] + [:c :b] + [:d :my-c]))) + +(defrecord ErrorStartComponentC [state error a b] + component/Lifecycle + (start [this] + (throw error)) + (stop [this] + this)) + +(defn error-start-c [error] + (component/using + (map->ErrorStartComponentC {:error error}) + [:a :b])) + +(defn setup-error + ([] + (setup-error (ex-info "Boom!" {}))) + ([error] + (try (component/start + (assoc (system-1) :c (error-start-c error))) + (catch Exception e e)))) + +(deftest error-thrown-with-partial-system + (let [ex (setup-error)] + (is (started? (-> ex ex-data :system :b :a))))) + +(deftest error-thrown-with-component-dependencies + (let [ex (setup-error)] + (is (started? (-> ex ex-data :component :a))) + (is (started? (-> ex ex-data :component :b))))) + +(deftest error-thrown-with-cause + (let [error (ex-info "Boom!" {}) + ex (setup-error error)] + (is (identical? error (.getCause ^Exception ex))))) + +(deftest error-is-from-component + (let [error (ex-info "Boom!" {}) + ex (setup-error error)] + (is (component/ex-component? ex)))) + +(deftest error-is-not-from-component + (is (not (component/ex-component? (ex-info "Boom!" {}))))) + +(deftest remove-components-from-error + (let [error (ex-info (str (rand-int Integer/MAX_VALUE)) {}) + ^Exception ex (setup-error error) + ^Exception ex-without (component/ex-without-components ex)] + (is (contains? (ex-data ex) :component)) + (is (contains? (ex-data ex) :system)) + (is (not (contains? (ex-data ex-without) :component))) + (is (not (contains? (ex-data ex-without) :system))) + (is (= (.getMessage ex) + (.getMessage ex-without))) + (is (= (.getCause ex) + (.getCause ex-without))) + (is (java.util.Arrays/equals + (.getStackTrace ex) + (.getStackTrace ex-without))))) + +(defrecord System2b [one] + component/Lifecycle + (start [this] + (assert (started? (get-in one [:b :a]))) + this) + (stop [this] + (assert (started? (get-in one [:b :a]))) + this)) + +(defn system-2 [] + (component/system-map :alpha (system-1) + :beta (component/using (->System2b nil) + {:one :alpha}))) + +(deftest composed-systems + (let [system (component/start (system-2))] + (is (started? (get-in system [:beta :one :d :my-c]))))) + +(defn increment-all-components [system] + (component/update-system + system (keys system) update-in [:n] inc)) + +(defn assert-increments [system] + (are [n keys] (= n (get-in system keys)) + 11 [:a :n] + 11 [:b :a :n] + 11 [:c :a :n] + 11 [:c :b :a :n] + 11 [:e :d :b :a :n] + 21 [:b :n] + 21 [:c :b :n] + 21 [:d :b :n] + 31 [:c :n] + 41 [:d :n] + 51 [:e :n])) + +(deftest update-with-custom-function-on-maps + (let [system {:a {:n 10} + :b (component/using {:n 20} [:a]) + :c (component/using {:n 30} [:a :b]) + :d (component/using {:n 40} [:a :b]) + :e (component/using {:n 50} [:b :c :d])}] + (assert-increments (increment-all-components system)))) + +(deftest t-system-using + (let [dependency-map {:b [:a] + :c [:a :b] + :d {:a :a :b :b} + :e [:b :c :d]} + system {:a {:n 10} + :b {:n 20} + :c {:n 30} + :d {:n 40} + :e {:n 50}} + system (component/system-using system dependency-map)] + (assert-increments (increment-all-components system)))) + +(defrecord ComponentWithoutLifecycle [state]) + +;; BB-TEST-PATCH: No implementation of method errors for start and stop +#_(deftest component-without-lifecycle + (let [c (->ComponentWithoutLifecycle nil)] + (is (= c (component/start c))) + (is (= c (component/stop c))))) + +(defrecord ComponentReturningNil [state] + component/Lifecycle + (start [this] + nil) + (stop [this] + nil)) + +(deftest component-returning-nil + (let [a (->ComponentReturningNil nil) + s (component/system-map :a a :b (component-b)) + e (try (component/start s) + false + (catch Exception e e))] + (is (= ::component/nil-component (:reason (ex-data e)))))) + +(deftest missing-dependency-error + (let [system-key ::system-b + local-key ::local-b + a (component/using (component-a) {local-key system-key}) + system (component/system-map + :a a) + e (try (component/start system) + false + (catch Exception e e)) + data (ex-data e)] + (is (= ::component/missing-dependency (:reason data))) + (is (= system-key (:system-key data))) + (is (= local-key (:dependency-key data))) + (is (= a (:component data))) + (is (= system (:system data))))) diff --git a/test-resources/lib_tests/com/wsscode/misc/coll_test.cljc b/test-resources/lib_tests/com/wsscode/misc/coll_test.cljc new file mode 100644 index 00000000..852f3b25 --- /dev/null +++ b/test-resources/lib_tests/com/wsscode/misc/coll_test.cljc @@ -0,0 +1,257 @@ +(ns com.wsscode.misc.coll-test + (:require + [clojure.test :refer [deftest is are run-tests testing]] + [com.wsscode.misc.coll :as coll])) + +(deftest distinct-by-test + (is (= (coll/distinct-by :id + [{:id 1 + :name "foo"} + {:id 2 + :name "bar"} + {:id 1 + :name "other"}]) + [{:id 1 + :name "foo"} + {:id 2 + :name "bar"}]))) + +(deftest dedupe-by-test + (is (= (coll/dedupe-by :id + [{:id 1 + :name "foo"} + {:id 1 + :name "dedup-me"} + {:id 2 + :name "bar"} + {:id 1 + :name "other"}]) + [{:id 1 + :name "foo"} + {:id 2 + :name "bar"} + {:id 1 + :name "other"}]))) + +(deftest index-by-test + (is (= (coll/index-by :id + [{:id 1 + :name "foo"} + {:id 1 + :name "dedup-me"} + {:id 2 + :name "bar"} + {:id 1 + :name "other"}]) + {1 {:id 1, :name "other"}, 2 {:id 2, :name "bar"}}))) + +(deftest find-first-test + (is (= (coll/find-first even? [1 2 3 4]) + 2))) + +(deftest sconj-test + (is (= (coll/sconj nil 42) #{42})) + (is (set? (coll/sconj nil 42)))) + +(deftest vconj-test + (is (= (coll/vconj nil 42) [42])) + (is (vector? (coll/vconj nil 42)))) + +(deftest queue-test + (let [queue (-> (coll/queue) + (conj 1 2))] + (is (= queue [1 2])) + (is (= (peek queue) 1)) + (is (= (pop queue) [2]))) + + (let [queue (coll/queue [1 2])] + (is (= queue [1 2])) + (is (= (peek queue) 1)) + (is (= (pop queue) [2])))) + +(deftest map-keys-test + (is (= (coll/map-keys inc {1 :a 2 :b}) + {2 :a 3 :b}))) + +(deftest filter-keys-test + (is (= (coll/filter-keys simple-keyword? {1 :a 2 :b "foo" 3 :bar 4}) + {:bar 4}))) + +(deftest filter-vals-test + (is (= (coll/filter-vals simple-keyword? {1 :a 2 :b "foo" 3 :bar 4}) + {1 :a 2 :b}))) + +(deftest remove-keys-test + (is (= (coll/remove-keys number? {1 :a 2 :b "foo" 3 :bar 4}) + {"foo" 3 :bar 4}))) + +(deftest remove-vals-test + (is (= (coll/remove-vals number? {1 :a 2 :b "foo" 3 :bar 4}) + {1 :a 2 :b}))) + +(deftest map-vals-test + (is (= (coll/map-vals inc {:a 1 :b 2}) + {:a 2 :b 3}))) + +(deftest keys-set-test + (is (= (coll/keys-set {:a 1 :b 2}) #{:a :b})) + (is (= (coll/keys-set 5) nil))) + +(deftest merge-grow-test + (is (= (coll/merge-grow) {})) + (is (= (coll/merge-grow {:foo "bar"}) {:foo "bar"})) + + (testing "merge sets by union" + (is (= (coll/merge-grow {:foo #{:a}} {:foo #{:b}}) + {:foo #{:a :b}}))) + + (testing "merge maps" + (is (= (coll/merge-grow {:foo {:a 1}} {:foo {:b 2}}) + {:foo {:a 1 :b 2}}))) + + (testing "keep left value if right one is nil" + (is (= (coll/merge-grow {:foo {:a 1}} {:foo {:a nil}}) + {:foo {:a 1}})))) + +(deftest merge-defaults-test + (is (= (coll/merge-defaults {:a 1} {:b 2}) + {:a 1 :b 2})) + (is (= (coll/merge-defaults {:a 1} {:a 2}) + {:a 1}))) + +(deftest assoc-if-test + (is (= (coll/assoc-if {} :foo "bar") + {:foo "bar"})) + + (is (= (coll/assoc-if {} :foo nil) + {})) + + (is (= (coll/assoc-if {} :foo false) + {})) + + (is (= (coll/assoc-if {} :foo false :bar 30) + {:bar 30})) + + (is (= (coll/assoc-if {} :foo false :bar 30 :baz false) + {:bar 30}))) + +(deftest update-contained-test + (is (= (coll/update-contained {:foo 3} :foo inc) + {:foo 4})) + (is (= (coll/update-contained {:foo nil} :foo #(str % " bla")) + {:foo " bla"})) + (is (= (coll/update-contained {} :foo inc) + {}))) + +(deftest update-if-test + (is (= (coll/update-if {:foo 3} :foo inc) + {:foo 4})) + (is (= (coll/update-if {:foo nil} :foo inc) + {:foo nil})) + (is (= (coll/update-if {} :foo inc) + {}))) + +(defrecord CustomRecord []) + +(deftest native-map?-test + (is (= true (coll/native-map? {}))) + (is (= true (coll/native-map? {:foo "bar"}))) + (is (= true (coll/native-map? (zipmap (range 50) (range 50))))) + (is (= false (coll/native-map? (->CustomRecord))))) + +(deftest restore-order-test + (is (= (coll/restore-order + [{:my.entity/id 1} {:my.entity/id 2}] + :my.entity/id + [{:my.entity/id 2 + :my.entity/color :my.entity.color/green} + {:my.entity/id 1 + :my.entity/color :my.entity.color/purple}]) + [{:my.entity/id 1 + :my.entity/color :my.entity.color/purple} + {:my.entity/id 2 + :my.entity/color :my.entity.color/green}])) + (is (= (coll/restore-order + [{:my.entity/id 1} + {:my.entity/id 2} + {:my.entity/id 3}] + :my.entity/id + [{:my.entity/id 3 + :my.entity/color :my.entity.color/green} + {:my.entity/id 1 + :my.entity/color :my.entity.color/purple}]) + [{:my.entity/id 1 + :my.entity/color :my.entity.color/purple} + {:my.entity/id 2} + {:my.entity/id 3 + :my.entity/color :my.entity.color/green}])) + (is (= (coll/restore-order [{:my.entity/id 1} + {:my.entity/id 2} + {:my.entity/id 3}] + :my.entity/id + [{:my.entity/id 3 + :my.entity/color :my.entity.color/green} + {:my.entity/id 1 + :my.entity/color :my.entity.color/purple}] + (fn [x] (assoc x :my.entity/color nil))) + [{:my.entity/id 1 + :my.entity/color :my.entity.color/purple} + {:my.entity/id 2 + :my.entity/color nil} + {:my.entity/id 3 + :my.entity/color :my.entity.color/green}]))) + +(deftest conj-at-index-test + (is (= (coll/conj-at-index [:a :b] 0 :c) + [:c :a :b])) + (is (= (coll/conj-at-index [:a :b] 1 :c) + [:a :c :b])) + (is (= (coll/conj-at-index [:a :b] 2 :c) + [:a :b :c]))) + +(deftest index-of-test + (is (= (coll/index-of [:a {:id :b} :c] :not-here) + nil)) + (is (= (coll/index-of [:a {:id :b} :c] :a) + 0)) + (is (= (coll/index-of [:a {:id :b} :c] {:id :b}) + 1))) + +(deftest coll-append-ahead?-test + (is (true? (coll/coll-append-at-head? (list "foo")))) + (is (true? (coll/coll-append-at-head? (map identity ["foo"])))) + (is (false? (coll/coll-append-at-head? ["foo"]))) + (is (false? (coll/coll-append-at-head? #{"foo"})))) + +(deftest collection?-test + (is (true? (coll/collection? []))) + (is (true? (coll/collection? '()))) + (is (true? (coll/collection? #{}))) + (is (true? (coll/collection? (map identity [])))) + (is (false? (coll/collection? {})))) + +(deftest vector-compare-test + (is (= (coll/vector-compare [0] [1]) + -1)) + (is (= (coll/vector-compare [1] [0]) + 1)) + (is (= (coll/vector-compare [1] [1]) + 0)) + (is (= (coll/vector-compare [2 0] [2 1]) + -1)) + (is (= (coll/vector-compare [2 0 0] [2 1]) + -1))) + +(deftest iterate-while-test + (is (= (coll/iterate-while :n {:x 1 :n {:x 2 :n {:x 3}}}) + [{:x 1, :n {:x 2, :n {:x 3}}} {:x 2, :n {:x 3}} {:x 3}]))) + +(deftest deep-merge-test + (is (= (coll/deep-merge {:a 1} {:b 2}) + {:a 1 :b 2})) + + (is (= (coll/deep-merge {:a {:x 1 :foo "bar"}} {:a {:baz "f" :foo "2"}}) + {:a {:baz "f" :foo "2" :x 1}})) + + (is (= (coll/deep-merge {:a [{:a 1}]} {:a [{:b 2}]}) + {:a [{:b 2}]}))) diff --git a/test-resources/lib_tests/com/wsscode/misc/macros_test.clj b/test-resources/lib_tests/com/wsscode/misc/macros_test.clj new file mode 100644 index 00000000..bd259bb8 --- /dev/null +++ b/test-resources/lib_tests/com/wsscode/misc/macros_test.clj @@ -0,0 +1,14 @@ +(ns com.wsscode.misc.macros-test + (:require + [clojure.test :refer [deftest is are run-tests testing]] + [com.wsscode.misc.macros :as macros])) + +(deftest full-symbol-test + (is (= (macros/full-symbol + 'known/foo + "bar") + 'known/foo)) + (is (= (macros/full-symbol + 'foo + "bar") + 'bar/foo))) diff --git a/test-resources/lib_tests/com/wsscode/misc/math_test.cljc b/test-resources/lib_tests/com/wsscode/misc/math_test.cljc new file mode 100644 index 00000000..65a6daf3 --- /dev/null +++ b/test-resources/lib_tests/com/wsscode/misc/math_test.cljc @@ -0,0 +1,28 @@ +(ns com.wsscode.misc.math-test + (:require + [clojure.test :refer [deftest is are run-tests testing]] + [com.wsscode.misc.math :as math])) + +(deftest floor-test + (is (= (math/floor 30.2) 30)) + (is (= (math/floor 30.9) 30))) + +(deftest round-test + (is (= (math/round 30.2) 30)) + (is (= (math/round 30.6) 31))) + +(deftest ceil-test + (is (= (math/ceil 30.2) 31)) + (is (= (math/ceil 30.9) 31))) + +(deftest divmod-test + (is (= (math/divmod 10 3) + [3 1]))) + +(deftest parse-long-test + (is (= (math/parse-long "21") + 21))) + +(deftest parse-double-test + (is (= (math/parse-double "21.3") + 21.3))) diff --git a/test-resources/lib_tests/com/wsscode/misc/refs_test.cljc b/test-resources/lib_tests/com/wsscode/misc/refs_test.cljc new file mode 100644 index 00000000..34b64141 --- /dev/null +++ b/test-resources/lib_tests/com/wsscode/misc/refs_test.cljc @@ -0,0 +1,36 @@ +(ns com.wsscode.misc.refs-test + (:require + [clojure.test :refer [deftest is are run-tests testing]] + [com.wsscode.misc.refs :refer [atom?] :as refs])) + +(deftest kw-identical?-test + (is (not (refs/kw-identical? :foo :bar))) + (is (not (refs/kw-identical? :foo "foo"))) + (is (refs/kw-identical? :foo :foo)) + (is (refs/kw-identical? :foo (keyword "foo")))) + +(deftest atom?-test + (is (true? (atom? (atom "x")))) + (is (false? (atom? "x")))) + +(deftest greset!-test + (let [x (atom nil)] + (refs/greset! x "val") + (is (= @x "val"))) + + (let [x (volatile! nil)] + (refs/greset! x "val") + (is (= @x "val")))) + +(deftest gswap!-test + (let [x (atom 10)] + (refs/gswap! x inc) + (is (= @x 11))) + + (let [x (volatile! 10)] + (refs/gswap! x inc) + (is (= @x 11))) + + (let [x (volatile! 10)] + (refs/gswap! x + 1 2 3 4 5) + (is (= @x 25)))) diff --git a/test-resources/lib_tests/com/wsscode/misc/uuid_test.cljc b/test-resources/lib_tests/com/wsscode/misc/uuid_test.cljc new file mode 100644 index 00000000..b0bf6673 --- /dev/null +++ b/test-resources/lib_tests/com/wsscode/misc/uuid_test.cljc @@ -0,0 +1,7 @@ +(ns com.wsscode.misc.uuid-test + (:require + [clojure.test :refer [deftest is are run-tests testing]] + [com.wsscode.misc.uuid :as uuid])) + +(deftest cljc-random-uuid-test + (is (uuid? (uuid/cljc-random-uuid)))) diff --git a/test-resources/lib_tests/component/component_test.clj b/test-resources/lib_tests/component/component_test.clj deleted file mode 100644 index 32b715f8..00000000 --- a/test-resources/lib_tests/component/component_test.clj +++ /dev/null @@ -1,41 +0,0 @@ -(ns component.component-test - (:require [clojure.test :refer [deftest is testing]] - [com.stuartsierra.component :as component])) - - -(def syslog (atom [])) - -(defn log [msg] - (swap! syslog conj msg)) - -(defrecord FakeDB [state] - component/Lifecycle - (start [_] - (log "start DB")) - (stop [_] - (log "stop DB"))) - -(defrecord FakeApp [db] - component/Lifecycle - (start [_] - (log "start app")) - (stop [_] - (log "stop app"))) - -(defn base-app [] - (map->FakeApp {})) - -(def sm - (component/system-map - :db (->FakeDB :foo) - :app (component/using (base-app) [:db]))) - -(component/start sm) - -;; do useful stuff here - -(component/stop sm) - -(deftest ordering-test - (testing "components are started and stopped in expected order" - (is (= ["start DB" "start app" "stop app" "stop DB"] @syslog)))) diff --git a/test-resources/lib_tests/contajners/core_test.clj b/test-resources/lib_tests/contajners/core_test.clj new file mode 100644 index 00000000..fb3aa8de --- /dev/null +++ b/test-resources/lib_tests/contajners/core_test.clj @@ -0,0 +1,22 @@ +(ns contajners.core-test + (:require [clojure.test :as t] + [contajners.core :as c])) + +(t/deftest docker-tests + (let [image "busybox:musl" + client (c/client {:engine :docker + :version "v1.41" + :category :images + :conn {:uri "unix:///var/run/docker.sock"}})] + (t/testing "pull an image" + (c/invoke client + {:op :ImageCreate + :params {:fromImage image}}) + (let [images (c/invoke client {:op :ImageList})] + (t/is (contains? (->> images + (mapcat :RepoTags) + (into #{})) + image))) + (c/invoke client + {:op :ImageDelete + :params {:name image}})))) diff --git a/test-resources/lib_tests/contajners/impl_test.clj b/test-resources/lib_tests/contajners/impl_test.clj new file mode 100644 index 00000000..58808220 --- /dev/null +++ b/test-resources/lib_tests/contajners/impl_test.clj @@ -0,0 +1,45 @@ +(ns contajners.impl-test + (:require + [clojure.test :as t] + [contajners.impl :as impl])) + +(t/deftest meta-cleanup + (t/testing "remove internal namespace" + (t/is (= [:foo] + (impl/remove-internal-meta [:contajners/foo :foo]))))) + +(t/deftest param-gathering + (t/testing "gathering params as header query and path" + (t/is (= {:header {:a 1 :b 2} + :query {:c 3 :d 4} + :path {:e 5 :f 6}} + (reduce (partial impl/gather-params {:a 1 :b 2 :c 3 :d 4 :e 5 :f 6}) + {} + [{:name "a" :in :header} + {:name "b" :in :header} + {:name "c" :in :query} + {:name "d" :in :query} + {:name "e" :in :path} + {:name "f" :in :path}]))))) + +(t/deftest body-serialization + (t/testing "body serialization when a map" + (t/is (= {:headers {"content-type" "application/json"} + :body "{\"a\":42}"} + (impl/maybe-serialize-body {:body {:a 42}})))) + (t/testing "body serialization when not a map" + (t/is (= {:body "yes"} + (impl/maybe-serialize-body {:body "yes"}))))) + +(t/deftest path-interpolation + (t/testing "path interpolation" + (t/is (= "/a/{w}/b/41/42" + (impl/interpolate-path "/a/{w}/b/{x}/{y}" {:x 41 :y 42 :z 43}))))) + +(t/deftest json-parsing + (t/testing "successful json parsing" + (t/is (= {:a 42} + (impl/try-json-parse "{\"a\":42}")))) + (t/testing "failed json parsing" + (t/is (= "yes" + (impl/try-json-parse "yes"))))) diff --git a/test-resources/lib_tests/cprop/smoke_test.clj b/test-resources/lib_tests/cprop/smoke_test.clj new file mode 100644 index 00000000..9f97d66a --- /dev/null +++ b/test-resources/lib_tests/cprop/smoke_test.clj @@ -0,0 +1,7 @@ +(ns cprop.smoke-test + (:require [clojure.test :as t :refer [deftest is]] + [cprop.core] + [cprop.source :refer [from-env]])) + +(deftest from-env-test + (println (:cprop-env (from-env)))) diff --git a/test-resources/lib_tests/datalog/parser/impl_test.cljc b/test-resources/lib_tests/datalog/parser/impl_test.cljc new file mode 100644 index 00000000..10e1bef9 --- /dev/null +++ b/test-resources/lib_tests/datalog/parser/impl_test.cljc @@ -0,0 +1,492 @@ +(ns datalog.parser.impl-test + (:require #?(:cljs [cljs.test :refer-macros [is are deftest testing]] + :clj [clojure.test :refer [is are deftest testing]]) + [datalog.parser.impl :as dp] + [datalog.parser.type :as t] + [datalog.parser.test.util]) + (:import [clojure.lang ExceptionInfo])) + +(deftest bindings + (are [form res] (= (dp/parse-binding form) res) + '?x + (t/->BindScalar (t/->Variable '?x)) + + '_ + (t/->BindIgnore) + + '[?x ...] + (t/->BindColl (t/->BindScalar (t/->Variable '?x))) + + '[?x] + (t/->BindTuple [(t/->BindScalar (t/->Variable '?x))]) + + '[?x ?y] + (t/->BindTuple [(t/->BindScalar (t/->Variable '?x)) (t/->BindScalar (t/->Variable '?y))]) + + '[_ ?y] + (t/->BindTuple [(t/->BindIgnore) (t/->BindScalar (t/->Variable '?y))]) + + '[[_ [?x ...]] ...] + (t/->BindColl + (t/->BindTuple [(t/->BindIgnore) + (t/->BindColl + (t/->BindScalar (t/->Variable '?x)))])) + + '[[?a ?b ?c]] + (t/->BindColl + (t/->BindTuple [(t/->BindScalar (t/->Variable '?a)) + (t/->BindScalar (t/->Variable '?b)) + (t/->BindScalar (t/->Variable '?c))]))) + + (is (thrown-with-msg? ExceptionInfo #"Cannot parse binding" + (dp/parse-binding :key)))) + +(deftest in + (are [form res] (= (dp/parse-in form) res) + '[?x] + [(t/->BindScalar (t/->Variable '?x))] + + '[$ $1 % _ ?x] + [(t/->BindScalar (t/->SrcVar '$)) + (t/->BindScalar (t/->SrcVar '$1)) + (t/->BindScalar (t/->RulesVar)) + (t/->BindIgnore) + (t/->BindScalar (t/->Variable '?x))] + + '[$ [[_ [?x ...]] ...]] + [(t/->BindScalar (t/->SrcVar '$)) + (t/->BindColl + (t/->BindTuple [(t/->BindIgnore) + (t/->BindColl + (t/->BindScalar (t/->Variable '?x)))]))]) + + (is (thrown-with-msg? ExceptionInfo #"Cannot parse binding" + (dp/parse-in ['?x :key])))) + +(deftest with + (is (= (dp/parse-with '[?x ?y]) + [(t/->Variable '?x) (t/->Variable '?y)])) + + (is (thrown-with-msg? ExceptionInfo #"Cannot parse :with clause" + (dp/parse-with '[?x _])))) + +(deftest test-parse-find + (is (= (dp/parse-find '[?a ?b]) + (t/->FindRel [(t/->Variable '?a) (t/->Variable '?b)]))) + (is (= (dp/parse-find '[[?a ...]]) + (t/->FindColl (t/->Variable '?a)))) + (is (= (dp/parse-find '[?a .]) + (t/->FindScalar (t/->Variable '?a)))) + (is (= (dp/parse-find '[[?a ?b]]) + (t/->FindTuple [(t/->Variable '?a) (t/->Variable '?b)])))) + +(deftest test-parse-aggregate + (is (= (dp/parse-find '[?a (count ?b)]) + (t/->FindRel [(t/->Variable '?a) (t/->Aggregate (t/->PlainSymbol 'count) [(t/->Variable '?b)])]))) + (is (= (dp/parse-find '[[(count ?a) ...]]) + (t/->FindColl (t/->Aggregate (t/->PlainSymbol 'count) [(t/->Variable '?a)])))) + (is (= (dp/parse-find '[(count ?a) .]) + (t/->FindScalar (t/->Aggregate (t/->PlainSymbol 'count) [(t/->Variable '?a)])))) + (is (= (dp/parse-find '[[(count ?a) ?b]]) + (t/->FindTuple [(t/->Aggregate (t/->PlainSymbol 'count) [(t/->Variable '?a)]) (t/->Variable '?b)])))) + +(deftest test-parse-custom-aggregates + (is (= (dp/parse-find '[(aggregate ?f ?a)]) + (t/->FindRel [(t/->Aggregate (t/->Variable '?f) [(t/->Variable '?a)])]))) + (is (= (dp/parse-find '[?a (aggregate ?f ?b)]) + (t/->FindRel [(t/->Variable '?a) (t/->Aggregate (t/->Variable '?f) [(t/->Variable '?b)])]))) + (is (= (dp/parse-find '[[(aggregate ?f ?a) ...]]) + (t/->FindColl (t/->Aggregate (t/->Variable '?f) [(t/->Variable '?a)])))) + (is (= (dp/parse-find '[(aggregate ?f ?a) .]) + (t/->FindScalar (t/->Aggregate (t/->Variable '?f) [(t/->Variable '?a)])))) + (is (= (dp/parse-find '[[(aggregate ?f ?a) ?b]]) + (t/->FindTuple [(t/->Aggregate (t/->Variable '?f) [(t/->Variable '?a)]) (t/->Variable '?b)])))) + +(deftest test-parse-find-elements + (is (= (dp/parse-find '[(count ?b 1 $x) .]) + (t/->FindScalar (t/->Aggregate (t/->PlainSymbol 'count) + [(t/->Variable '?b) + (t/->Constant 1) + (t/->SrcVar '$x)]))))) + +(deftest clauses + (are [form res] (= (set (dp/parse-rules form)) res) + '[[(rule ?x) + [?x :name _]]] + #{(t/->Rule + (t/->PlainSymbol 'rule) + [(t/->RuleBranch + (t/->RuleVars nil [(t/->Variable '?x)]) + [(t/->Pattern + (t/->DefaultSrc) + [(t/->Variable '?x) (t/->Constant :name) (t/->Placeholder)])])])}) + (is (thrown-with-msg? ExceptionInfo #"Reference to the unknown variable" + (dp/parse-rules '[[(rule ?x) [?x :name ?y]]])))) + +(deftest rule-vars + (are [form res] (= (set (dp/parse-rules form)) res) + '[[(rule [?x] ?y) + [_]]] + #{(t/->Rule + (t/->PlainSymbol 'rule) + [(t/->RuleBranch + (t/->RuleVars [(t/->Variable '?x)] [(t/->Variable '?y)]) + [(t/->Pattern (t/->DefaultSrc) [(t/->Placeholder)])])])} + + '[[(rule [?x ?y] ?a ?b) + [_]]] + #{(t/->Rule + (t/->PlainSymbol 'rule) + + [(t/->RuleBranch + (t/->RuleVars [(t/->Variable '?x) (t/->Variable '?y)] + [(t/->Variable '?a) (t/->Variable '?b)]) + [(t/->Pattern (t/->DefaultSrc) [(t/->Placeholder)])])])} + + '[[(rule [?x]) + [_]]] + #{(t/->Rule + (t/->PlainSymbol 'rule) + [(t/->RuleBranch + (t/->RuleVars [(t/->Variable '?x)] nil) + [(t/->Pattern (t/->DefaultSrc) [(t/->Placeholder)])])])}) + + (is (thrown-with-msg? ExceptionInfo #"Cannot parse rule-vars" + (dp/parse-rules '[[(rule) [_]]]))) + + (is (thrown-with-msg? ExceptionInfo #"Cannot parse rule-vars" + (dp/parse-rules '[[(rule []) [_]]]))) + + (is (thrown-with-msg? ExceptionInfo #"Rule variables should be distinct" + (dp/parse-rules '[[(rule ?x ?y ?x) [_]]]))) + + (is (thrown-with-msg? ExceptionInfo #"Rule variables should be distinct" + (dp/parse-rules '[[(rule [?x ?y] ?z ?x) [_]]])))) + +(deftest branches + (are [form res] (= (set (dp/parse-rules form)) res) + '[[(rule ?x) + [:a] + [:b]] + [(rule ?x) + [:c]]] + #{(t/->Rule + (t/->PlainSymbol 'rule) + [(t/->RuleBranch + (t/->RuleVars nil [(t/->Variable '?x)]) + [(t/->Pattern (t/->DefaultSrc) [(t/->Constant :a)]) + (t/->Pattern (t/->DefaultSrc) [(t/->Constant :b)])]) + (t/->RuleBranch + (t/->RuleVars nil [(t/->Variable '?x)]) + [(t/->Pattern (t/->DefaultSrc) [(t/->Constant :c)])])])} + + '[[(rule ?x) + [:a] + [:b]] + [(other ?x) + [:c]]] + #{(t/->Rule + (t/->PlainSymbol 'rule) + [(t/->RuleBranch + (t/->RuleVars nil [(t/->Variable '?x)]) + [(t/->Pattern (t/->DefaultSrc) [(t/->Constant :a)]) + (t/->Pattern (t/->DefaultSrc) [(t/->Constant :b)])])]) + (t/->Rule + (t/->PlainSymbol 'other) + [(t/->RuleBranch + (t/->RuleVars nil [(t/->Variable '?x)]) + [(t/->Pattern (t/->DefaultSrc) [(t/->Constant :c)])])])}) + + (is (thrown-with-msg? ExceptionInfo #"Rule branch should have clauses" + (dp/parse-rules '[[(rule ?x)]]))) + + (is (thrown-with-msg? ExceptionInfo #"Arity mismatch" + (dp/parse-rules '[[(rule ?x) [_]] + [(rule ?x ?y) [_]]]))) + + (is (thrown-with-msg? ExceptionInfo #"Arity mismatch" + (dp/parse-rules '[[(rule ?x) [_]] + [(rule [?x]) [_]]])))) + +(deftest pattern + (are [clause pattern] (= (dp/parse-clause clause) pattern) + '[?e ?a ?v] + (t/->Pattern (t/->DefaultSrc) [(t/->Variable '?e) (t/->Variable '?a) (t/->Variable '?v)]) + + '[_ ?a _ _] + (t/->Pattern (t/->DefaultSrc) [(t/->Placeholder) (t/->Variable '?a) (t/->Placeholder) (t/->Placeholder)]) + + '[$x _ ?a _ _] + (t/->Pattern (t/->SrcVar '$x) [(t/->Placeholder) (t/->Variable '?a) (t/->Placeholder) (t/->Placeholder)]) + + '[$x _ :name ?v] + (t/->Pattern (t/->SrcVar '$x) [(t/->Placeholder) (t/->Constant :name) (t/->Variable '?v)]) + + '[$x _ sym ?v] + (t/->Pattern (t/->SrcVar '$x) [(t/->Placeholder) (t/->Constant 'sym) (t/->Variable '?v)]) + + '[$x _ $src-sym ?v] + (t/->Pattern (t/->SrcVar '$x) [(t/->Placeholder) (t/->Constant '$src-sym) (t/->Variable '?v)])) + + (is (thrown-with-msg? ExceptionInfo #"Pattern could not be empty" + (dp/parse-clause '[])))) + +(deftest test-pred + (are [clause res] (= (dp/parse-clause clause) res) + '[(pred ?a 1)] + (t/->Predicate (t/->PlainSymbol 'pred) [(t/->Variable '?a) (t/->Constant 1)]) + + '[(pred)] + (t/->Predicate (t/->PlainSymbol 'pred) []) + + '[(?custom-pred ?a)] + (t/->Predicate (t/->Variable '?custom-pred) [(t/->Variable '?a)]))) + +(deftest test-fn + (are [clause res] (= (dp/parse-clause clause) res) + '[(fn ?a 1) ?x] + (t/->Function (t/->PlainSymbol 'fn) [(t/->Variable '?a) (t/->Constant 1)] (t/->BindScalar (t/->Variable '?x))) + + '[(fn) ?x] + (t/->Function (t/->PlainSymbol 'fn) [] (t/->BindScalar (t/->Variable '?x))) + + '[(?custom-fn) ?x] + (t/->Function (t/->Variable '?custom-fn) [] (t/->BindScalar (t/->Variable '?x))) + + '[(?custom-fn ?arg) ?x] + (t/->Function (t/->Variable '?custom-fn) [(t/->Variable '?arg)] (t/->BindScalar (t/->Variable '?x))))) + +(deftest rule-expr + (are [clause res] (= (dp/parse-clause clause) res) + '(friends ?x ?y) + (t/->RuleExpr (t/->DefaultSrc) (t/->PlainSymbol 'friends) [(t/->Variable '?x) (t/->Variable '?y)]) + + '(friends "Ivan" _) + (t/->RuleExpr (t/->DefaultSrc) (t/->PlainSymbol 'friends) [(t/->Constant "Ivan") (t/->Placeholder)]) + + '($1 friends ?x ?y) + (t/->RuleExpr (t/->SrcVar '$1) (t/->PlainSymbol 'friends) [(t/->Variable '?x) (t/->Variable '?y)]) + + '(friends something) + (t/->RuleExpr (t/->DefaultSrc) (t/->PlainSymbol 'friends) [(t/->Constant 'something)])) + + (is (thrown-with-msg? ExceptionInfo #"rule-expr requires at least one argument" + (dp/parse-clause '(friends))))) + +(deftest not-clause + (are [clause res] (= (dp/parse-clause clause) res) + '(not [?e :follows ?x]) + (t/->Not + (t/->DefaultSrc) + [(t/->Variable '?e) (t/->Variable '?x)] + [(t/->Pattern + (t/->DefaultSrc) + [(t/->Variable '?e) (t/->Constant :follows) (t/->Variable '?x)])]) + + '(not + [?e :follows ?x] + [?x _ ?y]) + (t/->Not + (t/->DefaultSrc) + [(t/->Variable '?e) (t/->Variable '?x) (t/->Variable '?y)] + [(t/->Pattern + (t/->DefaultSrc) + [(t/->Variable '?e) (t/->Constant :follows) (t/->Variable '?x)]) + (t/->Pattern + (t/->DefaultSrc) + [(t/->Variable '?x) (t/->Placeholder) (t/->Variable '?y)])]) + + '($1 not [?x]) + (t/->Not + (t/->SrcVar '$1) + [(t/->Variable '?x)] + [(t/->Pattern (t/->DefaultSrc) [(t/->Variable '?x)])]) + + '(not-join [?e ?y] + [?e :follows ?x] + [?x _ ?y]) + (t/->Not + (t/->DefaultSrc) + [(t/->Variable '?e) (t/->Variable '?y)] + [(t/->Pattern + (t/->DefaultSrc) + [(t/->Variable '?e) (t/->Constant :follows) (t/->Variable '?x)]) + (t/->Pattern + (t/->DefaultSrc) + [(t/->Variable '?x) (t/->Placeholder) (t/->Variable '?y)])]) + + '($1 not-join [?e] [?e :follows ?x]) + (t/->Not + (t/->SrcVar '$1) + [(t/->Variable '?e)] + [(t/->Pattern + (t/->DefaultSrc) + [(t/->Variable '?e) (t/->Constant :follows) (t/->Variable '?x)])])) + + (is (thrown-with-msg? ExceptionInfo #"Join variable not declared inside clauses: \[\?x\]" + (dp/parse-clause '(not-join [?x] [?y])))) + + (is (thrown-with-msg? ExceptionInfo #"Join variables should not be empty" + (dp/parse-clause '(not-join [] [?y])))) + + (is (thrown-with-msg? ExceptionInfo #"Join variables should not be empty" + (dp/parse-clause '(not [_])))) + + (is (thrown-with-msg? ExceptionInfo #"Cannot parse 'not-join' clause" + (dp/parse-clause '(not-join [?x])))) + + (is (thrown-with-msg? ExceptionInfo #"Cannot parse 'not' clause" + (dp/parse-clause '(not)))) + + (is (thrown-with-msg? ExceptionInfo #"Join variable not declared inside clauses: \[\?y\]" + (dp/parse-clause '(not-join [?y] + (not-join [?x] + [?x :follows ?y])))))) + +(deftest or-clause + (are [clause res] (= (dp/parse-clause clause) res) + '(or [?e :follows ?x]) + (t/->Or + (t/->DefaultSrc) + (t/->RuleVars nil [(t/->Variable '?e) (t/->Variable '?x)]) + [(t/->Pattern + (t/->DefaultSrc) + [(t/->Variable '?e) (t/->Constant :follows) (t/->Variable '?x)])]) + + '(or + [?e :follows ?x] + [?e :friend ?x]) + (t/->Or + (t/->DefaultSrc) + (t/->RuleVars nil [(t/->Variable '?e) (t/->Variable '?x)]) + [(t/->Pattern + (t/->DefaultSrc) + [(t/->Variable '?e) (t/->Constant :follows) (t/->Variable '?x)]) + (t/->Pattern + (t/->DefaultSrc) + [(t/->Variable '?e) (t/->Constant :friend) (t/->Variable '?x)])]) + + '(or + [?e :follows ?x] + (and + [?e :friend ?x] + [?x :friend ?e])) + (t/->Or + (t/->DefaultSrc) + (t/->RuleVars nil [(t/->Variable '?e) (t/->Variable '?x)]) + [(t/->Pattern + (t/->DefaultSrc) + [(t/->Variable '?e) (t/->Constant :follows) (t/->Variable '?x)]) + (t/->And + [(t/->Pattern + (t/->DefaultSrc) + [(t/->Variable '?e) (t/->Constant :friend) (t/->Variable '?x)]) + (t/->Pattern + (t/->DefaultSrc) + [(t/->Variable '?x) (t/->Constant :friend) (t/->Variable '?e)])])]) + + '($1 or [?x]) + (t/->Or + (t/->SrcVar '$1) + (t/->RuleVars nil [(t/->Variable '?x)]) + [(t/->Pattern (t/->DefaultSrc) [(t/->Variable '?x)])]) + + '(or-join [?e] + [?e :follows ?x] + [?e :friend ?y]) + (t/->Or + (t/->DefaultSrc) + (t/->RuleVars nil [(t/->Variable '?e)]) + [(t/->Pattern + (t/->DefaultSrc) + [(t/->Variable '?e) (t/->Constant :follows) (t/->Variable '?x)]) + (t/->Pattern + (t/->DefaultSrc) + [(t/->Variable '?e) (t/->Constant :friend) (t/->Variable '?y)])]) + + '(or-join [[?e]] + (and [?e :follows ?x] + [?e :friend ?y])) + (t/->Or + (t/->DefaultSrc) + (t/->RuleVars [(t/->Variable '?e)] nil) + [(t/->And + [(t/->Pattern + (t/->DefaultSrc) + [(t/->Variable '?e) (t/->Constant :follows) (t/->Variable '?x)]) + (t/->Pattern + (t/->DefaultSrc) + [(t/->Variable '?e) (t/->Constant :friend) (t/->Variable '?y)])])]) + + '($1 or-join [[?e] ?x] + [?e :follows ?x]) + (t/->Or + (t/->SrcVar '$1) + (t/->RuleVars [(t/->Variable '?e)] [(t/->Variable '?x)]) + [(t/->Pattern + (t/->DefaultSrc) + [(t/->Variable '?e) (t/->Constant :follows) (t/->Variable '?x)])])) + + ;; These tests reflect the or-join semantics of Datomic Datalog, https://docs.datomic.com/on-prem/query.html + ;; TODO use record constructors instead of wordy literals as for rest in this buffer + (is (= (dp/parse-clause '(or-join [?x] [?y])) + '#datalog.parser.type.Or{:source #datalog.parser.type.DefaultSrc{}, + :rule-vars #datalog.parser.type.RuleVars{:required nil, + :free [#datalog.parser.type.Variable{:symbol ?x}]}, + :clauses [#datalog.parser.type.Pattern{:source #datalog.parser.type.DefaultSrc{}, + :pattern [#datalog.parser.type.Variable{:symbol ?y}]}]})) + (is (= (dp/parse-clause '(or-join [?x ?y] [?x ?y] [?y])) + '#datalog.parser.type.Or{:source #datalog.parser.type.DefaultSrc{}, + :rule-vars #datalog.parser.type.RuleVars{:required nil, + :free [#datalog.parser.type.Variable{:symbol ?x} + #datalog.parser.type.Variable{:symbol ?y}]}, + :clauses [#datalog.parser.type.Pattern{:source #datalog.parser.type.DefaultSrc{}, + :pattern [#datalog.parser.type.Variable{:symbol ?x} + #datalog.parser.type.Variable{:symbol ?y}]} + #datalog.parser.type.Pattern{:source #datalog.parser.type.DefaultSrc{}, + :pattern [#datalog.parser.type.Variable{:symbol ?y}]}]})) + + (is (= (dp/parse-clause '(or-join [?y] + (or-join [?x] + [?x :follows ?y]))) + '#datalog.parser.type.Or{:source #datalog.parser.type.DefaultSrc{}, + :rule-vars #datalog.parser.type.RuleVars{:required nil, + :free [#datalog.parser.type.Variable{:symbol ?y}]}, + :clauses [#datalog.parser.type.Or{:source #datalog.parser.type.DefaultSrc{}, + :rule-vars #datalog.parser.type.RuleVars{:required nil, + :free [#datalog.parser.type.Variable{:symbol ?x}]}, + :clauses [#datalog.parser.type.Pattern{:source #datalog.parser.type.DefaultSrc{}, + :pattern [#datalog.parser.type.Variable{:symbol ?x} + #datalog.parser.type.Constant{:value :follows} #datalog.parser.type.Variable{:symbol ?y}]}]}]})) + + + (is (thrown-with-msg? ExceptionInfo #"Join variable not declared inside clauses: \[\?y\]" + (dp/parse-clause '(or [?x] [?x ?y])))) + + (is (thrown-with-msg? ExceptionInfo #"Join variable not declared inside clauses: \[\?y\]" + (dp/parse-clause '(or [?x] [?y])))) + + (is (thrown-with-msg? ExceptionInfo #"Cannot parse rule-vars" + (dp/parse-clause '(or-join [] [?y])))) + + (is (thrown-with-msg? ExceptionInfo #"Join variables should not be empty" + (dp/parse-clause '(or [_])))) + + (is (thrown-with-msg? ExceptionInfo #"Cannot parse 'or-join' clause" + (dp/parse-clause '(or-join [?x])))) + + (is (thrown-with-msg? ExceptionInfo #"Cannot parse 'or' clause" + (dp/parse-clause '(or))))) + + +(deftest test-parse-return-maps + (testing "failed parsing" + (is (thrown-with-msg? ExceptionInfo #"Only one of these three options is allowed: :keys :strs :syms" + (dp/parse-return-maps {:keys '("keys" "strs" "syms") :syms '("keys" "strs" "syms")})))) + (testing "parsing correct options" + (is (= #datalog.parser.type.ReturnMaps{:mapping-type :keys, :mapping-keys (#datalog.parser.type.MappingKey{:mapping-key "keys"} #datalog.parser.type.MappingKey{:mapping-key "strs"} #datalog.parser.type.MappingKey{:mapping-key "syms"})} + (dp/parse-return-maps {:keys '("keys" "strs" "syms")}))) + (is (= #datalog.parser.type.ReturnMaps{:mapping-type :strs, :mapping-keys (#datalog.parser.type.MappingKey{:mapping-key "keys"} #datalog.parser.type.MappingKey{:mapping-key "strs"} #datalog.parser.type.MappingKey{:mapping-key "syms"})} + (dp/parse-return-maps {:strs '("keys" "strs" "syms")}))) + (is (= #datalog.parser.type.ReturnMaps{:mapping-type :syms, :mapping-keys (#datalog.parser.type.MappingKey{:mapping-key "keys"} #datalog.parser.type.MappingKey{:mapping-key "strs"} #datalog.parser.type.MappingKey{:mapping-key "syms"})} + (dp/parse-return-maps {:syms '("keys" "strs" "syms")}))))) diff --git a/test-resources/lib_tests/datalog/parser/pull_test.cljc b/test-resources/lib_tests/datalog/parser/pull_test.cljc new file mode 100644 index 00000000..1a13ad84 --- /dev/null +++ b/test-resources/lib_tests/datalog/parser/pull_test.cljc @@ -0,0 +1,42 @@ +(ns datalog.parser.pull-test + (:require [datalog.parser.pull :as dpp] + #?(:cljs [cljs.test :as t :refer-macros [is are deftest testing]] + :clj [clojure.test :as t :refer [is are deftest testing]]))) + +#?(:cljs + (def Throwable js/Error)) + +(deftest test-parse-pattern + (are [pattern expected] (= expected (dpp/parse-pull pattern)) + '[:db/id :foo/bar] + (dpp/->PullSpec false {:db/id {:attr :db/id} + :foo/bar {:attr :foo/bar}}) + + '[(limit :foo 1)] + (dpp/->PullSpec false {:foo {:attr :foo :limit 1}}) + + '[* (default :foo "bar")] + (dpp/->PullSpec true {:foo {:attr :foo :default "bar"}}) + + '[{:foo ...}] + (dpp/->PullSpec false {:foo {:attr :foo :recursion nil}}) + + '[{(limit :foo 2) [:bar :me]}] + (dpp/->PullSpec + false + {:foo {:attr :foo + :limit 2 + :subpattern (dpp/->PullSpec + false + {:bar {:attr :bar} + :me {:attr :me}})}}))) + +(deftest test-parse-bad-limit + (is + (thrown? Throwable (dpp/parse-pull '[(limit :foo :bar)])))) + +(deftest test-parse-bad-default + (is + (thrown? Throwable (dpp/parse-pull '[(default 1 :bar)])))) + +#_(t/test-ns 'datahike.test.pull-parser) diff --git a/test-resources/lib_tests/datalog/parser/test/util.cljc b/test-resources/lib_tests/datalog/parser/test/util.cljc new file mode 100644 index 00000000..747ec8b8 --- /dev/null +++ b/test-resources/lib_tests/datalog/parser/test/util.cljc @@ -0,0 +1,16 @@ +(ns datalog.parser.test.util + (:require [#?(:clj clojure.test :cljs cljs.test) :as test])) + +#?(:clj + (defmethod test/assert-expr 'thrown-msg? [msg form] + (let [[_ match & body] form] + `(try ~@body + (test/do-report {:type :fail, :message ~msg, :expected '~form, :actual nil}) + (catch Throwable e# + (let [m# (.getMessage e#)] + (test/do-report + {:type (if (= ~match m#) :pass :fail) + :message ~msg + :expected '~form + :actual e#})) + e#))))) diff --git a/test-resources/lib_tests/datalog/parser_test.cljc b/test-resources/lib_tests/datalog/parser_test.cljc new file mode 100644 index 00000000..95764275 --- /dev/null +++ b/test-resources/lib_tests/datalog/parser_test.cljc @@ -0,0 +1,96 @@ +(ns datalog.parser-test + (:require #?(:cljs [cljs.test :refer-macros [are deftest]] + :clj [clojure.test :refer [are deftest]]) + [datalog.parser :as parser] + [datalog.parser.test.util])) + +(deftest validation + (are [q result] (= result (parser/parse q)) + '[:find ?e + :in $ ?fname ?lname + :keys foo + :where [?e :user/firstName ?fname] + [?e :user/lastName ?lname]] + '#datalog.parser.type.Query{:qfind #datalog.parser.type.FindRel{:elements [#datalog.parser.type.Variable{:symbol ?e}]}, :qwith nil, :qin [#datalog.parser.type.BindScalar{:variable #datalog.parser.type.SrcVar{:symbol $}} #datalog.parser.type.BindScalar{:variable #datalog.parser.type.Variable{:symbol ?fname}} #datalog.parser.type.BindScalar{:variable #datalog.parser.type.Variable{:symbol ?lname}}], :qwhere [#datalog.parser.type.Pattern{:source #datalog.parser.type.DefaultSrc{}, :pattern [#datalog.parser.type.Variable{:symbol ?e} #datalog.parser.type.Constant{:value :user/firstName} #datalog.parser.type.Variable{:symbol ?fname}]} #datalog.parser.type.Pattern{:source #datalog.parser.type.DefaultSrc{}, :pattern [#datalog.parser.type.Variable{:symbol ?e} #datalog.parser.type.Constant{:value :user/lastName} #datalog.parser.type.Variable{:symbol ?lname}]}], :qlimit nil, :qoffset nil, :qreturnmaps #datalog.parser.type.ReturnMaps{:mapping-type :keys, :mapping-keys (#datalog.parser.type.MappingKey{:mapping-key foo})}} + + '[:find ?e + :in $ ?fname ?lname + :strs foo + :where [?e :user/firstName ?fname] + [?e :user/lastName ?lname]] + '#datalog.parser.type.Query{:qfind #datalog.parser.type.FindRel{:elements [#datalog.parser.type.Variable{:symbol ?e}]}, :qwith nil, :qin [#datalog.parser.type.BindScalar{:variable #datalog.parser.type.SrcVar{:symbol $}} #datalog.parser.type.BindScalar{:variable #datalog.parser.type.Variable{:symbol ?fname}} #datalog.parser.type.BindScalar{:variable #datalog.parser.type.Variable{:symbol ?lname}}], :qwhere [#datalog.parser.type.Pattern{:source #datalog.parser.type.DefaultSrc{}, :pattern [#datalog.parser.type.Variable{:symbol ?e} #datalog.parser.type.Constant{:value :user/firstName} #datalog.parser.type.Variable{:symbol ?fname}]} #datalog.parser.type.Pattern{:source #datalog.parser.type.DefaultSrc{}, :pattern [#datalog.parser.type.Variable{:symbol ?e} #datalog.parser.type.Constant{:value :user/lastName} #datalog.parser.type.Variable{:symbol ?lname}]}], :qlimit nil, :qoffset nil, :qreturnmaps #datalog.parser.type.ReturnMaps{:mapping-type :strs, :mapping-keys (#datalog.parser.type.MappingKey{:mapping-key foo})}} + + '[:find ?e + :in $ ?fname ?lname + :syms foo + :where [?e :user/firstName ?fname] + [?e :user/lastName ?lname]] + '#datalog.parser.type.Query{:qfind #datalog.parser.type.FindRel{:elements [#datalog.parser.type.Variable{:symbol ?e}]}, :qwith nil, :qin [#datalog.parser.type.BindScalar{:variable #datalog.parser.type.SrcVar{:symbol $}} #datalog.parser.type.BindScalar{:variable #datalog.parser.type.Variable{:symbol ?fname}} #datalog.parser.type.BindScalar{:variable #datalog.parser.type.Variable{:symbol ?lname}}], :qwhere [#datalog.parser.type.Pattern{:source #datalog.parser.type.DefaultSrc{}, :pattern [#datalog.parser.type.Variable{:symbol ?e} #datalog.parser.type.Constant{:value :user/firstName} #datalog.parser.type.Variable{:symbol ?fname}]} #datalog.parser.type.Pattern{:source #datalog.parser.type.DefaultSrc{}, :pattern [#datalog.parser.type.Variable{:symbol ?e} #datalog.parser.type.Constant{:value :user/lastName} #datalog.parser.type.Variable{:symbol ?lname}]}], :qlimit nil, :qoffset nil, :qreturnmaps #datalog.parser.type.ReturnMaps{:mapping-type :syms, :mapping-keys (#datalog.parser.type.MappingKey{:mapping-key foo})}} + + '{:find [?e] + :in [$ ?fname ?lname] + :keys [foo] + :where [[?e :user/firstName ?fname] + [?e :user/lastName ?lname]]} + '#datalog.parser.type.Query{:qfind #datalog.parser.type.FindRel{:elements [#datalog.parser.type.Variable{:symbol ?e}]}, :qwith nil, :qin [#datalog.parser.type.BindScalar{:variable #datalog.parser.type.SrcVar{:symbol $}} #datalog.parser.type.BindScalar{:variable #datalog.parser.type.Variable{:symbol ?fname}} #datalog.parser.type.BindScalar{:variable #datalog.parser.type.Variable{:symbol ?lname}}], :qwhere [#datalog.parser.type.Pattern{:source #datalog.parser.type.DefaultSrc{}, :pattern [#datalog.parser.type.Variable{:symbol ?e} #datalog.parser.type.Constant{:value :user/firstName} #datalog.parser.type.Variable{:symbol ?fname}]} #datalog.parser.type.Pattern{:source #datalog.parser.type.DefaultSrc{}, :pattern [#datalog.parser.type.Variable{:symbol ?e} #datalog.parser.type.Constant{:value :user/lastName} #datalog.parser.type.Variable{:symbol ?lname}]}], :qlimit nil, :qoffset nil, :qreturnmaps #datalog.parser.type.ReturnMaps{:mapping-type :keys, :mapping-keys (#datalog.parser.type.MappingKey{:mapping-key foo})}} + + '{:find [[?e ?fname]] + :keys [foo] + :in [$ ?fname ?lname] + :where [[?e :user/firstName ?fname] + [?e :user/lastName ?lname]]} +#datalog.parser.type.Query{:qfind #datalog.parser.type.FindTuple{:elements [#datalog.parser.type.Variable{:symbol ?e} #datalog.parser.type.Variable{:symbol ?fname}]}, :qwith nil, :qin [#datalog.parser.type.BindScalar{:variable #datalog.parser.type.SrcVar{:symbol $}} #datalog.parser.type.BindScalar{:variable #datalog.parser.type.Variable{:symbol ?fname}} #datalog.parser.type.BindScalar{:variable #datalog.parser.type.Variable{:symbol ?lname}}], :qwhere [#datalog.parser.type.Pattern{:source #datalog.parser.type.DefaultSrc{}, :pattern [#datalog.parser.type.Variable{:symbol ?e} #datalog.parser.type.Constant{:value :user/firstName} #datalog.parser.type.Variable{:symbol ?fname}]} #datalog.parser.type.Pattern{:source #datalog.parser.type.DefaultSrc{}, :pattern [#datalog.parser.type.Variable{:symbol ?e} #datalog.parser.type.Constant{:value :user/lastName} #datalog.parser.type.Variable{:symbol ?lname}]}], :qlimit nil, :qoffset nil, :qreturnmaps #datalog.parser.type.ReturnMaps{:mapping-type :keys, :mapping-keys (#datalog.parser.type.MappingKey{:mapping-key foo})}} + )) + +(deftest validation-fails + (are [q msg] (thrown-msg? msg (parser/parse q)) + '[:find ?e :where [?x]] + "Query for unknown vars: [?e]" + + '[:find ?e :with ?f :where [?e]] + "Query for unknown vars: [?f]" + + '[:find ?e ?x ?t :in ?x :where [?e]] + "Query for unknown vars: [?t]" + + '[:find ?x ?e :with ?y ?e :where [?x ?e ?y]] + ":find and :with should not use same variables: [?e]" + + '[:find ?e :in $ $ ?x :where [?e]] + "Vars used in :in should be distinct" + + '[:find ?e :in ?x $ ?x :where [?e]] + "Vars used in :in should be distinct" + + '[:find ?e :in $ % ?x % :where [?e]] + "Vars used in :in should be distinct" + + '[:find ?n :with ?e ?f ?e :where [?e ?f ?n]] + "Vars used in :with should be distinct" + + '[:find ?x :where [$1 ?x]] + "Where uses unknown source vars: [$1]" + + '[:find ?x :in $1 :where [$2 ?x]] + "Where uses unknown source vars: [$2]" + + '[:find ?e :where (rule ?e)] + "Missing rules var '%' in :in" + + '[:find ?e :where [?e] :limit [42]] + "Cannot parse :limit, expected java.lang.Long" + + '[:find ?e :where [?e] :offset [666]] + "Cannot parse :offset, expected java.lang.Long" + + '[:find ?e :keys foo bar :where [?e] :offset 666] + "Count of :keys/:strs/:syms must match count of :find" + + '[:find ?e ?f :keys foo :where [?e ?f] :offset 666] + "Count of :keys/:strs/:syms must match count of :find" + + '[:find [?e ?f] :keys foo bar :where [?e ?f] :offset 666] + "Count of :keys/:strs/:syms must match count of :find" + + '[:find ?e :strs '(foo bar) :keys '("foo" "bar") :where [?e] :offset 666] + "Only one of these three options is allowed: :keys :strs :syms")) diff --git a/test-resources/lib_tests/datalog/unparser_test.clj b/test-resources/lib_tests/datalog/unparser_test.clj new file mode 100644 index 00000000..8dc959ef --- /dev/null +++ b/test-resources/lib_tests/datalog/unparser_test.clj @@ -0,0 +1,25 @@ +(ns datalog.unparser-test + (:require [datalog.unparser :refer [unparse]] + [datalog.parser :refer [parse]] + [clojure.test :refer [deftest testing is] :as test]) + (:use [datalog.unparser])) + +(let [q '[:find (sum ?balance-before) ?balance-before + :in $before $after $txn $txs + :where + [(= ?balance-before 42)]]] + (deftest unparse-roundtrip-test + (testing "Datahike query unparsing." + (is (= q (unparse (parse q))))))) + + + +(comment ;; TODO + (let [q '[:find ?foo ?baz + :in $before $after + :where + [(= ?balance-before 42)] + (not [?foo :bar ?baz])]] + (deftest unparse-roundtrip-test + (testing "Datahike query unparsing." + (is (= q (unparse (parse q)))))))) diff --git a/test-resources/lib_tests/docopt/core_test.clj b/test-resources/lib_tests/docopt/core_test.clj new file mode 100644 index 00000000..a881b9b4 --- /dev/null +++ b/test-resources/lib_tests/docopt/core_test.clj @@ -0,0 +1,88 @@ +(ns docopt.core-test + (:require [cheshire.core :as json] + [clojure.string :as s] + [clojure.test :refer :all] + [docopt.core :as d] + [docopt.match :as m])) + +(def doc-block-regex + (let [doc-begin "r\\\"{3}" + doc-body "((?:\\\"{0,2}[^\\\"]+)*)" + separator "\\\"{3}\n+" + tests "((?:[^r]|r(?!\\\"{3}))*)"] + (re-pattern (str doc-begin doc-body separator tests)))) + +(def test-block-regex + (let [input-begin "(?:\\A|\\n+)\\s*\\$\\s*prog" + input-body "(.*)" + separator "\\n" + tests "((?:.+\\n)*)"] + (re-pattern (str input-begin input-body separator tests)))) + +(defn load-test-cases + "Loads language-agnostic docopt tests from file (such as testcases.docopt)." + [path] + (into [] (mapcat (fn [[_ doc tests]] + (map (fn [[_ args result]] + [doc (into [] (filter seq (s/split (or args "") #"\s+"))) (json/parse-string result)]) + (re-seq test-block-regex tests))) + (re-seq doc-block-regex (s/replace (slurp path) #"#.*" ""))))) + +(defn test-case-error-report + "Returns a report of all failed test cases" + [doc in out] + (let [docinfo (try (d/parse doc) + (catch Exception e (.getMessage e)))] + (if (string? docinfo) + (str "\n" (s/trim-newline doc) "\n" docinfo) + (let [result (or (m/match-argv docinfo in) "user-error")] + (when (not= result out) + (str "\n" (s/trim-newline doc) + "\n$ prog " (s/join " " in) + "\nexpected: " (json/generate-string out) + "\nobtained: " (json/generate-string result) "\n\n")))))) + +(defn valid? + "Validates all test cases found in the file named 'test-cases-file-name'." + [test-cases-file-name] + (let [test-cases (load-test-cases test-cases-file-name)] + (when-let [eseq (seq (remove nil? (map (partial apply test-case-error-report) test-cases)))] + (println "Failed" (count eseq) "/" (count test-cases) "tests loaded from '" test-cases-file-name "'.\n") + (throw (Exception. (apply str eseq)))) + (println "Successfully passed" (count test-cases) "tests loaded from '" test-cases-file-name "'.\n") + true)) + +(deftest docopt-test + (testing "2-arity version" + (is (= {"" "a"} + (d/docopt "usage: prog " ["a"])))) + + (testing "3-arity version" + (is (= "a" + (d/docopt "usage: prog " ["a"] #(get % ""))))) + + (testing "4-arity version" + (is (= "usage: prog " + (d/docopt "usage: prog " [] identity identity)))) + + ;; Adding this test here since it seems testcases file doesn't support quoted args + (testing "should parse quoted args correctly" + (is (= {"-f" "a b"} + (d/docopt "usage: prog [options]\noptions: -f " ["-f" "a b"]))) + (is (= {"--foo" "a\nb"} + (d/docopt "usage: prog [options]\noptions: --foo " ["--foo" "a\nb"]))) + (is (= {"" "a b c "} + (d/docopt "usage: prog " ["a b c "]))) + (is (= {"" "a\tb\nc"} + (d/docopt "usage: prog " ["a\tb\nc"]))) + (binding [docopt.match/*sep-table* {\ "FOO" + \newline "BAR" + \tab "QUX" + \backspace "QUZ"}] + (is (= {"" "a b\nc\td\b"} + (d/docopt "usage: prog " ["aFOObBARcQUXdQUZ"])))))) + +(deftest language-agnostic-test + (is (valid? "https://raw.github.com/docopt/docopt/511d1c57b59cd2ed663a9f9e181b5160ce97e728/testcases.docopt")) + ;; BB-TEST-PATCH: Modified test path + (is (valid? "test-resources/lib_tests/docopt/extra_testcases.docopt"))) diff --git a/test-resources/lib_tests/docopt/extra_testcases.docopt b/test-resources/lib_tests/docopt/extra_testcases.docopt new file mode 100644 index 00000000..c73eac15 --- /dev/null +++ b/test-resources/lib_tests/docopt/extra_testcases.docopt @@ -0,0 +1,57 @@ +# Should output the same things as docopt/docopt for language agnostic tests + +# Testing `--` + +r"""Usage: prog foo -- ... + +""" + +$ prog foo +"user-error" + +$ prog foo -- --bar +{"--":true, "": ["--bar"], "foo":true} + +r"""Usage: prog foo [--] ... + +""" + +$ prog foo +"user-error" +# Wrong, should be +# {"foo": true, "--": false, "": []} + +$ prog foo -- --bar +{"foo": true, "--": true, "": ["--bar"]} + +r"""Complex command + +Usage: + prog [options] -- ... + prog [options] -- ... + prog [options] + prog [options] + +Options: + -f --foo Foo + --bar Bar + +""" + +$ prog x y --foo +{"--":false,"--bar":null,"--foo":true,"":[],"":null,"":null,"":null,"":null,"":"x","":"y"} + +$ prog a b c d +{"--":false,"--bar":null,"--foo":false,"":[],"":"a","":"b","":"c","":"d","":null,"":null} + +$ prog a b c d --foo --bar bar +{"--":false,"--bar":"bar","--foo":true,"":[],"":"a","":"b","":"c","":"d","":null,"":null} + +$ prog x y --bar bar -- extra +{"--bar": "bar", "--foo": false, "": "x", "": "y", "--": true, "": ["extra"], "": null, "": null, "": null, "": null} + +$ prog a b c d --foo --bar bar -- extra +{"--foo": true, "--bar": "bar", "": null, "": null, "--": true, "": ["extra"], "": "a", "": "b", "": "c", "": "d"} + +$ prog x y -- e1 e2 e3 e4 +{"--bar": null, "--foo": false, "": "x", "": "y", "--": true, "": ["e1", "e2", "e3", "e4"], "": null, "": null, "": null, "": null} diff --git a/test-resources/lib_tests/doric/test/core.clj b/test-resources/lib_tests/doric/test/core.clj index 21a327aa..777d2c28 100644 --- a/test-resources/lib_tests/doric/test/core.clj +++ b/test-resources/lib_tests/doric/test/core.clj @@ -2,8 +2,7 @@ (:refer-clojure :exclude [format name when]) (:use [doric.core] [clojure.test] - [doric.org :only [th td render]]) - (:require [clojure.string :as str])) + [doric.org :only [th td render]])) (deftest test-title-case (is (= "Foo" (title-case "foo"))) @@ -73,6 +72,7 @@ ;; TODO (deftest test-body) (deftest test-render + ;; BB-TEST-PATCH: Switch to set as .contains isn't supported in bb as it's atypical Clojure (let [rendered (set (render [["1" "2"]["3" "4"]]))] (is (contains? rendered "| 1 | 2 |")) (is (contains? rendered "| 3 | 4 |")) diff --git a/test-resources/lib_tests/doric/test/doctest.clj b/test-resources/lib_tests/doric/test/doctest.clj new file mode 100644 index 00000000..f05f1c0f --- /dev/null +++ b/test-resources/lib_tests/doric/test/doctest.clj @@ -0,0 +1,93 @@ +(ns doric.test.doctest + (:use [clojure.java.io :only [file]] + [clojure.test]) + (:import (java.io PushbackReader StringReader))) + +(defn fenced-blocks + "detect and extract github-style fenced blocks in a file" + [s] + (map second + (re-seq #"(?m)(?s)^```clojure\n(.*?)\n^```" s))) + +(def prompt + ;; regex for finding 'foo.bar>' repl prompts + "(?m)\n*^\\S*>\\s*") + +(defn skip? + "is a result skippable?" + ;; if it's a comment, the answer is yes + [s] + (.startsWith s ";")) + +(defn reps + "given a string of read-eval-print sequences, separate the different + 'r-e-p's from each other" + [prompt s] + (rest (.split s prompt))) + +(defn markdown-tests + "extract all the tests from a markdown file" + [f] + (->> f + slurp + fenced-blocks + (mapcat (partial reps prompt)))) + +(defn repl-tests + "extract all the tests from a repl-session-like file" + [f] + (->> f + slurp + (reps prompt))) + +(defn temp-ns + "create a temporary ns, and return its name" + [] + (binding [*ns* *ns*] + (in-ns (gensym)) + (use 'clojure.core) + ;; BB-TEST-PATCH: bb can't .getName on ns + (str *ns*))) + +(defn eval-in-ns + "evaluate a form inside the given ns-name" + [ns form] + (binding [*ns* *ns*] + (in-ns ns) + (eval form))) + +(defn run-doctest + "run a single doctest, reporting success or failure" + [file idx ns test] + (let [r (PushbackReader. (StringReader. test)) + form (read r) + expected (.trim (slurp r)) + actual (when-not (skip? expected) + (.trim (try + (with-out-str + (pr (eval-in-ns ns form)) + (flush)) + (catch Exception _ + (println _) + (.toString (gensym))))))] + (if (or (skip? expected) + (= actual expected)) + (report {:type :pass}) + (report {:type :fail + :file file :line idx + :expected expected :actual actual})))) + +(defn run-doctests + "use text-extract-fn to get all the tests out of file, and run them + all, reporting success or failure" + [test-extract-fn file] + (let [ns (temp-ns)] + (doseq [[idx t] (map-indexed vector (test-extract-fn file))] + (run-doctest file idx ns t)) + (remove-ns ns))) + + +(comment + ;; example usage + (deftest bar-repl + (run-doctests repl-tests "test/bar.repl"))) diff --git a/test-resources/lib_tests/doric/test/readme.clj b/test-resources/lib_tests/doric/test/readme.clj new file mode 100644 index 00000000..615459ed --- /dev/null +++ b/test-resources/lib_tests/doric/test/readme.clj @@ -0,0 +1,6 @@ +(ns doric.test.readme + (:use [clojure.test] + [doric.test.doctest])) + +(deftest readme + (run-doctests markdown-tests "README.md")) diff --git a/test-resources/lib_tests/edn_query_language/core_test.cljc b/test-resources/lib_tests/edn_query_language/core_test.cljc new file mode 100644 index 00000000..17a62b30 --- /dev/null +++ b/test-resources/lib_tests/edn_query_language/core_test.cljc @@ -0,0 +1,386 @@ +(ns edn-query-language.core-test + (:require [clojure.spec.alpha :as s] + [clojure.spec.test.alpha :as s.test] + [clojure.test :refer [deftest is testing]] + [clojure.test.check :as tc] + [clojure.test.check.clojure-test :as test] + [clojure.test.check.generators :as gen] + [clojure.test.check.properties :as props] + [edn-query-language.core :as eql] + [edn-query-language.gen :as eql-gen])) + +(s.test/instrument) + +;; spec tests + +(defn valid-queries-props [] + (props/for-all [query (eql-gen/make-gen {} ::eql-gen/gen-query)] + (s/valid? ::eql/query query))) + +(test/defspec generator-makes-valid-queries {:max-size 12 :num-tests 50} (valid-queries-props)) + +(comment + (tc/quick-check 50 (valid-queries-props) :max-size 12)) + +;; lib tests + +(defn remove-meta [x] + (eql/transduce-children (map #(dissoc % :meta)) x)) + +(defn tquery->ast [query] + (remove-meta (eql/query->ast query))) + +(deftest test-query->ast + (testing "empty query" + (is (= (tquery->ast []) + {:type :root, :children []}))) + + (testing "single property" + (is (= (tquery->ast [:a]) + {:type :root, :children [{:type :prop, :dispatch-key :a, :key :a}]}))) + + (testing "multiple properties" + (is (= (tquery->ast [:a :b]) + {:type :root, + :children [{:type :prop, :dispatch-key :a, :key :a} + {:type :prop, :dispatch-key :b, :key :b}]}))) + + (testing "blank join" + (is (= (tquery->ast [{:a []}]) + {:type :root, + :children [{:type :join, :dispatch-key :a, :key :a, :query [], :children []}]}))) + + (testing "simple join" + (is (= (tquery->ast [{:a [:b]}]) + {:type :root, + :children [{:type :join, + :dispatch-key :a, + :key :a, + :query [:b], + :children [{:type :prop, :dispatch-key :b, :key :b}]}]}))) + + (testing "param expression" + (is (= (tquery->ast ['(:a {:foo "bar"})]) + {:type :root, + :children [{:type :prop, + :dispatch-key :a, + :key :a, + :params {:foo "bar"},}]}))) + + (testing "param join" + (is (= (tquery->ast ['({:a [:sub]} {:foo "bar"})]) + {:type :root, + :children [{:type :join, + :dispatch-key :a, + :key :a, + :query [:sub], + :children [{:type :prop, :dispatch-key :sub, :key :sub}], + :params {:foo "bar"},}]}))) + + (testing "param join 2" + (is (= (tquery->ast [{'(:a {:foo "bar"}) [:sub]}]) + {:type :root + :children [{:children [{:dispatch-key :sub + :key :sub + :type :prop}] + :dispatch-key :a + :key :a + :params {:foo "bar"} + :query [:sub] + :type :join}]}))) + + (testing "union query" + (is (= (tquery->ast [{:foo {:a [:b] + :c [:d]}}]) + {:type :root, + :children [{:type :join, + :dispatch-key :foo, + :key :foo, + :query {:a [:b], :c [:d]}, + :children [{:type :union, + :query {:a [:b], :c [:d]}, + :children [{:type :union-entry, + :union-key :a, + :query [:b], + :children [{:type :prop, :dispatch-key :b, :key :b}]} + {:type :union-entry, + :union-key :c, + :query [:d], + :children [{:type :prop, :dispatch-key :d, :key :d}]}]}]}]}))) + + (testing "unbounded recursion" + (is (= (tquery->ast '[{:item [:a :b {:parent ...}]}]) + '{:type :root, + :children [{:type :join, + :dispatch-key :item, + :key :item, + :query [:a :b {:parent ...}], + :children [{:type :prop, :dispatch-key :a, :key :a} + {:type :prop, :dispatch-key :b, :key :b} + {:type :join, :dispatch-key :parent, :key :parent, :query ...}]}]}))) + + (testing "bounded recursion" + (is (= (tquery->ast '[{:item [:a :b {:parent 5}]}]) + '{:type :root, + :children [{:type :join, + :dispatch-key :item, + :key :item, + :query [:a :b {:parent 5}], + :children [{:type :prop, :dispatch-key :a, :key :a} + {:type :prop, :dispatch-key :b, :key :b} + {:type :join, :dispatch-key :parent, :key :parent, :query 5}]}]}))) + + (testing "mutation expression" + (is (= (tquery->ast ['(a {})]) + '{:type :root, + :children [{:dispatch-key a, + :key a, + :params {}, + :type :call}]}))) + + (testing "mutation join expression" + (is (= (tquery->ast [{'(a {}) [:sub-query]}]) + '{:type :root, + :children [{:dispatch-key a, + :key a, + :params {}, + :type :call, + :query [:sub-query], + :children [{:type :prop, :dispatch-key :sub-query, :key :sub-query}]}]})))) + +(defn query<->ast-props [] + (props/for-all [query (eql-gen/make-gen {::eql-gen/gen-params + (fn [_] + (gen/map gen/keyword gen/string-alphanumeric))} + ::eql-gen/gen-query)] + (let [ast (-> query + eql/query->ast + eql/ast->query + eql/query->ast)] + (= ast (-> ast + eql/ast->query + eql/query->ast))))) + +(test/defspec query-ast-roundtrip {:max-size 12 :num-tests 100} (query<->ast-props)) + +(comment + (tc/quick-check 100 (query<->ast-props) :max-size 12)) + +(deftest test-ast->query + (is (= (eql/ast->query {:type :prop + :key :foo + :dispatch-key :foo}) + [:foo])) + + (is (= (eql/ast->query {:type :root + :children [{:type :prop + :dispatch-key :foo + :key :foo}]}) + [:foo]))) + +(deftest test-focus-subquery + (is (= (eql/focus-subquery [] []) + [])) + (is (= (eql/focus-subquery [:a :b :c] []) + [])) + (is (= (eql/focus-subquery [:a :b :c] [:d]) + [])) + (is (= (eql/focus-subquery [:a :b :c] [:a]) + [:a])) + (is (= (eql/focus-subquery [:a :b :c] [:a :b]) + [:a :b])) + (is (= (eql/focus-subquery [:a {:b [:d]}] [:a :b]) + [:a {:b [:d]}])) + (is (= (eql/focus-subquery [:a {:b [:c :d]}] [:a {:b [:c]}]) + [:a {:b [:c]}])) + (is (= (eql/focus-subquery [:a '({:b [:c :d]} {:param "value"})] [:a {:b [:c]}]) + [:a '({:b [:c]} {:param "value"})])) + + ; in union case, keys absent from focus will be pulled anyway, given ones will focus + (is (= (eql/focus-subquery [:a {:b {:c [:d :e] + :f [:g :h]}}] + [:a {:b {:f [:g]}}]) + [:a {:b {:c [:d :e] :f [:g]}}]))) + +(defn transduce-query [xform query] + (->> query eql/query->ast + (eql/transduce-children xform) + eql/ast->query)) + +(deftest test-tranduce-children + (is (= (transduce-query + (comp (filter (comp #{:a :c} :key)) + (map #(assoc % :params {:n 42}))) + [:a :b :c :d]) + '[(:a {:n 42}) (:c {:n 42})]))) + +(deftest test-merge-queries + (is (= (eql/merge-queries nil nil) + [])) + + (is (= (eql/merge-queries [:a] nil) + [:a])) + + (is (= (eql/merge-queries [] []) + [])) + + (is (= (eql/merge-queries [:a] []) + [:a])) + + (is (= (eql/merge-queries [:a] [:a]) + [:a])) + + (is (= (eql/merge-queries [:a] [:b]) + [:a :b])) + + (is (= (eql/merge-queries [:a] [:b :c :d]) + [:a :b :c :d])) + + (is (= (eql/merge-queries [[:u/id 1]] [[:u/id 2]]) + [[:u/id 1] [:u/id 2]])) + + (is (= (eql/merge-queries [{:user [:name]}] [{:user [:email]}]) + [{:user [:name :email]}])) + + (is (= (eql/merge-queries [:a] [{:a [:x]}]) + [{:a [:x]}])) + + (is (= (eql/merge-queries [{:a [:x]}] [:a]) + [{:a [:x]}])) + + (testing "don't merge queries with different params" + (is (= (eql/merge-queries ['({:user [:name]} {:login "u1"})] + ['({:user [:email]} {:login "u2"})]) + nil))) + + (testing "don't merge queries with different params" + (is (= (eql/merge-queries ['(:user {:login "u1"})] + ['(:user {:login "u2"})]) + nil))) + + (testing "merge when params are same" + (is (= (eql/merge-queries ['({:user [:name]} {:login "u1"})] + ['({:user [:email]} {:login "u1"})]) + ['({:user [:name :email]} {:login "u1"})]))) + + (testing "calls can't be merged when same name occurs" + (is (= (eql/merge-queries ['(hello {:login "u1"})] + ['(hello {:bla "2"})]) + nil))) + + (testing "even when parameters are the same" + (is (= (eql/merge-queries ['(hello {:login "u1"})] + ['(hello {:login "u1"})]) + nil)))) + +(deftest test-update-child + (is (= (eql/update-child {:children [{:dispatch-key :id :key :id :type :prop} + {:dispatch-key :parent :key :parent :query 3 :type :join}] + :type :root} + :parent update :query dec) + {:children [{:dispatch-key :id :key :id :type :prop} + {:dispatch-key :parent :key :parent :query 2 :type :join}] + :type :root}))) + +(deftest update-recursive-depth-test + (is (= (eql/update-recursive-depth + {:children [{:dispatch-key :id :key :id :type :prop} + {:dispatch-key :parent :key :parent :query 3 :type :join}] + :type :root} + :parent dec) + {:children [{:dispatch-key :id :key :id :type :prop} + {:dispatch-key :parent :key :parent :query 2 :type :join}] + :type :root}))) + +(deftest test-mask-query + (is (= (eql/mask-query [] []) + [])) + (is (= (eql/mask-query [:foo :bar] []) + [])) + (is (= (eql/mask-query [:foo :bar] [:foo]) + [:foo])) + (is (= (eql/mask-query [:bar :foo] [:foo]) + [:foo])) + (is (= (eql/mask-query [:foo {:bar [:inside]}] [:foo]) + [:foo])) + (is (= (eql/mask-query ['(:foo {:bla "meh"}) :bar] [:foo]) + ['(:foo {:bla "meh"})])) + (is (= (eql/mask-query [:foo {:bar [:inside :more]}] [:foo :bar]) + [:foo {:bar [:inside :more]}])) + (is (= (eql/mask-query [:foo {:bar [:inside :more]}] [:foo {:bar [:inside]}]) + [:foo {:bar [:inside]}]))) + +(deftest test-normalize-query-variables + (testing "blank query" + (is (= (eql/normalize-query-variables []) + []))) + + (testing "simple query" + (is (= (eql/normalize-query-variables [:a :b :c]) + [:a :b :c]))) + + (testing "normalize ident values" + (is (= (eql/normalize-query-variables [[:foo "bar"]]) + [[:foo ::eql/var]]))) + + (testing "normalize params" + (is (= (eql/normalize-query-variables ['(:foo {:x 1 :y 2})]) + ['(:foo {:x ::eql/var :y ::eql/var})]))) + + (testing "all together" + (is (= (eql/normalize-query-variables '[:a :b {[:join "val"] [{(:c {:page 10}) [:d]}]}]) + '[:a :b + {[:join ::eql/var] + [({:c [:d]} + {:page ::eql/var})]}])))) + +(deftest test-query-id + (is (= (eql/query-id '[:a :b {[:join "val"] [{(:c {:page 10}) [:d]}]}]) + -61421281))) + + +(deftest shallow-conversion + (testing "requesting shallow conversion will only convert the first layer of a query" + (let [ast (eql/query->shallow-ast [:x + {:y [{:z [:a]}]} + {[:table 1] [:z {:other [:m :n]}]} + {:ujoin {:u1 [:x] :u2 [:y]}}])] + (is (= {:type :root, + :children [{:type :prop, :dispatch-key :x, :key :x} + ;; BB-TEST-PATCH: bb returns {} for some meta calls that clojure doesn't + {:type :join, :dispatch-key :y, :key :y, :query [{:z [:a]}] :meta {}} + {:type :join, :dispatch-key :table, :key [:table 1], :query [:z {:other [:m :n]}] :meta {}} + {:type :join, :dispatch-key :ujoin, :key :ujoin, :query {:u1 [:x], :u2 [:y]} :meta {}}]} + ast))))) + + +(deftest merge-asts-as-reduce-function + (testing + "init - when called with arity zero, it returns an empty ast" + (is (= {:type :root + :children []} + (transduce (map identity) + eql/merge-asts + [])))) + (testing + "completion - when called with arity one, it should return its argument" + (is (= {:children [{:dispatch-key :a + :key :a + :type :prop}] + :type :root} + (transduce (map identity) + eql/merge-asts + [(eql/query->ast [:a])])))) + (testing + "step - the old arity 2. Should compose both nodes into a new node" + (is (= {:children [{:dispatch-key :a + :key :a + :type :prop} + {:dispatch-key :b + :key :b + :type :prop}] + :type :root} + (transduce (map identity) + eql/merge-asts + [(eql/query->ast [:a]) + (eql/query->ast [:b])]))))) diff --git a/test-resources/lib_tests/exoscale/lingo/test/core_test.cljc b/test-resources/lib_tests/exoscale/lingo/test/core_test.cljc new file mode 100644 index 00000000..d6fa482c --- /dev/null +++ b/test-resources/lib_tests/exoscale/lingo/test/core_test.cljc @@ -0,0 +1,385 @@ +(ns exoscale.lingo.test.core-test + (:require [clojure.test :refer [are deftest is]] + [exoscale.lingo :as l] + [exoscale.lingo.impl :as impl] + [exoscale.lingo.highlight :as u] + [clojure.spec.alpha :as s])) + +(defn f2? [_] false) +(defn f3? [_] false) + +(l/set-spec-error! `exoscale.lingo.test.core-test/f2? "yolo") +(l/set-spec-error! `f3? "should match Something") + +(-> (s/def ::thing #(string? %)) + (l/set-spec-error! "should be a string with bla bla bla")) + +(s/def ::things (s/coll-of ::thing)) + +(s/def :foo/name string?) + +(s/def :foo/names (s/coll-of :foo/name)) + +(s/def :foo/person (s/keys :req-un [:foo/names])) + +(s/def :foo/age int?) +(s/def :foo/agent (s/keys :req-un [:foo/person :foo/age])) + +(s/def :foo/agent2 (s/keys :req-un [:foo/person :foo/age])) + +(def ^:dynamic *opts* {:highlight? false + :group-missing-keys? false + :group-or-problems? false + :header? false}) + +(deftest test-outputs + (are [spec val output] (= (l/explain-str spec val *opts*) + output) + + ::thing + 1 + "1 is an invalid :exoscale.lingo.test.core-test/thing - should be a string with bla bla bla\n" + + (s/coll-of ::thing) + [1] + "1 in `[0]` is an invalid :exoscale.lingo.test.core-test/thing - should be a string with bla bla bla\n" + + ::things + [1] + "1 in `[0]` is an invalid :exoscale.lingo.test.core-test/thing - should be a string with bla bla bla\n" + + ;; test traversing + (s/def ::things2 ::things) + [1] + "1 in `[0]` is an invalid :exoscale.lingo.test.core-test/thing - should be a string with bla bla bla\n" + + ::things + 1 + "1 is an invalid :exoscale.lingo.test.core-test/things - should be a Collection\n" + + (s/and string? #(> (count %) 3)) + "" + "\"\" is invalid - should contain more than 3 elements\n" + + (s/def ::cnt #(> (count %) 3)) + "" + "\"\" is an invalid :exoscale.lingo.test.core-test/cnt - should contain more than 3 elements\n" + + ;; test the original unchanged msg + (s/and string? #(pos? (count %))) + "" + "\"\" is invalid - (pos? (count %))\n" + + ;; with a custom pred matcher + (do + (l/set-pred-error! #{'(pos? (count %))} (constantly "should be non blank")) + (s/and string? #(pos? (count %)))) + "" + "\"\" is invalid - should be non blank\n" + + #{:a :b :c} + "b" + "\"b\" is invalid - should be one of :a, :b, :c\n" + + ;; (s/and string? #(xss/string-of* % {:blank? false :min-length 3 :max-length 10})) + ;; "" + ;; "\"\" is invalid - should be a String non blank, at least 3 characters in length, at most 10 characters in length\n" + (s/def :exoscale.lingo/c1 (s/map-of int? int? :count 3)) + {"a" "b"} + "{\"a\" \"b\"} is an invalid :exoscale.lingo/c1 - should contain exactly 3 elements\n" + + (s/and any? #(= 1 (count %))) + [] + "[] is invalid - should contain exactly 1 element\n" + + (s/and any? #(= (count %) 1)) + [] + "[] is invalid - should contain exactly 1 element\n" + + (s/and any? #(= 42 (count %))) + [] + "[] is invalid - should contain exactly 42 elements\n" + + (s/and any? #(= (count %) 42)) + [] + "[] is invalid - should contain exactly 42 elements\n" + + (s/and any? #(>= (count %) 42)) + [] + "[] is invalid - should contain at least 42 elements\n" + + (s/and any? #(<= (count %) 1)) + [1 1] + "[1 1] is invalid - should contain at most 1 element\n" + + (s/and any? #(<= % 1)) + 10 + "10 is invalid - should be at most 1\n" + + (s/and any? #(< % 1)) + 10 + "10 is invalid - should be less than 1\n" + + (s/and any? #(>= % 1)) + 0 + "0 is invalid - should be at least 1\n" + + (s/and any? #(> % 1)) + 0 + "0 is invalid - should be greater than 1\n" + + (s/and any? #(= % "yolo")) + 0 + "0 is invalid - should be equal to yolo\n" + + (s/and any? #(= "yolo" %)) + 0 + "0 is invalid - should be equal to yolo\n" + + (s/int-in 0 10) + -1 + "-1 is invalid - should be an Integer between 0 10\n" + + (s/and number? #(<= 0 % 10)) + -1 + "-1 is invalid - should be an Integer between 0 10\n" + + (s/double-in :min 0 :max 10) + (double 11) + "11.0 is invalid - should be at most 10\n" + + (s/coll-of any? :min-count 3) + [1] + "[1] is invalid - should contain at least 3 elements\n" + + (s/coll-of any? :max-count 3) + [1 1 1 1] + "[1 1 1 1] is invalid - should contain between 0 3 elements\n" + + (s/coll-of any? :max-count 3 :min-count 1) + [1 1 1 1] + "[1 1 1 1] is invalid - should contain between 1 3 elements\n" + + (s/coll-of any? :count 3) + [1 1 1 1] + "[1 1 1 1] is invalid - should contain exactly 3 elements\n" + + (s/coll-of any? :count 1) + [1 1 1 1] + "[1 1 1 1] is invalid - should contain exactly 1 element\n" + + (s/coll-of any? :kind set?) + [1] + "[1] is invalid - should be a Set\n" + + (s/map-of any? any? :count 1) + {:a 1 :b 2} + "{:a 1, :b 2} is invalid - should contain exactly 1 element\n" + + neg-int? + [1] + "[1] is invalid - should be a Negative Integer\n" + + (s/def :foo/agent (s/keys :req-un [:foo/person :foo/age])) + {:age 10} + "{:age 10} is an invalid :foo/agent - missing key :person\n" + + (s/def :foo/agent (s/keys :req [:foo/person :foo/age])) + {:foo/age 10} + "#:foo{:age 10} is an invalid :foo/agent - missing key :foo/person\n" + + (do + (alter-var-root #'*opts* assoc :hide-keyword-namespaces? true) + (s/def :foo/agent (s/keys :req [:foo/person :foo/age]))) + {:foo/age 10} + "#:foo{:age 10} is an invalid :foo/agent - missing key :person\n" + + (do + (alter-var-root #'*opts* dissoc :hide-keyword-namespaces?) + (s/def :foo/agent (s/keys :req-un [:foo/person :foo/age]))) + {:age 10 :person {:names [1]}} + "1 in `person.names[0]` is an invalid :foo/name - should be a String\n" + + (-> (s/def :foo/agent2 (s/keys :req-un [:foo/person :foo/age])) + ;; (xs/with-meta! {:exoscale.lingo/name "Agent"}) + ) + {:age ""} + "\"\" in `age` is an invalid :foo/age - should be an Integer\n{:age \"\"} is an invalid :foo/agent2 - missing key :person\n" + + (s/def :foo/animal #{:a :b :c}) + 1 + "1 is an invalid :foo/animal - should be one of :a, :b, :c\n" + + :foo/person + {:names [1 :yolo]} + "1 in `names[0]` is an invalid :foo/name - should be a String\n:yolo in `names[1]` is an invalid :foo/name - should be a String\n" + + nil? + 1 + "1 is invalid - should be nil\n" + + (s/nilable string?) + 1 + "1 is invalid - should be a String\n1 is invalid - should be nil\n" + + ;; BB-TEST-PATCH: bb returns sci details instead of string + #_f2? + #_1 + #_"1 is invalid - yolo\n" + + ;; BB-TEST-PATCH: bb returns sci details instead of string + #_f3? + #_1 + #_"1 is invalid - should match Something\n")) + +(deftest focus-test + (let [_ '_] + (is (= [_ _ _] (u/focus [3 2 1] nil))) + (is (= _ (u/focus 1 nil))) + (is (= 1 (u/focus 1 []))) + + (is (= [_ _ 1] (u/focus [3 2 1] [2]))) + (is (= [3 _ _] (u/focus [3 2 1] [0]))) + + (is (= {:a 1} (u/focus {:a 1} [:a]))) + (is (= {:a _} (u/focus {:a 1} [:b]))) + (is (= {:a _ :c 1} (u/focus {:a {:b 1} :c 1} [:c]))) + + (is (= {:a {:b [_ {:c {:d #{:b :a}, :e _}}]}} + (u/focus {:a {:b [1 {:c {:d #{:a :b} :e :foo}}]}} + [:a :b 1 :c :d] + {:descend-mismatching-nodes? true}))) + + (is (= {:a {:b [1 {:c {:d #{_}, :e _}}]}} + (u/focus {:a {:b [1 {:c {:d #{:a :b} :e :foo}}]}} + [:a :b 0] + {:descend-mismatching-nodes? true}))) + + (is (= {:a {:b [_ {:c {:d #{_}, :e _}}]}} + (u/focus {:a {:b [1 {:c {:d #{:a :b} :e :foo}}]}} + nil + {:descend-mismatching-nodes? true}))) + + (is (= {:a {:b [1 _]}} + (u/focus {:a {:b [1 {:c {:d #{:a :b} :e :foo}}]}} + [:a :b 0]))) + + (is (= {:a {:b [_ {:c {:d #{:b :a} :e _}}]}} + (u/focus {:a {:b [1 {:c {:d #{:b :a} :e {:f 1}}}]}} + [:a :b 1 :c :d]))))) + +(deftest highlight-test + (are [input path output] + (= (u/highlight input path {:focus? true}) + output) + + [3 2 1] {:in [2] :val 1} "[_ _ 1]\n ^" + + [3 2 1] {:in [0] :val 3} "[3 _ _]\n ^" + + {:a 1} {:in [:a] :val 1} "{:a 1}\n ^" + + {:a {:b 1} :c 1} {:in [:c] :val 1} "{:a _, :c 1}\n ^" + + {:a {:b [1 {:c {:d #{:a :b} :e :foo}}]}} + {:in [:a :b 1 :c :d] :val #{:a :b}} + "{:a {:b [_ {:c {:d #{:b :a}, :e _}}]}}\n ^^^^^^^^" + + {:a {:b [1 {:c {:d #{:a :b} :e :foo}}]}} + {:in [:a :b 0] :val 1} + "{:a {:b [1 _]}}\n ^" + + {:a {:b [1 {:c {:d #{:a :b} :e :foo}}]}} + {:in [:a :b 0] :val 1} + "{:a {:b [1 _]}}\n ^" + + {:a {:b [1 {:c {:d #{:b :a} :e {:f 1}}}]}} + {:in [:a :b 1 :c :d] :val #{:b :a}} + "{:a {:b [_ {:c {:d #{:b :a}, :e _}}]}}\n ^^^^^^^^" + + ;; single line hl + {:a {:bar 255555 :c 3 :d 4 :e 5}} + {:in [:a :bar] :val 255555} + "{:a {:bar 255555, :c _, :d _, :e _}}\n ^^^^^^" + + ;; ;; multiline hl output + {:aaaaaaaaaaaaa + {:bbbbbbbbbbbbbbbbbdddddddddddddddddddddddddddddddddddddd 2 :c 33333 :d 4 :e 5}} + {:in [:aaaaaaaaaaaaa :c] :val 33333} + "{:aaaaaaaaaaaaa\n {:bbbbbbbbbbbbbbbbbdddddddddddddddddddddddddddddddddddddd _,\n :c 33333,\n ^^^^^\n :d _,\n :e _}}") + (is (= ["[1]\n ^ should be a string with bla bla bla"] + (->> (l/explain-data ::things [1]) + :clojure.spec.alpha/problems + (map :exoscale.lingo.explain/highlight))))) + +(deftest test-group-map-keys + (is (= "missing keys :age, :person" + (-> (l/explain-data :foo/agent2 {} {:group-missing-keys? true}) + :clojure.spec.alpha/problems + first + :exoscale.lingo.explain/message))) + + (is (= #{"missing keys :age, :person" + "missing keys :names"} + (->> (l/explain-data (s/tuple :foo/agent2 :foo/person) + [{} {}] + {:group-missing-keys? true}) + :clojure.spec.alpha/problems + (map :exoscale.lingo.explain/message) + set)))) + +(deftest test-group-or-keys + (s/def ::test-group-or-keys (s/nilable string?)) + (s/def ::test-group-or-keys2 (s/or :str string? :int int?)) + (is (= #{"should be a String OR should be nil"} + (->> (l/explain-data ::test-group-or-keys + 1 + {:group-or-problems? true + :group-missing-keys? true}) + :clojure.spec.alpha/problems + (map :exoscale.lingo.explain/message) + set))) + (is (= #{"should be a String OR should be an Integer"} + (->> (l/explain-data ::test-group-or-keys2 + :kw + {:group-or-problems? true + :group-missing-keys? true}) + :clojure.spec.alpha/problems + (map :exoscale.lingo.explain/message) + set))) + + (is (= #{"should be a String OR should be nil"} + (->> (l/explain-data (s/coll-of (s/or :_ ::test-group-or-keys + :_ string?)) + ["" 1] + {:group-or-problems? true + :group-missing-keys? true}) + :clojure.spec.alpha/problems + (map :exoscale.lingo.explain/message) + set)) + "ensure there is no duplication of messages in the final pb string") + + (s/def ::test-group-or-keys3 int?) + (is (= #{"should be a String OR should be nil" + "should be a String OR should be an Integer" + "should be an Integer"} + (->> (l/explain-data (s/keys :req-un [::test-group-or-keys]) + {:test-group-or-keys 1 + ::test-group-or-keys2 :boom + ::test-group-or-keys3 ""} + {:group-or-problems? true + :group-missing-keys? true}) + :clojure.spec.alpha/problems + (map :exoscale.lingo.explain/message) + set)) + "grouping does not alter the other problems")) + +(deftest fix-map-path-test + (is (= [] (impl/fix-map-path [] []))) + (is (= [] (impl/fix-map-path {} []))) + (is (= [:a] (impl/fix-map-path {:a 1} [:a 1]))) + (is (= [:a :b :c] (impl/fix-map-path {:a {:b {:c 1}}} [:a 1 :b 1 :c 1]))) + (is (= [:a :b :c 0] (impl/fix-map-path {:a {:b {:c [1]}}} + [:a 1 :b 1 :c 1 0]))) + (is (= [:a :b :c 1 :d] + (impl/fix-map-path {:a {:b {:c [{} {:d 1}]}}} [:a 1 :b 1 :c 1 1 :d 1])))) diff --git a/test-resources/lib_tests/expound/alpha_test.cljc b/test-resources/lib_tests/expound/alpha_test.cljc new file mode 100644 index 00000000..5e663419 --- /dev/null +++ b/test-resources/lib_tests/expound/alpha_test.cljc @@ -0,0 +1,4350 @@ +(ns expound.alpha-test + (:require #?@(:clj + ;; just to include the specs + [[clojure.core.specs.alpha] + [ring.core.spec] + [onyx.spec]]) + + ;; Deps for specs that generate specs, which are currently disabled + #_[clojure.test.check.random :as random] + #_[clojure.test.check.rose-tree :as rose] + + [clojure.set :as set] + [clojure.spec.alpha :as s] + [clojure.spec.test.alpha :as st] + [clojure.string :as string] + [clojure.test :as ct :refer [is testing deftest use-fixtures]] + [clojure.test.check.generators :as gen] + + [clojure.walk :as walk] + [com.gfredericks.test.chuck :as chuck] + [com.gfredericks.test.chuck.clojure-test :refer [checking]] + [expound.alpha :as expound] + [expound.ansi :as ansi] + [expound.printer :as printer] + [expound.problems :as problems] + [expound.spec-gen :as sg] + [expound.test-utils :as test-utils] + [spec-tools.data-spec :as ds] + #?(:clj [orchestra.spec.test :as orch.st] + :cljs [orchestra-cljs.spec.test :as orch.st]))) + +;;;; override specs and add generators +;;;; this allows us to load expound with babaska and spartan.spec +(s/def :expound.printer/value-str-fn (s/with-gen ifn? + #(gen/return (fn [_ _ _ _] "NOT IMPLEMENTED")))) + +(s/def :expound.spec/spec (s/or + :set set? + :pred (s/with-gen ifn? + #(gen/elements [boolean? string? int? keyword? symbol?])) + :kw qualified-keyword? + :spec (s/with-gen s/spec? + #(gen/elements + (for [pr [boolean? string? int? keyword? symbol?]] + (s/spec pr)))))) + +;;;;;;;;;;;;;;;;;;;;;;;;;;;;; + +(def num-tests 5) + +(use-fixtures :once + test-utils/check-spec-assertions + test-utils/instrument-all) + +;; Missing onyx specs +(s/def :trigger/materialize any?) +(s/def :flow/short-circuit any?) + +(defn pf + "Fixes platform-specific namespaces and also formats using printf syntax" + [s & args] + (apply printer/format + #?(:cljs (string/replace s "pf." "cljs.") + :clj (string/replace s "pf." "clojure.")) + args)) + +(defn take-lines [n s] + (string/join "\n" (take n (string/split-lines s)))) + +(defn formatted-exception [printer-options f] + (let [printer (expound/custom-printer printer-options) + exception-data (binding [s/*explain-out* printer] + (try + (f) + (catch #?(:cljs :default :clj Exception) + e + #?(:cljs {:message (.-message e) + :data (.-data e)} + + :clj (Throwable->map e))))) + ed #?(:cljs (-> exception-data :data) + :clj (-> exception-data :via last :data)) + cause# (-> #?(:cljs (:message exception-data) + :clj (:cause exception-data)) + (clojure.string/replace #"Call to (.*) did not conform to spec:" + "Call to #'$1 did not conform to spec."))] + + (str cause# + (if (re-find #"Detected \d+ error" cause#) + "" + (str "\n" + (with-out-str (printer ed))))))) + +(defn orch-unstrument-test-fns [f] + (orch.st/unstrument [`results-str-fn1 + `results-str-fn2 + `results-str-fn4 + `results-str-fn7]) + (f)) + +(def inverted-ansi-codes + (reduce + (fn [m [k v]] + (assoc m (str v) k)) + {} + ansi/sgr-code)) + +(defn readable-ansi [s] + (string/replace + s + #"\x1b\[([0-9]*)m" + #(str "<" (string/upper-case (name (get inverted-ansi-codes (second %)))) ">"))) + +;; https://github.com/bhb/expound/issues/8 +(deftest expound-output-ends-in-newline + (is (= "\n" (str (last (expound/expound-str string? 1))))) + (is (= "\n" (str (last (expound/expound-str string? "")))))) + +(deftest expound-prints-expound-str + (is (= + (expound/expound-str string? 1) + (with-out-str (expound/expound string? 1))))) + +(deftest predicate-spec + (is (= (pf "-- Spec failed -------------------- + + 1 + +should satisfy + + string? + +------------------------- +Detected 1 error\n") + (expound/expound-str string? 1)))) + +(s/def :simple-type-based-spec/str string?) + +(deftest simple-type-based-spec + (testing "valid value" + (is (= "Success!\n" + (expound/expound-str :simple-type-based-spec/str "")))) + + (testing "invalid value" + (is (= + (pf "-- Spec failed -------------------- + + 1 + +should satisfy + + string? + +-- Relevant specs ------- + +:simple-type-based-spec/str: + pf.core/string? + +------------------------- +Detected 1 error\n") + (expound/expound-str :simple-type-based-spec/str 1))))) + +(s/def :set-based-spec/tag #{:foo :bar}) +(s/def :set-based-spec/nilable-tag (s/nilable :set-based-spec/tag)) +(s/def :set-based-spec/set-of-one #{:foobar}) + +(s/def :set-based-spec/one-or-two (s/or + :one (s/cat :a #{:one}) + :two (s/cat :b #{:two}))) + +(deftest set-based-spec + (testing "prints valid options" + (is (= "-- Spec failed -------------------- + + :baz + +should be one of: :bar, :foo + +-- Relevant specs ------- + +:set-based-spec/tag: + #{:bar :foo} + +------------------------- +Detected 1 error\n" + (expound/expound-str :set-based-spec/tag :baz)))) + + (testing "prints combined options for various specs" + (is (= (pf "-- Spec failed -------------------- + + [:three] + ^^^^^^ + +should be one of: :one, :two + +-- Relevant specs ------- + +:set-based-spec/one-or-two: + (pf.spec.alpha/or + :one + (pf.spec.alpha/cat :a #{:one}) + :two + (pf.spec.alpha/cat :b #{:two})) + +------------------------- +Detected 1 error\n") + (expound/expound-str :set-based-spec/one-or-two [:three])))) + + (testing "nilable version" + (is (= (pf "-- Spec failed -------------------- + + :baz + +should be one of: :bar, :foo + +or + +should satisfy + + nil? + +-- Relevant specs ------- + +:set-based-spec/tag: + #{:bar :foo} +:set-based-spec/nilable-tag: + (pf.spec.alpha/nilable :set-based-spec/tag) + +------------------------- +Detected 1 error\n") + (expound/expound-str :set-based-spec/nilable-tag :baz)))) + (testing "single element spec" + (is (= (pf "-- Spec failed -------------------- + + :baz + +should be: :foobar + +-- Relevant specs ------- + +:set-based-spec/set-of-one: + #{:foobar} + +------------------------- +Detected 1 error\n") + (expound/expound-str :set-based-spec/set-of-one :baz))))) + +(s/def :nested-type-based-spec/str string?) +(s/def :nested-type-based-spec/strs (s/coll-of :nested-type-based-spec/str)) + +(deftest nested-type-based-spec + (is (= + (pf "-- Spec failed -------------------- + + [... ... 33] + ^^ + +should satisfy + + string? + +-- Relevant specs ------- + +:nested-type-based-spec/str: + pf.core/string? +:nested-type-based-spec/strs: + (pf.spec.alpha/coll-of :nested-type-based-spec/str) + +------------------------- +Detected 1 error\n") + (expound/expound-str :nested-type-based-spec/strs ["one" "two" 33])))) + +(s/def :nested-type-based-spec-special-summary-string/int int?) +(s/def :nested-type-based-spec-special-summary-string/ints (s/coll-of :nested-type-based-spec-special-summary-string/int)) + +(deftest nested-type-based-spec-special-summary-string + (is (= + (pf "-- Spec failed -------------------- + + [... ... \"...\"] + ^^^^^ + +should satisfy + + int? + +-- Relevant specs ------- + +:nested-type-based-spec-special-summary-string/int: + pf.core/int? +:nested-type-based-spec-special-summary-string/ints: + (pf.spec.alpha/coll-of + :nested-type-based-spec-special-summary-string/int) + +------------------------- +Detected 1 error\n") + (expound/expound-str :nested-type-based-spec-special-summary-string/ints [1 2 "..."])))) + +(s/def :or-spec/str-or-int (s/or :int int? :str string?)) +(s/def :or-spec/vals (s/coll-of :or-spec/str-or-int)) + +(s/def :or-spec/str string?) +(s/def :or-spec/int int?) +(s/def :or-spec/m-with-str (s/keys :req [:or-spec/str])) +(s/def :or-spec/m-with-int (s/keys :req [:or-spec/int])) +(s/def :or-spec/m-with-str-or-int (s/or :m-with-str :or-spec/m-with-str + :m-with-int :or-spec/m-with-int)) + +(deftest or-spec + (testing "simple value" + (is (= (pf "-- Spec failed -------------------- + + :kw + +should satisfy + + int? + +or + + string? + +-- Relevant specs ------- + +:or-spec/str-or-int: + (pf.spec.alpha/or :int pf.core/int? :str pf.core/string?) + +------------------------- +Detected 1 error\n") + (expound/expound-str :or-spec/str-or-int :kw)))) + (testing "collection of values" + (is (= (pf "-- Spec failed -------------------- + + [... ... :kw ...] + ^^^ + +should satisfy + + int? + +or + + string? + +-- Relevant specs ------- + +:or-spec/str-or-int: + (pf.spec.alpha/or :int pf.core/int? :str pf.core/string?) +:or-spec/vals: + (pf.spec.alpha/coll-of :or-spec/str-or-int) + +------------------------- +Detected 1 error\n") + (expound/expound-str :or-spec/vals [0 "hi" :kw "bye"])))) + (is (= "-- Spec failed -------------------- + + 50 + +should satisfy + + coll? + +------------------------- +Detected 1 error +" + (expound/expound-str (s/or + :strs (s/coll-of string?) + :ints (s/coll-of int?)) + 50))) + (is (= "-- Spec failed -------------------- + + 50 + +should be one of: \"a\", \"b\", 1, 2 + +------------------------- +Detected 1 error +" + (expound/expound-str + (s/or + :letters #{"a" "b"} + :ints #{1 2}) + 50))) + (is (= (pf "-- Spec failed -------------------- + + {} + +should contain keys: :or-spec/int, :or-spec/str + +| key | spec | +|==============+=========| +| :or-spec/int | int? | +|--------------+---------| +| :or-spec/str | string? | + +-- Relevant specs ------- + +:or-spec/m-with-int: + (pf.spec.alpha/keys :req [:or-spec/int]) +:or-spec/m-with-str: + (pf.spec.alpha/keys :req [:or-spec/str]) +:or-spec/m-with-str-or-int: + (pf.spec.alpha/or + :m-with-str + :or-spec/m-with-str + :m-with-int + :or-spec/m-with-int) + +------------------------- +Detected 1 error +") + (expound/expound-str :or-spec/m-with-str-or-int {}))) + (testing "de-dupes keys" + (is (= "-- Spec failed -------------------- + + {} + +should contain keys: :or-spec/str + +| key | spec | +|==============+=========| +| :or-spec/str | string? | + +------------------------- +Detected 1 error +" + (expound/expound-str (s/or :m-with-str1 (s/keys :req [:or-spec/str]) + :m-with-int2 (s/keys :req [:or-spec/str])) {}))))) + +(s/def :and-spec/name (s/and string? #(pos? (count %)))) +(s/def :and-spec/names (s/coll-of :and-spec/name)) +(deftest and-spec + (testing "simple value" + (is (= (pf "-- Spec failed -------------------- + + \"\" + +should satisfy + + (fn [%%] (pos? (count %%))) + +-- Relevant specs ------- + +:and-spec/name: + (pf.spec.alpha/and + pf.core/string? + (pf.core/fn [%%] (pf.core/pos? (pf.core/count %%)))) + +------------------------- +Detected 1 error\n") + (expound/expound-str :and-spec/name "")))) + + (testing "shows both failures in order" + (is (= + (pf "-- Spec failed -------------------- + + [... ... \"\" ...] + ^^ + +should satisfy + + %s + +-- Relevant specs ------- + +:and-spec/name: + (pf.spec.alpha/and + pf.core/string? + (pf.core/fn [%%] (pf.core/pos? (pf.core/count %%)))) +:and-spec/names: + (pf.spec.alpha/coll-of :and-spec/name) + +-- Spec failed -------------------- + + [... ... ... 1] + ^ + +should satisfy + + string? + +-- Relevant specs ------- + +:and-spec/name: + (pf.spec.alpha/and + pf.core/string? + (pf.core/fn [%%] (pf.core/pos? (pf.core/count %%)))) +:and-spec/names: + (pf.spec.alpha/coll-of :and-spec/name) + +------------------------- +Detected 2 errors\n" + #?(:cljs "(fn [%] (pos? (count %)))" + :clj "(fn [%] (pos? (count %)))")) + (expound/expound-str :and-spec/names ["bob" "sally" "" 1]))))) + +(s/def :coll-of-spec/big-int-coll (s/coll-of int? :min-count 10)) + +(deftest coll-of-spec + (testing "min count" + (is (= + (pf "-- Spec failed -------------------- + + [] + +should satisfy + + (<= 10 (count %%) %s) + +-- Relevant specs ------- + +:coll-of-spec/big-int-coll: + (pf.spec.alpha/coll-of pf.core/int? :min-count 10) + +------------------------- +Detected 1 error\n" + #?(:cljs "9007199254740991" + :clj "Integer/MAX_VALUE")) + (expound/expound-str :coll-of-spec/big-int-coll []))))) + +(s/def :cat-spec/kw (s/cat :k keyword? :v any?)) +(s/def :cat-spec/set (s/cat :type #{:foo :bar} :str string?)) +(s/def :cat-spec/alt* (s/alt :s string? :i int?)) +(s/def :cat-spec/alt (s/+ :cat-spec/alt*)) +(s/def :cat-spec/alt-inline (s/+ (s/alt :s string? :i int?))) +(s/def :cat-spec/any (s/cat :x (s/+ any?))) ;; Not a useful spec, but worth testing +(deftest cat-spec + (testing "too few elements" + (is (= (pf "-- Syntax error ------------------- + + [] + +should have additional elements. The next element \":k\" should satisfy + + keyword? + +-- Relevant specs ------- + +:cat-spec/kw: + (pf.spec.alpha/cat :k pf.core/keyword? :v pf.core/any?) + +------------------------- +Detected 1 error\n") + (expound/expound-str :cat-spec/kw []))) + (is (= (pf "-- Syntax error ------------------- + + [] + +should have additional elements. The next element \":type\" should be one of: :bar, :foo + +-- Relevant specs ------- + +:cat-spec/set: + (pf.spec.alpha/cat :type #{:bar :foo} :str pf.core/string?) + +------------------------- +Detected 1 error\n") + (expound/expound-str :cat-spec/set []))) + (is (= (pf "-- Syntax error ------------------- + + [:foo] + +should have additional elements. The next element \":v\" should satisfy + + any? + +-- Relevant specs ------- + +:cat-spec/kw: + (pf.spec.alpha/cat :k pf.core/keyword? :v pf.core/any?) + +------------------------- +Detected 1 error\n") + (expound/expound-str :cat-spec/kw [:foo]))) + ;; This isn't ideal, but requires a fix from clojure + ;; https://clojure.atlassian.net/browse/CLJ-2364 + (is (= (pf "-- Syntax error ------------------- + + [] + +should have additional elements. The next element should satisfy + + (pf.spec.alpha/alt :s string? :i int?) + +-- Relevant specs ------- + +:cat-spec/alt*: + (pf.spec.alpha/alt :s pf.core/string? :i pf.core/int?) +:cat-spec/alt: + (pf.spec.alpha/+ :cat-spec/alt*) + +------------------------- +Detected 1 error\n") + (expound/expound-str :cat-spec/alt []))) + (is (= (pf "-- Syntax error ------------------- + + [] + +should have additional elements. The next element should satisfy + + (pf.spec.alpha/alt :s string? :i int?) + +-- Relevant specs ------- + +:cat-spec/alt-inline: + (pf.spec.alpha/+ + (pf.spec.alpha/alt :s pf.core/string? :i pf.core/int?)) + +------------------------- +Detected 1 error\n") + (expound/expound-str :cat-spec/alt-inline []))) + (is (= (pf "-- Syntax error ------------------- + + [] + +should have additional elements. The next element \":x\" should satisfy + + any? + +-- Relevant specs ------- + +:cat-spec/any: + (pf.spec.alpha/cat :x (pf.spec.alpha/+ pf.core/any?)) + +------------------------- +Detected 1 error\n") + (expound/expound-str :cat-spec/any [])))) + (testing "too many elements" + (is (= (pf "-- Syntax error ------------------- + + [... ... :bar ...] + ^^^^ + +has extra input + +-- Relevant specs ------- + +:cat-spec/kw: + (pf.spec.alpha/cat :k pf.core/keyword? :v pf.core/any?) + +------------------------- +Detected 1 error\n") + (expound/expound-str :cat-spec/kw [:foo 1 :bar :baz]))))) + +(s/def :keys-spec/name string?) +(s/def :keys-spec/age int?) +(s/def :keys-spec/user (s/keys :req [:keys-spec/name] + :req-un [:keys-spec/age])) + +(s/def :key-spec/state string?) +(s/def :key-spec/city string?) +(s/def :key-spec/zip pos-int?) + +(s/def :keys-spec/user2 (s/keys :req [(and :keys-spec/name + :keys-spec/age)] + :req-un [(or + :key-spec/zip + (and + :key-spec/state + :key-spec/city))])) + +(s/def :keys-spec/user3 (s/keys :req-un [(or + :key-spec/zip + (and + :key-spec/state + :key-spec/city))])) + +(s/def :keys-spec/user4 (s/keys :req [])) + +(defmulti key-spec-mspec :tag) +(defmethod key-spec-mspec :int [_] (s/keys :req-un [::tag ::i])) +(defmethod key-spec-mspec :string [_] (s/keys :req-un [::tag ::s])) +(deftest keys-spec + (testing "missing keys" + (is (= (pf "-- Spec failed -------------------- + + {} + +should contain keys: :age, :keys-spec/name + +| key | spec | +|=================+=========| +| :age | int? | +|-----------------+---------| +| :keys-spec/name | string? | + +-- Relevant specs ------- + +:keys-spec/user: + %s + +------------------------- +Detected 1 error\n" + #?(:cljs "(cljs.spec.alpha/keys :req [:keys-spec/name] :req-un [:keys-spec/age])" + :clj "(clojure.spec.alpha/keys\n :req\n [:keys-spec/name]\n :req-un\n [:keys-spec/age])")) + (expound/expound-str :keys-spec/user {})))) + (testing "missing compound keys" + (is (= (pf "-- Spec failed -------------------- + + {} + +should contain keys: + +(and (and :keys-spec/name :keys-spec/age) (or :zip (and :state :city))) + +| key | spec | +|=================+==========| +| :city | string? | +|-----------------+----------| +| :state | string? | +|-----------------+----------| +| :zip | pos-int? | +|-----------------+----------| +| :keys-spec/age | int? | +|-----------------+----------| +| :keys-spec/name | string? | + +-- Relevant specs ------- + +:keys-spec/user2: + (pf.spec.alpha/keys + :req + [(and :keys-spec/name :keys-spec/age)] + :req-un + [(or :key-spec/zip (and :key-spec/state :key-spec/city))]) + +------------------------- +Detected 1 error\n") + (expound/expound-str :keys-spec/user2 {}))) + (is (= (pf "-- Spec failed -------------------- + + {} + +should contain keys: + +(or :zip (and :state :city)) + +| key | spec | +|========+==========| +| :city | string? | +|--------+----------| +| :state | string? | +|--------+----------| +| :zip | pos-int? | + +-- Relevant specs ------- + +:keys-spec/user3: + (pf.spec.alpha/keys + :req-un + [(or :key-spec/zip (and :key-spec/state :key-spec/city))]) + +------------------------- +Detected 1 error\n") + (expound/expound-str :keys-spec/user3 {})))) + + (testing "inline spec with req-un" + (is (= (pf "-- Spec failed -------------------- + + {} + +should contain keys: :age, :name + +| key | spec | +|=======+=========| +| :age | int? | +|-------+---------| +| :name | string? | + +------------------------- +Detected 1 error\n" + #?(:cljs "(cljs.spec.alpha/keys :req [:keys-spec/name] :req-un [:keys-spec/age])" + :clj "(clojure.spec.alpha/keys\n :req\n [:keys-spec/name]\n :req-un\n [:keys-spec/age])")) + (expound/expound-str (s/keys :req-un [:keys-spec/name :keys-spec/age]) {}))) + (s/def :key-spec/mspec (s/multi-spec key-spec-mspec :tag)) + (s/def :key-spec/i int?) + (s/def :key-spec/s string?) + ;; We can't inspect the contents of a multi-spec (to figure out + ;; which spec we mean by :i), so this is the best we can do. + (is (= "-- Spec failed -------------------- + + {:tag :int} + +should contain key: :i + +| key | spec | +|=====+===================================================| +| :i | | + +------------------------- +Detected 1 error\n" + (expound/expound-str + :key-spec/mspec + {:tag :int} + {:print-specs? false})))) + + (testing "invalid key" + (is (= (pf "-- Spec failed -------------------- + + {:age ..., :keys-spec/name :bob} + ^^^^ + +should satisfy + + string? + +-- Relevant specs ------- + +:keys-spec/name: + pf.core/string? +:keys-spec/user: + %s + +------------------------- +Detected 1 error\n" + #?(:cljs "(cljs.spec.alpha/keys :req [:keys-spec/name] :req-un [:keys-spec/age])" + :clj "(clojure.spec.alpha/keys\n :req\n [:keys-spec/name]\n :req-un\n [:keys-spec/age])")) + (expound/expound-str :keys-spec/user {:age 1 :keys-spec/name :bob})))) + (testing "contains compound specs" + (s/def :keys-spec/states (s/coll-of :key-spec/state :kind vector?)) + (s/def :keys-spec/address (s/keys :req [:key-spec/city :key-space/state])) + (s/def :keys-spec/cities (s/coll-of :key-spec/city :kind set?)) + (s/def :keys-spec/locations (s/keys :req-un [:keys-spec/states + :keys-spec/address + :keys-spec/locations])) + (is (= + "-- Spec failed -------------------- + + {} + +should contain keys: :address, :locations, :states + +| key | spec | +|============+===============================================================| +| :address | (keys :req [:key-spec/city :key-space/state]) | +|------------+---------------------------------------------------------------| +| :locations | (keys | +| | :req-un | +| | [:keys-spec/states :keys-spec/address :keys-spec/locations]) | +|------------+---------------------------------------------------------------| +| :states | (coll-of :key-spec/state :kind vector?) | + +------------------------- +Detected 1 error +" + (expound/expound-str :keys-spec/locations {} {:print-specs? false}))))) + +(s/def :keys-spec/foo string?) +(s/def :keys-spec/bar string?) +(s/def :keys-spec/baz string?) +(s/def :keys-spec/qux (s/or :string string? + :int int?)) +(s/def :keys-spec/child-1 (s/keys :req-un [:keys-spec/baz :keys-spec/qux])) +(s/def :keys-spec/child-2 (s/keys :req-un [:keys-spec/bar :keys-spec/child-1])) + +(s/def :keys-spec/map-spec-1 (s/keys :req-un [:keys-spec/foo + :keys-spec/bar + :keys-spec/baz])) +(s/def :keys-spec/map-spec-2 (s/keys :req-un [:keys-spec/foo + :keys-spec/bar + :keys-spec/qux])) +(s/def :keys-spec/map-spec-3 (s/keys :req-un [:keys-spec/foo + :keys-spec/child-2])) + +(deftest grouping-and-key-specs + (is (= (pf + "-- Spec failed -------------------- + + {:foo 1.2, :bar ..., :baz ...} + ^^^ + +should satisfy + + string? + +-- Spec failed -------------------- + + {:foo ..., :bar 123, :baz ...} + ^^^ + +should satisfy + + string? + +-- Spec failed -------------------- + + {:foo ..., :bar ..., :baz true} + ^^^^ + +should satisfy + + string? + +------------------------- +Detected 3 errors\n") + (expound/expound-str :keys-spec/map-spec-1 {:foo 1.2 + :bar 123 + :baz true} + {:print-specs? false}))) + (is (= (pf + "-- Spec failed -------------------- + + {:foo 1.2, :bar ..., :qux ...} + ^^^ + +should satisfy + + string? + +-- Spec failed -------------------- + + {:foo ..., :bar 123, :qux ...} + ^^^ + +should satisfy + + string? + +-- Spec failed -------------------- + + {:foo ..., :bar ..., :qux false} + ^^^^^ + +should satisfy + + string? + +or + + int? + +------------------------- +Detected 3 errors\n") + (expound/expound-str :keys-spec/map-spec-2 {:foo 1.2 + :bar 123 + :qux false} + {:print-specs? false}))) + + (is (= + "-- Spec failed -------------------- + + {:foo 1.2, :child-2 ...} + ^^^ + +should satisfy + + string? + +-- Spec failed -------------------- + + {:foo ..., :child-2 {:bar 123, :child-1 ...}} + ^^^ + +should satisfy + + string? + +-- Spec failed -------------------- + + {:foo ..., + :child-2 + {:bar ..., :child-1 {:baz true, :qux ...}}} + ^^^^ + +should satisfy + + string? + +-- Spec failed -------------------- + + {:foo ..., + :child-2 + {:bar ..., :child-1 {:baz ..., :qux false}}} + ^^^^^ + +should satisfy + + string? + +or + + int? + +------------------------- +Detected 4 errors\n" + (expound/expound-str :keys-spec/map-spec-3 {:foo 1.2 + :child-2 {:bar 123 + :child-1 {:baz true + :qux false}}} + {:print-specs? false})))) + +(s/def :multi-spec/value string?) +(s/def :multi-spec/children vector?) +(defmulti el-type :multi-spec/el-type) +(defmethod el-type :text [_x] + (s/keys :req [:multi-spec/value])) +(defmethod el-type :group [_x] + (s/keys :req [:multi-spec/children])) +(s/def :multi-spec/el (s/multi-spec el-type :multi-spec/el-type)) + +(defmulti multi-spec-bar-spec :type) +(defmethod multi-spec-bar-spec ::b [_] (s/keys :req [::b])) +(deftest multi-spec + (testing "missing dispatch key" + (is (= + (pf "-- Missing spec ------------------- + +Cannot find spec for + + {} + +with + + Spec multimethod: `expound.alpha-test/el-type` + Dispatch value: `nil` + +-- Relevant specs ------- + +:multi-spec/el: + (pf.spec.alpha/multi-spec + expound.alpha-test/el-type + :multi-spec/el-type) + +------------------------- +Detected 1 error\n") + (expound/expound-str :multi-spec/el {})))) + (testing "invalid dispatch value" + (is (= + (pf "-- Missing spec ------------------- + +Cannot find spec for + + {:multi-spec/el-type :image} + +with + + Spec multimethod: `expound.alpha-test/el-type` + Dispatch value: `:image` + +-- Relevant specs ------- + +:multi-spec/el: + (pf.spec.alpha/multi-spec + expound.alpha-test/el-type + :multi-spec/el-type) + +------------------------- +Detected 1 error\n") + (expound/expound-str :multi-spec/el {:multi-spec/el-type :image})))) + + (testing "valid dispatch value, but other error" + (is (= + (pf "-- Spec failed -------------------- + + {:multi-spec/el-type :text} + +should contain key: :multi-spec/value + +| key | spec | +|===================+=========| +| :multi-spec/value | string? | + +-- Relevant specs ------- + +:multi-spec/el: + (pf.spec.alpha/multi-spec + expound.alpha-test/el-type + :multi-spec/el-type) + +------------------------- +Detected 1 error\n") + (expound/expound-str :multi-spec/el {:multi-spec/el-type :text})))) + + ;; https://github.com/bhb/expound/issues/122 + (testing "when re-tag is a function" + (s/def :multi-spec/b string?) + (s/def :multi-spec/bar (s/multi-spec multi-spec-bar-spec (fn [val tag] (assoc val :type tag)))) + (is (= "-- Missing spec ------------------- + +Cannot find spec for + + {} + +with + + Spec multimethod: `expound.alpha-test/multi-spec-bar-spec` + Dispatch value: `nil` + +------------------------- +Detected 1 error +" + (expound/expound-str :multi-spec/bar {} {:print-specs? false}))))) + +(s/def :recursive-spec/tag #{:text :group}) +(s/def :recursive-spec/on-tap (s/coll-of map? :kind vector?)) +(s/def :recursive-spec/props (s/keys :opt-un [:recursive-spec/on-tap])) +(s/def :recursive-spec/el (s/keys :req-un [:recursive-spec/tag] + :opt-un [:recursive-spec/props :recursive-spec/children])) +(s/def :recursive-spec/children (s/coll-of (s/nilable :recursive-spec/el) :kind vector?)) + +(s/def :recursive-spec/tag-2 (s/or :text (fn [n] (= n :text)) + :group (fn [n] (= n :group)))) +(s/def :recursive-spec/on-tap-2 (s/coll-of map? :kind vector?)) +(s/def :recursive-spec/props-2 (s/keys :opt-un [:recursive-spec/on-tap-2])) +(s/def :recursive-spec/el-2 (s/keys :req-un [:recursive-spec/tag-2] + :opt-un [:recursive-spec/props-2 + :recursive-spec/children-2])) +(s/def :recursive-spec/children-2 (s/coll-of (s/nilable :recursive-spec/el-2) :kind vector?)) + +(deftest recursive-spec + (testing "only shows problem with data at 'leaves' (not problems with all parents in tree)" + (is (= (pf + "-- Spec failed -------------------- + + {:tag ..., :children [{:tag :group, :children [{:tag :group, :props {:on-tap {}}}]}]} + ^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^ + +should satisfy + + nil? + +or value + + {:tag ..., + :children [{:tag ..., :children [{:tag :group, :props {:on-tap {}}}]}]} + ^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^ + +should satisfy + + nil? + +or value + + {:tag ..., + :children + [{:tag ..., + :children + [{:tag ..., :props {:on-tap {}}}]}]} + ^^ + +should satisfy + + vector? + +------------------------- +Detected 1 error\n") + (expound/expound-str + :recursive-spec/el + {:tag :group + :children [{:tag :group + :children [{:tag :group + :props {:on-tap {}}}]}]} + {:print-specs? false})))) + (testing "test that our new recursive spec grouping function works with + alternative paths" + (is (= (pf + "-- Spec failed -------------------- + + {:tag-2 ..., :children-2 [{:tag-2 :group, :children-2 [{:tag-2 :group, :props-2 {:on-tap-2 {}}}]}]} + ^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^ + +should satisfy + + nil? + +or value + + {:tag-2 ..., + :children-2 [{:tag-2 ..., :children-2 [{:tag-2 :group, :props-2 {:on-tap-2 {}}}]}]} + ^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^ + +should satisfy + + nil? + +or value + + {:tag-2 ..., + :children-2 + [{:tag-2 ..., + :children-2 + [{:tag-2 ..., :props-2 {:on-tap-2 {}}}]}]} + ^^ + +should satisfy + + vector? + +------------------------- +Detected 1 error\n") + (expound/expound-str + :recursive-spec/el-2 + {:tag-2 :group + :children-2 [{:tag-2 :group + :children-2 [{:tag-2 :group + :props-2 {:on-tap-2 {}}}]}]} + {:print-specs? false}))))) + +(s/def :cat-wrapped-in-or-spec/kv (s/and + sequential? + (s/cat :k keyword? :v any?))) +(s/def :cat-wrapped-in-or-spec/type #{:text}) +(s/def :cat-wrapped-in-or-spec/kv-or-string (s/or + :map (s/keys :req [:cat-wrapped-in-or-spec/type]) + :kv :cat-wrapped-in-or-spec/kv)) + +(deftest cat-wrapped-in-or-spec + (is (= (pf "-- Spec failed -------------------- + + {\"foo\" \"hi\"} + +should contain key: :cat-wrapped-in-or-spec/type + +| key | spec | +|==============================+==========| +| :cat-wrapped-in-or-spec/type | #{:text} | + +or + +should satisfy + + sequential? + +-- Relevant specs ------- + +:cat-wrapped-in-or-spec/kv: + (pf.spec.alpha/and + pf.core/sequential? + (pf.spec.alpha/cat :k pf.core/keyword? :v pf.core/any?)) +:cat-wrapped-in-or-spec/kv-or-string: + (pf.spec.alpha/or + :map + (pf.spec.alpha/keys :req [:cat-wrapped-in-or-spec/type]) + :kv + :cat-wrapped-in-or-spec/kv) + +------------------------- +Detected 1 error\n") + (expound/expound-str :cat-wrapped-in-or-spec/kv-or-string {"foo" "hi"})))) + +(s/def :map-of-spec/name string?) +(s/def :map-of-spec/age pos-int?) +(s/def :map-of-spec/name->age (s/map-of :map-of-spec/name :map-of-spec/age)) +(deftest map-of-spec + (is (= (pf "-- Spec failed -------------------- + + {\"Sally\" \"30\"} + ^^^^ + +should satisfy + + pos-int? + +-- Relevant specs ------- + +:map-of-spec/age: + pf.core/pos-int? +:map-of-spec/name->age: + (pf.spec.alpha/map-of :map-of-spec/name :map-of-spec/age) + +------------------------- +Detected 1 error\n") + (expound/expound-str :map-of-spec/name->age {"Sally" "30"}))) + (is (= (pf "-- Spec failed -------------------- + + {:sally ...} + ^^^^^^ + +should satisfy + + string? + +-- Relevant specs ------- + +:map-of-spec/name: + pf.core/string? +:map-of-spec/name->age: + (pf.spec.alpha/map-of :map-of-spec/name :map-of-spec/age) + +------------------------- +Detected 1 error\n") + (expound/expound-str :map-of-spec/name->age {:sally 30})))) + +(deftest generated-simple-spec + (checking + "simple spec" + (chuck/times num-tests) + [simple-spec sg/simple-spec-gen + form gen/any-printable] + (is (string? (expound/expound-str simple-spec form))))) + +(deftest generated-coll-of-specs + (checking + "'coll-of' spec" + (chuck/times num-tests) + [simple-spec sg/simple-spec-gen + every-args (s/gen :specs/every-args) + :let [spec (sg/apply-coll-of simple-spec every-args)] + form gen/any-printable] + (is (string? (expound/expound-str spec form))))) + +(deftest generated-and-specs + (checking + "'and' spec" + (chuck/times num-tests) + [simple-spec1 sg/simple-spec-gen + simple-spec2 sg/simple-spec-gen + :let [spec (s/and simple-spec1 simple-spec2)] + form gen/any-printable] + (is (string? (expound/expound-str spec form))))) + +(deftest generated-or-specs + (checking + "'or' spec generates string" + (chuck/times num-tests) + [simple-spec1 sg/simple-spec-gen + simple-spec2 sg/simple-spec-gen + :let [spec (s/or :or1 simple-spec1 :or2 simple-spec2)] + form gen/any-printable] + (is (string? (expound/expound-str spec form)))) + (checking + "nested 'or' spec reports on all problems" + (chuck/times num-tests) + [simple-specs (gen/vector-distinct + (gen/elements [:specs/string + :specs/vector + :specs/int + :specs/boolean + :specs/keyword + :specs/map + :specs/symbol + :specs/pos-int + :specs/neg-int + :specs/zero]) + {:num-elements 4}) + :let [[simple-spec1 + simple-spec2 + simple-spec3 + simple-spec4] simple-specs + spec (s/or :or1 + (s/or :or1.1 + simple-spec1 + :or1.2 + simple-spec2) + :or2 + (s/or :or2.1 + simple-spec3 + :or2.2 + simple-spec4)) + sp-form (s/form spec)] + form gen/any-printable] + (let [ed (s/explain-data spec form)] + (when-not (zero? (count (::s/problems ed))) + (is (= (dec (count (::s/problems ed))) + (count (re-seq #"\nor\n" (expound/expound-str spec form)))) + (str "Failed to print out all problems\nspec: " sp-form "\nproblems: " (printer/pprint-str (::s/problems ed)) "\nmessage: " (expound/expound-str spec form))))))) + +(deftest generated-map-of-specs + (checking + "'map-of' spec" + (chuck/times num-tests) + [simple-spec1 sg/simple-spec-gen + simple-spec2 sg/simple-spec-gen + simple-spec3 sg/simple-spec-gen + every-args1 (s/gen :specs/every-args) + every-args2 (s/gen :specs/every-args) + :let [spec (sg/apply-map-of simple-spec1 (sg/apply-map-of simple-spec2 simple-spec3 every-args1) every-args2)] + form test-utils/any-printable-wo-nan] + (is (string? (expound/expound-str spec form))))) + +(s/def :expound.ds/spec-key (s/or :kw keyword? + :req (s/tuple + #{:expound.ds/req-key} + (s/map-of + #{:k} + keyword? + :count 1)) + :opt (s/tuple + #{:expound.ds/opt-key} + (s/map-of + #{:k} + keyword? + :count 1)))) + +(defn real-spec [form] + (walk/prewalk + (fn [x] + (if (vector? x) + (case (first x) + :expound.ds/opt-key + (ds/map->OptionalKey (second x)) + + :expound.ds/req-key + (ds/map->RequiredKey (second x)) + + :expound.ds/maybe-spec + (ds/maybe (second x)) + + x) + x)) + form)) + +(s/def :expound.ds/maybe-spec + (s/tuple + #{:expound.ds/maybe-spec} + :expound.ds/spec)) + +(s/def :expound.ds/simple-specs + #{string? + vector? + int? + boolean? + keyword? + map? + symbol? + pos-int? + neg-int? + nat-int?}) + +(s/def :expound.ds/vector-spec (s/coll-of + :expound.ds/spec + :count 1 + :kind vector?)) + +(s/def :expound.ds/set-spec (s/coll-of + :expound.ds/spec + :count 1 + :kind set?)) + +(s/def :expound.ds/map-spec + (s/map-of :expound.ds/spec-key + :expound.ds/spec)) + +(s/def :expound.ds/spec + (s/or + :map :expound.ds/map-spec + :vector :expound.ds/vector-spec + :set :expound.ds/set-spec + :simple :expound.ds/simple-specs + :maybe :expound.ds/maybe-spec)) + +(deftest generated-data-specs + (checking + "generated data specs" + (chuck/times num-tests) + [data-spec (s/gen :expound.ds/spec) + form test-utils/any-printable-wo-nan + prefix (s/gen qualified-keyword?) + :let [gen-spec (ds/spec prefix (real-spec data-spec))]] + (is (string? (expound/expound-str gen-spec form))))) + +;; FIXME - keys +;; FIXME - cat + alt, + ? * +;; FIXME - nilable +;; FIXME - test coll-of that is a set . can i should a bad element of a set? + +(s/def :test-assert/name string?) +(deftest test-assert + (testing "assertion passes" + (is (= "hello" + (s/assert :test-assert/name "hello")))) + (testing "assertion fails" + #?(:cljs + (try + (binding [s/*explain-out* expound/printer] + (s/assert :test-assert/name :hello)) + (catch :default e + (is (= "Spec assertion failed\n-- Spec failed -------------------- + + :hello + +should satisfy + + string? + +-- Relevant specs ------- + +:test-assert/name: + cljs.core/string? + +------------------------- +Detected 1 error\n" + (.-message e))))) + :clj + (try + (binding [s/*explain-out* expound/printer] + (s/assert :test-assert/name :hello)) + (catch Exception e + (is (= "Spec assertion failed +-- Spec failed -------------------- + + :hello + +should satisfy + + string? + +-- Relevant specs ------- + +:test-assert/name: + clojure.core/string? + +------------------------- +Detected 1 error\n" + ;; FIXME - move assertion out of catch, similar to instrument tests + (:cause (Throwable->map e))))))))) + +(s/def :test-explain-str/name string?) +(deftest test-explain-str + (is (= (pf "-- Spec failed -------------------- + + :hello + +should satisfy + + string? + +-- Relevant specs ------- + +:test-explain-str/name: + pf.core/string? + +------------------------- +Detected 1 error\n") + (binding [s/*explain-out* expound/printer] + (s/explain-str :test-explain-str/name :hello))))) + +(s/fdef test-instrument-adder + :args (s/cat :x int? :y int?) + :fn #(> (:ret %) (-> % :args :x)) + :ret pos-int?) +(defn test-instrument-adder [& args] + (let [[x y] args] + (+ x y))) + +(defn no-linum [s] + (string/replace s #"(.cljc?):\d+" "$1:LINUM")) + +(deftest test-instrument + (st/instrument `test-instrument-adder) + #?(:cljs (is (= + "Call to #'expound.alpha-test/test-instrument-adder did not conform to spec. +: + +-- Spec failed -------------------- + +Function arguments + + (\"\" ...) + ^^ + +should satisfy + + int? + +------------------------- +Detected 1 error\n" + (formatted-exception {:print-specs? false} #(test-instrument-adder "" :x)))) + :clj + (is (= "Call to #'expound.alpha-test/test-instrument-adder did not conform to spec. +alpha_test.cljc:LINUM + +-- Spec failed -------------------- + +Function arguments + + (\"\" ...) + ^^ + +should satisfy + + int? + +------------------------- +Detected 1 error\n" + (no-linum + (formatted-exception {:print-specs? false :show-valid-values? false} #(test-instrument-adder "" :x)))))) + (st/unstrument `test-instrument-adder)) + +(deftest test-instrument-with-orchestra-args-spec-failure + (orch.st/instrument `test-instrument-adder) + #?(:cljs (is (= + "Call to #'expound.alpha-test/test-instrument-adder did not conform to spec. +: + +-- Spec failed -------------------- + +Function arguments + + (\"\" ...) + ^^ + +should satisfy + + int? + +------------------------- +Detected 1 error\n" + (no-linum (formatted-exception {:print-specs? false} #(test-instrument-adder "" :x))))) + :clj (is (= "Call to #'expound.alpha-test/test-instrument-adder did not conform to spec. +alpha_test.cljc:LINUM + +-- Spec failed -------------------- + +Function arguments + + (\"\" ...) + ^^ + +should satisfy + + int? + +------------------------- +Detected 1 error\n" + (no-linum + (formatted-exception + {} + #(test-instrument-adder "" :x)))))) + + (orch.st/unstrument `test-instrument-adder)) + +;; Note - you may need to comment out this test out when +;; using figwheel.main for testing, since the compilation +;; warning seems to impact the building of other tests +(deftest test-instrument-with-orchestra-args-syntax-failure + (orch.st/instrument `test-instrument-adder) + #?(:cljs (is (= + "Call to #'expound.alpha-test/test-instrument-adder did not conform to spec. +: + +-- Syntax error ------------------- + +Function arguments + + (1) + +should have additional elements. The next element \":y\" should satisfy + + int? + +------------------------- +Detected 1 error\n" + (no-linum (formatted-exception {:print-specs? false} #(test-instrument-adder 1))))) + :clj + (is (= "Call to #'expound.alpha-test/test-instrument-adder did not conform to spec. +alpha_test.cljc:LINUM + +-- Syntax error ------------------- + +Function arguments + + (1) + +should have additional elements. The next element \":y\" should satisfy + + int? + +------------------------- +Detected 1 error\n" + (no-linum + (formatted-exception + {:print-specs? false} + #(test-instrument-adder 1)))))) + (orch.st/unstrument `test-instrument-adder)) + +(deftest test-instrument-with-orchestra-ret-failure + (orch.st/instrument `test-instrument-adder) + #?(:cljs (is (= + "Call to #'expound.alpha-test/test-instrument-adder did not conform to spec. +: + +-- Spec failed -------------------- + +Return value + + -3 + +should satisfy + + pos-int? + +------------------------- +Detected 1 error\n" + (formatted-exception {} + #(test-instrument-adder -1 -2)) + #_(.-message (try + (binding [s/*explain-out* expound/printer] + (test-instrument-adder -1 -2)) + (catch :default e e))))) + :clj + (is (= "Call to #'expound.alpha-test/test-instrument-adder did not conform to spec. +alpha_test.cljc:LINUM + +-- Spec failed -------------------- + +Return value + + -3 + +should satisfy + + pos-int? + +------------------------- +Detected 1 error\n" + (no-linum + (formatted-exception + {:print-specs? false} + #(test-instrument-adder -1 -2)))))) + (orch.st/unstrument `test-instrument-adder)) + +(deftest test-instrument-with-orchestra-fn-failure + (orch.st/instrument `test-instrument-adder) + #?(:cljs (is (= + "Call to #'expound.alpha-test/test-instrument-adder did not conform to spec. +: + +-- Spec failed -------------------- + +Function arguments and return value + + {:ret 1, :args {:x 1, :y 0}} + +should satisfy + + (fn [%] (> (:ret %) (-> % :args :x))) + +------------------------- +Detected 1 error\n" + (formatted-exception {} #(test-instrument-adder 1 0)))) + :clj + (is (= "Call to #'expound.alpha-test/test-instrument-adder did not conform to spec. +alpha_test.cljc:LINUM + +-- Spec failed -------------------- + +Function arguments and return value + + {:ret 1, :args {:x 1, :y 0}} + +should satisfy + + (fn + [%] + (> (:ret %) (-> % :args :x))) + +------------------------- +Detected 1 error\n" + (no-linum + (formatted-exception {:print-specs? false} #(test-instrument-adder 1 0)))))) + + (orch.st/unstrument `test-instrument-adder)) + +(deftest test-instrument-with-custom-value-printer + (st/instrument `test-instrument-adder) + #?(:cljs + (is (= + "Call to #'expound.alpha-test/test-instrument-adder did not conform to spec. +: + +-- Spec failed -------------------- + +Function arguments + + (\"\" :x) + ^^ + +should satisfy + + int? + +------------------------- +Detected 1 error\n" + (no-linum + (formatted-exception {:print-specs? false :show-valid-values? true} #(test-instrument-adder "" :x))))) + :clj + (is (= + "Call to #'expound.alpha-test/test-instrument-adder did not conform to spec. +alpha_test.cljc:LINUM + +-- Spec failed -------------------- + +Function arguments + + (\"\" :x) + ^^ + +should satisfy + + int? + +------------------------- +Detected 1 error\n" + (no-linum + (formatted-exception {:print-specs? false :show-valid-values? true} #(test-instrument-adder "" :x)))))) + + (st/unstrument `test-instrument-adder)) + +(s/def :custom-printer/strings (s/coll-of string?)) +(deftest custom-printer + (testing "custom value printer" + (is (= (pf "-- Spec failed -------------------- + + + +should satisfy + + string? + +-- Relevant specs ------- + +:custom-printer/strings: + (pf.spec.alpha/coll-of pf.core/string?) + +------------------------- +Detected 1 error +") + (binding [s/*explain-out* (expound/custom-printer {:value-str-fn (fn [_spec-name _form _path _val] " ")})] + (s/explain-str :custom-printer/strings ["a" "b" :c])))))) + +(s/def :alt-spec/int-alt-str (s/alt :int int? :string string?)) + +(s/def :alt-spec/num-types (s/alt :int int? :float float?)) +(s/def :alt-spec/str-types (s/alt :int (fn [n] (= n "int")) + :float (fn [n] (= n "float")))) +(s/def :alt-spec/num-or-str (s/alt :num :alt-spec/num-types + :str :alt-spec/str-types)) + +(s/def :alt-spec/i int?) +(s/def :alt-spec/s string?) +(s/def :alt-spec/alt-or-map (s/or :i :alt-spec/i + :s :alt-spec/s + :k (s/keys :req-un [:alt-spec/i :alt-spec/s]))) + +(defmulti alt-spec-mspec :tag) +(s/def :alt-spec/mspec (s/multi-spec alt-spec-mspec :tag)) +(defmethod alt-spec-mspec :x [_] (s/keys :req-un [:alt-spec/one-many-int])) + +(deftest alt-spec + (testing "alternatives at different paths in spec" + (is (= + "-- Spec failed -------------------- + + [\"foo\"] + +should satisfy + + int? + +or value + + [\"foo\"] + ^^^^^ + +should satisfy + + int? + +------------------------- +Detected 1 error\n" + (expound/expound-str + (s/or + :i int? + :seq (s/cat :x1 int? :x2 int?)) + ["foo"] + {:print-specs? false}))) + (s/def :alt-spec/one-many-int (s/cat :bs (s/alt :one int? + :many (s/spec (s/+ int?))))) + (is (= (pf "-- Spec failed -------------------- + + [[\"1\"]] + ^^^^^ + +should satisfy + + int? + +or value + + [[\"1\"]] + ^^^ + +should satisfy + + int? + +-- Relevant specs ------- + +:alt-spec/one-many-int: + (pf.spec.alpha/cat + :bs + (pf.spec.alpha/alt + :one + pf.core/int? + :many + (pf.spec.alpha/spec (pf.spec.alpha/+ pf.core/int?)))) + +------------------------- +Detected 1 error\n") + (binding [s/*explain-out* (expound/custom-printer {})] + (s/explain-str + :alt-spec/one-many-int + [["1"]])))) + (s/def :alt-spec/one-many-int-or-str (s/cat :bs (s/alt :one :alt-spec/int-alt-str + :many (s/spec (s/+ :alt-spec/int-alt-str))))) + (is (= "-- Spec failed -------------------- + + [[:one]] + ^^^^^^ + +should satisfy + + int? + +or + + string? + +or value + + [[:one]] + ^^^^ + +should satisfy + + int? + +or + + string? + +------------------------- +Detected 1 error\n" + (binding [s/*explain-out* (expound/custom-printer {:print-specs? false})] + (s/explain-str + :alt-spec/one-many-int-or-str + [[:one]])))) + (s/def :alt-spec/int-or-str (s/or :i int? + :s string?)) + (s/def :alt-spec/one-many-int-or-str (s/cat :bs (s/alt :one :alt-spec/int-or-str + :many (s/spec (s/+ :alt-spec/int-or-str))))) + (is (= "-- Spec failed -------------------- + + [[:one]] + ^^^^^^ + +should satisfy + + int? + +or + + string? + +or value + + [[:one]] + ^^^^ + +should satisfy + + int? + +or + + string? + +------------------------- +Detected 1 error\n" + (binding [s/*explain-out* (expound/custom-printer {:print-specs? false})] + (s/explain-str + :alt-spec/one-many-int-or-str + [[:one]]))))) + (is (= (pf "-- Spec failed -------------------- + + [:hi] + ^^^ + +should satisfy + + int? + +or + + string? + +-- Relevant specs ------- + +:alt-spec/int-alt-str: + %s + +------------------------- +Detected 1 error\n" + #?(:clj "(clojure.spec.alpha/alt + :int + clojure.core/int? + :string + clojure.core/string?)" + :cljs "(cljs.spec.alpha/alt :int cljs.core/int? :string cljs.core/string?)")) + (expound/expound-str :alt-spec/int-alt-str [:hi]))) + + (is (= "-- Spec failed -------------------- + + {:i \"\", :s 1} + +should satisfy + + int? + +or + + string? + +-- Spec failed -------------------- + + {:i \"\", :s ...} + ^^ + +should satisfy + + int? + +-- Spec failed -------------------- + + {:i ..., :s 1} + ^ + +should satisfy + + string? + +------------------------- +Detected 3 errors +" + + (expound/expound-str + :alt-spec/alt-or-map + {:i "" :s 1} + {:print-specs? false}))) + + (is (= "-- Spec failed -------------------- + + [true] + ^^^^ + +should satisfy + + int? + +or + + float? + +or + + (fn [n] (= n \"int\")) + +or + + (fn [n] (= n \"float\")) + +------------------------- +Detected 1 error\n" (expound/expound-str :alt-spec/num-or-str [true] {:print-specs? false}))) + ;; If two s/alt specs have the same tags, we shouldn't confuse them. + (is (= "-- Spec failed -------------------- + + {:num-types [true], :str-types ...} + ^^^^ + +should satisfy + + int? + +or + + float? + +-- Spec failed -------------------- + + {:num-types ..., :str-types [false]} + ^^^^^ + +should satisfy + + (fn [n] (= n \"int\")) + +or + + (fn [n] (= n \"float\")) + +------------------------- +Detected 2 errors\n" + (binding [s/*explain-out* (expound/custom-printer {:print-specs? false})] + (s/explain-str (s/keys :req-un [:alt-spec/num-types :alt-spec/str-types]) + {:num-types [true] :str-types [false]})))) + + (is (= + "-- Spec failed -------------------- + + [\"\"] + +should satisfy + + nil? + +or value + + [\"\"] + ^^ + +should satisfy + + int? + +or + + float? + +------------------------- +Detected 1 error +" + (expound/expound-str + (s/nilable (s/cat :n (s/alt :int int? :float float?))) + [""] + {:print-specs? false}))) + (is (= + ;; This output is not what we want: ideally, the two alternates + ;; should be grouped into a single problem. + ;; I'm adding it as a spec to avoid regressions and to keep it as + ;; an example of something I could improve. + ;; The reason we can't do better is that we can't reliably look + ;; at the form of a multi-spec. It would be nice if spec inserted + ;; the actual spec form that was returned by the multi-spec, but + ;; as it stands today, we'd have to figure out how to call the multi- + ;; method with the actual value. That would be complicated and + ;; potentially have unknown side effects from running arbitrary code. + + "-- Spec failed -------------------- + + {:mspec {:tag ..., :one-many-int [[\"1\"]]}} + ^^^^^ + +should satisfy + + int? + +-- Spec failed -------------------- + + {:mspec {:tag ..., :one-many-int [[\"1\"]]}} + ^^^ + +should satisfy + + int? + +------------------------- +Detected 2 errors\n" + + (expound/expound-str + (s/keys + :req-un [:alt-spec/mspec]) + {:mspec + {:tag :x + :one-many-int [["1"]]}} + + {:print-specs? false})))) + +(defn mutate-coll [x] + (cond + (map? x) + (into [] x) + + (vector? x) + (into #{} x) + + (set? x) + (reverse (into '() x)) + + (list? x) + (into {} (map vec (partition 2 x))) + + :else + x)) + +(defn mutate-type [x] + (cond + (number? x) + (str x) + + (string? x) + (keyword x) + + (keyword? x) + (str x) + + (boolean? x) + (str x) + + (symbol? x) + (str x) + + (char? x) + #?(:cljs (.charCodeAt x) + :clj (int x)) + + (uuid? x) + (str x) + + :else + x)) + +(defn mutate [form path] + (let [[head & rst] path] + (cond + (empty? path) + (if (coll? form) + (mutate-coll form) + (mutate-type form)) + + (map? form) + (if (empty? form) + (mutate-coll form) + (let [k (nth (keys form) (mod head (count (keys form))))] + (assoc form k + (mutate (get form k) rst)))) + + (vector? form) + (if (empty? form) + (mutate-coll form) + (let [idx (mod head (count form))] + (assoc form idx + (mutate (nth form idx) rst)))) + + (not (coll? form)) + (mutate-type form) + + :else + (mutate-coll form)))) + +(deftest test-assert2 + (is (thrown-with-msg? + #?(:cljs :default :clj Exception) + #"\"Key must be integer\"\n\nshould be one of: \"Extra input\", \"Insufficient input\", \"no method" + (binding [s/*explain-out* expound/printer] + (try + (s/check-asserts true) + (s/assert (s/nilable #{"Insufficient input" "Extra input" "no method"}) "Key must be integer") + (finally (s/check-asserts false))))))) + +(defn inline-specs [keyword] + (walk/postwalk + (fn [x] + (if (contains? (s/registry) x) + (s/form x) + x)) + (s/form keyword))) + +#?(:clj + (deftest real-spec-tests + (checking + "for any real-world spec and any data, explain-str returns a string" + ;; At 50, it might find a bug in failures for the + ;; :ring/handler spec, but keep it plugged in, since it + ;; takes a long time to shrink + (chuck/times num-tests) + [spec sg/spec-gen + form gen/any-printable] + ;; Can't reliably test fspecs until + ;; https://dev.clojure.org/jira/browse/CLJ-2258 is fixed + ;; because the algorithm to fix up the 'in' paths depends + ;; on the non-conforming value existing somewhere within + ;; the top-level form + (when-not + ;; a conformer generally won't work against any arbitrary value + ;; e.g. we can't conform 0 with the conformer 'seq' + (or (contains? #{:conformers-test/string-AB} spec) + (some + #{"clojure.spec.alpha/fspec"} + (->> spec + inline-specs + (tree-seq coll? identity) + (map str)))) + (is (string? (expound/expound-str spec form))))))) + +#?(:clj + (deftest assert-on-real-spec-tests + (checking + "for any real-world spec and any data, assert returns an error that matches explain-str" + (chuck/times num-tests) + [spec sg/spec-gen + form gen/any-printable] + ;; Can't reliably test fspecs until + ;; https://dev.clojure.org/jira/browse/CLJ-2258 is fixed + ;; because the algorithm to fix up the 'in' paths depends + ;; on the non-conforming value existing somewhere within + ;; the top-level form + (when-not (some + #{"clojure.spec.alpha/fspec"} + (->> spec + inline-specs + (tree-seq coll? identity) + (map str))) + (when-not (s/valid? spec form) + (let [expected-err-msg (str "Spec assertion failed\n" + (binding [s/*explain-out* (expound/custom-printer {:print-specs? true})] + (s/explain-str spec form)))] + (is (thrown-with-msg? + #?(:cljs :default :clj Exception) + (re-pattern (java.util.regex.Pattern/quote expected-err-msg)) + (binding [s/*explain-out* expound/printer] + (try + (s/check-asserts true) + (s/assert spec form) + (finally + (s/check-asserts false))))) + (str "Expected: " expected-err-msg)))))))) + +(deftest test-mutate + (checking + "mutation alters data structure" + (chuck/times num-tests) + [form gen/any-printable + mutate-path (gen/vector gen/nat 1 10)] + (is (not= form + (mutate form mutate-path))))) + +#?(:clj + 1 + #_(deftest real-spec-tests-mutated-valid-value + ;; FIXME - we need to use generate mutated value, instead + ;; of adding randomness to test + #_(checking + "for any real-world spec and any mutated valid data, explain-str returns a string" + (chuck/times num-tests) + [spec sg/spec-gen + mutate-path (gen/vector gen/pos-int)] + (when-not (some + #{"clojure.spec.alpha/fspec"} + (->> spec + inline-specs + (tree-seq coll? identity) + (map str))) + (when (contains? (s/registry) spec) + (try + (let [valid-form (first (s/exercise spec 1)) + invalid-form (mutate valid-form mutate-path)] + (is (string? (expound/expound-str spec invalid-form)))) + (catch clojure.lang.ExceptionInfo e + (when (not= :no-gen (::s/failure (ex-data e))) + (when (not= "Couldn't satisfy such-that predicate after 100 tries." (.getMessage e)) + (throw e)))))))))) + +;; Using conformers for transformation should not crash by default, or at least give useful error message. +(defn numberify [s] + (cond + (number? s) s + (re-matches #"^\d+$" s) #?(:cljs (js/parseInt s 10) + :clj (Integer. s)) + :else ::s/invalid)) + +(s/def :conformers-test/number (s/conformer numberify)) + +(defn conform-by + [tl-key payload-key] + (s/conformer (fn [m] + (let [id (get m tl-key)] + (if (and id (map? (get m payload-key))) + (assoc-in m [payload-key tl-key] id) + ::s/invalid))))) + +(s/def :conformers-test.query/id qualified-keyword?) + +(defmulti query-params :conformers-test.query/id) +(s/def :conformers-test.query/params (s/multi-spec query-params :conformers-test.query/id)) +(s/def :user/id string?) + +(defmethod query-params :conformers-test/lookup-user [_] + (s/keys :req [:user/id])) + +(s/def :conformers-test/query + (s/and + (conform-by :conformers-test.query/id :conformers-test.query/params) + (s/keys :req [:conformers-test.query/id + :conformers-test.query/params]))) + +(s/def :conformers-test/string-AB-seq (s/cat :a #{\A} :b #{\B})) + +(s/def :conformers-test/string-AB + (s/and + ;; conform as sequence (seq function) + (s/conformer #(if (seqable? %) (seq %) %)) + ;; re-use previous sequence spec + :conformers-test/string-AB-seq)) + +(defn parse-csv [s] + (map string/upper-case (string/split s #","))) + +(deftest conformers-test + ;; Example from http://cjohansen.no/a-unified-specification/ + (binding [s/*explain-out* (expound/custom-printer {:print-specs? false}) + *print-namespace-maps* false] + (testing "conform string to int" + (is (string? + (s/explain-str :conformers-test/number "123a")))) + ;; Example from https://github.com/bhb/expound/issues/15#issuecomment-326838879 + (testing "conform maps" + (is (string? (s/explain-str :conformers-test/query {}))) + (is (= "-- Spec failed -------------------- + +Part of the value + + {:conformers-test.query/id :conformers-test/lookup-user, :conformers-test.query/params {}} + +when conformed as + + {:conformers-test.query/id :conformers-test/lookup-user} + +should contain key: :user/id + +| key | spec | +|==========+=========| +| :user/id | string? | + +------------------------- +Detected 1 error\n" + (s/explain-str :conformers-test/query {:conformers-test.query/id :conformers-test/lookup-user + :conformers-test.query/params {}})))) + ;; Minified example based on https://github.com/bhb/expound/issues/15 + ;; This doesn't look ideal, but really, it's not a good idea to use spec + ;; for string parsing, so I'm OK with it + (testing "conform string to seq" + (is (= + ;; clojurescript doesn't have a character type + #?(:cljs "-- Spec failed --------------------\n\n \"A\"C\"\"\n ^^^\n\nshould be: \"B\"\n\n-------------------------\nDetected 1 error\n" + :clj "-- Spec failed -------------------- + + \"A\\C\" + ^^ + +should be: \\B + +------------------------- +Detected 1 error +") + (s/explain-str :conformers-test/string-AB "AC")))) + (testing "s/cat" + (s/def :conformers-test/sorted-pair (s/and (s/cat :x int? :y int?) #(< (-> % :x) (-> % :y)))) + (is (= (pf "-- Spec failed -------------------- + + [1 0] + +when conformed as + + {:x 1, :y 0} + +should satisfy + + %s + +------------------------- +Detected 1 error +" + #?(:cljs "(fn [%] (< (-> % :x) (-> % :y)))" + :clj "(fn + [%] + (< (-> % :x) (-> % :y)))")) + (expound/expound-str :conformers-test/sorted-pair [1 0] {:print-specs? false}))) + (is (= (pf "-- Spec failed -------------------- + + [... [1 0]] + ^^^^^ + +when conformed as + + {:x 1, :y 0} + +should satisfy + + %s + +------------------------- +Detected 1 error\n" + #?(:cljs "(fn [%] (< (-> % :x) (-> % :y)))" + :clj "(fn + [%] + (< (-> % :x) (-> % :y)))")) + (expound/expound-str (s/coll-of :conformers-test/sorted-pair) [[0 1] [1 0]] {:print-specs? false}))) + (is (= (pf "-- Spec failed -------------------- + + {:a [1 0]} + ^^^^^ + +when conformed as + + {:x 1, :y 0} + +should satisfy + + %s + +------------------------- +Detected 1 error\n" + #?(:cljs "(fn [%] (< (-> % :x) (-> % :y)))" + :clj "(fn + [%] + (< (-> % :x) (-> % :y)))")) + (expound/expound-str (s/map-of keyword? :conformers-test/sorted-pair) {:a [1 0]} {:print-specs? false}))) + (is (= (pf "-- Spec failed -------------------- + + [... \"a\"] + ^^^ + +should satisfy + + int? + +------------------------- +Detected 1 error\n") + (expound/expound-str :conformers-test/sorted-pair [1 "a"] {:print-specs? false})))) + (testing "conformers that modify path of values" + (s/def :conformers-test/vals (s/coll-of (s/and string? + #(re-matches #"[A-G]+" %)))) + (s/def :conformers-test/csv (s/and string? + (s/conformer parse-csv) + :conformers-test/vals)) + (is (= "-- Spec failed -------------------- + +Part of the value + + \"abc,def,ghi\" + +when conformed as + + \"GHI\" + +should satisfy + + (fn [%] (re-matches #\"[A-G]+\" %)) + +------------------------- +Detected 1 error\n" + (expound/expound-str :conformers-test/csv "abc,def,ghi" {:print-specs? false})))) + + ;; this is NOT recommended! + ;; so I'm not inclined to make this much nicer than + ;; the default spec output + (s/def :conformers-test/coerced-kw (s/and (s/conformer #(if (string? %) + (keyword %) + ::s/invalid)) + keyword?)) + (testing "coercion" + (is (= (pf "-- Spec failed -------------------- + + nil + +should satisfy + + (pf.spec.alpha/conformer + (fn + [%%] + (if + (string? %%) + (keyword %%) + :pf.spec.alpha/invalid))) + +------------------------- +Detected 1 error +") + (binding [s/*explain-out* (expound/custom-printer {:print-specs? false})] + (s/explain-str :conformers-test/coerced-kw nil)))) + + (is (= (pf "-- Spec failed -------------------- + + [... ... ... 0] + ^ + +should satisfy + + (pf.spec.alpha/conformer + (fn + [%%] + (if + (string? %%) + (keyword %%) + :pf.spec.alpha/invalid))) + +------------------------- +Detected 1 error +") + (binding [s/*explain-out* (expound/custom-printer {:print-specs? false})] + (s/explain-str (s/coll-of :conformers-test/coerced-kw) ["a" "b" "c" 0]))))) + ;; Also not recommended + (s/def :conformers-test/str-kw? (s/and (s/conformer #(if (string? %) + (keyword %) + ::s/invalid) + name) keyword?)) + (testing "coercion with unformer" + (is (= (pf "-- Spec failed -------------------- + + nil + +should satisfy + + (pf.spec.alpha/conformer + (fn + [%%] + (if + (string? %%) + (keyword %%) + :pf.spec.alpha/invalid))) + +------------------------- +Detected 1 error +") + (binding [s/*explain-out* (expound/custom-printer {:print-specs? false})] + (s/explain-str :conformers-test/coerced-kw nil)))) + + (is (= (pf "-- Spec failed -------------------- + + [... ... ... 0] + ^ + +should satisfy + + (pf.spec.alpha/conformer + (fn + [%%] + (if + (string? %%) + (keyword %%) + :pf.spec.alpha/invalid))) + +------------------------- +Detected 1 error +") + (binding [s/*explain-out* (expound/custom-printer {:print-specs? false})] + (s/explain-str (s/coll-of :conformers-test/coerced-kw) ["a" "b" "c" 0]))))) + + (s/def :conformers-test/name string?) + (s/def :conformers-test/age pos-int?) + (s/def :conformers-test/person (s/keys* :req-un [:conformers-test/name + :conformers-test/age])) + ;; FIXME: Implementation could be simpler once + ;; https://dev.clojure.org/jira/browse/CLJ-2406 is fixed + (testing "spec defined with keys*" + (is (= "-- Spec failed -------------------- + + [... ... ... :Stan] + ^^^^^ + +should satisfy + + string? + +------------------------- +Detected 1 error +" + (binding [s/*explain-out* (expound/custom-printer {:print-specs? false})] + (s/explain-str :conformers-test/person [:age 30 :name :Stan]))))) + + (testing "spec defined with keys* and copies of bad value elsewhere in the data" + (is (= "-- Spec failed -------------------- + +Part of the value + + [:Stan [:age 30 :name :Stan]] + +when conformed as + + :Stan + +should satisfy + + string? + +------------------------- +Detected 1 error\n" + (binding [s/*explain-out* (expound/custom-printer {:print-specs? false})] + (s/explain-str (s/tuple + keyword? + :conformers-test/person) [:Stan [:age 30 :name :Stan]]))))) + + (testing "ambiguous value" + (is (= (pf "-- Spec failed -------------------- + + {[0 1] ..., [1 0] ...} + ^^^^^ + +when conformed as + + {:x 1, :y 0} + +should satisfy + + %s + +------------------------- +Detected 1 error +" + #?(:cljs "(fn [%] (< (-> % :x) (-> % :y)))" + :clj "(fn + [%] + (< (-> % :x) (-> % :y)))")) + (binding [s/*explain-out* (expound/custom-printer {:print-specs? false})] + (s/explain-str (s/map-of :conformers-test/sorted-pair any?) {[0 1] [1 0] + [1 0] [1 0]}))))))) + +(s/def :duplicate-preds/str-or-str (s/or + ;; Use anonymous functions to assure + ;; non-equality + :str1 #(string? %) + :str2 #(string? %))) +(deftest duplicate-preds + (testing "duplicate preds only appear once" + (is (= (pf "-- Spec failed -------------------- + + 1 + +should satisfy + + (fn [%%] (string? %%)) + +-- Relevant specs ------- + +:duplicate-preds/str-or-str: + (pf.spec.alpha/or + :str1 + (pf.core/fn [%%] (pf.core/string? %%)) + :str2 + (pf.core/fn [%%] (pf.core/string? %%))) + +------------------------- +Detected 1 error +") + (expound/expound-str :duplicate-preds/str-or-str 1))))) + +(s/def :fspec-test/div (s/fspec + :args (s/cat :x int? :y pos-int?))) + +(defn my-div [x y] + (assert (not (zero? (/ x y))))) + +(defn until-unsuccessful [f] + (let [nil-or-failure #(if (= "Success! +" %) + nil + %)] + (or (nil-or-failure (f)) + (nil-or-failure (f)) + (nil-or-failure (f)) + (nil-or-failure (f)) + (nil-or-failure (f))))) + +(deftest fspec-exception-test + (testing "args that throw exception" + (is (= (pf "-- Exception ---------------------- + + expound.alpha-test/my-div + +threw exception + + \"Assert failed: (not (zero? (/ x y)))\" + +with args: + + 0, 1 + +-- Relevant specs ------- + +:fspec-test/div: + (pf.spec.alpha/fspec + :args + (pf.spec.alpha/cat :x pf.core/int? :y pf.core/pos-int?) + :ret + pf.core/any? + :fn + nil) + +------------------------- +Detected 1 error\n") + + ;; + (until-unsuccessful #(expound/expound-str :fspec-test/div my-div)))) + + (is (= (pf "-- Exception ---------------------- + + [expound.alpha-test/my-div] + ^^^^^^^^^^^^^^^^^^^^^^^^^ + +threw exception + + \"Assert failed: (not (zero? (/ x y)))\" + +with args: + + 0, 1 + +-- Relevant specs ------- + +:fspec-test/div: + (pf.spec.alpha/fspec + :args + (pf.spec.alpha/cat :x pf.core/int? :y pf.core/pos-int?) + :ret + pf.core/any? + :fn + nil) + +------------------------- +Detected 1 error\n") + (until-unsuccessful #(expound/expound-str (s/coll-of :fspec-test/div) [my-div])))))) + +(s/def :fspec-ret-test/my-int pos-int?) +(s/def :fspec-ret-test/plus (s/fspec + :args (s/cat :x int? :y pos-int?) + :ret :fspec-ret-test/my-int)) + +(defn my-plus [x y] + (+ x y)) + +(deftest fspec-ret-test + (testing "invalid ret" + (is (= (pf "-- Function spec failed ----------- + + expound.alpha-test/my-plus + +returned an invalid value + + 0 + +should satisfy + + pos-int? + +------------------------- +Detected 1 error\n") + (until-unsuccessful #(expound/expound-str :fspec-ret-test/plus my-plus {:print-specs? false})))) + + (is (= (pf "-- Function spec failed ----------- + + [expound.alpha-test/my-plus] + ^^^^^^^^^^^^^^^^^^^^^^^^^^ + +returned an invalid value + + 0 + +should satisfy + + pos-int? + +------------------------- +Detected 1 error\n") + (until-unsuccessful #(expound/expound-str (s/coll-of :fspec-ret-test/plus) [my-plus] {:print-specs? false})))) + (s/def :fspec-ret-test/return-map (s/fspec + :args (s/cat) + :ret (s/keys :req-un [:fspec-ret-test/my-int]))) + (is (= (pf "-- Function spec failed ----------- + + + +returned an invalid value + + {} + +should contain key: :my-int + +| key | spec | +|=========+==========| +| :my-int | pos-int? | + +------------------------- +Detected 1 error +") + (until-unsuccessful #(expound/expound-str :fspec-ret-test/return-map + (fn [] {}) + {:print-specs? false})))))) + +(s/def :fspec-fn-test/minus (s/fspec + :args (s/cat :x int? :y int?) + :fn (s/and + #(< (:ret %) (-> % :args :x)) + #(< (:ret %) (-> % :args :y))))) + +(defn my-minus [x y] + (- x y)) + +(deftest fspec-fn-test + (testing "invalid ret" + (is (= (pf "-- Function spec failed ----------- + + expound.alpha-test/my-minus + +failed spec. Function arguments and return value + + {:args {:x 0, :y 0}, :ret 0} + +should satisfy + + %s + +------------------------- +Detected 1 error\n" + + #?(:clj + "(fn + [%] + (< (:ret %) (-> % :args :x)))" + :cljs "(fn [%] (< (:ret %) (-> % :args :x)))")) + (binding [s/*explain-out* (expound/custom-printer {:print-specs? false})] + (until-unsuccessful #(s/explain-str :fspec-fn-test/minus my-minus))))) + + (is (= (pf "-- Function spec failed ----------- + + [expound.alpha-test/my-minus] + ^^^^^^^^^^^^^^^^^^^^^^^^^^^ + +failed spec. Function arguments and return value + + {:args {:x 0, :y 0}, :ret 0} + +should satisfy + + %s + +------------------------- +Detected 1 error\n" + #?(:clj + "(fn + [%] + (< (:ret %) (-> % :args :x)))" + :cljs "(fn [%] (< (:ret %) (-> % :args :x)))")) + (binding [s/*explain-out* (expound/custom-printer {:print-specs? false})] + (until-unsuccessful #(s/explain-str (s/coll-of :fspec-fn-test/minus) [my-minus]))))))) + +(deftest ifn-fspec-test + (testing "keyword ifn / ret failure" + (is (= "-- Function spec failed ----------- + + [:foo] + ^^^^ + +returned an invalid value + + nil + +should satisfy + + int? + +------------------------- +Detected 1 error\n" + (binding [s/*explain-out* (expound/custom-printer {:print-specs? false})] + (until-unsuccessful #(s/explain-str (s/coll-of (s/fspec :args (s/cat :x int?) :ret int?)) + [:foo]))))) + (testing "set ifn / ret failure" + (is (= "-- Function spec failed ----------- + + [#{}] + ^^^ + +returned an invalid value + + nil + +should satisfy + + int? + +------------------------- +Detected 1 error\n" + (binding [s/*explain-out* (expound/custom-printer {:print-specs? false})] + (until-unsuccessful #(s/explain-str (s/coll-of (s/fspec :args (s/cat :x int?) :ret int?)) + [#{}]))))))) + #?(:clj + (testing "vector ifn / exception failure" + (is (= "-- Exception ---------------------- + + [[]] + ^^ + +threw exception + + nil + +with args: + + 0 + +------------------------- +Detected 1 error\n" + (binding [s/*explain-out* (expound/custom-printer {:print-specs? false})] + (until-unsuccessful #(s/explain-str (s/coll-of (s/fspec :args (s/cat :x int?) :ret int?)) + [[]])))))))) + +#?(:clj + (deftest form-containing-incomparables + (checking + "for any value including NaN, or Infinity, expound returns a string" + (chuck/times num-tests) + [form (gen/frequency + [[1 (gen/elements + [Double/NaN + Double/POSITIVE_INFINITY + Double/NEGATIVE_INFINITY + '(Double/NaN Double/POSITIVE_INFINITY Double/NEGATIVE_INFINITY) + [Double/NaN Double/POSITIVE_INFINITY Double/NEGATIVE_INFINITY] + {Double/NaN Double/NaN + Double/POSITIVE_INFINITY Double/POSITIVE_INFINITY + Double/NEGATIVE_INFINITY Double/NEGATIVE_INFINITY}])] + [5 gen/any-printable]])] + (is (string? (expound/expound-str (constantly false) form)))))) + +#?(:cljs + (deftest form-containing-incomparables + (checking + "for any value including NaN, or Infinity, expound returns a string" + (chuck/times num-tests) + [form (gen/frequency + [[1 (gen/elements + [js/NaN + js/Infinity + js/-Infinity + '(js/NaN js/Infinity js/-Infinity) + [js/NaN js/Infinity js/-Infinity] + {js/NaN js/NaN + js/Infinity js/Infinity + js/-Infinity js/-Infinity}])] + [5 gen/any-printable]])] + (is (string? (expound/expound-str (constantly false) form)))))) + +(defmulti pet :pet/type) +(defmethod pet :dog [_] + (s/keys)) +(defmethod pet :cat [_] + (s/keys)) + +(defmulti animal :animal/type) +(defmethod animal :dog [_] + (s/keys)) +(defmethod animal :cat [_] + (s/keys)) + +(s/def :multispec-in-compound-spec/pet1 (s/and + map? + (s/multi-spec pet :pet/type))) + +(s/def :multispec-in-compound-spec/pet2 (s/or + :map1 (s/multi-spec pet :pet/type) + :map2 (s/multi-spec animal :animal/type))) + +(deftest multispec-in-compound-spec + (testing "multispec combined with s/and" + (is (= (pf "-- Missing spec ------------------- + +Cannot find spec for + + {:pet/type :fish} + +with + + Spec multimethod: `expound.alpha-test/pet` + Dispatch value: `:fish` + +-- Relevant specs ------- + +:multispec-in-compound-spec/pet1: + (pf.spec.alpha/and + pf.core/map? + (pf.spec.alpha/multi-spec expound.alpha-test/pet :pet/type)) + +------------------------- +Detected 1 error\n") + (expound/expound-str :multispec-in-compound-spec/pet1 {:pet/type :fish})))) + ;; FIXME - improve this, maybe something like: + ;;;;;;;;;;;;;;;;;;; + + ;; {:pet/type :fish} + + ;; should be described by a spec multimethod, but + + ;; expound.alpha-test/pet + + ;; is missing a method for value + + ;; (:pet/type {:pet/type :fish}) ; => :fish + + ;; or + + ;; should be described by a spec multimethod, but + + ;; expound.alpha-test/pet + + ;; is missing a method for value + + ;; (:animal/type {:pet/type :fish}) ; => nil + (testing "multispec combined with s/or" + (is (= (pf "-- Missing spec ------------------- + +Cannot find spec for + + {:pet/type :fish} + +with + + Spec multimethod: `expound.alpha-test/pet` + Dispatch value: `:fish` + +or with + + Spec multimethod: `expound.alpha-test/animal` + Dispatch value: `nil` + +-- Relevant specs ------- + +:multispec-in-compound-spec/pet2: + (pf.spec.alpha/or + :map1 + (pf.spec.alpha/multi-spec expound.alpha-test/pet :pet/type) + :map2 + (pf.spec.alpha/multi-spec expound.alpha-test/animal :animal/type)) + +------------------------- +Detected 1 error\n") + (expound/expound-str :multispec-in-compound-spec/pet2 {:pet/type :fish}))))) + +(expound/def :predicate-messages/string string? "should be a string") +(expound/def :predicate-messages/vector vector? "should be a vector") + +(deftest predicate-messages + (binding [s/*explain-out* (expound/custom-printer {:print-specs? false})] + (testing "predicate with error message" + (is (= "-- Spec failed -------------------- + + :hello + +should be a string + +------------------------- +Detected 1 error +" + (s/explain-str :predicate-messages/string :hello)))) + (testing "predicate within a collection" + (is (= "-- Spec failed -------------------- + + [... :foo] + ^^^^ + +should be a string + +------------------------- +Detected 1 error +" + (s/explain-str (s/coll-of :predicate-messages/string) ["" :foo])))) + (testing "two predicates with error messages" + (is (= "-- Spec failed -------------------- + + 1 + +should be a string + +or + +should be a vector + +------------------------- +Detected 1 error +" + (s/explain-str (s/or :s :predicate-messages/string + :v :predicate-messages/vector) 1)))) + (testing "one predicate with error message, one without" + (is (= "-- Spec failed -------------------- + + foo + +should satisfy + + pos-int? + +or + + vector? + +or + +should be a string + +------------------------- +Detected 1 error +" + (s/explain-str (s/or :p pos-int? + :s :predicate-messages/string + :v vector?) 'foo)))) + (testing "compound predicates" + (let [email-regex #"^[a-zA-Z0-9._%+-]+@[a-zA-Z0-9.-]+\.[a-zA-Z]{2,63}$"] + (expound/def :predicate-messages/email (s/and string? #(re-matches email-regex %)) "should be a valid email address") + (is (= "-- Spec failed -------------------- + + \"sally@\" + +should be a valid email address + +------------------------- +Detected 1 error +" + (s/explain-str + :predicate-messages/email + "sally@")))) + (expound/def :predicate-messages/score (s/int-in 0 100) "should be between 0 and 100") + (is (= "-- Spec failed -------------------- + + 101 + +should be between 0 and 100 + +------------------------- +Detected 1 error +" + (s/explain-str + :predicate-messages/score + 101)))))) + +(s/fdef results-str-fn1 + :args (s/cat :x nat-int? :y nat-int?) + :ret pos?) +(defn results-str-fn1 [x y] + #?(:clj (+' x y) + :cljs (+ x y))) + +(s/fdef results-str-fn2 + :args (s/cat :x nat-int? :y nat-int?) + :fn #(let [x (-> % :args :x) + ret (-> % :ret)] + (< x ret))) +(defn results-str-fn2 [x y] + (+ x y)) + +(s/fdef results-str-fn3 + :args (s/cat :x #{0} :y #{0}) + :ret nat-int?) +(defn results-str-fn3 [x y] + (+ x y)) + +(s/fdef results-str-fn4 + :args (s/cat :x int?) + :ret (s/coll-of int?)) +(defn results-str-fn4 [x] + [x :not-int]) + +(s/fdef results-str-fn5 + :args (s/cat :x #{1} :y #{1}) + :ret string?) +(defn results-str-fn5 + [_x _y] + #?(:clj (throw (Exception. "Ooop!")) + :cljs (throw (js/Error. "Oops!")))) + +(s/fdef results-str-fn6 + :args (s/cat :f fn?) + :ret any?) +(defn results-str-fn6 + [f] + (f 1)) + +(s/def :results-str-fn7/k string?) +(s/fdef results-str-fn7 + :args (s/cat :m (s/keys)) + :ret (s/keys :req-un [:results-str-fn7/k])) +(defn results-str-fn7 + [m] + m) + +(s/fdef results-str-missing-fn + :args (s/cat :x int?)) + +(s/fdef results-str-missing-args-spec + :ret int?) +(defn results-str-missing-args-spec [] 1) + +(deftest explain-results + (testing "explaining results with non-expound printer" + (is (thrown-with-msg? + #?(:cljs :default :clj Exception) + #"Cannot print check results" + (binding [s/*explain-out* s/explain-printer] + (expound/explain-results-str (st/check `results-str-fn1)))))) + + (testing "single bad result (failing return spec)" + (is (= (pf + "== Checked expound.alpha-test/results-str-fn1 + +-- Function spec failed ----------- + + (expound.alpha-test/results-str-fn1 0 0) + +returned an invalid value. + + 0 + +should satisfy + + pos? + +------------------------- +Detected 1 error +") + (binding [s/*explain-out* expound/printer] + (expound/explain-results-str (orch-unstrument-test-fns #(st/check `results-str-fn1)))))) + (is (= (pf + "== Checked expound.alpha-test/results-str-fn7 + +-- Function spec failed ----------- + + (expound.alpha-test/results-str-fn7 {}) + +returned an invalid value. + + {} + +should contain key: :k + +| key | spec | +|=====+=========| +| :k | string? | + +------------------------- +Detected 1 error +") + (binding [s/*explain-out* expound/printer] + (expound/explain-results-str (orch-unstrument-test-fns #(st/check `results-str-fn7))))))) + (testing "single bad result (failing fn spec)" + (is (= (pf "== Checked expound.alpha-test/results-str-fn2 + +-- Function spec failed ----------- + + (expound.alpha-test/results-str-fn2 0 0) + +failed spec. Function arguments and return value + + {:args {:x 0, :y 0}, :ret 0} + +should satisfy + + (fn + [%%] + (let + [x (-> %% :args :x) ret (-> %% :ret)] + (< x ret))) + +------------------------- +Detected 1 error +") + (binding [s/*explain-out* expound/printer] + (expound/explain-results-str (orch-unstrument-test-fns #(st/check `results-str-fn2))))))) + (testing "single valid result" + (is (= "== Checked expound.alpha-test/results-str-fn3 + +Success! +" + (binding [s/*explain-out* expound/printer] + (expound/explain-results-str (st/check `results-str-fn3)))))) + #?(:clj + (testing "multiple results" + (is (= "== Checked expound.alpha-test/results-str-fn2 + +-- Function spec failed ----------- + + (expound.alpha-test/results-str-fn2 0 0) + +failed spec. Function arguments and return value + + {:args {:x 0, :y 0}, :ret 0} + +should satisfy + + (fn + [%] + (let + [x (-> % :args :x) ret (-> % :ret)] + (< x ret))) + +------------------------- +Detected 1 error + + +== Checked expound.alpha-test/results-str-fn3 + +Success! +" + (binding [s/*explain-out* expound/printer] + (expound/explain-results-str (orch-unstrument-test-fns #(st/check [`results-str-fn2 `results-str-fn3])))))))) + + (testing "check-fn" + (is (= "== Checked ======================== + +-- Function spec failed ----------- + + ( 0 0) + +failed spec. Function arguments and return value + + {:args {:x 0, :y 0}, :ret 0} + +should satisfy + + (fn + [%] + (let + [x (-> % :args :x) ret (-> % :ret)] + (< x ret))) + +------------------------- +Detected 1 error +" + (binding [s/*explain-out* expound/printer] + (expound/explain-result-str (st/check-fn `results-str-fn1 (s/spec `results-str-fn2))))))) + #?(:clj (testing "custom printer" + (is (= "== Checked expound.alpha-test/results-str-fn4 + +-- Function spec failed ----------- + + (expound.alpha-test/results-str-fn4 0) + +returned an invalid value. + + [0 :not-int] + ^^^^^^^^ + +should satisfy + + int? + +------------------------- +Detected 1 error +" + (binding [s/*explain-out* (expound/custom-printer {:show-valid-values? true})] + (expound/explain-results-str (orch-unstrument-test-fns #(st/check `results-str-fn4)))))))) + (testing "exceptions raised during check" + (is (= "== Checked expound.alpha-test/results-str-fn5 + + (expound.alpha-test/results-str-fn5 1 1) + + threw error" + (binding [s/*explain-out* expound/printer] + (take-lines 5 (expound/explain-results-str (st/check `results-str-fn5))))))) + (testing "colorized output" + (is (= (pf "== Checked expound.alpha-test/results-str-fn5 + + (expound.alpha-test/results-str-fn5 1 1) + + threw error") + (binding [s/*explain-out* (expound/custom-printer {:theme :figwheel-theme})] + (readable-ansi (take-lines 5 (expound/explain-results-str (st/check `results-str-fn5)))))))) + + (testing "failure to generate" + (is (= + #?(:clj "== Checked expound.alpha-test/results-str-fn6 + +Unable to construct generator for [:f] in + + (clojure.spec.alpha/cat :f clojure.core/fn?) +" + ;; CLJS doesn't contain correct data for check failure + + :cljs "== Checked expound.alpha-test/results-str-fn6 + +Unable to construct gen at: [:f] for: fn? in + + (cljs.spec.alpha/cat :f cljs.core/fn?) +") + (binding [s/*explain-out* expound/printer] + (expound/explain-results-str (st/check `results-str-fn6)))))) + (testing "no-fn failure" + (is (= #?(:clj "== Checked expound.alpha-test/results-str-missing-fn + +Failed to check function. + + expound.alpha-test/results-str-missing-fn + +is not defined +" + :cljs "== Checked ======================== + +Failed to check function. + + + +is not defined +") + (binding [s/*explain-out* expound/printer] + (expound/explain-results-str (st/check `results-str-missing-fn)))))) + (testing "no args spec" + (is (= (pf "== Checked expound.alpha-test/results-str-missing-args-spec + +Failed to check function. + + (pf.spec.alpha/fspec :ret pf.core/int?) + +should contain an :args spec +") + (binding [s/*explain-out* expound/printer] + (expound/explain-results-str (st/with-instrument-disabled (st/check `results-str-missing-args-spec)))))))) + +#?(:clj (deftest explain-results-gen + (checking + "all functions can be checked and printed" + (chuck/times num-tests) + [sym-to-check (gen/elements (remove + ;; these functions print to stdout, but return + ;; nothing + #{`expound/explain-results + `expound/explain-result + `expound/expound + `expound/printer} + (st/checkable-syms)))] + ;; Just confirm an error is not thrown + (is (string? + (binding [s/*explain-out* expound/printer] + (expound/explain-results-str + (st/with-instrument-disabled + (st/check sym-to-check + {:clojure.spec.test.check/opts {:num-tests 10}}))))) + (str "Failed to check " sym-to-check))))) + +(s/def :colorized-output/strings (s/coll-of string?)) +(deftest colorized-output + (is (= (pf "-- Spec failed -------------------- + + [... :a ...] + ^^ + +should satisfy + + string? + +-- Relevant specs ------- + +:colorized-output/strings: + (pf.spec.alpha/coll-of pf.core/string?) + +------------------------- +Detected 1 error +") + (expound/expound-str :colorized-output/strings ["" :a ""] {:theme :none}))) + (is (= (pf "-- Spec failed -------------------- + + [... :a ...] + ^^ + +should satisfy + + string? + +-- Relevant specs ------- + +:colorized-output/strings: + (pf.spec.alpha/coll-of pf.core/string?) + +------------------------- +Detected 1 error +") + (readable-ansi (expound/expound-str :colorized-output/strings ["" :a ""] {:theme :figwheel-theme}))))) + +(s/def ::spec-name (s/with-gen + qualified-keyword? + #(gen/let [kw gen/keyword] + (keyword (str "expound-generated-spec/" (name kw)))))) + +(s/def ::fn-spec (s/with-gen + (s/or + :sym symbol? + :anon (s/cat :fn #{`fn `fn*} + :args-list (s/coll-of any? :kind vector?) + :body (s/* any?)) + :form (s/cat :comp #{`comp `partial} + :args (s/+ any?))) + #(gen/return `any?))) + +(s/def ::pred-spec + (s/with-gen + ::fn-spec + #(gen/elements + [`any? + `boolean? + `bytes? + `double? + `ident? + `indexed? + `int? + `keyword? + `map? + `nat-int? + `neg-int? + `pos-int? + `qualified-ident? + `qualified-keyword? + `qualified-symbol? + `seqable? + `simple-ident? + `simple-keyword? + `simple-symbol? + `string? + `symbol? + `uri? + `uuid? + `vector?]))) + +(s/def ::and-spec (s/cat + :and #{`s/and} + :branches (s/+ + ::spec))) + +(s/def ::or-spec (s/cat + :or #{`s/or} + :branches (s/+ + (s/cat + :kw keyword? + :spec ::spec)))) + +(s/def ::set-spec (s/with-gen + (s/coll-of + any? + :kind set? + :min-count 1) + #(s/gen (s/coll-of + (s/or + :s string? + :i int? + :b boolean? + :k keyword?) + :kind set?)))) + +(s/def ::spec (s/or + :amp ::amp-spec + :alt ::alt-spec + :and ::and-spec + :cat ::cat-spec + :coll ::coll-spec + :defined-spec ::spec-name + :every ::every-spec + :fspec ::fspec-spec + :keys ::keys-spec + :map ::map-of-spec + :merge ::merge-spec + :multi ::multispec-spec + :nilable ::nilable-spec + :or ::or-spec + :regex-unary ::regex-unary-spec + :set ::set-spec + :simple ::pred-spec + :spec-wrapper (s/cat :wrapper #{`s/spec} :spec ::spec) + :conformer (s/cat + :conformer #{`s/conformer} + :f ::fn-spec + :unf ::fn-spec) + :with-gen (s/cat + :with-gen #{`s/with-gen} + :spec ::spec + :f ::fn-spec) + :tuple-spec ::tuple-spec)) + +(s/def ::every-opts (s/* + (s/alt + :kind (s/cat + :k #{:kind} + :v #{nil + vector? set? map? list? + `vector? `set? `map? `list?}) + :count (s/cat + :k #{:count} + :v (s/nilable nat-int?)) + :min-count (s/cat + :k #{:min-count} + :v (s/nilable nat-int?)) + :max-count (s/cat + :k #{:max-count} + :v (s/nilable nat-int?)) + :distinct (s/cat + :k #{:distinct} + :v (s/nilable boolean?)) + :into (s/cat + :k #{:into} + :v (s/or :coll #{[] {} #{}} + :list #{'()})) + :gen-max (s/cat + :k #{:gen-max} + :v nat-int?)))) + +(s/def ::every-spec (s/cat + :every #{`s/every} + :spec ::spec + :opts ::every-opts)) + +(s/def ::coll-spec (s/cat + :coll-of #{`s/coll-of} + :spec (s/spec ::spec) + :opts ::every-opts)) + +(s/def ::map-of-spec (s/cat + :map-of #{`s/map-of} + :k ::spec + :w ::spec + :opts ::every-opts)) + +(s/def ::nilable-spec (s/cat + :nilable #{`s/nilable} + :spec ::spec)) + +(s/def ::name-combo + (s/or + :one ::spec-name + :combo (s/cat + :operator #{'and 'or} + :operands + (s/+ + ::name-combo)))) + +(s/def ::keys-spec (s/cat + :keys #{`s/keys `s/keys*} + + :reqs (s/* + (s/cat + :op #{:req :req-un} + :names (s/coll-of + ::name-combo + :kind vector?))) + :opts (s/* + (s/cat + :op #{:opt :opt-un} + :names (s/coll-of + ::spec-name + :kind vector?))))) + +(s/def ::amp-spec + (s/cat :op #{`s/&} + :spec ::spec + :preds (s/* + (s/with-gen + (s/or :pred ::pred-spec + :defined ::spec-name) + #(gen/return `any?))))) + +(s/def ::alt-spec + (s/cat :op #{`s/alt} + :key-pred-forms (s/+ + (s/cat + :key keyword? + :pred (s/spec ::spec))))) + +(s/def ::regex-unary-spec + (s/cat :op #{`s/+ `s/* `s/?} :pred (s/spec ::spec))) + +(s/def ::cat-pred-spec + (s/or + :spec (s/spec ::spec) + :regex-unary ::regex-unary-spec + :amp ::amp-spec + :alt ::alt-spec)) + +(defmulti fake-multimethod :fake-tag) + +(s/def ::multispec-spec + (s/cat + :mult-spec #{`s/multi-spec} + :mm (s/with-gen + symbol? + #(gen/return `fake-multimethod)) + :tag (s/with-gen + (s/or :sym symbol? + :k keyword?) + #(gen/return :fake-tag)))) + +(s/def ::cat-spec (s/cat + :cat #{`s/cat} + :key-pred-forms + (s/* + (s/cat + :key keyword? + :pred ::cat-pred-spec)))) + +(s/def ::fspec-spec (s/cat + :cat #{`s/fspec} + :args (s/cat + :args #{:args} + :spec ::spec) + :ret (s/? + (s/cat + :ret #{:ret} + :spec ::spec)) + :fn (s/? + (s/cat + :fn #{:fn} + :spec (s/nilable ::spec))))) + +(s/def ::tuple-spec (s/cat + :tuple #{`s/tuple} + :preds (s/+ + ::spec))) + +(s/def ::merge-spec (s/cat + :merge #{`s/merge} + :pred-forms (s/* ::spec))) + +(s/def ::spec-def (s/cat + :def #{`s/def} + :name ::spec-name + :spec (s/spec ::spec))) + +#?(:clj (s/def ::spec-defs (s/coll-of ::spec-def + :min-count 1 + :gen-max 3))) + +(defn exercise-count [spec] + (case spec + (::spec-def ::fspec-spec ::regex-unary-spec ::spec-defs ::alt-spec) 1 + + (::cat-spec ::merge-spec ::and-spec ::every-spec ::spec ::coll-spec ::map-of-spec ::or-spec ::tuple-spec ::keys-spec) 2 + + 4)) + +(deftest spec-specs-can-generate + (doseq [spec-spec (filter keyword? (sg/topo-sort (filter #(= "expound.alpha-test" (namespace %)) + (keys (s/registry)))))] + (is + (doall (s/exercise spec-spec (exercise-count spec-spec))) + (str "Failed to generate examples for spec " spec-spec)))) + +#_(defn sample-seq + "Return a sequence of realized values from `generator`." + [generator seed] + (s/assert some? generator) + (let [max-size 1 + r (if seed + (random/make-random seed) + (random/make-random)) + size-seq (gen/make-size-range-seq max-size)] + (map #(rose/root (gen/call-gen generator %1 %2)) + (gen/lazy-random-states r) + size-seq))) + +#_(defn missing-specs [spec-defs] + (let [defined (set (map second spec-defs)) + used (set + (filter + #(and (qualified-keyword? %) + (= "expound-generated-spec" (namespace %))) + (tree-seq coll? seq spec-defs)))] + (set/difference used defined))) + +#?(:clj 1 #_(deftest eval-gen-test + ;; FIXME - this is a useful test but not 100% reliable yet + ;; so I'm disabling to get this PR in + (binding [s/*recursion-limit* 2] + (checking + "expound returns string" + 5 ;; Hard-code at 5, since generating specs explodes in size quite quickly + [spec-defs (s/gen ::spec-defs) + pred-specs (gen/vector (s/gen ::pred-spec) 5) + seed (s/gen pos-int?) + mutate-path (gen/vector gen/pos-int)] + (try + (doseq [[spec-name spec] (map vector (missing-specs spec-defs) (cycle pred-specs))] + (eval `(s/def ~spec-name ~spec))) + (doseq [spec-def spec-defs] + (eval spec-def)) + + (let [spec (second (last spec-defs)) + form (last (last spec-defs)) + disallowed #{"clojure.spec.alpha/fspec" + "clojure.spec.alpha/multi-spec" + "clojure.spec.alpha/with-gen"}] + (when-not (or (some + disallowed + (map str (tree-seq coll? identity form))) + (some + disallowed + (->> spec + inline-specs + (tree-seq coll? identity) + (map str)))) + (let [valid-form (first (sample-seq (s/gen spec) seed)) + invalid-form (mutate valid-form mutate-path)] + (try + (is (string? + (expound/expound-str spec invalid-form))) + (is (not + (string/includes? + (expound/expound-str (second (last spec-defs)) invalid-form) + "should contain keys"))) + (catch Exception e + (is (or + (string/includes? + (:cause (Throwable->map e)) + "Method code too large!") + (string/includes? + (:cause (Throwable->map e)) + "Cannot convert path.")))))))) + (finally + ;; Get access to private atom in clojure.spec + (def spec-reg (deref #'s/registry-ref)) + (doseq [k (filter + (fn [k] (= "expound-generated-spec" (namespace k))) + (keys (s/registry)))] + (swap! spec-reg dissoc k)))))))) + +(deftest clean-registry + (testing "only base spec remains" + (is (<= (count (filter + (fn [k] (= "expound-generated-spec" (namespace k))) + (keys (s/registry)))) + 1) + (str "Found leftover specs: " (vec (filter + (fn [k] (= "expound-generated-spec" (namespace k))) + (keys (s/registry)))))))) + +(deftest valid-spec-spec + (checking + "spec for specs validates against real specs" + (chuck/times num-tests) + [sp (gen/elements + (sg/topo-sort + (remove + (fn [k] + (string/includes? (pr-str (s/form (s/get-spec k))) "clojure.core.specs.alpha/quotable")) + (filter + (fn [k] (or + (string/starts-with? (namespace k) "clojure") + (string/starts-with? (namespace k) "expound") + (string/starts-with? (namespace k) "onyx") + (string/starts-with? (namespace k) "ring"))) + (keys (s/registry))))))] + (is (s/valid? ::spec (s/form (s/get-spec sp))) + (str + "Spec name: " sp "\n" + "Error: " + (binding [s/*explain-out* (expound/custom-printer {:show-valid-values? true + :print-specs? false + :theme :figwheel-theme})] + (s/explain-str ::spec (s/form (s/get-spec sp)))))))) + +(defmethod expound/problem-group-str ::test-problem1 [_type _spec-name _val _path _problems _opts] + "fake-problem-group-str") + +(defmethod expound/problem-group-str ::test-problem2 [type spec-name val path problems opts] + (str "fake-problem-group-str\n" + (expound/expected-str type spec-name val path problems opts))) + +(defmethod expound/expected-str ::test-problem2 [_type _spec-name _val _path _problems _opts] + "fake-expected-str") + +(deftest extensibility-test + (testing "can overwrite entire message" + (let [printer-str #'expound/printer-str + ed (assoc-in (s/explain-data int? "") + [::s/problems 0 :expound.spec.problem/type] + ::test-problem1)] + + (is (= "fake-problem-group-str\n\n-------------------------\nDetected 1 error\n" + (printer-str {:print-specs? false} ed))))) + (testing "can overwrite 'expected' str" + (let [printer-str #'expound/printer-str + ed (assoc-in (s/explain-data int? "") + [::s/problems 0 :expound.spec.problem/type] + ::test-problem2)] + + (is (= "fake-problem-group-str\nfake-expected-str\n\n-------------------------\nDetected 1 error\n" + (printer-str {:print-specs? false} ed))))) + (testing "if type has no mm implemented, throw an error" + (let [printer-str #'expound/printer-str + ed (assoc-in (s/explain-data int? "") + [::s/problems 0 :expound.spec.problem/type] + ::test-problem3)] + + (is (thrown-with-msg? + #?(:cljs :default :clj Exception) + #"No method in multimethod" + (printer-str {:print-specs? false} ed)))))) + +#?(:clj (deftest macroexpansion-errors + (let [actual (formatted-exception {:print-specs? false} #(macroexpand '(clojure.core/let [a] 2)))] + (is (or + (= "Call to #'clojure.core/let did not conform to spec. +-- Spec failed -------------------- + + ([a] ...) + ^^^ + +should satisfy + + even-number-of-forms? + +------------------------- +Detected 1 error\n" + actual) + (= "Call to clojure.core/let did not conform to spec. +-- Spec failed -------------------- + + ([a] ...) + ^^^ + +should satisfy + + even-number-of-forms? + +------------------------- +Detected 1 error\n" + actual)))) + (let [ed (try + (macroexpand '(clojure.core/let [a] 2)) + (catch Exception e + (-> (Throwable->map e) :via last :data)))] + (is (= "-- Spec failed -------------------- + + ([a] ...) + ^^^ + +should satisfy + + even-number-of-forms? + +------------------------- +Detected 1 error\n" + (with-out-str ((expound/custom-printer {:print-specs? false}) + + ed))))))) + +(deftest sorted-map-values + (is (= "-- Spec failed -------------------- + + {\"bar\" 1} + +should satisfy + + number? + +------------------------- +Detected 1 error\n" + (expound/expound-str + number? + (sorted-map "bar" 1)))) + (is (= "-- Spec failed -------------------- + + {:foo {\"bar\" 1}} + +should satisfy + + number? + +------------------------- +Detected 1 error\n" + (expound/expound-str + number? + {:foo (sorted-map "bar" + + 1)})))) + +(defn select-expound-info [spec value] + (->> (s/explain-data spec value) + (problems/annotate) + (:expound/problems) + (map #(select-keys % [:expound.spec.problem/type :expound/in])) + (set))) + +#?(:clj + (deftest or-includes-problems-for-each-branch + (let [p1 (select-expound-info :ring.sync/handler (fn handler [_req] {})) + p2 (select-expound-info :ring.async/handler (fn handler [_req] {})) + p3 (select-expound-info :ring.sync+async/handler (fn handler [_req] {})) + all-problems (select-expound-info :ring/handler (fn handler [_req] {}))] + + (is (set/subset? p1 all-problems) {:extra (set/difference p1 all-problems)}) + (is (set/subset? p2 all-problems) {:extra (set/difference p2 all-problems)}) + (is (set/subset? p3 all-problems) {:extra (set/difference p3 all-problems)}))) + :cljs + (set/index #{} [:x]) ; noop to keep clj-kondo happy + ) + +(deftest defmsg-test + (s/def :defmsg-test/id1 string?) + (expound/defmsg :defmsg-test/id1 "should be a string ID") + (testing "messages for predicate specs" + (is (= "-- Spec failed -------------------- + + 123 + +should be a string ID + +------------------------- +Detected 1 error\n" + (expound/expound-str + :defmsg-test/id1 + 123 + {:print-specs? false})))) + + (s/def :defmsg-test/id2 (s/and string? + #(<= 4 (count %)))) + (expound/defmsg :defmsg-test/id2 "should be a string ID of length 4 or more") + (testing "messages for 'and' specs" + (is (= "-- Spec failed -------------------- + + \"123\" + +should be a string ID of length 4 or more + +------------------------- +Detected 1 error\n" + (expound/expound-str + :defmsg-test/id2 + "123" + {:print-specs? false})))) + + (s/def :defmsg-test/statuses #{:ok :failed}) + (expound/defmsg :defmsg-test/statuses "should be either :ok or :failed") + (testing "messages for set specs" + (is (= "-- Spec failed -------------------- + + :oak + +should be either :ok or :failed + +------------------------- +Detected 1 error +" + (expound/expound-str + :defmsg-test/statuses + :oak + {:print-specs? false})))) + (testing "messages for alt specs" + (s/def ::x int?) + (s/def ::y int?) + (expound/defmsg ::x "must be an integer") + (is (= + "-- Spec failed -------------------- + + [\"\" ...] + ^^ + +must be an integer + +------------------------- +Detected 1 error\n" + (expound/expound-str (s/alt :one + (s/cat :x ::x) + :two + (s/cat :x ::x + :y ::y)) + + ["" ""] + {:print-specs? false})))) + + (testing "messages for alt specs (if user duplicates existing message)" + (s/def ::x int?) + (s/def ::y int?) + (expound/defmsg ::x "should satisfy\n\n int?") + (is (= + "-- Spec failed -------------------- + + [\"\"] + ^^ + +should satisfy + + int? + +------------------------- +Detected 1 error\n" + (expound/expound-str (s/alt :one + ::x + :two + ::y) + [""] + {:print-specs? false})))) + (testing "messages for alternatives and set specs" + (is (= "-- Spec failed -------------------- + + :oak + +should be either :ok or :failed + +or + +should satisfy + + string? + +------------------------- +Detected 1 error\n" + (expound/expound-str + (s/or + :num + :defmsg-test/statuses + :s string?) + :oak + {:print-specs? false}))))) + +(deftest printer + (st/instrument ['expound/printer]) + (binding [s/*explain-out* expound/printer] + (is (string? (s/explain-str int? "a"))) + (is (= "Success!\n" (s/explain-str int? 1))) + (is (= "Success!\n" (with-out-str (expound/printer (s/explain-data int? 1)))))) + (st/unstrument ['expound/printer])) + +(deftest undefined-key + (is (= "-- Spec failed -------------------- + + {} + +should contain key: :undefined-key/does-not-exist + +| key | spec | +|===============================+===============================| +| :undefined-key/does-not-exist | :undefined-key/does-not-exist | + +------------------------- +Detected 1 error +" + (expound/expound-str (s/keys :req [:undefined-key/does-not-exist]) + {} + {:print-specs? false})))) + +#?(:clj + (deftype FakeDB [m] + + clojure.lang.Seqable + (seq [_] + (seq m)) + + clojure.lang.IPersistentCollection + + (count [_] + (count m)) + (cons [_ _o] + (throw (Exception. "FakeDB doesn't implement 'cons'"))) + (empty [_] + (FakeDB. {})) + (equiv [_ o] + (= + m + (:m o))) + + clojure.lang.Associative + (containsKey [_ k] (contains? m k)) + (entryAt [_ k] (get m k)) + + clojure.lang.IPersistentMap + (assoc [_this _k _v] (throw (Exception. "FakeDB doesn't implement 'assoc'"))) + (assocEx [_this _k _v] (throw (Exception. "FakeDB doesn't implement 'assocEx'"))) + (without [_this _k] (throw (Exception. "FakeDB doesn't implement 'without'"))) + + clojure.lang.ILookup + (valAt [_ k] + (get m k)) + (valAt [_ k not-found] + (get m k not-found)))) + +(s/def ::db-val (s/or :i int? :s string?)) + +;; https://github.com/bhb/expound/issues/205 +#?(:clj (deftest unwalkable-values + ;; run bin/test-datomic for real test of datomic DB, + ;; but this at least simulates the failure. We should not + ;; try to walk arbitrary values + (let [db (FakeDB. {:a 1})] + (is (= true (map? db))) + (is (= "Success!\n" + (expound/expound-str some? db))) + (is (= "-- Spec failed -------------------- + + [{:a 1}] + ^^^^^^ + +should contain key: :expound.alpha-test/db-val + +| key | spec | +|============================+=========================| +| :expound.alpha-test/db-val | (or :i int? :s string?) | + +------------------------- +Detected 1 error +" + (expound/expound-str (s/cat :db (s/keys + :req [::db-val])) [db])))))) + +;; https://github.com/bhb/expound/issues/217 +(deftest small-values-for-print-length + (binding [*print-length* 5] + (is (= "-- Spec failed -------------------- + + 9 + + in + + (0 1 2 3 4 ...) + +should satisfy + + (fn [x] (< x 9)) + +------------------------- +Detected 1 error +" + (expound/expound-str + (clojure.spec.alpha/coll-of (fn [x] (< x 9))) + (range 10)))))) + +;; https://github.com/bhb/expound/issues/215 +(s/def :keys-within-operators.user/name string?) +(s/def :keys-within-operators.user/age pos-int?) + +(deftest keys-within-operators + + (is (= "-- Spec failed -------------------- + + {} + +should contain keys: :age, :keys-within-operators.user/name + +| key | spec | +|==================================+==========| +| :age | pos-int? | +|----------------------------------+----------| +| :keys-within-operators.user/name | string? | + +------------------------- +Detected 1 error\n" + (expound/expound-str (s/and (s/keys :req [:keys-within-operators.user/name] + :req-un [:keys-within-operators.user/age]) + #(contains? % :foo)) {} {:print-specs? false}))) + + (is (= "-- Spec failed -------------------- + + {} + +should contain keys: :age, :foo, :keys-within-operators.user/name + +| key | spec | +|==================================+===================================================| +| :age | pos-int? | +|----------------------------------+---------------------------------------------------| +| :foo | | +|----------------------------------+---------------------------------------------------| +| :keys-within-operators.user/name | string? | + +------------------------- +Detected 1 error\n" + (expound/expound-str (s/or :k1 (s/keys :req [:keys-within-operators.user/name] + :req-un [:keys-within-operators.user/age]) + :k2 #(contains? % :foo)) {} {:print-specs? false})))) diff --git a/test-resources/lib_tests/expound/paths_test.cljc b/test-resources/lib_tests/expound/paths_test.cljc new file mode 100644 index 00000000..e64a5136 --- /dev/null +++ b/test-resources/lib_tests/expound/paths_test.cljc @@ -0,0 +1,39 @@ +(ns expound.paths-test + (:require [clojure.test :as ct :refer [is deftest use-fixtures]] + [clojure.test.check.generators :as gen] + [com.gfredericks.test.chuck.clojure-test :refer [checking]] + [expound.paths :as paths] + [expound.test-utils :as test-utils] + [com.gfredericks.test.chuck :as chuck])) + +(def num-tests 100) + +(use-fixtures :once + test-utils/check-spec-assertions + test-utils/instrument-all) + +(deftest compare-paths-test + (checking + "path to a key comes before a path to a value" + 10 + [k gen/simple-type-printable] + (is (= -1 (paths/compare-paths [(paths/->KeyPathSegment k)] [k]))) + (is (= 1 (paths/compare-paths [k] [(paths/->KeyPathSegment k)]))))) + +(defn nth-value [form i] + (let [seq (remove map-entry? (tree-seq coll? seq form))] + (nth seq (mod i (count seq))))) + +(deftest paths-to-value-test + (checking + "value-in is inverse of paths-to-value" + (chuck/times num-tests) + [form test-utils/any-printable-wo-nan + i gen/nat + :let [x (nth-value form i) + paths (paths/paths-to-value form x [] [])]] + (is (seq paths)) + (doseq [path paths] + (is (= x + (paths/value-in form + path)))))) diff --git a/test-resources/lib_tests/expound/print_length_test.cljc b/test-resources/lib_tests/expound/print_length_test.cljc new file mode 100644 index 00000000..7c89fb58 --- /dev/null +++ b/test-resources/lib_tests/expound/print_length_test.cljc @@ -0,0 +1,23 @@ +(ns expound.print-length-test + (:require [clojure.test :as ct :refer [is deftest testing]] + [clojure.spec.alpha :as s] + [expound.alpha] + [clojure.string :as string])) + +(def the-value (range 10)) +;; Fails on the last element of the range +(def the-spec (s/coll-of #(< % 9))) +(def the-explanation (s/explain-data the-spec the-value)) + +(deftest print-length-test + (testing "Expound works even in face of a low `*print-length*` and `*print-level*`, without throwing exceptions. +See https://github.com/bhb/expound/issues/217" + (doseq [length [1 5 100 *print-length*] + level [1 5 100 *print-level*] + ;; Note that the `is` resides outside of the `binding`. Else test output itself can be affected. + :let [v (binding [*print-length* length + *print-level* level] + (with-out-str + (expound.alpha/printer the-explanation)))]] + ;; Don't make a particularly specific test assertion, since a limited print-length isn't necessarily realistic/usual: + (is (not (string/blank? v)))))) diff --git a/test-resources/lib_tests/expound/printer_test.cljc b/test-resources/lib_tests/expound/printer_test.cljc new file mode 100644 index 00000000..2ea1ccb0 --- /dev/null +++ b/test-resources/lib_tests/expound/printer_test.cljc @@ -0,0 +1,428 @@ +(ns expound.printer-test + (:require [clojure.spec.alpha :as s] + [clojure.test :as ct :refer [is deftest use-fixtures testing]] + [expound.printer :as printer] + [clojure.string :as string] + [com.gfredericks.test.chuck.clojure-test :refer [checking]] + [expound.test-utils :as test-utils :refer [contains-nan?]] + [expound.spec-gen :as sg] + [expound.problems :as problems])) + +(def num-tests 5) + +(use-fixtures :once + test-utils/check-spec-assertions + test-utils/instrument-all) + +(defn example-fn []) +(defn get-args [& args] args) + +(deftest pprint-fn + (is (= "string?" + (printer/pprint-fn (::s/spec (s/explain-data string? 1))))) + (is (= "expound.printer-test/example-fn" + (printer/pprint-fn example-fn))) + (is (= "" + (printer/pprint-fn #(inc (inc %))))) + (is (= "" + (printer/pprint-fn (constantly true)))) + (is (= "" + (printer/pprint-fn (comp vec str)))) + (is (= "expound.test-utils/instrument-all" + (printer/pprint-fn test-utils/instrument-all))) + (is (= "expound.test-utils/contains-nan?" + (printer/pprint-fn contains-nan?)))) + +(s/def :print-spec-keys/field1 string?) +(s/def :print-spec-keys/field2 (s/coll-of :print-spec-keys/field1)) +(s/def :print-spec-keys/field3 int?) +(s/def :print-spec-keys/field4 string?) +(s/def :print-spec-keys/field5 string?) +(s/def :print-spec-keys/key-spec (s/keys + :req [:print-spec-keys/field1] + :req-un [:print-spec-keys/field2])) +(s/def :print-spec-keys/key-spec2 (s/keys + :req-un [(and + :print-spec-keys/field1 + (or + :print-spec-keys/field2 + :print-spec-keys/field3))])) +(s/def :print-spec-keys/key-spec3 (s/keys + :req-un [:print-spec-keys/field1 + :print-spec-keys/field4 + :print-spec-keys/field5])) +(s/def :print-spec-keys/set-spec (s/coll-of :print-spec-keys/field1 + :kind set?)) +(s/def :print-spec-keys/vector-spec (s/coll-of :print-spec-keys/field1 + :kind vector?)) +(s/def :print-spec-keys/key-spec4 (s/keys + :req-un [:print-spec-keys/set-spec + :print-spec-keys/vector-spec + :print-spec-keys/key-spec3])) + +(defn copy-key [m k1 k2] + (assoc m k2 (get m k1))) + +(deftest print-spec-keys* + (is (= + [{"key" :field2, "spec" "(coll-of :print-spec-keys/field1)"} + {"key" :print-spec-keys/field1, "spec" "string?"}] + (printer/print-spec-keys* + (map #(copy-key % :via :expound/via) + (::s/problems + (s/explain-data + :print-spec-keys/key-spec + {})))))) + (is (nil? + (printer/print-spec-keys* + (map #(copy-key % :via :expound/via) + (::s/problems + (s/explain-data + (s/keys + :req [:print-spec-keys/field1] + :req-un [:print-spec-keys/field2]) + {})))))) + + (is (= + [{"key" :print-spec-keys/field1, "spec" "string?"}] + (printer/print-spec-keys* + (map #(copy-key % :via :expound/via) + (::s/problems + (s/explain-data + (s/keys + :req [:print-spec-keys/field1] + :req-un [:print-spec-keys/field2]) + {:field2 [""]})))))) + + (is (= + [{"key" :print-spec-keys/field1, "spec" "string?"} + {"key" :print-spec-keys/field2, + "spec" "(coll-of :print-spec-keys/field1)"}] + (printer/print-spec-keys* + (map #(copy-key % :via :expound/via) + (::s/problems + (s/explain-data + (s/keys + :req [:print-spec-keys/field1 + :print-spec-keys/field2]) + {})))))) + (is (= + [{"key" :field1, "spec" "string?"} + {"key" :field2, "spec" "(coll-of :print-spec-keys/field1)"} + {"key" :field3, "spec" "int?"}] + (printer/print-spec-keys* + (map #(copy-key % :via :expound/via) + (::s/problems + (s/explain-data + :print-spec-keys/key-spec2 + {})))))) + (is (= + [{"key" :key-spec3, + "spec" #?(:clj + "(keys\n :req-un\n [:print-spec-keys/field1\n :print-spec-keys/field4\n :print-spec-keys/field5])" + :cljs + "(keys\n :req-un\n [:print-spec-keys/field1\n :print-spec-keys/field4 \n :print-spec-keys/field5])")} + {"key" :set-spec, "spec" #?(:clj + "(coll-of\n :print-spec-keys/field1\n :kind\n set?)" + :cljs + "(coll-of :print-spec-keys/field1 :kind set?)")} + {"key" :vector-spec, "spec" #?(:clj "(coll-of\n :print-spec-keys/field1\n :kind\n vector?)" + :cljs "(coll-of\n :print-spec-keys/field1 \n :kind \n vector?)")}] + (printer/print-spec-keys* + (map #(copy-key % :via :expound/via) + (::s/problems + (s/explain-data + :print-spec-keys/key-spec4 + {}))))))) + +(deftest print-table + (is (= + " +| :key | :spec | +|======+=======| +| abc | a | +| | b | +|------+-------| +| def | d | +| | e | +" + (printer/print-table [{:key "abc" :spec "a\nb"} + {:key "def" :spec "d\ne"}]))) + ;; can select ordering of keys + (is (= + " +| :b | :c | +|====+====| +| 2 | 3 | +|----+----| +| {} | () | +" + (printer/print-table + [:b :c] + [{:a 1 :b 2 :c 3} + {:a [] :b {} :c '()}]))) + + ;; ordering is deterministic, not based on hashmap + ;; semantics + (is (= + " +| :k | :a | :b | :c | :d | :e | :f | :g | :h | :i | :j | +|====+====+====+====+====+====+====+====+====+====+====| +| k | a | b | c | d | e | f | g | h | i | j | +|----+----+----+----+----+----+----+----+----+----+----| +| k | a | b | c | d | e | f | g | h | i | j | +" + (printer/print-table + [:k :a :b :c :d :e :f :g :h :i :j] + [{:a "a" :b "b" :c "c" :d "d" :e "e" :f "f" :g "g" :h "h" :i "i" :j "j" :k "k" :l "l"} + {:l "l" :k "k" :j "j" :i "i" :h "h" :g "g" :f "f" :e "e" :d "d" :c "c" :b "b" :a "a"}])))) + +(deftest print-table-gen + (checking + "any table with have constant width" + num-tests + [col-count (s/gen pos-int?) + keys (s/gen (s/coll-of keyword? :min-count 1)) + row-count (s/gen pos-int?) + vals (s/gen (s/coll-of + (s/coll-of string? :count col-count) + :count row-count)) + :let [rows (mapv + #(zipmap keys (get vals %)) + (range 0 row-count)) + table (printer/print-table rows) + srows (rest (string/split table #"\n"))]] + + (is (apply = (map count srows)))) + + (checking + "any table will contain a sub-table of all rows but the last" + num-tests + [col-count (s/gen pos-int?) + keys (s/gen (s/coll-of keyword? :min-count 1)) + row-count (s/gen (s/int-in 2 10)) + vals (s/gen (s/coll-of + (s/coll-of string? :count col-count) + :count row-count)) + :let [rows (mapv + #(zipmap keys (get vals %)) + (range 0 row-count)) + sub-rows (butlast rows) + table (printer/print-table rows) + sub-table (printer/print-table sub-rows) + sub-table-last-row (last (string/split sub-table #"\n")) + table-last-row (last (string/split table #"\n"))]] + ;; If the line we delete shrinks the width of the table + ;; (because it was the widest value) + ;; then the property will not apply + (when (= (count sub-table-last-row) (count table-last-row)) + (is (string/includes? table sub-table)))) + + #?(:clj + (checking + "for any known registered spec, table has max width" + num-tests + [spec sg/spec-gen + :let [rows [{:key spec + :spec (printer/expand-spec spec)}] + table (printer/print-table rows) + srows (rest (string/split table #"\n"))]] + (is (< (count (last srows)) 200))) + :cljs + ;; Noop, just to make clj-kondo happy + (sg/topo-sort []))) + +(deftest highlighted-value + (testing "atomic value" + (is (= "\"Fred\"\n^^^^^^" + (printer/highlighted-value + {} + {:expound/form "Fred" + :expound/in []})))) + (testing "value in vector" + (is (= "[... :b ...]\n ^^" + (printer/highlighted-value + {} + {:expound/form [:a :b :c] + :expound/in [1]})))) + (testing "long, composite values are pretty-printed" + (is (= (str "{:letters {:a \"aaaaaaaa\", + :b \"bbbbbbbb\", + :c \"cccccccd\", + :d \"dddddddd\", + :e \"eeeeeeee\"}}" + #?(:clj "\n ^^^^^^^^^^^^^^^" + :cljs "\n ^^^^^^^^^^^^^^^^")) + ;; ^- the above works in clojure - maybe not CLJS? + (printer/highlighted-value + {} + {:expound/form + {:letters + {:a "aaaaaaaa" + :b "bbbbbbbb" + :c "cccccccd" + :d "dddddddd" + :e "eeeeeeee"}} + :expound/in [:letters]})))) + (testing "args to function" + (is (= "(1 ... ...)\n ^" + (printer/highlighted-value + {} + {:expound/form (get-args 1 2 3) + :expound/in [0]})))) + (testing "show all values" + (is (= "(1 2 3)\n ^" + (printer/highlighted-value + {:show-valid-values? true} + {:expound/form (get-args 1 2 3) + :expound/in [0]})))) + + (testing "special replacement chars are not used" + (is (= "\"$ $$ $1 $& $` $'\"\n^^^^^^^^^^^^^^^^^^" + (printer/highlighted-value + {} + (first + (:expound/problems + (problems/annotate + (s/explain-data keyword? "$ $$ $1 $& $` $'")))))))) + + (testing "nested map-of specs" + (is (= "{:a {:b 1}}\n ^" + (printer/highlighted-value + {} + (first + (:expound/problems + (problems/annotate + (s/explain-data :highlighted-value/nested-map-of {:a {:b 1}}))))))) + (is (= "{:a {\"a\" ...}}\n ^^^" + (printer/highlighted-value + {} + (first + (:expound/problems + (problems/annotate + (s/explain-data :highlighted-value/nested-map-of {:a {"a" :b}}))))))) + (is (= "{1 ...}\n ^" + (printer/highlighted-value + {} + (first + (:expound/problems + (problems/annotate + (s/explain-data :highlighted-value/nested-map-of {1 {:a :b}})))))))) + + (testing "nested keys specs" + (is (= "{:address {:city 1}}\n ^" + (printer/highlighted-value + {} + (first + (:expound/problems + (problems/annotate + (s/explain-data :highlighted-value/house {:address {:city 1}}))))))) + (is (= "{:address {\"city\" \"Denver\"}}\n ^^^^^^^^^^^^^^^^^" + (printer/highlighted-value + {} + (first + (:expound/problems + (problems/annotate + (s/explain-data :highlighted-value/house {:address {"city" "Denver"}}))))))) + (is (= "{\"address\" {:city \"Denver\"}}\n^^^^^^^^^^^^^^^^^^^^^^^^^^^^" + (printer/highlighted-value + {} + (first + (:expound/problems + (problems/annotate + (s/explain-data :highlighted-value/house {"address" {:city "Denver"}}))))))))) + +(deftest highlighted-value-on-alt + (is (= "[... 0]\n ^" + (printer/highlighted-value + {} + (first + (:expound/problems + (problems/annotate + (s/explain-data + (clojure.spec.alpha/alt :a int? + :b (clojure.spec.alpha/spec (clojure.spec.alpha/cat :c int?))) + [1 0])))))))) + +(deftest highlighted-value-on-coll-of + ;; sets + (is (= "#{1 3 2 :a}\n ^^" + (printer/highlighted-value + {} + (first + (:expound/problems + (problems/annotate + (s/explain-data + (s/coll-of integer?) + #{1 :a 2 3}))))))) + (is (= "#{:a}\n ^^" + (printer/highlighted-value + {} + (first + (:expound/problems + (problems/annotate + (s/explain-data + (s/coll-of integer?) + #{:a}))))))) + + ;; lists + (is (= "(... :a ... ...)\n ^^" + (printer/highlighted-value + {} + (first + (:expound/problems + (problems/annotate + (s/explain-data + (s/coll-of integer?) + '(1 :a 2 3)))))))) + (is (= "(:a)\n ^^" + (printer/highlighted-value + {} + (first + (:expound/problems + (problems/annotate + (s/explain-data + (s/coll-of integer?) + '(:a)))))))) + + ;; vectors + (is (= "[... :a ... ...]\n ^^" + (printer/highlighted-value + {} + (first + (:expound/problems + (problems/annotate + (s/explain-data + (s/coll-of integer?) + [1 :a 2 3]))))))) + + (is (= "[:a]\n ^^" + (printer/highlighted-value + {} + (first + (:expound/problems + (problems/annotate + (s/explain-data + (s/coll-of integer?) + [:a]))))))) + + ;; maps + (is (= "[1 :a]\n^^^^^^" + (printer/highlighted-value + {} + (first + (:expound/problems + (problems/annotate + (s/explain-data + (s/coll-of integer?) + {1 :a 2 3}))))))) + + (is (= "[:a 1]\n^^^^^^" + (printer/highlighted-value + {} + (first + (:expound/problems + (problems/annotate + (s/explain-data + (s/coll-of integer?) + {:a 1})))))))) diff --git a/test-resources/lib_tests/expound/problems_test.cljc b/test-resources/lib_tests/expound/problems_test.cljc new file mode 100644 index 00000000..a40642af --- /dev/null +++ b/test-resources/lib_tests/expound/problems_test.cljc @@ -0,0 +1,30 @@ +(ns expound.problems-test + (:require [clojure.test :as ct :refer [is deftest use-fixtures]] + [clojure.spec.alpha :as s] + [expound.problems :as problems] + [expound.test-utils :as test-utils])) + +(use-fixtures :once + test-utils/check-spec-assertions + test-utils/instrument-all) + +(s/def :highlighted-value/nested-map-of (s/map-of keyword? (s/map-of keyword? keyword?))) + +(s/def :highlighted-value/city string?) +(s/def :highlighted-value/address (s/keys :req-un [:highlighted-value/city])) +(s/def :highlighted-value/house (s/keys :req-un [:highlighted-value/address])) + +(s/def :annotate-test/div-fn (s/fspec + :args (s/cat :x int? :y pos-int?))) +(defn my-div [x y] + (assert (pos? (/ x y)))) + +(deftest annotate-test + (is (= {:expound/in [0] + :val '(0 1) + :reason "Assert failed: (pos? (/ x y))"} + (-> (s/explain-data (s/coll-of :annotate-test/div-fn) [my-div]) + problems/annotate + :expound/problems + first + (select-keys [:expound/in :val :reason]))))) \ No newline at end of file diff --git a/test-resources/lib_tests/expound/spec_gen.cljc b/test-resources/lib_tests/expound/spec_gen.cljc new file mode 100644 index 00000000..68c684ac --- /dev/null +++ b/test-resources/lib_tests/expound/spec_gen.cljc @@ -0,0 +1,97 @@ +(ns expound.spec-gen + (:require [clojure.spec.alpha :as s] + [com.stuartsierra.dependency :as deps] + [clojure.test.check.generators :as gen] + [expound.alpha :as expound])) + +;; I want to do something like +;; (s/def :specs.coll-of/into #{[] '() #{}}) +;; but Clojure (not Clojurescript) won't allow +;; this. As a workaround, I'll just use vectors instead +;; of vectors and lists. +;; FIXME - force a specific type of into/kind one for each test +;; (one for vectors, one for lists, etc) + +(s/def :specs.coll-of/into #{[] #{}}) +(s/def :specs.coll-of/kind #{vector? list? set?}) +(s/def :specs.coll-of/count pos-int?) +(s/def :specs.coll-of/max-count pos-int?) +(s/def :specs.coll-of/min-count pos-int?) +(s/def :specs.coll-of/distinct boolean?) + +(s/def :specs/every-args + (s/keys :req-un + [:specs.coll-of/into + :specs.coll-of/kind + :specs.coll-of/count + :specs.coll-of/max-count + :specs.coll-of/min-count + :specs.coll-of/distinct])) + +(defn apply-coll-of [spec {:keys [into max-count min-count distinct]}] + (s/coll-of spec :into into :min-count min-count :max-count max-count :distinct distinct)) + +(defn apply-map-of [spec1 spec2 {:keys [into max-count min-count distinct _gen-max]}] + (s/map-of spec1 spec2 :into into :min-count min-count :max-count max-count :distinct distinct)) + +;; Since CLJS prints out entire source of a function when +;; it pretty-prints a failure, the output becomes much nicer if +;; we wrap each function in a simple spec +(expound/def :specs/string string? "should be a string") +(expound/def :specs/vector vector? "should be a vector") +(s/def :specs/int int?) +(s/def :specs/boolean boolean?) +(expound/def :specs/keyword keyword? "should be a keyword") +(s/def :specs/map map?) +(s/def :specs/symbol symbol?) +(s/def :specs/pos-int pos-int?) +(s/def :specs/neg-int neg-int?) +(s/def :specs/zero #(and (number? %) (zero? %))) +(s/def :specs/keys (s/keys + :req-un [:specs/string] + :req [:specs/map] + :opt-un [:specs/vector] + :opt [:specs/int])) + +(def simple-spec-gen (gen/one-of + [(gen/elements [:specs/string + :specs/vector + :specs/int + :specs/boolean + :specs/keyword + :specs/map + :specs/symbol + :specs/pos-int + :specs/neg-int + :specs/zero + :specs/keys]) + (gen/set gen/simple-type-printable)])) + +(defn spec-dependencies [spec] + (->> spec + s/form + (tree-seq coll? seq) + (filter #(and (s/get-spec %) (not= spec %))) + distinct)) + +(defn topo-sort [specs] + (deps/topo-sort + (reduce + (fn [gr spec] + (reduce + (fn [g d] + ;; If this creates a circular reference, then + ;; just skip it. + (if (deps/depends? g d spec) + g + (deps/depend g spec d))) + gr + (spec-dependencies spec))) + (deps/graph) + specs))) + +#?(:clj + (def spec-gen (gen/elements (->> (s/registry) + (map key) + topo-sort + (filter keyword?))))) diff --git a/test-resources/lib_tests/expound/specs_test.cljc b/test-resources/lib_tests/expound/specs_test.cljc new file mode 100644 index 00000000..bd545ce7 --- /dev/null +++ b/test-resources/lib_tests/expound/specs_test.cljc @@ -0,0 +1,26 @@ +(ns expound.specs-test + (:require [expound.specs] + [clojure.spec.alpha :as s] + [clojure.test :as ct :refer [is deftest use-fixtures]] + [expound.test-utils :as test-utils] + [expound.alpha :as expound])) + +(use-fixtures :once + test-utils/check-spec-assertions + test-utils/instrument-all) + +(deftest provided-specs + (binding [s/*explain-out* (expound/custom-printer {:print-specs? false})] + (is (= "-- Spec failed -------------------- + + 1 + +should be a keyword with no namespace + +------------------------- +Detected 1 error +" + (s/explain-str :expound.specs/simple-kw 1))) + (doseq [kw expound.specs/public-specs] + (is (some? (s/get-spec kw)) (str "Failed to find spec for keyword " kw)) + (is (some? (expound/error-message kw)) (str "Failed to find error message for keyword " kw))))) diff --git a/test-resources/lib_tests/expound/spell_spec_test.cljc b/test-resources/lib_tests/expound/spell_spec_test.cljc new file mode 100644 index 00000000..6ffb1e4f --- /dev/null +++ b/test-resources/lib_tests/expound/spell_spec_test.cljc @@ -0,0 +1,115 @@ +;; copied from +;; https://github.com/bhauman/spell-spec/blob/master/test/spell_spec/expound_test.cljc +;; so I don't break the extension API +(ns expound.spell-spec-test + (:require [#?(:clj clojure.test :cljs cljs.test) + :refer [deftest is testing]] + [#?(:clj clojure.spec.alpha + :cljs cljs.spec.alpha) + :as s] + [clojure.string :as string] + [spell-spec.alpha :as spell :refer [warn-keys strict-keys warn-strict-keys]] + [expound.alpha :as exp] + [spell-spec.expound :as sp.ex])) + +;; copied from +;; https://github.com/bhauman/spell-spec/blob/48ea2ca544f02b04a73dc42a91aa4876dcc5fc95/src/spell_spec/expound.cljc#L23-L34 +;; because test-refresh doesn't refesh libraries if I set explicit paths and +;; if I don't restrict the paths, it tries to reload deps in the CLJS build + +(defmethod exp/problem-group-str :spell-spec.alpha/misspelled-key [_type spec-name val path problems opts] + (sp.ex/exp-formated "Misspelled map key" _type spec-name val path problems opts)) + +(defmethod exp/expected-str :spell-spec.alpha/misspelled-key [_type _spec-name _val _path problems _opts] + (let [{:keys [:spell-spec.alpha/likely-misspelling-of]} (first problems)] + (str "should probably be" (sp.ex/format-correction-list likely-misspelling-of)))) + +(defmethod exp/problem-group-str :spell-spec.alpha/unknown-key [_type spec-name val path problems opts] + (sp.ex/exp-formated "Unknown map key" _type spec-name val path problems opts)) + +(defmethod exp/expected-str :spell-spec.alpha/unknown-key [_type _spec-name _val _path problems _opts] + (str "should be" (sp.ex/format-correction-list (-> problems first :pred)))) + +;;;;;;;;;;;;;;;;;;;;;;;;;;;; + +(defn fetch-warning-output [thunk] + #?(:clj (binding [*err* (java.io.StringWriter.)] + (thunk) + (str *err*)) + :cljs (with-out-str (thunk)))) + +(deftest check-misspell-test + (let [spec (spell/keys :opt-un [::hello ::there]) + data {:there 1 :helloo 1 :barabara 1} + result + (exp/expound-str spec data)] + (is (string/includes? result "Misspelled map key")) + (is (string/includes? result "should probably be")) + (is (string/includes? result " :hello\n")))) + +(deftest check-misspell-with-namespace-test + (let [spec (spell/keys :opt [::hello ::there]) + data {::there 1 ::helloo 1 :barabara 1} + result (exp/expound-str spec data)] + (is (string/includes? result "Misspelled map key")) + (is (string/includes? result "should probably be")) + (is (string/includes? result ":expound.spell-spec-test/hello\n")))) + +(s/def ::hello integer?) +(s/def ::there integer?) + +(deftest other-errors-test + (let [spec (spell/keys :opt-un [::hello ::there]) + data {:there "1" :helloo 1 :barabara 1} + result (exp/expound-str spec data)] + (is (string/includes? result "Misspelled map key")) + (is (string/includes? result "should probably be")) + (is (string/includes? result " :hello\n")) + + (is (not (string/includes? result "Spec failed"))) + (is (not (string/includes? result "should satisfy"))) + (is (not (string/includes? result "integer?"))))) + +(deftest warning-is-valid-test + (let [spec (warn-keys :opt-un [::hello ::there]) + data {:there 1 :helloo 1 :barabara 1}] + (testing "expound prints warning to *err*" + (is (= (fetch-warning-output #(exp/expound-str spec data)) + "SPEC WARNING: possible misspelled map key :helloo should probably be :hello in {:there 1, :helloo 1, :barabara 1}\n"))))) + +(deftest strict-keys-test + (let [spec (strict-keys :opt-un [::hello ::there]) + data {:there 1 :barabara 1} + result (exp/expound-str spec data)] + (is (string/includes? result "Unknown map key")) + (is (string/includes? result "should be one of")) + (is (string/includes? result " :hello, :there\n")))) + +(deftest warn-on-unknown-keys-test + (let [spec (warn-strict-keys :opt-un [::hello ::there]) + data {:there 1 :barabara 1}] + (testing "expound prints warning to *err*" + (is (= (fetch-warning-output #(exp/expound-str spec data)) + "SPEC WARNING: unknown map key :barabara in {:there 1, :barabara 1}\n"))))) + +(deftest multiple-spelling-matches + (let [spec (spell/keys :opt-un [::hello1 ::hello2 ::hello3 ::hello4 ::there]) + data {:there 1 :helloo 1 :barabara 1} + result (exp/expound-str spec data)] + (is (string/includes? result "Misspelled map key")) + (is (string/includes? result "should probably be one of")) + (doseq [k [:hello1 :hello2 :hello3 :hello4]] + (is (string/includes? result (pr-str k))))) + (let [spec (spell/keys :opt-un [::hello1 ::hello2 ::hello3 ::there]) + data {:there 1 :helloo 1 :barabara 1} + result (exp/expound-str spec data)] + (is (string/includes? result "Misspelled map key")) + (is (string/includes? result "should probably be one of")) + (is (not (string/includes? result (pr-str :hello4)))) + (doseq [k [:hello1 :hello2 :hello3]] + (is (string/includes? result (pr-str k))))) + (let [spec (spell/keys :opt-un [::hello ::there]) + data {:there 1 :helloo 1 :barabara 1} + result (exp/expound-str spec data)] + (is (string/includes? result "Misspelled map key")) + (is (string/includes? result "should probably be: :hello\n")))) diff --git a/test-resources/lib_tests/expound/test_runner.cljs b/test-resources/lib_tests/expound/test_runner.cljs new file mode 100644 index 00000000..39f3e00e --- /dev/null +++ b/test-resources/lib_tests/expound/test_runner.cljs @@ -0,0 +1,28 @@ +(ns expound.test-runner + (:require [jx.reporter.karma :refer-macros [#_run-tests #_run-all-tests]] + [expound.alpha-test] + [expound.paths-test] + [expound.printer-test] + [expound.print-length-test] + [expound.problems-test] + [expound.test-utils] + [expound.specs-test] + [expound.spell-spec-test])) + +(enable-console-print!) + +;; runs all tests in all namespaces +;; This is what runs by default +(defn ^:export run-all [karma] + (jx.reporter.karma/run-all-tests karma)) + +;; runs all tests in all namespaces - only namespaces with names matching +;; the regular expression will be tested +;; You can use this by changing client.args in karma.conf.js +#_(defn ^:export run-all-regex [karma] + (run-all-tests karma #".*-test$")) + +;; runs all tests in the given namespaces +;; You can use this by changing client.args in karma.conf.js +#_(defn ^:export run [karma] + (run-tests karma 'expound.alpha-test)) diff --git a/test-resources/lib_tests/expound/test_utils.cljc b/test-resources/lib_tests/expound/test_utils.cljc new file mode 100644 index 00000000..e1975ae5 --- /dev/null +++ b/test-resources/lib_tests/expound/test_utils.cljc @@ -0,0 +1,41 @@ +(ns expound.test-utils + (:require [clojure.spec.alpha :as s] + #?(:cljs + [clojure.spec.test.alpha :as st] + ;; FIXME + ;; orchestra is supposed to work with cljs but + ;; it isn't working for me right now + #_[orchestra-cljs.spec.test :as st] + :clj [orchestra.spec.test :as st]) + [expound.alpha :as expound] + [clojure.test :as ct] + ;; BB-TEST-PATCH: Don't have this dep and can't load it + #_[com.gfredericks.test.chuck.clojure-test :as chuck] + [expound.util :as util] + [clojure.test.check.generators :as gen])) + +;; test.chuck defines a reporter for the shrunk results, but only for the +;; default reporter (:cljs.test/default). Since karma uses its own reporter, +;; we need to provide an implementation of the report multimethod for +;; the karma reporter and shrunk results + +; (defmethod ct/report [:jx.reporter.karma/karma ::chuck/shrunk] [m] +; (let [f (get (methods ct/report) [::ct/default ::chuck/shrunk])] +; (f m))) + +(defn check-spec-assertions [test-fn] + (s/check-asserts true) + (test-fn) + (s/check-asserts false)) + +(defn instrument-all [test-fn] + (binding [s/*explain-out* (expound/custom-printer {:theme :figwheel-theme})] + (st/instrument) + (test-fn) + (st/unstrument))) + +(defn contains-nan? [x] + (boolean (some util/nan? (tree-seq coll? identity x)))) + +(def any-printable-wo-nan (gen/such-that (complement contains-nan?) + gen/any-printable)) diff --git a/test-resources/lib_tests/failjure/runner.cljs b/test-resources/lib_tests/failjure/runner.cljs new file mode 100644 index 00000000..5b334cbc --- /dev/null +++ b/test-resources/lib_tests/failjure/runner.cljs @@ -0,0 +1,5 @@ +(ns failjure.runner + (:require [doo.runner :refer-macros [doo-tests]] + [failjure.test-core])) + +(doo-tests 'failjure.test-core) diff --git a/test-resources/lib_tests/gaka/core_test.clj b/test-resources/lib_tests/gaka/core_test.clj index 622c4756..7305fdbc 100644 --- a/test-resources/lib_tests/gaka/core_test.clj +++ b/test-resources/lib_tests/gaka/core_test.clj @@ -1,7 +1,6 @@ (ns gaka.core-test - (:require [clojure.test :refer [deftest is are]] - [gaka.core :refer [css compile* inline-css render-rule]] - )) + (:use gaka.core + clojure.test)) (defmacro =? [& body] `(are [x# y#] (= x# y#) @@ -194,3 +193,4 @@ (is (re-find #"^(color: red; border: 1;|border: 1; color: red;)$" (inline-css {:color :red :border 1})))) + diff --git a/test-resources/lib_tests/honey/sql/helpers_test.cljc b/test-resources/lib_tests/honey/sql/helpers_test.cljc index 33ea68c5..76fa2f88 100644 --- a/test-resources/lib_tests/honey/sql/helpers_test.cljc +++ b/test-resources/lib_tests/honey/sql/helpers_test.cljc @@ -2,8 +2,7 @@ (ns honey.sql.helpers-test (:refer-clojure :exclude [filter for group-by partition-by set update]) - (:require #?(:clj [clojure.test :refer [deftest is testing]] - :cljs [cljs.test :refer-macros [deftest is testing]]) + (:require [clojure.test :refer [deftest is testing]] [honey.sql :as sql] [honey.sql.helpers :as h :refer [add-column add-index alter-table columns create-table create-table-as create-view diff --git a/test-resources/lib_tests/honey/sql/postgres_test.cljc b/test-resources/lib_tests/honey/sql/postgres_test.cljc index ad173596..9649a665 100644 --- a/test-resources/lib_tests/honey/sql/postgres_test.cljc +++ b/test-resources/lib_tests/honey/sql/postgres_test.cljc @@ -9,8 +9,7 @@ (ns honey.sql.postgres-test (:refer-clojure :exclude [update partition-by set]) - (:require #?(:clj [clojure.test :refer [deftest is testing]] - :cljs [cljs.test :refer-macros [deftest is testing]]) + (:require [clojure.test :refer [deftest is testing]] ;; pull in all the PostgreSQL helpers that the nilenso ;; library provided (as well as the regular HoneySQL ones): [honey.sql.helpers :as sqlh :refer @@ -320,7 +319,7 @@ (deftest values-except-select (testing "select which values are not not present in a table" - (is (= ["(VALUES (?), (?), (?)) EXCEPT (SELECT id FROM images)" 4 5 6] + (is (= ["VALUES (?), (?), (?) EXCEPT SELECT id FROM images" 4 5 6] (sql/format {:except [{:values [[4] [5] [6]]} @@ -328,7 +327,7 @@ (deftest select-except-select (testing "select which rows are not present in another table" - (is (= ["(SELECT ip) EXCEPT (SELECT ip FROM ip_location)"] + (is (= ["SELECT ip EXCEPT SELECT ip FROM ip_location"] (sql/format {:except [{:select [:ip]} @@ -336,7 +335,7 @@ (deftest values-except-all-select (testing "select which values are not not present in a table" - (is (= ["(VALUES (?), (?), (?)) EXCEPT ALL (SELECT id FROM images)" 4 5 6] + (is (= ["VALUES (?), (?), (?) EXCEPT ALL SELECT id FROM images" 4 5 6] (sql/format {:except-all [{:values [[4] [5] [6]]} @@ -344,7 +343,7 @@ (deftest select-except-all-select (testing "select which rows are not present in another table" - (is (= ["(SELECT ip) EXCEPT ALL (SELECT ip FROM ip_location)"] + (is (= ["SELECT ip EXCEPT ALL SELECT ip FROM ip_location"] (sql/format {:except-all [{:select [:ip]} diff --git a/test-resources/lib_tests/honey/sql_test.cljc b/test-resources/lib_tests/honey/sql_test.cljc index d1043ed7..3c93cac4 100644 --- a/test-resources/lib_tests/honey/sql_test.cljc +++ b/test-resources/lib_tests/honey/sql_test.cljc @@ -3,8 +3,7 @@ (ns honey.sql-test (:refer-clojure :exclude [format]) (:require [clojure.string :as str] - #?(:clj [clojure.test :refer [deftest is testing]] - :cljs [cljs.test :refer-macros [deftest is testing]]) + [clojure.test :refer [deftest is testing]] [honey.sql :as sut :refer [format]] [honey.sql.helpers :as h]) #?(:clj (:import (clojure.lang ExceptionInfo)))) @@ -15,17 +14,39 @@ {:dialect :mysql})))) (deftest expr-tests + ;; special-cased = nil: (is (= ["id IS NULL"] (sut/format-expr [:= :id nil]))) (is (= ["id IS NULL"] (sut/format-expr [:is :id nil]))) + (is (= ["id = TRUE"] + (sut/format-expr [:= :id true]))) + (is (= ["id IS TRUE"] + (sut/format-expr [:is :id true]))) + (is (= ["id <> TRUE"] + (sut/format-expr [:<> :id true]))) + (is (= ["id IS NOT TRUE"] + (sut/format-expr [:is-not :id true]))) + (is (= ["id = FALSE"] + (sut/format-expr [:= :id false]))) + (is (= ["id IS FALSE"] + (sut/format-expr [:is :id false]))) + (is (= ["id <> FALSE"] + (sut/format-expr [:<> :id false]))) + (is (= ["id IS NOT FALSE"] + (sut/format-expr [:is-not :id false]))) + ;; special-cased <> nil: (is (= ["id IS NOT NULL"] (sut/format-expr [:<> :id nil]))) + ;; legacy alias: (is (= ["id IS NOT NULL"] (sut/format-expr [:!= :id nil]))) + ;; legacy alias: + (is (= ["id IS NOT NULL"] + (sut/format-expr [:not= :id nil]))) (is (= ["id IS NOT NULL"] (sut/format-expr [:is-not :id nil]))) - ;; degenerate cases: + ;; degenerate (special) cases: (is (= ["NULL IS NULL"] (sut/format-expr [:= nil nil]))) (is (= ["NULL IS NOT NULL"] @@ -185,30 +206,30 @@ ;; ORDER BY foo ASC (is (= (format {:union [{:select [:foo] :from [:bar1]} {:select [:foo] :from [:bar2]}]}) - ["(SELECT foo FROM bar1) UNION (SELECT foo FROM bar2)"])) + ["SELECT foo FROM bar1 UNION SELECT foo FROM bar2"])) (testing "union complex values" (is (= (format {:union [{:select [:foo] :from [:bar1]} {:select [:foo] :from [:bar2]}] :with [[[:bar {:columns [:spam :eggs]}] {:values [[1 2] [3 4] [5 6]]}]]}) - ["WITH bar (spam, eggs) AS (VALUES (?, ?), (?, ?), (?, ?)) (SELECT foo FROM bar1) UNION (SELECT foo FROM bar2)" + ["WITH bar (spam, eggs) AS (VALUES (?, ?), (?, ?), (?, ?)) SELECT foo FROM bar1 UNION SELECT foo FROM bar2" 1 2 3 4 5 6])))) (deftest union-all-test (is (= (format {:union-all [{:select [:foo] :from [:bar1]} {:select [:foo] :from [:bar2]}]}) - ["(SELECT foo FROM bar1) UNION ALL (SELECT foo FROM bar2)"]))) + ["SELECT foo FROM bar1 UNION ALL SELECT foo FROM bar2"]))) (deftest intersect-test (is (= (format {:intersect [{:select [:foo] :from [:bar1]} {:select [:foo] :from [:bar2]}]}) - ["(SELECT foo FROM bar1) INTERSECT (SELECT foo FROM bar2)"]))) + ["SELECT foo FROM bar1 INTERSECT SELECT foo FROM bar2"]))) (deftest except-test (is (= (format {:except [{:select [:foo] :from [:bar1]} {:select [:foo] :from [:bar2]}]}) - ["(SELECT foo FROM bar1) EXCEPT (SELECT foo FROM bar2)"]))) + ["SELECT foo FROM bar1 EXCEPT SELECT foo FROM bar2"]))) (deftest inner-parts-test (testing "The correct way to apply ORDER BY to various parts of a UNION" @@ -222,7 +243,7 @@ :order-by [[:amount :desc]] :limit 5}]}] :order-by [[:amount :asc]]}) - ["(SELECT amount, id, created_on FROM transactions) UNION (SELECT amount, id, created_on FROM (SELECT amount, id, created_on FROM other_transactions ORDER BY amount DESC LIMIT ?)) ORDER BY amount ASC" 5])))) + ["SELECT amount, id, created_on FROM transactions UNION SELECT amount, id, created_on FROM (SELECT amount, id, created_on FROM other_transactions ORDER BY amount DESC LIMIT ?) ORDER BY amount ASC" 5])))) (deftest compare-expressions-test (testing "Sequences should be fns when in value/comparison spots" @@ -254,14 +275,14 @@ {:select [:foo] :from [:bar2]}] :with [[[:bar {:columns [:spam :eggs]}] {:values [[1 2] [3 4] [5 6]]}]]}) - ["WITH bar (spam, eggs) AS (VALUES (?, ?), (?, ?), (?, ?)) (SELECT foo FROM bar1) UNION (SELECT foo FROM bar2)" 1 2 3 4 5 6]))) + ["WITH bar (spam, eggs) AS (VALUES (?, ?), (?, ?), (?, ?)) SELECT foo FROM bar1 UNION SELECT foo FROM bar2" 1 2 3 4 5 6]))) (deftest union-all-with-cte (is (= (format {:union-all [{:select [:foo] :from [:bar1]} {:select [:foo] :from [:bar2]}] :with [[[:bar {:columns [:spam :eggs]}] {:values [[1 2] [3 4] [5 6]]}]]}) - ["WITH bar (spam, eggs) AS (VALUES (?, ?), (?, ?), (?, ?)) (SELECT foo FROM bar1) UNION ALL (SELECT foo FROM bar2)" 1 2 3 4 5 6]))) + ["WITH bar (spam, eggs) AS (VALUES (?, ?), (?, ?), (?, ?)) SELECT foo FROM bar1 UNION ALL SELECT foo FROM bar2" 1 2 3 4 5 6]))) (deftest parameterizer-none (testing "array parameter" @@ -277,7 +298,7 @@ :with [[[:bar {:columns [:spam :eggs]}] {:values [[1 2] [3 4] [5 6]]}]]} {:inline true}) - ["WITH bar (spam, eggs) AS (VALUES (1, 2), (3, 4), (5, 6)) (SELECT foo FROM bar1) UNION (SELECT foo FROM bar2)"])))) + ["WITH bar (spam, eggs) AS (VALUES (1, 2), (3, 4), (5, 6)) SELECT foo FROM bar1 UNION SELECT foo FROM bar2"])))) (deftest inline-was-parameterizer-none (testing "array parameter" @@ -294,7 +315,7 @@ :with [[[:bar {:columns [:spam :eggs]}] {:values (mapv #(mapv vector (repeat :inline) %) [[1 2] [3 4] [5 6]])}]]}) - ["WITH bar (spam, eggs) AS (VALUES (1, 2), (3, 4), (5, 6)) (SELECT foo FROM bar1) UNION (SELECT foo FROM bar2)"])))) + ["WITH bar (spam, eggs) AS (VALUES (1, 2), (3, 4), (5, 6)) SELECT foo FROM bar1 UNION SELECT foo FROM bar2"])))) (deftest similar-regex-tests (testing "basic similar to" @@ -379,11 +400,21 @@ (is (= ["UPDATE `foo` INNER JOIN `bar` ON `bar`.`id` = `foo`.`bar_id` SET `a` = ? WHERE `bar`.`b` = ?" 1 42] (-> - {:update :foo - :join [:bar [:= :bar.id :foo.bar_id]] - :set {:a 1} - :where [:= :bar.b 42]} - (format {:dialect :mysql}))))) + {:update :foo + :join [:bar [:= :bar.id :foo.bar_id]] + :set {:a 1} + :where [:= :bar.b 42]} + (format {:dialect :mysql})))) + ;; issue 344 + (is (= + ["UPDATE `foo` INNER JOIN `bar` ON `bar`.`id` = `foo`.`bar_id` SET `f`.`a` = ? WHERE `bar`.`b` = ?" 1 42] + (-> + {:update :foo + :join [:bar [:= :bar.id :foo.bar_id]] + ;; do not drop ns in set clause for MySQL: + :set {:f/a 1} + :where [:= :bar.b 42]} + (format {:dialect :mysql}))))) (deftest format-arity-test (testing "format can be called with no options" @@ -401,7 +432,8 @@ (-> {:delete-from :foo :where [:= :foo.id 42]} (format :dialect :mysql :pretty true))))) - (when (str/starts-with? #?(:bb "1.11" + ;; BB-TEST-PATCH: bb doesn't have clojure-version + (when (str/starts-with? #?(:bb "1.11" :clj (clojure-version) :cljs *clojurescript-version*) "1.11") (testing "format can be called with mixed arguments" @@ -439,7 +471,7 @@ (format {:dialect :mysql}))))) (deftest inlined-values-are-stringified-correctly - (is (= ["SELECT 'foo', 'It''s a quote!', BAR, NULL"] + (is (= ["SELECT 'foo', 'It''s a quote!', bar, NULL"] (format {:select [[[:inline "foo"]] [[:inline "It's a quote!"]] [[:inline :bar]] @@ -784,3 +816,31 @@ ORDER BY id = ? DESC :from :bar :join [[{:select :a :from :b :where [:= :id 123]} :x] :y] :where [:= :id 456]}))))) + +(deftest fetch-offset-issue-338 + (testing "default offset (with and without limit)" + (is (= ["SELECT foo FROM bar LIMIT ? OFFSET ?" 10 20] + (format {:select :foo :from :bar + :limit 10 :offset 20}))) + (is (= ["SELECT foo FROM bar OFFSET ?" 20] + (format {:select :foo :from :bar + :offset 20})))) + (testing "default offset / fetch" + (is (= ["SELECT foo FROM bar OFFSET ? ROWS FETCH NEXT ? ROWS ONLY" 20 10] + (format {:select :foo :from :bar + :fetch 10 :offset 20}))) + (is (= ["SELECT foo FROM bar OFFSET ? ROW FETCH NEXT ? ROW ONLY" 1 1] + (format {:select :foo :from :bar + :fetch 1 :offset 1}))) + (is (= ["SELECT foo FROM bar FETCH FIRST ? ROWS ONLY" 2] + (format {:select :foo :from :bar + :fetch 2})))) + (testing "SQL Server offset" + (is (= ["SELECT [foo] FROM [bar] OFFSET ? ROWS FETCH NEXT ? ROWS ONLY" 20 10] + (format {:select :foo :from :bar + :fetch 10 :offset 20} + {:dialect :sqlserver}))) + (is (= ["SELECT [foo] FROM [bar] OFFSET ? ROWS" 20] + (format {:select :foo :from :bar + :offset 20} + {:dialect :sqlserver}))))) diff --git a/test-resources/lib_tests/honeysql/core_test.cljc b/test-resources/lib_tests/honeysql/core_test.cljc index 4247f1bc..d1fc2f8b 100644 --- a/test-resources/lib_tests/honeysql/core_test.cljc +++ b/test-resources/lib_tests/honeysql/core_test.cljc @@ -3,11 +3,12 @@ (:require [#?@(:clj [clojure.test :refer] :cljs [cljs.test :refer-macros]) [deftest testing is]] [honeysql.core :as sql] + [honeysql.format :as sql-f] [honeysql.helpers :refer [select modifiers from join left-join right-join full-join cross-join where group having order-by limit offset values columns - insert-into with merge-where]] + insert-into with merge-where merge-having]] honeysql.format-test)) ;; TODO: more tests @@ -90,7 +91,7 @@ (-> (insert-into :foo) (columns :bar) - (values [[(honeysql.format/value {:baz "my-val"})]]) + (values [[(sql-f/value {:baz "my-val"})]]) sql/format))) (is (= ["INSERT INTO foo (a, b, c) VALUES (?, ?, ?), (?, ?, ?)" "a" "b" "c" "a" "b" "c"] @@ -217,43 +218,113 @@ sql/format)))) (deftest merge-where-no-params-test - (testing "merge-where called with just the map as parameter - see #228" - (let [sqlmap (-> (select :*) - (from :table) - (where [:= :foo :bar]))] - (is (= ["SELECT * FROM table WHERE foo = bar"] - (sql/format (apply merge-where sqlmap []))))))) + (doseq [[k [f merge-f]] {"WHERE" [where merge-where] + "HAVING" [having merge-having]}] + (testing "merge-where called with just the map as parameter - see #228" + (let [sqlmap (-> (select :*) + (from :table) + (f [:= :foo :bar]))] + (is (= [(str "SELECT * FROM table " k " foo = bar")] + (sql/format (apply merge-f sqlmap [])))))))) (deftest merge-where-test - (is (= ["SELECT * FROM table WHERE (foo = bar AND quuz = xyzzy)"] - (-> (select :*) - (from :table) - (where [:= :foo :bar] [:= :quuz :xyzzy]) - sql/format))) - (is (= ["SELECT * FROM table WHERE (foo = bar AND quuz = xyzzy)"] - (-> (select :*) - (from :table) - (where [:= :foo :bar]) - (merge-where [:= :quuz :xyzzy]) - sql/format)))) + (doseq [[k sql-keyword f merge-f] [[:where "WHERE" where merge-where] + [:having "HAVING" having merge-having]]] + (is (= [(str "SELECT * FROM table " sql-keyword " (foo = bar AND quuz = xyzzy)")] + (-> (select :*) + (from :table) + (f [:= :foo :bar] [:= :quuz :xyzzy]) + sql/format))) + (is (= [(str "SELECT * FROM table " sql-keyword " (foo = bar AND quuz = xyzzy)")] + (-> (select :*) + (from :table) + (f [:= :foo :bar]) + (merge-f [:= :quuz :xyzzy]) + sql/format))) + (testing "Should work when first arg isn't a map" + (is (= {k [:and [:x] [:y]]} + (merge-f [:x] [:y])))) + (testing "Shouldn't use conjunction if there is only one clause in the result" + (is (= {k [:x]} + (merge-f {} [:x])))) + (testing "Should be able to specify the conjunction type" + (is (= {k [:or [:x] [:y]]} + (merge-f {} + :or + [:x] [:y])))) + (testing "Should ignore nil clauses" + (is (= {k [:or [:x] [:y]]} + (merge-f {} + :or + [:x] nil [:y])))))) + +(deftest merge-where-build-clause-test + (doseq [k [:where :having]] + (testing (str "Should be able to build a " k " clause with sql/build") + (is (= {k [:and [:a] [:x] [:y]]} + (sql/build + k [:a] + (keyword (str "merge-" (name k))) [:and [:x] [:y]])))))) + +(deftest merge-where-combine-clauses-test + (doseq [[k f] {:where merge-where + :having merge-having}] + (testing (str "Combine new " k " clauses into the existing clause when appropriate. (#282)") + (testing "No existing clause" + (is (= {k [:and [:x] [:y]]} + (f {} + [:x] [:y])))) + (testing "Existing clause is not a conjunction." + (is (= {k [:and [:a] [:x] [:y]]} + (f {k [:a]} + [:x] [:y])))) + (testing "Existing clause IS a conjunction." + (testing "New clause(s) are not conjunctions" + (is (= {k [:and [:a] [:b] [:x] [:y]]} + (f {k [:and [:a] [:b]]} + [:x] [:y])))) + (testing "New clauses(s) ARE conjunction(s)" + (is (= {k [:and [:a] [:b] [:x] [:y]]} + (f {k [:and [:a] [:b]]} + [:and [:x] [:y]]))) + (is (= {k [:and [:a] [:b] [:x] [:y]]} + (f {k [:and [:a] [:b]]} + [:and [:x]] + [:y]))) + (is (= {k [:and [:a] [:b] [:x] [:y]]} + (f {k [:and [:a] [:b]]} + [:and [:x]] + [:and [:y]]))))) + (testing "if existing clause isn't the same conjunction, don't merge into it" + (testing "existing conjunction is `:or`" + (is (= {k [:and [:or [:a] [:b]] [:x] [:y]]} + (f {k [:or [:a] [:b]]} + [:x] [:y])))) + (testing "pass conjunction type as a param (override default of :and)" + (is (= {k [:or [:and [:a] [:b]] [:x] [:y]]} + (f {k [:and [:a] [:b]]} + :or + [:x] [:y])))))))) (deftest where-nil-params-test - (testing "where called with nil parameters - see #246" - (is (= ["SELECT * FROM table WHERE (foo = bar AND quuz = xyzzy)"] - (-> (select :*) - (from :table) - (where nil [:= :foo :bar] nil [:= :quuz :xyzzy] nil) - sql/format))) - (is (= ["SELECT * FROM table"] - (-> (select :*) - (from :table) - (where) - sql/format))) - (is (= ["SELECT * FROM table"] - (-> (select :*) - (from :table) - (where nil nil nil nil) - sql/format))))) + (doseq [[_ sql-keyword f] [[:where "WHERE" where] + [:having "HAVING" having]]] + (testing (str sql-keyword " called with nil parameters - see #246") + (is (= [(str "SELECT * FROM table " sql-keyword " (foo = bar AND quuz = xyzzy)")] + (-> (select :*) + (from :table) + (f nil [:= :foo :bar] nil [:= :quuz :xyzzy] nil) + sql/format))) + (is (= ["SELECT * FROM table"] + (-> (select :*) + (from :table) + (f) + sql/format))) + (is (= ["SELECT * FROM table"] + (-> (select :*) + (from :table) + (f nil nil nil nil) + sql/format)))))) (deftest cross-join-test (is (= ["SELECT * FROM foo CROSS JOIN bar"] diff --git a/test-resources/lib_tests/honeysql/format_test.cljc b/test-resources/lib_tests/honeysql/format_test.cljc index d7fa8c7b..7ddea793 100644 --- a/test-resources/lib_tests/honeysql/format_test.cljc +++ b/test-resources/lib_tests/honeysql/format_test.cljc @@ -320,3 +320,17 @@ (format {:select [:*] :from [[:foo :f]] :cross-join [[:bar :b]]})))) + +(deftest issue-299-test + (let [name "test field" + ;; this was being rendered inline into the SQL + ;; creating an injection vulnerability (v1 only) + ;; the context for seq->sql here seems to be the + ;; 'regular' one so it tries to treat this as an + ;; alias: 'value alias' -- the fix was to make it + ;; a function context so it becomes (TRUE, ?): + enabled [true, "); SELECT case when (SELECT current_setting('is_superuser'))='off' then pg_sleep(0.2) end; -- "]] + (is (= ["INSERT INTO table (name, enabled) VALUES (?, (TRUE, ?))" name (second enabled)] + (format {:insert-into :table + :values [{:name name + :enabled enabled}]}))))) \ No newline at end of file diff --git a/test-resources/lib_tests/integrant/core_test.cljc b/test-resources/lib_tests/integrant/core_test.cljc index f8cae2ad..065bb5a5 100644 --- a/test-resources/lib_tests/integrant/core_test.cljc +++ b/test-resources/lib_tests/integrant/core_test.cljc @@ -98,6 +98,7 @@ "{:foo/a #test/var clojure.core/+}") {:foo/a #'+})))) +;; BB-TEST-PATCH: No *loaded-libs* in bb #?(:bb :TODO :clj (defn- remove-lib [lib] (remove-ns lib) @@ -105,6 +106,7 @@ (derive :integrant.test-child/foo :integrant.test/foo) +;; BB-TEST-PATCH: No *loaded-libs* in bb #?(:bb :TODO :clj (deftest load-namespaces-test diff --git a/test-resources/lib_tests/io/aviso/binary_test.clj b/test-resources/lib_tests/io/aviso/binary_test.clj new file mode 100644 index 00000000..bdaf0bc8 --- /dev/null +++ b/test-resources/lib_tests/io/aviso/binary_test.clj @@ -0,0 +1,52 @@ +(ns io.aviso.binary-test + "Tests for the io.aviso.binary namespace." + (:use io.aviso.binary + clojure.test) + (:import (java.nio ByteBuffer))) + +(defn ^:private format-string-as-byte-array [str] + (format-binary (.getBytes str))) + +(deftest format-byte-array-test + + (are [input expected] + (= expected (format-string-as-byte-array input)) + + "Hello" "0000: 48 65 6C 6C 6F\n" + + "This is a longer text that spans to a second line." + "0000: 54 68 69 73 20 69 73 20 61 20 6C 6F 6E 67 65 72 20 74 65 78 74 20 74 68 61 74 20 73 70 61 6E 73\n0020: 20 74 6F 20 61 20 73 65 63 6F 6E 64 20 6C 69 6E 65 2E\n")) + +(deftest format-string-as-byte-data + (are [input expected] + (= expected (format-binary input)) + "" "" + + "Hello" "0000: 48 65 6C 6C 6F\n" + + "This is a longer text that spans to a second line." + + "0000: 54 68 69 73 20 69 73 20 61 20 6C 6F 6E 67 65 72 20 74 65 78 74 20 74 68 61 74 20 73 70 61 6E 73\n0020: 20 74 6F 20 61 20 73 65 63 6F 6E 64 20 6C 69 6E 65 2E\n")) + +(deftest nil-is-an-empty-data + (is (= (format-binary nil) ""))) + +(deftest byte-buffer + (let [bb (ByteBuffer/wrap (.getBytes "Duty Now For The Future" "UTF-8"))] + (is (= "0000: 44 75 74 79 20 4E 6F 77 20 46 6F 72 20 54 68 65 20 46 75 74 75 72 65\n" + (format-binary bb))) + + (is (= "0000: 44 75 74 79\n" + (-> bb + (.position 5) + (.limit 9) + format-binary))) + + (is (= "0000: 46 6F 72\n" + (-> bb + (.position 9) + (.limit 12) + .slice + format-binary))) + + )) diff --git a/test-resources/lib_tests/io/aviso/exception_test.clj b/test-resources/lib_tests/io/aviso/exception_test.clj new file mode 100644 index 00000000..f8b1cbe0 --- /dev/null +++ b/test-resources/lib_tests/io/aviso/exception_test.clj @@ -0,0 +1,583 @@ +(ns io.aviso.exception-test + (:use clojure.test) + (:require [clojure.string :as str] + [io.aviso.exception :as e :refer [*fonts* parse-exception format-exception]] + [clojure.pprint :refer [pprint]] + [com.stuartsierra.component :as component] + [com.walmartlabs.test-reporting :refer [reporting]] + io.aviso.component)) + +(deftest write-exceptions + (testing "exception properties printing" + (testing "Does not fail with ex-info's map keys not implementing clojure.lang.Named" + (is (re-find #"string-key.*string-val" + (format-exception (ex-info "Error" {"string-key" "string-val"}))))))) + +(defn parse [& text-lines] + (let [text (str/join \newline text-lines)] + (binding [*fonts* nil] + (parse-exception text nil)))) + +(deftest parse-exceptions + (is (= [{:class-name "java.lang.IllegalArgumentException" + :message "No value supplied for key: {:host \"example.com\"}" + :stack-trace + [{:simple-class "PersistentHashMap" + :package "clojure.lang" + :omitted true + :is-clojure? false + :method "create" + :name "" + :formatted-name "..." + :file "" + :line nil + :class "clojure.lang.PersistentHashMap" + :names []} + {:simple-class "client$tcp_client" + :package "riemann" + :is-clojure? true + :method "doInvoke" + :name "riemann.client/tcp-client" + :formatted-name "riemann.client/tcp-client" + :file "client.clj" + :line 90 + :class "riemann.client$tcp_client" + :names '("riemann.client" "tcp-client")} + {:simple-class "RestFn" + :package "clojure.lang" + :omitted true + :is-clojure? false + :method "invoke" + :name "" + :formatted-name "..." + :file "" + :line nil + :class "clojure.lang.RestFn" + :names []} + {:simple-class "error_monitor$make_connection" + :package "com.example" + :is-clojure? true + :method "invoke" + :name "com.example.error-monitor/make-connection" + :formatted-name "com.example.error-monitor/make-connection" + :file "error_monitor.clj" + :line 22 + :class "com.example.error_monitor$make_connection" + :names '("com.example.error-monitor" "make-connection")} + {:simple-class "error_monitor$make_client" + :package "com.example" + :is-clojure? true + :method "invoke" + :name "com.example.error-monitor/make-client" + :formatted-name "com.example.error-monitor/make-client" + :file "error_monitor.clj" + :line 26 + :class "com.example.error_monitor$make_client" + :names '("com.example.error-monitor" "make-client")} + {:simple-class "core$map$fn__4553" + :package "clojure" + :is-clojure? true + :method "invoke" + :name "clojure.core/map/fn" + :formatted-name "clojure.core/map/fn" + :file "core.clj" + :line 2624 + :class "clojure.core$map$fn__4553" + :names '("clojure.core" "map" "fn")} + {:simple-class "LazySeq" + :package "clojure.lang" + :omitted true + :is-clojure? false + :method "sval" + :name "" + :formatted-name "..." + :file "" + :line nil + :class "clojure.lang.LazySeq" + :names []} + {:simple-class "core$seq__4128" + :package "clojure" + :is-clojure? true + :method "invoke" + :name "clojure.core/seq" + :formatted-name "clojure.core/seq" + :file "core.clj" + :line 137 + :class "clojure.core$seq__4128" + :names '("clojure.core" "seq")} + {:simple-class "core$sort" + :package "clojure" + :is-clojure? true + :method "invoke" + :name "clojure.core/sort" + :formatted-name "clojure.core/sort" + :file "core.clj" + :line 2981 + :class "clojure.core$sort" + :names '("clojure.core" "sort")} + {:simple-class "core$sort_by" + :package "clojure" + :is-clojure? true + :method "invoke" + :name "clojure.core/sort-by" + :formatted-name "clojure.core/sort-by" + :file "core.clj" + :line 2998 + :class "clojure.core$sort_by" + :names '("clojure.core" "sort-by")} + {:simple-class "core$sort_by" + :package "clojure" + :is-clojure? true + :method "invoke" + :name "clojure.core/sort-by" + :formatted-name "clojure.core/sort-by" + :file "core.clj" + :line 2996 + :class "clojure.core$sort_by" + :names '("clojure.core" "sort-by")} + {:simple-class "error_monitor$make_clients" + :package "com.example" + :is-clojure? true + :method "invoke" + :name "com.example.error-monitor/make-clients" + :formatted-name "com.example.error-monitor/make-clients" + :file "error_monitor.clj" + :line 31 + :class "com.example.error_monitor$make_clients" + :names '("com.example.error-monitor" "make-clients")} + {:simple-class "error_monitor$report_and_reset" + :package "com.example" + :is-clojure? true + :method "invoke" + :name "com.example.error-monitor/report-and-reset" + :formatted-name "com.example.error-monitor/report-and-reset" + :file "error_monitor.clj" + :line 185 + :class "com.example.error_monitor$report_and_reset" + :names '("com.example.error-monitor" "report-and-reset")} + {:simple-class "main$_main$fn__705" + :package "com.example.error_monitor" + :is-clojure? true + :method "invoke" + :name "com.example.error-monitor.main/-main/fn" + :formatted-name "com.example.error-monitor.main/-main/fn" + :file "main.clj" + :line 19 + :class "com.example.error_monitor.main$_main$fn__705" + :names '("com.example.error-monitor.main" "-main" "fn")} + {:simple-class "main$_main" + :package "com.example.error_monitor" + :is-clojure? true + :method "doInvoke" + :name "com.example.error-monitor.main/-main" + :formatted-name "com.example.error-monitor.main/-main" + :file "main.clj" + :line 16 + :class "com.example.error_monitor.main$_main" + :names '("com.example.error-monitor.main" "-main")} + {:simple-class "RestFn" + :package "clojure.lang" + :omitted true + :is-clojure? false + :method "applyTo" + :name "" + :formatted-name "..." + :file "" + :line nil + :class "clojure.lang.RestFn" + :names []} + {:class "com.example.error_monitor.main" + :file "" + :formatted-name "com.example.error_monitor.main.main" + :is-clojure? false + :line nil + :method "main" + :name "" + :names [] + :package "com.example.error_monitor" + :simple-class "main"}]}] + (parse "java.lang.IllegalArgumentException: No value supplied for key: {:host \"example.com\"}" + "\tat clojure.lang.PersistentHashMap.create(PersistentHashMap.java:77)" + "\tat riemann.client$tcp_client.doInvoke(client.clj:90)" + "\tat clojure.lang.RestFn.invoke(RestFn.java:408)" + "\tat com.example.error_monitor$make_connection.invoke(error_monitor.clj:22)" + "\tat com.example.error_monitor$make_client.invoke(error_monitor.clj:26)" + "\tat clojure.core$map$fn__4553.invoke(core.clj:2624)" + "\tat clojure.lang.LazySeq.sval(LazySeq.java:40)" + "\tat clojure.lang.LazySeq.seq(LazySeq.java:49)" + "\tat clojure.lang.RT.seq(RT.java:507)" + "\tat clojure.core$seq__4128.invoke(core.clj:137)" + "\tat clojure.core$sort.invoke(core.clj:2981)" + "\tat clojure.core$sort_by.invoke(core.clj:2998)" + "\tat clojure.core$sort_by.invoke(core.clj:2996)" + "\tat com.example.error_monitor$make_clients.invoke(error_monitor.clj:31)" + "\tat com.example.error_monitor$report_and_reset.invoke(error_monitor.clj:185)" + "\tat com.example.error_monitor.main$_main$fn__705.invoke(main.clj:19)" + "\tat com.example.error_monitor.main$_main.doInvoke(main.clj:16)" + "\tat clojure.lang.RestFn.applyTo(RestFn.java:137)" + "\tat com.example.error_monitor.main.main(Unknown Source)")) + + (is (= [{:class-name "java.lang.RuntimeException", :message "Request handling exception"} + {:class-name "java.lang.RuntimeException", :message "Failure updating row"} + {:class-name "java.sql.SQLException" + :message "Database failure\nSELECT FOO, BAR, BAZ\nFROM GNIP\nfailed with ABC123" + :stack-trace [{:simple-class "user$jdbc_update" + :package nil + :is-clojure? true + :method "invoke" + :name "user/jdbc-update" + :formatted-name "user/jdbc-update" + :file "user.clj" + :line 7 + :class "user$jdbc_update" + :names '("user" "jdbc-update")} + {:simple-class "user$make_jdbc_update_worker$reify__497" + :package nil + :is-clojure? true + :method "do_work" + :name "user/make-jdbc-update-worker/reify/do-work" + :formatted-name "user/make-jdbc-update-worker/reify/do-work" + :file "user.clj" + :line 18 + :class "user$make_jdbc_update_worker$reify__497" + :names '("user" "make-jdbc-update-worker" "reify" "do-work")} + {:simple-class "user$update_row" + :package nil + :is-clojure? true + :method "invoke" + :name "user/update-row" + :formatted-name "user/update-row" + :file "user.clj" + :line 23 + :class "user$update_row" + :names '("user" "update-row")} + {:simple-class "user$make_exception" + :package nil + :is-clojure? true + :method "invoke" + :name "user/make-exception" + :formatted-name "user/make-exception" + :file "user.clj" + :line 31 + :class "user$make_exception" + :names '("user" "make-exception")} + {:simple-class "user$eval2018" + :package nil + :is-clojure? true + :method "invoke" + :name "user/eval2018" + :formatted-name "user/eval2018" + :file "REPL Input" + :line nil + :class "user$eval2018" + :names '("user" "eval2018")} + {:simple-class "Compiler" + :package "clojure.lang" + :omitted true + :is-clojure? false + :method "eval" + :name "" + :formatted-name "..." + :file "" + :line nil + :class "clojure.lang.Compiler" + :names []} + {:simple-class "core$eval" + :package "clojure" + :is-clojure? true + :method "invoke" + :name "clojure.core/eval" + :formatted-name "clojure.core/eval" + :file "core.clj" + :line 2852 + :class "clojure.core$eval" + :names '("clojure.core" "eval")}]}] + (parse "java.lang.RuntimeException: Request handling exception" + "\tat user$make_exception.invoke(user.clj:31)" + "\tat user$eval2018.invoke(form-init1482095333541107022.clj:1)" + "\tat clojure.lang.Compiler.eval(Compiler.java:6619)" + "\tat clojure.lang.Compiler.eval(Compiler.java:6582)" + "\tat clojure.core$eval.invoke(core.clj:2852)" + "\tat clojure.main$repl$read_eval_print__6602$fn__6605.invoke(main.clj:259)" + "\tat clojure.main$repl$read_eval_print__6602.invoke(main.clj:259)" + "\tat clojure.main$repl$fn__6611$fn__6612.invoke(main.clj:277)" + "\tat clojure.main$repl$fn__6611.invoke(main.clj:277)" + "\tat clojure.main$repl.doInvoke(main.clj:275)" + "\tat clojure.lang.RestFn.invoke(RestFn.java:1523)" + "\tat clojure.tools.nrepl.middleware.interruptible_eval$evaluate$fn__1419.invoke(interruptible_eval.clj:72)" + "\tat clojure.lang.AFn.applyToHelper(AFn.java:159)" + "\tat clojure.lang.AFn.applyTo(AFn.java:151)" + "\tat clojure.core$apply.invoke(core.clj:617)" + "\tat clojure.core$with_bindings_STAR_.doInvoke(core.clj:1788)" + "\tat clojure.lang.RestFn.invoke(RestFn.java:425)" + "\tat clojure.tools.nrepl.middleware.interruptible_eval$evaluate.invoke(interruptible_eval.clj:56)" + "\tat clojure.tools.nrepl.middleware.interruptible_eval$interruptible_eval$fn__1461$fn__1464.invoke(interruptible_eval.clj:191)" + "\tat clojure.tools.nrepl.middleware.interruptible_eval$run_next$fn__1456.invoke(interruptible_eval.clj:159)" + "\tat clojure.lang.AFn.run(AFn.java:24)" + "\tat java.util.concurrent.ThreadPoolExecutor.runWorker(ThreadPoolExecutor.java:1142)" + "\tat java.util.concurrent.ThreadPoolExecutor$Worker.run(ThreadPoolExecutor.java:617)" + "\tat java.lang.Thread.run(Thread.java:745)" + "Caused by: java.lang.RuntimeException: Failure updating row" + "\tat user$update_row.invoke(user.clj:23)" + "\t... 24 more" + "Caused by: java.sql.SQLException: Database failure" + "SELECT FOO, BAR, BAZ" + "FROM GNIP" + "failed with ABC123" + "\tat user$jdbc_update.invoke(user.clj:7)" + "\tat user$make_jdbc_update_worker$reify__497.do_work(user.clj:18)" + "\t... 25 more")) + + (is (= [{:class-name "com.datastax.driver.core.TransportException", :message "/17.76.3.14:9042 Cannot connect"} + {:class-name "java.net.ConnectException", + :message "Connection refused: /17.76.3.14:9042", + :stack-trace [{:simple-class "SocketChannelImpl" + :package "sun.nio.ch" + :is-clojure? false + :method "checkConnect" + :name "" + :formatted-name "sun.nio.ch.SocketChannelImpl.checkConnect" + :file "" + :line nil + :class "sun.nio.ch.SocketChannelImpl" + :names []} + {:simple-class "SocketChannelImpl" + :package "sun.nio.ch" + :is-clojure? false + :method "finishConnect" + :name "" + :formatted-name "sun.nio.ch.SocketChannelImpl.finishConnect" + :file "SocketChannelImpl.java" + :line 717 + :class "sun.nio.ch.SocketChannelImpl" + :names []} + {:simple-class "NioClientBoss" + :package "com.datastax.shaded.netty.channel.socket.nio" + :is-clojure? false + :method "connect" + :name "" + :formatted-name "com.datastax.shaded.netty.channel.socket.nio.NioClientBoss.connect" + :file "NioClientBoss.java" + :line 150 + :class "com.datastax.shaded.netty.channel.socket.nio.NioClientBoss" + :names []} + {:simple-class "NioClientBoss" + :package "com.datastax.shaded.netty.channel.socket.nio" + :is-clojure? false + :method "processSelectedKeys" + :name "" + :formatted-name "com.datastax.shaded.netty.channel.socket.nio.NioClientBoss.processSelectedKeys" + :file "NioClientBoss.java" + :line 105 + :class "com.datastax.shaded.netty.channel.socket.nio.NioClientBoss" + :names []} + {:simple-class "NioClientBoss" + :package "com.datastax.shaded.netty.channel.socket.nio" + :is-clojure? false + :method "process" + :name "" + :formatted-name "com.datastax.shaded.netty.channel.socket.nio.NioClientBoss.process" + :file "NioClientBoss.java" + :line 79 + :class "com.datastax.shaded.netty.channel.socket.nio.NioClientBoss" + :names []} + {:simple-class "AbstractNioSelector" + :package "com.datastax.shaded.netty.channel.socket.nio" + :is-clojure? false + :method "run" + :name "" + :formatted-name "com.datastax.shaded.netty.channel.socket.nio.AbstractNioSelector.run" + :file "AbstractNioSelector.java" + :line 318 + :class "com.datastax.shaded.netty.channel.socket.nio.AbstractNioSelector" + :names []} + {:simple-class "NioClientBoss" + :package "com.datastax.shaded.netty.channel.socket.nio" + :is-clojure? false + :method "run" + :name "" + :formatted-name "com.datastax.shaded.netty.channel.socket.nio.NioClientBoss.run" + :file "NioClientBoss.java" + :line 42 + :class "com.datastax.shaded.netty.channel.socket.nio.NioClientBoss" + :names []} + {:simple-class "ThreadRenamingRunnable" + :package "com.datastax.shaded.netty.util" + :is-clojure? false + :method "run" + :name "" + :formatted-name "com.datastax.shaded.netty.util.ThreadRenamingRunnable.run" + :file "ThreadRenamingRunnable.java" + :line 108 + :class "com.datastax.shaded.netty.util.ThreadRenamingRunnable" + :names []} + {:simple-class "DeadLockProofWorker$1" + :package "com.datastax.shaded.netty.util.internal" + :is-clojure? false + :method "run" + :name "" + :formatted-name "com.datastax.shaded.netty.util.internal.DeadLockProofWorker$1.run" + :file "DeadLockProofWorker.java" + :line 42 + :class "com.datastax.shaded.netty.util.internal.DeadLockProofWorker$1" + :names []} + {:simple-class "Connection" + :package "com.datastax.driver.core" + :is-clojure? false + :method "" + :name "" + :formatted-name "com.datastax.driver.core.Connection." + :file "Connection.java" + :line 104 + :class "com.datastax.driver.core.Connection" + :names []} + {:simple-class "PooledConnection" + :package "com.datastax.driver.core" + :is-clojure? false + :method "" + :name "" + :formatted-name "com.datastax.driver.core.PooledConnection." + :file "PooledConnection.java" + :line 32 + :class "com.datastax.driver.core.PooledConnection" + :names []} + {:simple-class "Connection$Factory" + :package "com.datastax.driver.core" + :is-clojure? false + :method "open" + :name "" + :formatted-name "com.datastax.driver.core.Connection$Factory.open" + :file "Connection.java" + :line 557 + :class "com.datastax.driver.core.Connection$Factory" + :names []} + {:simple-class "DynamicConnectionPool" + :package "com.datastax.driver.core" + :is-clojure? false + :method "" + :name "" + :formatted-name "com.datastax.driver.core.DynamicConnectionPool." + :file "DynamicConnectionPool.java" + :line 74 + :class "com.datastax.driver.core.DynamicConnectionPool" + :names []} + {:simple-class "HostConnectionPool" + :package "com.datastax.driver.core" + :is-clojure? false + :method "newInstance" + :name "" + :formatted-name "com.datastax.driver.core.HostConnectionPool.newInstance" + :file "HostConnectionPool.java" + :line 33 + :class "com.datastax.driver.core.HostConnectionPool" + :names []} + {:simple-class "SessionManager$2" + :package "com.datastax.driver.core" + :is-clojure? false + :method "call" + :name "" + :formatted-name "com.datastax.driver.core.SessionManager$2.call" + :file "SessionManager.java" + :line 231 + :class "com.datastax.driver.core.SessionManager$2" + :names []} + {:simple-class "SessionManager$2" + :package "com.datastax.driver.core" + :is-clojure? false + :method "call" + :name "" + :formatted-name "com.datastax.driver.core.SessionManager$2.call" + :file "SessionManager.java" + :line 224 + :class "com.datastax.driver.core.SessionManager$2" + :names []} + {:simple-class "FutureTask" + :package "java.util.concurrent" + :is-clojure? false + :method "run" + :name "" + :formatted-name "java.util.concurrent.FutureTask.run" + :file "FutureTask.java" + :line 266 + :class "java.util.concurrent.FutureTask" + :names []} + {:simple-class "ThreadPoolExecutor" + :package "java.util.concurrent" + :is-clojure? false + :method "runWorker" + :name "" + :formatted-name "java.util.concurrent.ThreadPoolExecutor.runWorker" + :file "ThreadPoolExecutor.java" + :line 1142 + :class "java.util.concurrent.ThreadPoolExecutor" + :names []} + {:simple-class "ThreadPoolExecutor$Worker" + :package "java.util.concurrent" + :is-clojure? false + :method "run" + :name "" + :formatted-name "java.util.concurrent.ThreadPoolExecutor$Worker.run" + :file "ThreadPoolExecutor.java" + :line 617 + :class "java.util.concurrent.ThreadPoolExecutor$Worker" + :names []} + {:simple-class "Thread" + :package "java.lang" + :is-clojure? false + :method "run" + :name "" + :formatted-name "java.lang.Thread.run" + :file "Thread.java" + :line 745 + :class "java.lang.Thread" + :names []}]}] + + (parse "com.datastax.driver.core.TransportException: /17.76.3.14:9042 Cannot connect" + "\tat com.datastax.driver.core.Connection.(Connection.java:104) ~store-service.jar:na" + "\tat com.datastax.driver.core.PooledConnection.(PooledConnection.java:32) ~store-service.jar:na" + "\tat com.datastax.driver.core.Connection$Factory.open(Connection.java:557) ~store-service.jar:na" + "\tat com.datastax.driver.core.DynamicConnectionPool.(DynamicConnectionPool.java:74) ~store-service.jar:na" + "\tat com.datastax.driver.core.HostConnectionPool.newInstance(HostConnectionPool.java:33) ~store-service.jar:na" + "\tat com.datastax.driver.core.SessionManager$2.call(SessionManager.java:231) store-service.jar:na" + "\tat com.datastax.driver.core.SessionManager$2.call(SessionManager.java:224) store-service.jar:na" + "\tat java.util.concurrent.FutureTask.run(FutureTask.java:266) na:1.8.0_66" + "\tat java.util.concurrent.ThreadPoolExecutor.runWorker(ThreadPoolExecutor.java:1142) na:1.8.0_66" + "\tat java.util.concurrent.ThreadPoolExecutor$Worker.run(ThreadPoolExecutor.java:617) na:1.8.0_66" + "\tat java.lang.Thread.run(Thread.java:745) na:1.8.0_66" + "Caused by: java.net.ConnectException: Connection refused: /17.76.3.14:9042" + "\tat sun.nio.ch.SocketChannelImpl.checkConnect(Native Method) ~na:1.8.0_66" + "\tat sun.nio.ch.SocketChannelImpl.finishConnect(SocketChannelImpl.java:717) ~na:1.8.0_66" + "\tat com.datastax.shaded.netty.channel.socket.nio.NioClientBoss.connect(NioClientBoss.java:150) ~store-service.jar:na" + "\tat com.datastax.shaded.netty.channel.socket.nio.NioClientBoss.processSelectedKeys(NioClientBoss.java:105) ~store-service.jar:na" + "\tat com.datastax.shaded.netty.channel.socket.nio.NioClientBoss.process(NioClientBoss.java:79) ~store-service.jar:na" + "\tat com.datastax.shaded.netty.channel.socket.nio.AbstractNioSelector.run(AbstractNioSelector.java:318) ~store-service.jar:na" + "\tat com.datastax.shaded.netty.channel.socket.nio.NioClientBoss.run(NioClientBoss.java:42) ~store-service.jar:na" + "\tat com.datastax.shaded.netty.util.ThreadRenamingRunnable.run(ThreadRenamingRunnable.java:108) ~store-service.jar:na" + "\tat com.datastax.shaded.netty.util.internal.DeadLockProofWorker$1.run(DeadLockProofWorker.java:42) ~store-service.jar:na" + "\t... 3 common frames omitted")))))) + +(defrecord MyComponent [] + + component/Lifecycle + (start [this] this) + (stop [this] this)) + + +(deftest component-print-behavior + (binding [e/*fonts* nil] + (let [my-component (map->MyComponent {}) + system (component/system-map + :my-component my-component) + sys-exception (format-exception (ex-info "System Exception" {:system system})) + comp-exception (format-exception (ex-info "Component Exception" {:component my-component}))] + + (reporting {sys-exception (str/split-lines sys-exception)} + (is (re-find #"system: #" sys-exception))) + + (reporting {comp-exception (str/split-lines comp-exception)} + (is (re-find #"component: #" comp-exception)))))) + +(deftest write-exceptions-with-nil-data + (testing "Does not fail with a nil ex-info map key" + (is (re-find #"nil.*nil" + (format-exception (ex-info "Error" {nil nil})))))) diff --git a/test-resources/lib_tests/lambdaisland/regal/malli_test.cljc b/test-resources/lib_tests/lambdaisland/regal/malli_test.cljc new file mode 100644 index 00000000..5b3072e3 --- /dev/null +++ b/test-resources/lib_tests/lambdaisland/regal/malli_test.cljc @@ -0,0 +1,19 @@ +(ns lambdaisland.regal.malli-test + (:require [clojure.test :refer [deftest is ]] + [malli.core :as m] + [malli.error :as me] + [lambdaisland.regal.malli :as regal-malli])) + +(def malli-opts {:registry {:regal regal-malli/regal-schema}}) + +(def form [:+ "y"]) + +(def schema (m/schema [:regal form] malli-opts)) + +(deftest regal-malli-test + (is (= [:regal [:+ "y"]] (m/form schema))) + (is (= :regal (m/type schema))) + (is (= true (m/validate schema "yyy"))) + (is (= ["Pattern does not match"] (me/humanize (m/explain schema "xxx"))))) + + diff --git a/test-resources/lib_tests/lambdaisland/regal/parse_test.cljc b/test-resources/lib_tests/lambdaisland/regal/parse_test.cljc new file mode 100644 index 00000000..2a169516 --- /dev/null +++ b/test-resources/lib_tests/lambdaisland/regal/parse_test.cljc @@ -0,0 +1,29 @@ +(ns lambdaisland.regal.parse-test + (:require [clojure.test :refer [deftest testing is are]] + [lambdaisland.regal :as regal] + [lambdaisland.regal.parse :as parse])) + +(deftest parse-whitespace-test + (is (= [:class " " :tab :newline :vertical-tab :form-feed :return] + (regal/with-flavor :java + (parse/parse-pattern "\\s")))) + + (is (= :whitespace + (regal/with-flavor :ecma + (parse/parse-pattern "\\s")))) + + (is (= [:not " " :tab :newline :vertical-tab :form-feed :return] + (regal/with-flavor :java + (parse/parse-pattern "\\S")))) + + (is (= :non-whitespace + (regal/with-flavor :ecma + (parse/parse-pattern "\\S"))))) + +(deftest ^{:kaocha/pending + "Needs a special case in the regex generation code"} + whitespace-round-trip + (is (= "\\s" + (regal/with-flavor :java + (regal/pattern + (parse/parse-pattern "\\s")))))) diff --git a/test-resources/lib_tests/lambdaisland/regal/re2_test.clj b/test-resources/lib_tests/lambdaisland/regal/re2_test.clj new file mode 100644 index 00000000..6f26c84c --- /dev/null +++ b/test-resources/lib_tests/lambdaisland/regal/re2_test.clj @@ -0,0 +1,45 @@ +(ns lambdaisland.regal.re2-test + (:require [clojure.spec.alpha :as s] + [clojure.test :refer [is]] + [clojure.test.check.clojure-test :refer [defspec]] + [clojure.test.check.generators :as gen] + [com.gfredericks.test.chuck.properties :as prop'] + [lambdaisland.regal :as regal] + [lambdaisland.regal.generator :as regal-gen] + [lambdaisland.regal.test-util :refer [re2-find re2-compile]] + [lambdaisland.regal.spec-alpha :as regal-spec])) + +(defn gen-carefully [fgen else-gen] + (try + (let [gen (fgen)] + (gen/->Generator + (fn [rnd size] + (try + (gen/call-gen gen rnd size) + (catch Exception _ + (gen/call-gen else-gen rnd size)))))) + (catch Exception _ + else-gen))) + +(defn can-generate? [regal] + (try + (gen/sample (regal-gen/gen regal)) + true + (catch Exception _ + false))) + +(defspec re2-matches-like-java 10 + (with-redefs [regal-spec/token-gen #(s/gen (disj regal-spec/known-tokens :line-break :start :end))] + (prop'/for-all [regal (s/gen ::regal/form) + :when (can-generate? regal) + s (gen-carefully #(regal-gen/gen regal) + gen/string) + :let [java-result + (try (re-find (regal/regex regal) s) + (catch Exception _ + :fail))] + :when (not= :fail java-result)] + (is (= java-result + (re2-find (regal/with-flavor :re2 + (re2-compile (regal/pattern regal))) + s)))))) diff --git a/test-resources/lib_tests/lambdaisland/regal/spec_gen_test.clj b/test-resources/lib_tests/lambdaisland/regal/spec_gen_test.clj new file mode 100644 index 00000000..20b14f16 --- /dev/null +++ b/test-resources/lib_tests/lambdaisland/regal/spec_gen_test.clj @@ -0,0 +1,39 @@ +(ns lambdaisland.regal.spec-gen-test + (:require [clojure.spec.alpha :as s] + [clojure.spec.gen.alpha :as spec-gen] + [clojure.test :refer [deftest is are testing run-tests]] + [clojure.test.check.clojure-test :refer [defspec]] + [clojure.test.check.generators :as gen] + [clojure.test.check.properties :as prop] + [lambdaisland.regal :as regal] + [lambdaisland.regal.parse :as parse] + [lambdaisland.regal.spec-alpha])) + +(def form-gen (s/gen ::regal/form)) +(def canonical-form-gen (gen/fmap regal/normalize (s/gen ::regal/form))) + +(defspec generated-forms-can-be-converted 100 + (prop/for-all [regal form-gen] + (try + (regal/regex regal) + (catch Exception _ + false)))) + +(defn- round-trip? [form] + (try + (= form (parse/parse (regal/regex form))) + (catch Exception _ false))) + +(defspec round-trip-property 100 + (prop/for-all* [canonical-form-gen] round-trip?)) + +(deftest round-trip-test + (is (round-trip? [:cat " " [:class "&& "]])) + (is (round-trip? [:class " " [" " "["]])) + (is (round-trip? [:ctrl "A"])) + (is (round-trip? [:class " - "])) + (is (round-trip? [:alt " " [:capture " " :escape]])) + (is (round-trip? :whitespace)) + (is (round-trip? [:? [:? "x"]])) + (is (round-trip? [:cat " " [:class " " :non-whitespace]])) + (is (round-trip? [:cat "-" [:repeat [:repeat "x" 0] 0]]))) diff --git a/test-resources/lib_tests/lambdaisland/regal/test_util.cljc b/test-resources/lib_tests/lambdaisland/regal/test_util.cljc new file mode 100644 index 00000000..04c1d659 --- /dev/null +++ b/test-resources/lib_tests/lambdaisland/regal/test_util.cljc @@ -0,0 +1,146 @@ +(ns lambdaisland.regal.test-util + (:require [lambdaisland.regal :as regal]) + #?(:cljs (:require-macros [lambdaisland.regal.test-util :refer [inline-resource]]) + :clj (:require [clojure.java.io :as io] + [clojure.test.check.generators :as gen] + [lambdaisland.regal.generator :as regal-gen] + ;; BB-TEST-PATCH: Don't have this dependency + #_[com.gfredericks.test.chuck.regexes.charsets :as charsets]))) + +#?(:clj + (defmacro inline-resource [resource-path] + (read-string (slurp (io/resource resource-path))))) + +(defn read-test-cases [] + #? (:clj (read-string (slurp (io/resource "lambdaisland/regal/test_cases.edn"))) + :cljs (inline-resource "lambdaisland/regal/test_cases.edn"))) + +(defn flavor-parents [flavor] + (->> flavor + (iterate (comp first (partial parents regal/flavor-hierarchy))) + (take-while identity))) + +(defn format-cases [cases] + (for [[form pattern & tests :as case] cases + :let [[props tests] (if (map? (first tests)) + [(first tests) (rest tests)] + [{} tests])]] + (with-meta (merge + {:pattern pattern + :form form + :tests tests} + props) + (meta case)))) + +(defn test-cases + ([] + (let [cases (read-test-cases)] + (loop [[id & cases] cases + result []] + (if id + (recur (drop-while vector? cases) + (conj result + {:id id + :cases (format-cases (take-while vector? cases))})) + result))))) + +;; BB-TEST-PATCH: bb doesn't have Pattern class +#_(:clj + (do + (defn re2-compile ^com.google.re2j.Pattern [s] + (com.google.re2j.Pattern/compile s)) + (defn re2-groups + [^com.google.re2j.Matcher m] + (let [gc (. m (groupCount))] + (if (zero? gc) + (. m (group)) + (loop [ret [] c 0] + (if (<= c gc) + (recur (conj ret (. m (group c))) (inc c)) + ret))))) + (defn re2-find + ([^com.google.re2j.Matcher m] + (when (. m (find)) + (re2-groups m))) + ([^com.google.re2j.Pattern re s] + (let [m (.matcher re s)] + (re2-find m)))))) +;; BB-TEST-PATCH: Uses ns that can't load +#_(:clj + (do + ;; Implementation for generating classes using test.chuck's charsets. + ;; This should eventually be moved to lambdaisland.regal.generator + ;; when we have our own charset implementation + (def token->charset-map + (let [whitespace-charset (apply charsets/union + (map (comp charsets/singleton str char) regal/whitespace-char-codes))] + {:any charsets/all-unicode-but-line-terminators + :digit (charsets/predefined-regex-classes \d) + :non-digit (charsets/predefined-regex-classes \D) + :word (charsets/predefined-regex-classes \w) + :non-word (charsets/predefined-regex-classes \W) + :whitespace whitespace-charset + :non-whitespace (charsets/difference + (charsets/intersection charsets/all-unicode + (charsets/range "\u0000" "\uFFFF")) + whitespace-charset) + :newline (charsets/singleton "\n") + :return (charsets/singleton "\r") + :tab (charsets/singleton "\t") + :form-feed (charsets/singleton "\f") + :alert (charsets/singleton "\u0007") + :escape (charsets/singleton "\u001B") + :vertical-whitespace (charsets/predefined-regex-classes \v) + :vertical-tab (charsets/singleton "\u000B") + :null (charsets/singleton "\u0000")})) + + (defn token->charset [token] + (or (get token->charset-map token) + (throw (ex-info "Unknown token type" {:token token})))) + + (defn class->charset [cls] + (reduce charsets/union* + charsets/empty + (for [c cls] + (try + (cond + (vector? c) + (let [[start end] (map str c)] + (assert (>= 0 (compare start end))) + (charsets/range start end)) + + (simple-keyword? c) + (token->charset c) + + (string? c) + (reduce charsets/union* + (map (comp charsets/singleton str) c)) + + (char? c) + (charsets/singleton (str c))) + (catch Exception e + (throw (ex-info "Failed to translate class element into charset" + {:cls cls + :element c} + e))))))) + + (defn class->gen [[op & elts :as expr]] + (let [cls (class->charset elts) + cls (case op + :not (charsets/difference charsets/all-unicode cls) + :class cls + + (throw (ex-info "Unknown character class op" {:op op})))] + (if (nat-int? (charsets/size cls)) + (gen/fmap #(charsets/nth cls %) (gen/choose 0 (dec (charsets/size cls)))) + (throw (ex-info "Can't generate empty class" {:expr expr}))))) + + (defmethod regal-gen/-generator :not + [r _opts] + (class->gen r)) + + (defmethod regal-gen/-generator :class + [r _opts] + (class->gen r)))) +#_ +(test-cases) diff --git a/test-resources/lib_tests/lambdaisland/regal_test.cljc b/test-resources/lib_tests/lambdaisland/regal_test.cljc new file mode 100644 index 00000000..cdc14b74 --- /dev/null +++ b/test-resources/lib_tests/lambdaisland/regal_test.cljc @@ -0,0 +1,174 @@ +(ns lambdaisland.regal-test + (:require [lambdaisland.regal :as regal] + [lambdaisland.regal.spec-alpha] + [lambdaisland.regal.generator :as regal-gen] + [lambdaisland.regal.test-util :as test-util] + ;; BB-TEST-PATCH: bb can't load ns + #_[lambdaisland.regal.parse :as parse] + [clojure.spec.test.alpha :as stest] + [clojure.test :refer [deftest testing is are]] + [clojure.spec.alpha :as s])) + +(stest/instrument `regal/regex) + +(deftest regex-test + (is (= "abc" + (regal/pattern [:cat "a" "b" "c"]))) + + (is (= "a|b|c" + (regal/pattern [:alt "a" "b" "c"]))) + + (is (= "a*" + (regal/pattern [:* "a"]))) + + (is (= "(?:ab)*" + (regal/pattern [:* "ab"]))) + + (is (= "(?:ab)*" + (regal/pattern [:* "a" "b"]))) + + (is (= "(?:a|b)*" + (regal/pattern [:* [:alt "a" "b"]]))) + + (is (= "a*?" + (regal/pattern [:*? "a"]))) + + (is (= "(?:ab)*?" + (regal/pattern [:*? "ab"]))) + + (is (= "(?:ab)*?" + (regal/pattern [:*? "a" "b"]))) + + (is (= "(?:a|b)*?" + (regal/pattern [:*? [:alt "a" "b"]]))) + + (is (= "a+" + (regal/pattern [:+ "a"]))) + + (is (= "a+?" + (regal/pattern [:+? "a"]))) + + (is (= "a?" + (regal/pattern [:? "a"]))) + + (is (= "a??" + (regal/pattern [:?? "a"]))) + + (is (= "[a-z0-9_\\-]" + (regal/pattern [:class [\a \z] [\0 \9] \_ \-]))) + + (is (= "[^a-z0-9_\\-]" + (regal/pattern [:not [\a \z] [\0 \9] \_ \-]))) + + (is (= "a{3,5}" + (regal/pattern [:repeat \a 3 5]))) + + (regal/with-flavor :ecma + (is (= "^a$" + (regal/pattern [:cat :start \a :end])))) + + (regal/with-flavor :java + (is (= "^a$" + (regal/pattern [:cat :start \a :end])))) + + (is (= "a(?:b|c)" + (regal/pattern [:cat "a" [:alt "b" "c"]]))) + + (is (= "(abc)" + (regal/pattern [:capture "abc"]))) + + (is (= "a(b|c)" + (regal/pattern [:cat "a" [:capture [:alt "b" "c"]]])))) + +(deftest escape-test + (are [in out] (= out (regal/escape in)) + "$" "\\$" + "(" "\\(" + ")" "\\)" + "*" "\\*" + "+" "\\+" + "." "\\." + "?" "\\?" + "[" "\\[" + "]" "\\]" + "\\" "\\\\" + "^" "\\^" + "{" "\\{" + "|" "\\|" + "}" "\\}")) + + +(def flavors [:java8 :java9 :ecma :re2]) + +(def parseable-flavor? #{:java8 :java9 :ecma}) + +(deftest data-based-tests + (doseq [{:keys [id cases]} (test-util/test-cases) + {:keys [form pattern equivalent tests] :as test-case} cases + :let [skip? (set (when (map? pattern) + (for [flavor flavors + :when (= (get pattern flavor :skip) :skip)] + flavor))) + throws? (set (when (map? pattern) + (for [[flavor p] pattern + :when (and (vector? p) (= (first p) :throws))] + flavor)))]] + + (testing (str (pr-str form) " -> " (pr-str pattern)) + (is (s/valid? ::regal/form form)) + + (doseq [flavor flavors + :when (not (skip? flavor)) + :let [pattern (if (map? pattern) + (some pattern (test-util/flavor-parents flavor)) + pattern)]] + (if (throws? flavor) + (testing (str "Generating pattern throws (" (name id) ") " (pr-str form) " (" flavor ")") + (if-some [msg (second pattern)] + (is (thrown-with-msg? #?(:clj Exception + :cljs js/Error) (re-pattern msg) + (regal/with-flavor flavor + (regal/pattern form)))) + (is (thrown? #?(:clj Exception + :cljs js/Error) + (regal/with-flavor flavor + (regal/pattern form)))))) + (testing (str "Generated pattern is correct (" (name id) ") " (pr-str form) " (" flavor ")") + (regal/with-flavor flavor + (is (= pattern (regal/pattern form)))))) + + ;; BB-TEST-PATCH: Uses ns that can't load + #_(when (and (parseable-flavor? flavor) + (not-any? (comp :no-parse meta) [test-case cases])) + (testing (str "Pattern parses correctly (" (name id) ") " (pr-str pattern) " (" flavor ")") + (regal/with-flavor flavor + (is (= form (parse/parse-pattern pattern))))))) + + (doseq [[input match] tests] + (testing (str "Test case " (pr-str form) " matches " (pr-str input)) + + (testing "Generated pattern matches" + (is (= match (re-find (regal/regex form) input)))) + ;; BB-TEST-PATCH: Uses ns that can't load + #_(:clj + (when-not (or (skip? :re2) (throws? :re2)) + (testing "Generated pattern matches (re2)" + (is (= match (test-util/re2-find (regal/with-flavor :re2 + (test-util/re2-compile + (regal/pattern form))) + input)))))) + + (doseq [pattern (if (map? equivalent) + (some equivalent (test-util/flavor-parents (regal/runtime-flavor))) + equivalent)] + (testing (str "Alternative equivalent pattern " (pr-str pattern) " matches") + (is (= match (re-find (regal/compile pattern) input))))))) + + (testing (str "creating a generator does not throw exception " (pr-str form)) + (is (regal-gen/gen form))) + + ;; We should do this with proper properties so we get shrinking, just a + ;; basic check for now + (testing (str "generated strings match the given pattern " (pr-str form)) + (doseq [s (regal-gen/sample form)] + (is (re-find (regal/regex form) s))))))) diff --git a/test-resources/lib_tests/markdown/md_test.cljc b/test-resources/lib_tests/markdown/md_test.cljc new file mode 100644 index 00000000..b2279d00 --- /dev/null +++ b/test-resources/lib_tests/markdown/md_test.cljc @@ -0,0 +1,450 @@ +(ns markdown.md-test + (:require #?(:cljs [goog.string]) + [clojure.test :refer [deftest is]] + [markdown.core :as markdown] + [markdown.tables :as tables])) + +(def entry-function + #?(:clj markdown/md-to-html-string + :cljs markdown/md->html)) + +(deftest heading1 + (is (= "

Ticket #123

" (entry-function "# Ticket #123"))) + (is (= "

Foo

" (entry-function " # Foo"))) + (is (= "

foo

" (entry-function "#foo"))) + (is (= "

foo

" (entry-function "foo\n==="))) + (is (= "

foo

" (entry-function "#foo#"))) + (is (= "

foo

" (entry-function "#foo#\n"))) + (is (= "

some header with_an_underscore

" + (entry-function "# some header `with_an_underscore`"))) + (is (= "
  • one

heading1

" + (entry-function "* one\n\nheading1\n========\n")))) + +(deftest heading2 + (is (= "

foo

" (entry-function "##foo"))) + (is (= "

foo

" (entry-function "foo\n---"))) + (is (= "

foo

" (entry-function "##foo##"))) + (is (= "

foo

" (entry-function "##foo##\n")))) + +(deftest heading-with-complex-anchor + (is (= + "

foo bar BAz

some text

" + (entry-function "###foo bar BAz\nsome text" :heading-anchors true))) + (is (= + "

foo bar BAz

some text

" + (entry-function "###foo bar BAz##\nsome text" :heading-anchors true)))) + +(deftest br + (is (= "

foo

" (entry-function "foo ")))) + +(deftest hr + (is (= "
" (entry-function "***"))) + (is (= "
" (entry-function " * * * "))) + (is (= "
" (entry-function " *****"))) + (is (= "
" (entry-function "- - - ")))) + +(deftest em + (is (= "

foo

" (entry-function "*foo*")))) + +(deftest italics + (is (= "

foo

" (entry-function "_foo_")))) + +(deftest strong + (is (= "

foo

" (entry-function "**foo**")))) + +(deftest bold-italics + (is (= "

foo

" (entry-function "***foo***")))) + +(deftest bold + (is (= "

foo

" (entry-function "__foo__")))) + +(deftest strong-inside-em + (is (= "

foobarbaz

" (entry-function "*foo**bar**baz*")))) + +(deftest bold-inside-a-list + (is (= "
  1. chickens.

See more: Cluck Cluck

" + (entry-function "1. chickens. \n\n **See more: [Cluck Cluck](http://cluck.cluck.com)** \n\n")))) + +(deftest em-inside-strong + (is (= "

foobarbaz

" (entry-function "**foo*bar*baz**")))) + +(deftest paragraph + (is (= "

Lorem ipsum dolor sit amet, consectetur adipisicing elit, sed do eiusmod tempor incididunt ut labore

" + (entry-function "\nLorem ipsum dolor sit amet, consectetur adipisicing elit, sed do eiusmod tempor incididunt ut labore")))) + +(deftest paragraph-multiline + (is (= "

Lorem ipsum dolor sit amet, consectetur adipisicing elit, sed do eiusmod tempor incididunt ut labore

" + (entry-function "\nLorem ipsum dolor\nsit amet, consectetur adipisicing elit,\nsed do eiusmod tempor incididunt ut labore")))) + +(deftest paragraph-before-codeblock + (is (= "

foo

bar\n

baz

" + (entry-function "foo\n```\nbar\n```\nbaz"))) + (is (= "
foo  \nbar
" (entry-function "```\nfoo \nbar```"))) + (is (= "

" (entry-function "```\n```"))) + (is (= "

" (entry-function "```go\n```"))) + (is (= "
<html>\n</html>\n
" (entry-function "```\n\n\n``` ")))) + +(deftest paragraph-after-codeblock + (is (= "
foo\n

bar baz

" + (entry-function "```\nfoo\n```\nbar\nbaz")))) + +(deftest mulitple-paragraphs + (is (= "

foo bar baz

foo bar baz

" + (entry-function "\nfoo bar baz\n\n\nfoo bar baz")))) + +(deftest ul + (is (= "
  • foo
  • bar
  • baz
" + (entry-function "* foo\n* bar\n* baz"))) + (is (= "
  • foo
  • bar
  • baz
" + (entry-function "- foo\n- bar\n- baz"))) + (is (= "
  • foo
  • bar
  • baz
" + (entry-function "+ foo\n+ bar\n+ baz")))) + +(deftest list-in-a-codeblock + (is + (= "
list:\n- 1\n- 2\n
" + (entry-function "```yaml\nlist:\n- 1\n- 2\n```")))) + +(deftest ul-followed-by-paragraph + (is (= "
  • foo
  • bar
  • baz

paragraph next line

" + (entry-function "* foo\n* bar\n* baz\n\nparagraph\nnext line")))) + +(deftest ul-with-codeblock + (is (= "
  • foo
  • bar
      (defn foo []\n  bar)\n  
  • baz
  • more text
" + (entry-function + "\n* foo\n* bar\n ```\n (defn foo []\n bar)\n ```\n* baz\n* more text\n"))) + (is (= "
  • foo
  • bar
      (defn foo []\n  bar)\n  
    text
  • baz
  • more text
" + (entry-function + "\n* foo\n* bar\n ```\n (defn foo []\n bar)\n ```\n text\n* baz\n* more text\n")))) + +(deftest ul-followed-by-multiline-paragraph + (is (= "
  • foo
  • bar
  • baz

paragraph

" + (entry-function "* foo\n* bar\n* baz\n\nparagraph")))) + +(deftest ul-nested + (is (= "
  • first item
    • first sub-item
      • second sub-item
    • third sub-item
  • second item
    • first sub-item
    • second sub-item
  • third item
" + (entry-function "* first item\n * first sub-item\n * second sub-item\n * third sub-item\n* second item\n * first sub-item\n * second sub-item\n* third item"))) + (is (= "
  • first item
    • first sub-item
      • second sub-item
    • third sub-item
  • second item
    • first sub-item
    • second sub-item
  • third item
" + (entry-function "* first item\n - first sub-item\n - second sub-item\n - third sub-item\n* second item\n + first sub-item\n + second sub-item\n* third item"))) + (is (= "
  • abc
  • def
" (entry-function " * abc\n\n+ def")))) + +(deftest ol + (is (= "
  1. Foo
  2. Bar
  3. Baz
" + (entry-function "1. Foo\n2. Bar\n3. Baz")))) + +(deftest ul-in-ol + (is (= "
  1. Bar
    1. Subbar
      • foo
      • bar
      • baz
  2. Baz
" + (entry-function "1. Bar\n 2. Subbar\n * foo\n * bar\n * baz\n3. Baz")))) + +(deftest ol-in-ul + (is (= "
  • Foo
    1. Bar
      1. Subbar
  • Baz
" + (entry-function "* Foo\n 1. Bar\n 1. Subbar\n* Baz"))) + (is (= "
  • Foo
    1. Bar
" + (entry-function "* Foo\n 1. Bar")))) + +(deftest multilist + (is (= + "
  • foo
  • bar
    • baz
      1. foo
      2. bar
    • fuzz
      • blah
      • blue
  • brass
" + (entry-function + "* foo +* bar + + * baz + 1. foo + 2. bar + + * fuzz + + * blah + * blue +* brass")))) + +(deftest code + (is (= "

foo bar baz x = y + z; foo

" + (entry-function "foo bar baz `x = y + z;` foo"))) + (is (= "

bar foo --- -- bar foo

" + (entry-function "bar `foo --- -- bar` foo"))) + (is (= "

<?xml version='1.0' encoding='UTF-8'?><channel></channel>

" + (entry-function "``"))) + (is (= "

foo bar baz (fn [x & xs] (str "x:" x)) foo

" + (entry-function "foo bar baz `(fn [x & xs] (str \"x:\" x))` foo"))) + (is (= "
```\nfoo\n```
" + (entry-function " ```\n foo\n ```")))) + +(deftest multiline-code + (is (= "
x = 5\ny = 6\nz = x + y
" + (entry-function " x = 5\n y = 6\n z = x + y"))) + (is (= "
x = 5\ny = 6\nz = x + y\n(fn [x & xs] (str "x"))
" + (entry-function " x = 5\n y = 6\n z = x + y\n (fn [x & xs] (str \"x\"))")))) + +(deftest codeblock + (is (= "
(defn- write^ [writer text]\n  (doseq [c text]\n    (.write writer (int c))))\n
" + (entry-function "```\n(defn- write^ [writer text]\n (doseq [c text]\n (.write writer (int c))))\n```"))) + (is (= "
(fn [x & xs]\n  (str "x"))\n
" + (entry-function "```\n(fn [x & xs]\n (str \"x\"))\n```"))) + (is (= "
(fn [x & xs]\n  (str "x"))\n
" + (entry-function "```\n(fn [x & xs]\n (str \"x\"))\n```"))) + (is (= "
(fn [x & xs]\n  (str "x"))\n
" + (entry-function "```clojure\n(fn [x & xs]\n (str \"x\"))\n```"))) + (is (= "
------------\n============\n    ------------\n    ============\n
" + (entry-function + " +```nohighlight +------------ +============ + ------------ + ============ +``` +")))) + +(deftest indented-codeblock + (is (= "
foo
" + (entry-function " foo"))) + (is (= "
foo

bar

" + (entry-function " foo\n\nbar"))) + (is (= "
foo
bar" + (entry-function " foo\nbar"))) + (is (= "

baz foo

bar

" + (entry-function "baz\n foo\n\nbar"))) + (is (= "

Element #1

" + (entry-function "
\n
\n

Element #1

\n
\n
")))) + +(deftest strikethrough + (is (= "

foo

" + (entry-function "~~foo~~")))) + +(deftest superscript + (is (= "

foobar baz

" + (entry-function "foo^bar baz")))) + +(deftest link + (is (= "

underscoresarefine

" + (entry-function "underscores_are_fine"))) + (is (= "

github

" + (entry-function "[github](http://github.com)"))) + (is (= "

github

" + (entry-function "[github](http://github.com/~)"))) + (is (= "

github

" + (entry-function "[github](http://github.com/^)"))) + (is (= "

github

" + (entry-function "[github](http://github.com/*)"))) + (is (= "" + (entry-function "* [github](http://github.com/*)"))) + (is (= "
  • hi

a link

" + (entry-function "* hi\n\n[a link](https://see-here)"))) + (is (= "

>!

" + (entry-function "[>!](https://clojure.github.io/core.async/#clojure.core.async/>!)"))) + (is (= "

" + (entry-function "[github

" + (entry-function "[*github*](http://github.com)"))) + (is (= "

github

" + (entry-function "[_github_](http://github.com)"))) + (is (= "

github

" + (entry-function "[__github__](http://github.com)"))) + (is (= "

github

" + (entry-function "[**github**](http://github.com)"))) + (is (= "

github

" + (entry-function "[~~github~~](http://github.com)")))) + +(deftest img + (is (= "

\"Alt

" + (entry-function "![Alt text](/path/to/img.jpg)"))) + (is (= "

\"Alt

" + (entry-function "![Alt text](/path/to/_img_.jpg \"Optional Title\")")))) + +(deftest img-link + (is (= "

\"Continuous

" + (entry-function "[![Continuous Integration status](https://secure.travis-ci.org/yogthos/markdown-clj.png)](http://travis-ci.org/yogthos/markdown-clj)"))) + (is (= "

\"\"

" + (entry-function "![](https://secure.travis-ci.org/yogthos/markdown-clj.png)")))) + +(deftest bad-link + (is (= "

[github](http://github.comfooo

" + (entry-function "[github](http://github.comfooo"))) + (is (= "

[github] no way (http://github.com)

" + (entry-function "[github] no way (http://github.com)")))) + +(deftest bad-link-title + (is (= "

[github(http://github.comfooo)

" + (entry-function "[github(http://github.comfooo)")))) + +(deftest blockquote + (is (= "

Foo bar baz

" + (entry-function ">Foo bar baz")))) + +(deftest blockquote-footer + (is (= "

Foo bar baz

Leo Tolstoy
" + (entry-function "> Foo bar baz\n>- Leo Tolstoy")))) + +(deftest blockquote-empty-footer + (is (= "

Foo bar baz

" + (entry-function "> Foo bar baz\n>-")))) + +(deftest blockquote-multiline-without-leading-angle-bracket + (is (= "

Foo bar baz

" + (entry-function "> Foo bar\nbaz")))) + +(deftest blockquote-multiple-paragraphs + (is (= "

Foo bar

baz

" + (entry-function "> Foo bar\n>\n> baz")))) + +(deftest blockquote-bullets + (is (= "

list:

  • foo
  • bar

end.

" + (entry-function "> list:\n>* foo\n>* bar\n\nend."))) + (is (= "

  • foo
  • bar
  • baz

" + (entry-function ">* foo\n>* bar\n>* baz")))) + +(deftest blockquote-headings + (is (= "

Foo

bar baz

" + (entry-function "> ## Foo\n>bar baz"))) + (is (= "

Foo

bar

baz

" + (entry-function "> Foo\n>## bar\n> baz")))) + +(deftest escaped-characters + (is + (= "

^*‘_{}[]footestbar{x}[y]

" + (entry-function "\\^\\*\\`\\_\\{\\}\\[\\]*foo*`test`_bar_{x}[y]")))) + +(deftest paragraph-after-list + (is (= "
  1. a
  2. b

test bold and italic

" + (entry-function "1. a\n2. b\n\ntest **bold** and *italic*")))) + +(deftest paragraph-close-before-list + (is (= "

in paragraph

  • list
" + (entry-function "in paragraph\n- list")))) + +(deftest autourl + (is (= "

http://example.com/

" + (entry-function ""))) + + (is (= "

Some content with a http://www.google.com/abc__123__efg link it in

" + (entry-function "Some content with a link it in"))) + + (is (= "

http://foo https://bar/baz foo bar

" + (entry-function " foo bar"))) + + #?(:bb nil :org.babashka/nbb nil + :default + (is (= "

abc@google.com

" + (#?(:clj org.apache.commons.lang.StringEscapeUtils/unescapeHtml + :cljs goog.string/unescapeEntities) + (entry-function ""))))) + + #?(:bb nil :org.babashka/nbb nil + :default + (is (= "

abc_def_ghi@google.com

" + (#?(:clj org.apache.commons.lang.StringEscapeUtils/unescapeHtml + :cljs goog.string/unescapeEntities) + (entry-function "")))))) + +(deftest not-a-list + (is (= "

The fish was 192.8 lbs and was amazing to see.

" + (entry-function "The fish was\n192.8 lbs and was amazing to see.")))) + +(deftest dont-encode-chars-in-hrefs + (is (= "

example_link with tilde ~ and carat ^ and splat *

" + (entry-function "[example_link with tilde ~ and carat ^ and splat *](http://www.google.com/example_link_foo~_^*)")))) + +(deftest complex-link-with-terminal-encoding-inside-header + (is (= "

With a link the contents of the_link

" + (entry-function "##With a link [the contents of the_link](http://a.com/under_score_in_the_link/)")))) + +(deftest two-links-tests-link-processing + (is (= "

When you have a pair of links link1 and you want both Wow

" + (entry-function "## When you have a pair of links [link1](http://123.com/1) and you want both [Wow](That%27s%20crazy)")))) + +(deftest link-then-image-processing + (is (= "

You can have a link followed by an image \"\"

" + (entry-function "You can have a [link](github.com) followed by an image ![](img.png)")))) + +(deftest image-then-link-processing + (is (= "

You can have an image \"\" followed by a link

" + (entry-function "You can have an image ![](img.png) followed by a [link](github.com)")))) + +(deftest link-with-optional-title + (is (= "

Cryogens site

" + (entry-function "[Cryogens site](https://github.com/cryogen-project/cryogen \"Cryogen Github\")")))) + +(deftest parse-table-row + (is (= (tables/parse-table-row "| table cell contents |") [{:text "table cell contents"}])) + (is (= (tables/parse-table-row "| contents 1 | contents 2 | contents 3 | contents 4 |") + [{:text "contents 1"} {:text "contents 2"} {:text "contents 3"} {:text "contents 4"}]))) + +(deftest table-row->str + (is (= (tables/table-row->str + [{:text "contents 1"} {:text "contents 2"} {:text "contents 3"} {:text "contents 4"}] + true) + "contents 1contents 2contents 3contents 4")) + (is (= (tables/table-row->str + [{:text "contents 1"} {:text "contents 2"} {:text "contents 3"} {:text "contents 4"}] + false) + "contents 1contents 2contents 3contents 4")) + (is (= (tables/table-row->str + [{:text "contents 1" :alignment :left} + {:text "contents 2" :alignment :center} + {:text "contents 3" :alignment :right} + {:text "contents 4"}] + false) + "contents 1contents 2contents 3contents 4"))) + +(deftest table->str + (is (= (tables/table->str + {:alignment-seq + [{:alignment :left} {:alignment :center} {:alignment :right} {:alignment nil}] + :data [[{:text "Header 1"} + {:text "Header 2"} + {:text "Header 3"} + {:text "Header 4"}] + [{:text "contents 1"} + {:text "contents 2"} + {:text "contents 3"} + {:text "contents 4"}]]}) + "
Header 1Header 2Header 3Header 4
contents 1contents 2contents 3contents 4
"))) + +(deftest divider-seq->alignment + (is (= (tables/divider-seq->alignment + [{:text "-----"} {:text ":-----"} {:text "-----:"} {:text ":-----:"}]) + [nil {:alignment :left} {:alignment :right} {:alignment :center}]))) + +(deftest n-dash + (is (= "

boo – bar

" (entry-function "boo -- bar")))) + +(deftest m-dash + (is (= "

boo — bar

" (entry-function "boo --- bar")))) + +(deftest inhibit-simple + (is (= "

_abc_

" (entry-function "$_abc_$" :inhibit-separator "$")))) + +(deftest inhibit-simple-seq + (is (= "

_abc_

" (entry-function "$_abc_$" :inhibit-separator [\$])))) + +(deftest inhibit-inline-code + (is (= "

`abc`

" (entry-function "$`abc`$" :inhibit-separator [\$])))) + +(deftest inhibit-inside-code + (is (= "

a*b* & dc

" (entry-function "`a$*b* & d$c`" :inhibit-separator "$")))) + +(deftest inhibit-across-backticks + (is (= "

one` `two

" (entry-function "`one$` `$two`" :inhibit-separator "$")))) + +(deftest inhibit-escape + (is (= "

$

" (entry-function "$$" :inhibit-separator [\$])))) + +(deftest inhibit-escape-twice + (is (= "

$$

" (entry-function "$$$$" :inhibit-separator "$")))) + +(deftest img-reprocess + (is (= "

\"Text\" and Edit

" + (entry-function "![Text](img.jpg) and [Edit](#)")))) + +(deftest dont-inhibit-text-within-escapes + (is (= "

$abc$

" (entry-function "$$*abc*$$" :inhibit-separator "$")))) + +(deftest inhibit-escape-inside-code + (is (= "

$

" (entry-function "`$$`" :inhibit-separator "$")))) + +(deftest whitespace-paragraphs + (is (= "

foo

bar

" (entry-function "foo\n \nbar")))) diff --git a/test-resources/lib_tests/markdown/nbb_runner.cljs b/test-resources/lib_tests/markdown/nbb_runner.cljs new file mode 100644 index 00000000..ec9bffa0 --- /dev/null +++ b/test-resources/lib_tests/markdown/nbb_runner.cljs @@ -0,0 +1,10 @@ +(ns nbb-runner + (:require [clojure.string :as str] + [clojure.test :refer [run-tests]] + [nbb.classpath :as cp])) + +(cp/add-classpath (str/join ":" ["src/cljs" "src/cljc" "test"])) + +(require '[markdown.md-test]) + +(run-tests 'markdown.md-test) diff --git a/test-resources/lib_tests/markdown/runner.cljs b/test-resources/lib_tests/markdown/runner.cljs new file mode 100644 index 00000000..aa2cf9f4 --- /dev/null +++ b/test-resources/lib_tests/markdown/runner.cljs @@ -0,0 +1,5 @@ +(ns markdown.runner + (:require [doo.runner :refer-macros [doo-tests]] + [markdown.md-test])) + +(doo-tests 'markdown.md-test) diff --git a/test-resources/lib_tests/medley/core_test.cljc b/test-resources/lib_tests/medley/core_test.cljc new file mode 100644 index 00000000..98f6c505 --- /dev/null +++ b/test-resources/lib_tests/medley/core_test.cljc @@ -0,0 +1,409 @@ +(ns medley.core-test + #?(:clj (:import [clojure.lang ArityException])) + (:require #?(:clj [clojure.test :refer :all] + :cljs [cljs.test :refer-macros [deftest is testing]]) + [medley.core :as m])) + +(deftest test-find-first + (testing "sequences" + (is (= (m/find-first even? [7 3 3 2 8]) 2)) + (is (nil? (m/find-first even? [7 3 3 7 3])))) + (testing "transducers" + (is (= (transduce (m/find-first even?) + 0 [7 3 3 2 8]) 2)) + (is (= (transduce (m/find-first even?) + 0 [7 3 3 7 3]) 0)))) + +(deftest test-dissoc-in + (is (= (m/dissoc-in {:a {:b {:c 1 :d 2}}} [:a :b :c]) + {:a {:b {:d 2}}})) + (is (= (m/dissoc-in {:a {:b {:c 1}}} [:a :b :c]) + {})) + (is (= (m/dissoc-in {:a {:b {:c 1} :d 2}} [:a :b :c]) + {:a {:d 2}})) + (is (= (m/dissoc-in {:a {:b {:c 1} :d 2} :b {:c {:d 2 :e 3}}} [:a :b :c] [:b :c :d]) + {:a {:d 2} :b {:c {:e 3}}})) + (is (= (m/dissoc-in {:a 1} []) + {:a 1}))) + +(deftest test-assoc-some + (is (= (m/assoc-some {:a 1} :b 2) {:a 1 :b 2})) + (is (= (m/assoc-some {:a 1} :b nil) {:a 1})) + (is (= (m/assoc-some {:a 1} :b 2 :c nil :d 3) {:a 1 :b 2 :d 3}))) + +(deftest test-update-existing + (is (= (m/update-existing {:a 1} :a inc) {:a 2})) + (is (= (m/update-existing {:a 1 :b 2} :a inc) {:a 2 :b 2})) + (is (= (m/update-existing {:b 2} :a inc) {:b 2})) + (is (= (m/update-existing {:a nil} :a str) {:a ""})) + (is (= (m/update-existing {} :a str) {}))) + +(deftest test-update-existing-in + (is (= (m/update-existing-in {:a 1} [:a] inc) {:a 2})) + (is (= (m/update-existing-in {:a 1 :b 2} [:a] inc) {:a 2 :b 2})) + (is (= (m/update-existing-in {:b 2} [:a] inc) {:b 2})) + (is (= (m/update-existing-in {:a nil} [:a] str) {:a ""})) + (is (= (m/update-existing-in {} [:a] str) {})) + (is (= (m/update-existing-in {:a [:b {:c 42} :d]} [:a 1 :c] inc) + {:a [:b {:c 43} :d]})) + (is (= (m/update-existing-in {:a [:b {:c 42} :d]} [:a 1 :c] + 7) + {:a [:b {:c 49} :d]})) + (is (= (m/update-existing-in {:a [:b {:c 42} :d]} [:a 1 :c] + 3 4) + {:a [:b {:c 49} :d]})) + (is (= (m/update-existing-in {:a [:b {:c 42} :d]} [:a 1 :c] + 3 3 1) + {:a [:b {:c 49} :d]})) + (is (= (m/update-existing-in {:a [:b {:c 42} :d]} [:a 1 :c] vector 9 10 11 12 13 14) + {:a [:b {:c [42 9 10 11 12 13 14]} :d]}))) + +(deftest test-map-entry + (is (= (key (m/map-entry :a 1)) :a)) + (is (= (val (m/map-entry :a 1)) 1)) + (is (= (first (m/map-entry :a 1)) :a)) + (is (= (second (m/map-entry :a 1)) 1)) + (is (= (type (m/map-entry :a 1)) + (type (first {:a 1}))))) + +(defrecord MyRecord [x]) + +(deftest test-map-kv + (is (= (m/map-kv (fn [k v] [(name k) (inc v)]) {:a 1 :b 2}) + {"a" 2 "b" 3})) + (is (= (m/map-kv (fn [k v] [(name k) (inc v)]) (sorted-map :a 1 :b 2)) + {"a" 2 "b" 3})) + (is (= (m/map-kv (fn [k v] (m/map-entry (name k) (inc v))) {:a 1 :b 2}) + {"a" 2 "b" 3})) + (testing "map-kv with record" + (is (= (m/map-kv (fn [k v] (m/map-entry (name k) (inc v))) (->MyRecord 1)) {"x" 2})))) + +(deftest test-map-keys + (is (= (m/map-keys name {:a 1 :b 2}) + {"a" 1 "b" 2})) + (is (= (m/map-keys name (sorted-map :a 1 :b 2)) + (sorted-map "a" 1 "b" 2))) + (testing "map-keys with record" + (is (= (m/map-keys name (->MyRecord 1)) {"x" 1})))) + +(deftest test-map-vals + (is (= (m/map-vals inc {:a 1 :b 2}) + {:a 2 :b 3})) + (is (= (m/map-vals inc (sorted-map :a 1 :b 2)) + (sorted-map :a 2 :b 3))) + (testing "map-vals with record" + (is (= (m/map-vals inc (->MyRecord 1)) {:x 2}))) + (testing "multiple collections" + (is (= (m/map-vals + {:a 1 :b 2 :c 3} {:a 4 :c 5 :d 6}) + {:a 5, :c 8})) + (is (= (m/map-vals min + (sorted-map :z 10 :y 8 :x 4) + {:x 7, :y 14, :z 13} + {:x 11, :y 6, :z 9} + {:x 19, :y 3, :z 2} + {:x 4, :y 0, :z 16} + {:x 17, :y 14, :z 13}) + (sorted-map :x 4 :y 0 :z 2))) + (is (= (m/map-vals #(%1 %2) {:a nil? :b some?} {:b nil}) + {:b false})))) + +(deftest test-map-kv-keys + (is (= (m/map-kv-keys + {1 2, 2 4}) + {3 2, 6 4})) + (is (= (m/map-kv-keys + (sorted-map 1 2, 2 4)) + (sorted-map 3 2, 6 4))) + (is (= (m/map-kv-keys str (->MyRecord 1)) + {":x1" 1}))) + +(deftest test-map-kv-vals + (is (= (m/map-kv-vals + {1 2, 2 4}) + {1 3, 2 6})) + (is (= (m/map-kv-vals + (sorted-map 1 2, 2 4)) + (sorted-map 1 3, 2 6))) + (is (= (m/map-kv-vals str (->MyRecord 1)) + {:x ":x1"}))) + +(deftest test-filter-kv + (is (= (m/filter-kv (fn [k v] (and (keyword? k) (number? v))) {"a" 1 :b 2 :c "d"}) + {:b 2})) + (is (= (m/filter-kv (fn [k v] (= v 2)) (sorted-map "a" 1 "b" 2)) + (sorted-map "b" 2)))) + +(deftest test-filter-keys + (is (= (m/filter-keys keyword? {"a" 1 :b 2}) + {:b 2})) + (is (= (m/filter-keys #(re-find #"^b" %) (sorted-map "a" 1 "b" 2)) + (sorted-map "b" 2)))) + +(deftest test-filter-vals + (is (= (m/filter-vals even? {:a 1 :b 2}) + {:b 2})) + (is (= (m/filter-vals even? (sorted-map :a 1 :b 2)) + (sorted-map :b 2)))) + +(deftest test-remove-kv + (is (= (m/remove-kv (fn [k v] (and (keyword? k) (number? v))) {"a" 1 :b 2 :c "d"}) + {"a" 1 :c "d"})) + (is (= (m/remove-kv (fn [k v] (= v 2)) (sorted-map "a" 1 "b" 2)) + (sorted-map "a" 1)))) + +(deftest test-remove-keys + (is (= (m/remove-keys keyword? {"a" 1 :b 2}) + {"a" 1})) + (is (= (m/remove-keys #(re-find #"^b" %) (sorted-map "a" 1 "b" 2)) + {"a" 1}))) + +(deftest test-remove-vals + (is (= (m/remove-vals even? {:a 1 :b 2}) + {:a 1})) + (is (= (m/remove-keys #(re-find #"^b" %) (sorted-map "a" 1 "b" 2)) + {"a" 1}))) + +(deftest test-queue + (testing "empty" + #?(:clj (is (instance? clojure.lang.PersistentQueue (m/queue))) + :cljs (is (instance? cljs.core.PersistentQueue (m/queue)))) + (is (empty? (m/queue)))) + (testing "not empty" + #?(:clj (is (instance? clojure.lang.PersistentQueue (m/queue [1 2 3]))) + :cljs (is (instance? cljs.core.PersistentQueue (m/queue [1 2 3])))) + (is (= (first (m/queue [1 2 3])) 1)))) + +(deftest test-queue? + #?(:clj (is (m/queue? clojure.lang.PersistentQueue/EMPTY)) + :cljs (is (m/queue? cljs.core.PersistentQueue.EMPTY))) + (is (not (m/queue? [])))) + +(deftest test-boolean? + (is (m/boolean? true)) + (is (m/boolean? false)) + (is (not (m/boolean? nil))) + (is (not (m/boolean? "foo"))) + (is (not (m/boolean? 1)))) + +(deftest test-least + (is (= (m/least) nil)) + (is (= (m/least "a") "a")) + (is (= (m/least "a" "b") "a")) + (is (= (m/least 3 2 5 -1 0 2) -1))) + +(deftest test-greatest + (is (= (m/greatest) nil)) + (is (= (m/greatest "a") "a")) + (is (= (m/greatest "a" "b") "b")) + (is (= (m/greatest 3 2 5 -1 0 2) 5))) + +(deftest test-join + (is (= (m/join [[1 2] [] [3] [4 5 6]]) [1 2 3 4 5 6])) + (is (= (m/join (sorted-map :x 1, :y 2, :z 3)) [:x 1 :y 2 :z 3])) + (let [a (atom 0) + s (m/join (iterate #(do (swap! a inc) (range (inc (count %)))) ()))] + (is (= (first s) 0)) + (is (= @a 1)) + (is (= (second s) 0)) + (is (= @a 2)))) + +(deftest test-deep-merge + (is (= (m/deep-merge) nil)) + (is (= (m/deep-merge {:a 1}) {:a 1})) + (is (= (m/deep-merge {:a 1} nil) {:a 1})) + (is (= (m/deep-merge {:a 1} {:a 2 :b 3}) {:a 2 :b 3})) + (is (= (m/deep-merge {:a {:b 1 :c 2}} {:a {:b 2 :d 3}}) {:a {:b 2 :c 2 :d 3}})) + (is (= (m/deep-merge {:a {:b 1}} {:a 1}) {:a 1})) + (is (= (m/deep-merge {:a 1} {:b 2} {:b 3 :c 4}) {:a 1 :b 3 :c 4})) + (is (= (m/deep-merge {:a {:b {:c {:d 1}}}} {:a {:b {:c {:e 2}}}}) {:a {:b {:c {:d 1 :e 2}}}})) + (is (= (m/deep-merge {:a {:b [1 2]}} {:a {:b [3 4]}}) {:a {:b [3 4]}})) + (is (= (m/deep-merge (->MyRecord 1) {:x 2}) (->MyRecord 2))) + (is (= (m/deep-merge {:a (->MyRecord 1)} {:a {:x 2 :y 3}}) {:a (map->MyRecord {:x 2 :y 3})}))) + +(deftest test-mapply + (letfn [(foo [& {:keys [bar]}] bar)] + (is (= (m/mapply foo {}) nil)) + (is (= (m/mapply foo {:baz 1}) nil)) + (is (= (m/mapply foo {:bar 1}) 1))) + (letfn [(foo [bar & {:keys [baz]}] [bar baz])] + (is (= (m/mapply foo 0 {}) [0 nil])) + (is (= (m/mapply foo 0 {:baz 1}) [0 1])) + (is (= (m/mapply foo 0 {:spam 1}) [0 nil])) + (is (= (m/mapply foo 0 nil) [0 nil])) + #?@(:clj [;; BB-TEST-PATCH: bb throws Exception + #_(is (thrown? ArityException (m/mapply foo {}))) + (is (thrown? IllegalArgumentException (m/mapply foo 0)))] + :cljs [(is (thrown? js/Error (m/mapply foo 0)))]))) + +(deftest test-index-by + (is (= (m/index-by identity [1 2 3]) {1 1, 2 2, 3 3})) + (is (= (m/index-by inc [1 2 3]) {2 1, 3 2, 4 3})) + (is (= (m/index-by first ["foo" "bar" "baz"]) {\f "foo", \b "baz"})) + (is (= (m/index-by first []) {}))) + +(deftest test-interleave-all + (is (= (m/interleave-all []) [])) + (is (= (m/interleave-all [1 2 3]) [1 2 3])) + (is (= (m/interleave-all [1 2 3] [4 5 6]) [1 4 2 5 3 6])) + (is (= (m/interleave-all [1 2 3] [4 5 6] [7 8 9]) [1 4 7 2 5 8 3 6 9])) + (is (= (m/interleave-all [1 2] [3]) [1 3 2])) + (is (= (m/interleave-all [1 2 3] [4 5]) [1 4 2 5 3])) + (is (= (m/interleave-all [1] [2 3] [4 5 6]) [1 2 4 3 5 6]))) + +(deftest test-distinct-by + (testing "sequences" + (is (= (m/distinct-by count ["a" "ab" "c" "cd" "def"]) + ["a" "ab" "def"])) + (is (= (m/distinct-by count []) + [])) + (is (= (m/distinct-by first ["foo" "faa" "boom" "bar"]) + ["foo" "boom"]))) + + (testing "transucers" + (is (= (into [] (m/distinct-by count) ["a" "ab" "c" "cd" "def"]) + ["a" "ab" "def"])) + (is (= (into [] (m/distinct-by count) []) + [])) + (is (= (into [] (m/distinct-by first) ["foo" "faa" "boom" "bar"]) + ["foo" "boom"])))) + +(deftest test-dedupe-by + (testing "sequences" + (is (= (m/dedupe-by count ["a" "b" "bc" "bcd" "cd"]) + ["a" "bc" "bcd" "cd"])) + (is (= (m/dedupe-by count []) + [])) + (is (= (m/dedupe-by first ["foo" "faa" "boom" "bar"]) + ["foo" "boom"]))) + + (testing "transucers" + (is (= (into [] (m/dedupe-by count) ["a" "b" "bc" "bcd" "cd"]) + ["a" "bc" "bcd" "cd"])) + (is (= (into [] (m/dedupe-by count) []) + [])) + (is (= (into [] (m/dedupe-by first) ["foo" "faa" "boom" "bar"]) + ["foo" "boom"])))) + +(deftest test-take-upto + (testing "sequences" + (is (= (m/take-upto zero? [1 2 3 0 4 5 6]) [1 2 3 0])) + (is (= (m/take-upto zero? [0 1 2 3 4 5 6]) [0])) + (is (= (m/take-upto zero? [1 2 3 4 5 6 7]) [1 2 3 4 5 6 7]))) + + (testing "tranducers" + (is (= (into [] (m/take-upto zero?) [1 2 3 0 4 5 6]) [1 2 3 0])) + (is (= (into [] (m/take-upto zero?) [0 1 2 3 4 5 6]) [0])) + (is (= (into [] (m/take-upto zero?) [1 2 3 4 5 6 7]) [1 2 3 4 5 6 7])) + (is (= (transduce (m/take-upto zero?) + (completing (fn [_ x] (reduced x))) + nil + [0 1 2]) + 0)))) + +(deftest test-drop-upto + (testing "sequences" + (is (= (m/drop-upto zero? [1 2 3 0 4 5 6]) [4 5 6])) + (is (= (m/drop-upto zero? [0 1 2 3 4 5 6]) [1 2 3 4 5 6])) + (is (= (m/drop-upto zero? [1 2 3 4 5 6 7]) []))) + + (testing "transducers" + (is (= (into [] (m/drop-upto zero?) [1 2 3 0 4 5 6]) [4 5 6])) + (is (= (into [] (m/drop-upto zero?) [0 1 2 3 4 5 6]) [1 2 3 4 5 6])) + (is (= (into [] (m/drop-upto zero?) [1 2 3 4 5 6 7]) [])))) + +(deftest test-indexed + (testing "sequences" + (is (= (m/indexed [:a :b :c :d]) + [[0 :a] [1 :b] [2 :c] [3 :d]])) + (is (= (m/indexed []) + []))) + + (testing "transducers" + (is (= (into [] (m/indexed) [:a :b :c :d]) + [[0 :a] [1 :b] [2 :c] [3 :d]])) + (is (= (into [] (m/indexed) []) + [])))) + +(deftest test-insert-nth + (testing "sequences" + (is (= (m/insert-nth 0 :a [1 2 3 4]) [:a 1 2 3 4])) + (is (= (m/insert-nth 1 :a [1 2 3 4]) [1 :a 2 3 4])) + (is (= (m/insert-nth 3 :a [1 2 3 4]) [1 2 3 :a 4])) + (is (= (m/insert-nth 4 :a [1 2 3 4]) [1 2 3 4 :a]))) + + (testing "transducers" + (is (= (into [] (m/insert-nth 0 :a) [1 2 3 4]) [:a 1 2 3 4])) + (is (= (into [] (m/insert-nth 1 :a) [1 2 3 4]) [1 :a 2 3 4])) + (is (= (into [] (m/insert-nth 3 :a) [1 2 3 4]) [1 2 3 :a 4])) + (is (= (into [] (m/insert-nth 4 :a) [1 2 3 4]) [1 2 3 4 :a])))) + +(deftest test-remove-nth + (testing "sequences" + (is (= (m/remove-nth 0 [1 2 3 4]) [2 3 4])) + (is (= (m/remove-nth 1 [1 2 3 4]) [1 3 4])) + (is (= (m/remove-nth 3 [1 2 3 4]) [1 2 3]))) + + (testing "transducers" + (is (= (into [] (m/remove-nth 0) [1 2 3 4]) [2 3 4])) + (is (= (into [] (m/remove-nth 1) [1 2 3 4]) [1 3 4])) + (is (= (into [] (m/remove-nth 3) [1 2 3 4]) [1 2 3])))) + +(deftest test-replace-nth + (testing "sequences" + (is (= (m/replace-nth 0 :a [1 2 3 4]) [:a 2 3 4])) + (is (= (m/replace-nth 1 :a [1 2 3 4]) [1 :a 3 4])) + (is (= (m/replace-nth 3 :a [1 2 3 4]) [1 2 3 :a]))) + + (testing "transducers" + (is (= (into [] (m/replace-nth 0 :a) [1 2 3 4]) [:a 2 3 4])) + (is (= (into [] (m/replace-nth 1 :a) [1 2 3 4]) [1 :a 3 4])) + (is (= (into [] (m/replace-nth 3 :a) [1 2 3 4]) [1 2 3 :a])))) + +(deftest test-abs + (is (= (m/abs -3) 3)) + (is (= (m/abs 2) 2)) + (is (= (m/abs -2.1) 2.1)) + (is (= (m/abs 1.8) 1.8)) + #?@(:clj [(is (= (m/abs -1/3) 1/3)) + (is (= (m/abs 1/2) 1/2)) + (is (= (m/abs 3N) 3N)) + (is (= (m/abs -4N) 4N))])) + +(deftest test-deref-swap! + (let [a (atom 0)] + (is (= (m/deref-swap! a inc) 0)) + (is (= @a 1)) + (is (= (m/deref-swap! a inc) 1)) + (is (= @a 2)))) + +(deftest test-deref-reset! + (let [a (atom 0)] + (is (= (m/deref-reset! a 3) 0)) + (is (= @a 3)) + (is (= (m/deref-reset! a 1) 3)) + (is (= @a 1)))) + +(deftest test-ex-message + (is (= (m/ex-message (ex-info "foo" {})) "foo")) + (is (= (m/ex-message (new #?(:clj Exception :cljs js/Error) "bar")) "bar"))) + +(deftest test-ex-cause + (let [cause (new #?(:clj Exception :cljs js/Error) "foo")] + (is (= (m/ex-cause (ex-info "foo" {} cause)) cause)) + #?(:clj (is (= (m/ex-cause (Exception. "foo" cause)) cause))))) + +(deftest test-uuid? + (let [x #uuid "d1a4adfa-d9cf-4aa5-9f05-a15365d1bfa6"] + (is (m/uuid? x)) + (is (not (m/uuid? 2))) + (is (not (m/uuid? (str x)))) + (is (not (m/uuid? nil))))) + +(deftest test-uuid + (let [x (m/uuid "d1a4adfa-d9cf-4aa5-9f05-a15365d1bfa6")] + (is (instance? #?(:clj java.util.UUID :cljs cljs.core.UUID) x)) + (is (= x #uuid "d1a4adfa-d9cf-4aa5-9f05-a15365d1bfa6")))) + +(deftest test-random-uuid + (let [x (m/random-uuid) + y (m/random-uuid)] + (is (instance? #?(:clj java.util.UUID :cljs cljs.core.UUID) x)) + (is (instance? #?(:clj java.util.UUID :cljs cljs.core.UUID) y)) + (is (not= x y)))) + +;; BB-TEST-PATCH: Not available yet for latest maven release +#_(deftest test-regexp? + (is (m/regexp? #"x")) + (is (not (m/regexp? "x"))) + (is (not (m/regexp? nil)))) diff --git a/test-resources/lib_tests/medley/test_runner.cljs b/test-resources/lib_tests/medley/test_runner.cljs new file mode 100644 index 00000000..4cc95109 --- /dev/null +++ b/test-resources/lib_tests/medley/test_runner.cljs @@ -0,0 +1,5 @@ +(ns medley.test-runner + (:require [doo.runner :refer-macros [doo-tests]] + [medley.core-test])) + +(doo-tests 'medley.core-test) diff --git a/test-resources/lib_tests/meta_merge/core_test.cljc b/test-resources/lib_tests/meta_merge/core_test.cljc new file mode 100644 index 00000000..a737e362 --- /dev/null +++ b/test-resources/lib_tests/meta_merge/core_test.cljc @@ -0,0 +1,57 @@ +(ns meta-merge.core-test + (:require #?(:clj [clojure.test :refer :all] + :cljs [cljs.test :refer-macros [deftest is testing]]) + [meta-merge.core :refer [meta-merge]])) + +(deftest test-meta-merge + (testing "simple merge" + (is (= (meta-merge {:a 1 :b 2} {:b 3 :c 4}) + {:a 1 :b 3 :c 4}))) + + (testing "inner map merge" + (is (= (meta-merge {:a {:b 1 :c 2}} {:a {:c 3}}) + {:a {:b 1 :c 3}}))) + + (testing "inner set merge" + (is (= (meta-merge {:a #{:b :c}} {:a #{:c :d}}) + {:a #{:b :c :d}}))) + + (testing "inner vector merge" + (is (= (meta-merge {:a [:b :c]} {:a [:d]}) + {:a [:b :c :d]}))) + + (testing "meta replace" + (is (= (meta-merge {:a [:b :c]} {:a ^:replace [:d]}) + {:a [:d]}))) + + (testing "meta displace" + (is (= (meta-merge {:a [:b :c]} {:a ^:displace [:d]}) + {:a [:b :c]}))) + + (testing "meta prepend" + (is (= (meta-merge {:a [:b :c]} {:a ^:prepend [:d]}) + {:a [:d :b :c]}))) + + (testing "deep inner merge" + (is (= (meta-merge {:a {:b {:c [:d]}}} {:a {:b {:c [:e] :f :g}}}) + {:a {:b {:c [:d :e] :f :g}}}))) + + (testing "collection type remains the same" + (is (map? (meta-merge {:a :b} {:c :d}))) + (is (vector? (meta-merge [:a :b] [:c]))) + (is (set? (meta-merge #{:a :b} #{:c}))) + (is (list? (meta-merge '(:a :b) '(:c))))) + + (testing "nil displace" + (is (= (meta-merge {:b :c} {:a ^:displace [:d]}) + {:a [:d] :b :c}))) + + (testing "varargs" + (is (= (meta-merge) + {})) + (is (= (meta-merge {:a :b}) + {:a :b})) + (is (= (meta-merge {:a :b :x 1} {:a :c :y 2} {:a :d}) + {:a :d :x 1 :y 2})) + (is (= (meta-merge {:a :b :x 1} {:a :c :y 2} {:a :d} {:y 4 :z 3}) + {:a :d :x 1 :y 4 :z 3})))) diff --git a/test-resources/lib_tests/meta_merge/test_runner.cljs b/test-resources/lib_tests/meta_merge/test_runner.cljs new file mode 100644 index 00000000..134b8e9b --- /dev/null +++ b/test-resources/lib_tests/meta_merge/test_runner.cljs @@ -0,0 +1,5 @@ +(ns meta-merge.test-runner + (:require [doo.runner :refer-macros [doo-tests]] + [meta-merge.core-test])) + +(doo-tests 'meta-merge.core-test) diff --git a/test-resources/lib_tests/minimallist/core_test.cljc b/test-resources/lib_tests/minimallist/core_test.cljc index d86176f1..1faaaa23 100644 --- a/test-resources/lib_tests/minimallist/core_test.cljc +++ b/test-resources/lib_tests/minimallist/core_test.cljc @@ -40,6 +40,16 @@ [1] [2] + (-> (h/fn int?) + (h/with-condition (h/fn odd?))) + [1] + [2] + + (-> (h/fn symbol?) + (h/with-condition (h/fn (complement #{'if 'val})))) + ['a] + ['if] + ;; enum (h/enum #{1 "2" :3}) [1 "2" :3] @@ -79,8 +89,7 @@ {:a 1, :b 'bar, [1 2 3] "soleil !"}] ;; map, keys and values - (h/map-of (h/fn keyword?) - (h/fn int?)) + (h/map-of (h/vector (h/fn keyword?) (h/fn int?))) [{} {:a 1, :b 2}] [{:a 1, :b "2"} [[:a 1] [:b 2]] {true 1, false 2}] @@ -89,6 +98,10 @@ ['(1 2 3) [1 2 3] `(1 2 ~3)] ['(1 :a) #{1 2 3} {:a 1, :b 2, :c 3}] + (h/sequence-of (h/fn char?)) + ["" "hi" "hello"] + [[1 2 3]] + ;; sequence, with condition (-> (h/sequence-of (h/fn int?)) (h/with-condition (h/fn (fn [coll] (= coll (reverse coll)))))) @@ -97,29 +110,38 @@ ;; sequence as a list (h/list-of (h/fn int?)) - ['(1 2 3)] - ['(1 :a) [1 2 3] #{1 2 3} - #_`(1 2 ~3)] ; this is not a list in cljs + ['(1 2 3) `(1 2 ~3)] + ['(1 :a) [1 2 3] #{1 2 3}] ;; sequence as a vector (h/vector-of (h/fn int?)) [[1 2 3]] [[1 :a] '(1 2 3) #{1 2 3} `(1 2 ~3)] + ;; sequence as a string + (h/string-of (h/enum (set "0123456789abcdef"))) + ["03ab4c" "cafe"] + ["coffee" [1 :a] '(1 2 3) #{1 2 3} `(1 2 ~3)] + ;; sequence with size specified using a model (-> (h/sequence-of (h/fn any?)) (h/with-count (h/enum #{2 3}))) - ['(1 2) [1 "2"] `(1 ~"2") [1 "2" :3]] - [#{1 "a"} [1 "2" :3 :4]] + ['(1 2) [1 "2"] `(1 ~"2") [1 "2" :3] "hi"] + [#{1 "a"} [1 "2" :3 :4] "hello"] ;; sequence with entries (fixed size is implied) (h/tuple (h/fn int?) (h/fn string?)) ['(1 "2") [1 "2"] `(1 ~"2")] [#{1 "a"} [1 "2" :3]] + ;; sequence with entries in a string + (h/string-tuple (h/val \a) (h/enum #{\b \c})) + ["ab" "ac"] + [[\a \b] #{\a \b}] + ;; alt (h/alt [:int (h/fn int?)] - [:strings (h/cat (h/fn string?))]) + [:strings (h/vector-of (h/fn string?))]) [1 ["1"]] [[1] "1" :1 [:1]] @@ -144,6 +166,12 @@ [[1 "2" 3] [1 :2 3] [1 ["a" :b] 3]] [[1 "a" :b 3]] + ;; cat & repeat - a color string + (-> (h/cat (h/val \#) + (h/repeat 6 6 (h/enum (set "0123456789abcdefABCDEF"))))) + ["#000000" "#af4Ea5"] + ["000000" "#cafe" "#coffee"] + ;; cat of cat, the inner cat is implicitly inlined (-> (h/cat (h/fn int?) (h/cat (h/fn int?))) @@ -163,15 +191,20 @@ [[] [1] [1 2] '() '(1) '(2 3)] [[1 2 3] '(1 2 3)] + ;; repeat - inside a list + (h/in-list (h/repeat 0 2 (h/fn int?))) + ['() '(1) '(2 3)] + [[] [1] [1 2] [1 2 3] '(1 2 3)] + ;; repeat - inside a vector (h/in-vector (h/repeat 0 2 (h/fn int?))) [[] [1] [1 2]] [[1 2 3] '() '(1) '(2 3) '(1 2 3)] - ;; repeat - inside a list - (h/in-list (h/repeat 0 2 (h/fn int?))) - ['() '(1) '(2 3)] - [[] [1] [1 2] [1 2 3] '(1 2 3)] + ;; repeat - inside a string + (h/in-string (h/repeat 4 6 (h/fn char?))) + ["hello"] + ["" "hi" [] [1] '(1 2 3)] ;; repeat - min > 0 (h/repeat 2 3 (h/fn int?)) @@ -196,6 +229,16 @@ [[[1 "a"]] [[1 "a"] [2 "b"]] ['(1 "a") [2 "b"]]] [[] [1] [1 2] [1 "a"] [1 "a" 2 "b"] [1 "a" 2 "b" 3 "c"]] + ;; char-cat & char-set + (-> (h/cat (h/char-cat "good") + (h/val \space) + (h/alt (h/char-cat "morning") + (h/char-cat "afternoon") + (h/repeat 3 10 (h/char-set "#?!@_*+%")))) + (h/in-string)) + ["good morning" "good afternoon" "good #@*+?!"] + ["good" "good " "good day"] + ;; let / ref (h/let ['pos-even? (h/and (h/fn pos-int?) (h/fn even?))] @@ -236,14 +279,24 @@ [1 1 1 "hi" "hi" "hi"]] [[1 1 "hi"] [1 "hi" "hi"] - [1 1 :no "hi" "hi"]]]] + [1 1 :no "hi" "hi"]] + ; let / ref - with shadowed local model + (h/let ['foo (h/ref 'bar) + 'bar (h/fn int?)] + (h/let ['bar (h/fn string?)] + (h/ref 'foo))) + [1] + ["hi"]]] (doseq [[model valid-coll invalid-coll] (partition 3 test-data)] (doseq [data valid-coll] (is (valid? model data))) (doseq [data invalid-coll] - (is (not (valid? model data))))))) + (is (not (valid? model data)))))) + + (is (thrown? #?(:clj Exception :cljs js/Object) + (valid? (h/let [] (h/ref 'foo)) 'bar)))) (deftest describe-test @@ -252,6 +305,16 @@ [1 1 2 :invalid] + (-> (h/fn int?) + (h/with-condition (h/fn odd?))) + [1 1 + 2 :invalid] + + (-> (h/fn symbol?) + (h/with-condition (h/fn (complement #{'if 'val})))) + ['a 'a + 'if :invalid] + ;; enum (h/enum #{1 "2" false nil}) [1 1 @@ -278,7 +341,7 @@ ;; set (h/set-of (h/fn int?)) - [#{1} #{1}] + [#{1 2} [1 2]] ;; map (h/map [:a {:optional true} (h/fn int?)] @@ -294,20 +357,29 @@ ; extra entry {:a 1, :b 2, :c 3} {:a 1, :b 2}] - ;; map-of - :keys - (h/map-of (h/fn keyword?) (h/fn any?)) - [{:a 1, :b 2} {:a 1, :b 2} + ;; map-of - entry-model + (h/map-of (h/vector (h/fn keyword?) (h/fn int?))) + [{:a 1, :b 2} [[:a 1] [:b 2]] {"a" 1} :invalid] - ;; map-of - :values - (h/map-of (h/fn any?) (h/fn int?)) - [{:a 1, "b" 2} {:a 1, "b" 2} - {:a "1"} :invalid] + ;; map-of - real world use case + (h/map-of (h/alt [:symbol (h/vector (h/fn simple-symbol?) (h/fn keyword?))] + [:keys (h/vector (h/val :keys) (h/vector-of (h/fn symbol?)))] + [:as (h/vector (h/val :as) (h/fn simple-symbol?))])) + '[{first-name :first-name + last-name :last-name + :keys [foo bar] + :as foobar} + [[:symbol [first-name :first-name]] + [:symbol [last-name :last-name]] + [:keys [:keys [foo bar]]] + [:as [:as foobar]]]] ;; sequence - :elements-model (h/sequence-of (h/fn int?)) [[1 2 3] [1 2 3] '(1 2 3) '(1 2 3) + `(1 2 3) '(1 2 3) [1 "2" 3] :invalid] ;; sequence - :elements-model with condition @@ -319,7 +391,14 @@ ;; sequence - :coll-type vector (h/vector-of (h/fn any?)) [[1 2 3] [1 2 3] - '(1 2 3) :invalid] + '(1 2 3) :invalid + `(1 2 3) :invalid] + + ;; sequence - :coll-type list + (h/list-of (h/fn any?)) + [[1 2 3] :invalid + '(1 2 3) '(1 2 3) + `(1 2 3) '(1 2 3)] ;; sequence - :entries (h/tuple (h/fn int?) (h/fn string?)) @@ -327,16 +406,27 @@ [1 2] :invalid [1] :invalid] + (h/tuple (h/fn int?) + [:text (h/fn string?)]) + [[1 "a"] {:text "a"}] + + (h/tuple [:number (h/fn int?)] + [:text (h/fn string?)]) + [[1 "a"] {:number 1, :text "a"}] + ;; sequence - :count-model (-> (h/sequence-of (h/fn any?)) (h/with-count (h/val 3))) [[1 2] :invalid [1 2 3] [1 2 3] - [1 2 3 4] :invalid] + [1 2 3 4] :invalid + "12" :invalid + "123" (into [] "123") + "1234" :invalid] ;; alt - not inside a sequence (h/alt [:number (h/fn int?)] - [:sequence (h/cat (h/fn string?))]) + [:sequence (h/vector-of (h/fn string?))]) [1 [:number 1] ["1"] [:sequence ["1"]] [1] :invalid @@ -457,4 +547,7 @@ (doseq [[model data-description-pairs] (partition 2 test-data)] (doseq [[data description] (partition 2 data-description-pairs)] (is (= [data (describe model data)] - [data description])))))) + [data description]))))) + + (is (thrown? #?(:clj Exception :cljs js/Object) + (describe (h/let [] (h/ref 'foo)) 'bar)))) diff --git a/test-resources/lib_tests/minimallist/generator_test.cljc b/test-resources/lib_tests/minimallist/generator_test.cljc new file mode 100644 index 00000000..af9f8706 --- /dev/null +++ b/test-resources/lib_tests/minimallist/generator_test.cljc @@ -0,0 +1,546 @@ +(ns minimallist.generator-test + (:require [clojure.test :refer [deftest testing is are]] + [clojure.test.check.generators :as tcg] + [clojure.string :as str] + [minimallist.core :refer [valid?]] + [minimallist.helper :as h] + [minimallist.util :as util] + [minimallist.generator :as mg :refer [gen fn-any? fn-int? fn-string? fn-char? + fn-symbol? fn-simple-symbol? fn-qualified-symbol? + fn-keyword? fn-simple-keyword? fn-qualified-keyword?]])) + +(defn- path-test-visitor [] + ;; Testing using side effects. + ;; A little ugly, but good enough for tests. + (let [paths (atom [])] + (fn + ([] @paths) + ([model stack path] + (swap! paths conj path) + model)))) + +(deftest postwalk-visit-order-test + (are [model expected-paths] + (let [visitor (path-test-visitor)] + (mg/postwalk model visitor) ; Create side effects + (= (visitor) expected-paths)) ; Collect and compare the side effects + + (h/let ['leaf (h/fn int?) + 'tree (h/ref 'leaf)] + (h/ref 'tree)) + [[:bindings 'leaf] + [:bindings 'tree] + [:body] + []] + + (h/let ['root (h/let ['leaf (h/fn int?) + 'tree (h/ref 'leaf)] + (h/ref 'tree))] + (h/ref 'root)) + [[:bindings 'root :bindings 'leaf] + [:bindings 'root :bindings 'tree] + [:bindings 'root :body] + [:bindings 'root] + [:body] + []] + + (h/let ['leaf (h/fn int?) + 'root (h/let ['tree (h/ref 'leaf)] + (h/ref 'tree))] + (h/ref 'root)) + [[:bindings 'leaf] + [:bindings 'root :bindings 'tree] + [:bindings 'root :body] + [:bindings 'root] + [:body] + []] + + ; test of no visit more than once + (h/let ['leaf (h/fn int?) + 'tree (h/tuple (h/ref 'leaf) (h/ref 'leaf))] + (h/ref 'tree)) + [[:bindings 'leaf] + [:bindings 'tree :entries 0 :model] + [:bindings 'tree :entries 1 :model] + [:bindings 'tree] + [:body] + []] + + ; test of no visit more than once, infinite loop otherwise + (h/let ['leaf (h/fn int?) + 'tree (h/tuple (h/ref 'tree) (h/ref 'leaf))] + (h/ref 'tree)) + [[:bindings 'tree :entries 0 :model] + [:bindings 'leaf] + [:bindings 'tree :entries 1 :model] + [:bindings 'tree] + [:body] + []] + + #__)) + +(deftest assoc-leaf-distance-visitor-test + (are [model expected-walked-model] + (= (-> model + (mg/postwalk mg/assoc-leaf-distance-visitor) + (util/walk-map-dissoc :fn)) + expected-walked-model) + + ; Recursive data-structure impossible to generate + ; This one is trying to bring the generator function in an infinite loop. + (h/let ['loop (h/ref 'loop)] + (h/ref 'loop)) + {:type :let + :bindings {'loop {:type :ref + :key 'loop}} + :body {:type :ref + :key 'loop}} + + ; Recursive data-structure impossible to generate + (h/let ['leaf (h/fn int?) + 'tree (h/tuple (h/ref 'tree) (h/ref 'leaf))] + (h/ref 'tree)) + {:type :let + :bindings {'leaf {:type :fn + ::mg/leaf-distance 0} + 'tree {:type :sequence + :entries [{:model {:type :ref + :key 'tree}} + {:model {:type :ref + :key 'leaf + ::mg/leaf-distance 1}}]}} + :body {:type :ref + :key 'tree}} + + ; Recursive data-structure impossible to generate + (h/let ['rec-map (h/map [:a (h/fn int?)] + [:b (h/ref 'rec-map)])] + (h/ref 'rec-map)) + {:type :let + :bindings {'rec-map {:type :map + :entries [{:key :a + :model {:type :fn + ::mg/leaf-distance 0}} + {:key :b + :model {:type :ref + :key 'rec-map}}]}} + :body {:type :ref + :key 'rec-map}} + + ; Recursive data-structure which can be generated + (h/let ['leaf (h/fn int?) + 'tree (h/alt (h/ref 'tree) (h/ref 'leaf))] + (h/ref 'tree)) + {:type :let + :bindings {'leaf {:type :fn + ::mg/leaf-distance 0} + 'tree {:type :alt + :entries [{:model {:type :ref + :key 'tree}} + {:model {:type :ref + :key 'leaf + ::mg/leaf-distance 1}}] + ::mg/leaf-distance 2}} + :body {:type :ref + :key 'tree + ::mg/leaf-distance 3} + ::mg/leaf-distance 4} + + (h/let ['rec-map (h/map [:a (h/fn int?)] + [:b {:optional true} (h/ref 'rec-map)])] + (h/ref 'rec-map)) + {:type :let + :bindings {'rec-map {:type :map + :entries [{:key :a + :model {:type :fn + ::mg/leaf-distance 0}} + {:key :b + :optional true + :model {:type :ref + :key 'rec-map}}] + ::mg/leaf-distance 1}} + :body {:type :ref + :key 'rec-map + ::mg/leaf-distance 2} + ::mg/leaf-distance 3} + + #__)) + + +(deftest assoc-min-cost-visitor-test + (are [model expected-walked-model] + (= (-> model + (mg/postwalk mg/assoc-min-cost-visitor) + (util/walk-map-dissoc :fn)) + expected-walked-model) + + (h/tuple (h/fn int?) (h/fn string?)) + {:type :sequence + :entries [{:model {:type :fn + ::mg/min-cost 1}} + {:model {:type :fn + ::mg/min-cost 1}}] + ::mg/min-cost 3} + + (h/cat (h/fn int?) (h/fn string?)) + {:type :cat + :entries [{:model {:type :fn + ::mg/min-cost 1}} + {:model {:type :fn + ::mg/min-cost 1}}] + ::mg/min-cost 3} + + (h/in-vector (h/cat (h/fn int?) (h/fn string?))) + {:type :cat + :coll-type :vector + :entries [{:model {:type :fn + ::mg/min-cost 1}} + {:model {:type :fn + ::mg/min-cost 1}}] + ::mg/min-cost 3} + + (h/not-inlined (h/cat (h/fn int?) (h/fn string?))) + {:type :cat + :inlined false + :entries [{:model {:type :fn + ::mg/min-cost 1}} + {:model {:type :fn + ::mg/min-cost 1}}] + ::mg/min-cost 3} + + (h/map [:a (h/fn int?)] + [:b {:optional true} (h/fn int?)]) + {:type :map + :entries [{:key :a + :model {:type :fn + ::mg/min-cost 1}} + {:key :b + :optional true + :model {:type :fn + ::mg/min-cost 1}}] + ::mg/min-cost 2} + + (h/map-of (h/vector (h/fn keyword?) (h/fn int?))) + {:type :map-of + :entry-model {:type :sequence + :coll-type :vector + :entries [{:model {:type :fn + ::mg/min-cost 1}} + {:model {:type :fn + ::mg/min-cost 1}}] + ::mg/min-cost 3} + ::mg/min-cost 1} + + (-> (h/map-of (h/vector (h/fn keyword?) (h/fn int?))) + (h/with-count (h/enum #{3 4}))) + {:type :map-of + :entry-model {:type :sequence + :coll-type :vector + :entries [{:model {:type :fn + ::mg/min-cost 1}} + {:model {:type :fn + ::mg/min-cost 1}}] + ::mg/min-cost 3} + :count-model {:type :enum + :values #{3 4}} + ::mg/min-cost 7} + + (h/set-of (h/fn any?)) + {:type :set-of + :elements-model {:type :fn + ::mg/min-cost 1} + ::mg/min-cost 1} + + (-> (h/set-of (h/fn any?)) + (h/with-count (h/val 3))) + {:type :set-of + :elements-model {:type :fn + ::mg/min-cost 1} + :count-model {:type :enum + :values #{3}} + ::mg/min-cost 4} + + (h/let ['foo (-> (h/set-of (h/fn int?)) + (h/with-count (h/val 3)))] + (h/ref 'foo)) + {:type :let + :bindings {'foo {:type :set-of + :count-model {:type :enum + :values #{3}} + :elements-model {:type :fn + ::mg/min-cost 1} + ::mg/min-cost 4}} + :body {:type :ref + :key 'foo + ::mg/min-cost 4} + ::mg/min-cost 4} + + #__)) + +(deftest budget-split-gen-test + (is (every? (fn [[a b c]] + (and (<= 0 a 5) + (<= 5 b 10) + (<= 10 c 15))) + (-> (#'mg/budget-split-gen 20.0 [0 5 10]) + tcg/sample))) + (is (every? #(= % [5 10 10]) + (-> (#'mg/budget-split-gen 20.0 [5 10 10]) + tcg/sample))) + (is (every? empty? + (-> (#'mg/budget-split-gen 10.0 []) + tcg/sample)))) + +(comment + ;; For occasional hand testing + + (tcg/sample (gen (-> (h/set-of fn-any?) + (h/with-count (h/enum #{1 2 3 10})) + (h/with-condition (h/fn (comp #{1 2 3} count)))))) + + (tcg/sample (gen (h/map-of (h/vector fn-int? fn-simple-symbol?)))) + + (tcg/sample (gen (-> (h/map [:a fn-int?]) + (h/with-optional-entries [:b fn-string?])))) + + (tcg/sample (gen (h/sequence-of fn-int?))) + + (tcg/sample (gen (h/tuple fn-int? fn-string?))) + + (tcg/sample (gen (h/cat fn-int? fn-string?))) + + (tcg/sample (gen (h/repeat 2 3 fn-int?))) + + (tcg/sample (gen (h/repeat 2 3 (h/cat fn-int? fn-string?)))) + + (tcg/sample (gen (h/let ['int? fn-int? + 'string? fn-string? + 'int-string? (h/cat (h/ref 'int?) (h/ref 'string?))] + (h/repeat 2 3 (h/ref 'int-string?))))) + + (tcg/sample (gen (-> (h/set-of fn-int?) + (h/with-condition (h/fn (fn [coll] + (or (empty? coll) + (some even? coll)))))))) + + (tcg/sample (gen (-> (h/set-of fn-any?) + (h/with-count (h/enum #{1 2 3 10})) + (h/with-condition (h/fn (comp #{1 2 3} count)))))) + + (tcg/sample (gen (h/let ['node (h/set-of (h/ref 'node))] + (h/ref 'node)))) + + (tcg/sample (gen (h/let ['node (h/map-of (h/vector fn-int? (h/ref 'node)))] + (h/ref 'node)) 50)) + + (tcg/sample (gen (h/let ['node (h/map-of (h/vector fn-keyword? (h/ref 'node)))] + (h/ref 'node)) 100) 1) + + (tcg/sample (gen (h/map [:a fn-int?]))) + + (tcg/sample (gen (-> (h/map [:a fn-int?]) + (h/with-optional-entries [:b fn-string?])))) + + (tcg/sample (gen (h/cat (h/vector-of fn-int?) + (h/vector-of fn-int?)) 20)) + + (tcg/sample (gen (h/repeat 5 10 fn-int?))) + + (tcg/sample (gen fn-symbol?)) + (tcg/sample (gen fn-simple-symbol?)) + (tcg/sample (gen fn-qualified-symbol?)) + + (tcg/sample (gen fn-keyword?)) + (tcg/sample (gen fn-simple-keyword?)) + (tcg/sample (gen fn-qualified-keyword?)) + + (tcg/sample (gen (-> (h/cat (h/char-cat "good") + (h/val \space) + (h/alt (h/char-cat "morning") + (h/char-cat "afternoon") + (h/repeat 3 10 (h/char-set "#?!@_*+%")))) + (h/in-string))) + 100) + + + #__) + +(deftest gen-test + (let [model fn-string?] + (is (every? (partial valid? model) + (tcg/sample (gen model))))) + + (let [model (h/enum #{:1 2 "3"})] + (is (every? (partial valid? model) + (tcg/sample (gen model))))) + + (let [model (-> (h/set-of fn-int?) + (h/with-condition (h/fn (fn [coll] + (or (empty? coll) + (some even? coll))))))] + (is (every? (partial valid? model) + (tcg/sample (gen model))))) + + (let [model (-> (h/set-of fn-any?) + (h/with-count (h/enum #{1 2 3 10})) + (h/with-condition (h/fn (comp #{1 2 3} count))))] + (is (every? (partial valid? model) + (tcg/sample (gen model))))) + + (let [model (h/map-of (h/vector fn-int? fn-string?))] + (is (every? (partial valid? model) + (tcg/sample (gen model))))) + + (let [model (-> (h/map [:a fn-int?]) + (h/with-optional-entries [:b fn-string?]) + (h/with-entries [:c fn-int?]) + (h/with-optional-entries [:d fn-string?])) + sample (tcg/sample (gen model) 100)] + (is (and (every? (partial valid? model) sample) + (every? (fn [element] (contains? element :a)) sample) + (some (fn [element] (contains? element :b)) sample) + (some (fn [element] (not (contains? element :b))) sample) + (every? (fn [element] (contains? element :c)) sample) + (some (fn [element] (contains? element :d)) sample) + (some (fn [element] (not (contains? element :d))) sample)))) + + (let [model (h/sequence-of fn-int?)] + (is (every? (partial valid? model) + (tcg/sample (gen model))))) + + (let [model (h/tuple fn-int? fn-string?) + sample (tcg/sample (gen model) 100)] + (is (and (every? (partial valid? model) sample) + (some list? sample) + (some vector? sample)))) + + (let [model (h/list fn-int? fn-string?) + sample (tcg/sample (gen model))] + (is (and (every? (partial valid? model) sample) + (every? list? sample)))) + + (let [model (h/vector fn-int? fn-string?) + sample (tcg/sample (gen model))] + (is (and (every? (partial valid? model) sample) + (every? vector? sample)))) + + (let [model (h/string-tuple fn-char? fn-char?) + sample (tcg/sample (gen model))] + (is (and (every? (partial valid? model) sample) + (every? string? sample)))) + + (let [model (h/in-list (h/cat fn-int? fn-string?)) + sample (tcg/sample (gen model))] + (is (and (every? (partial valid? model) sample) + (every? list? sample)))) + + (let [model (h/in-vector (h/cat fn-int? fn-string?)) + sample (tcg/sample (gen model))] + (is (and (every? (partial valid? model) sample) + (every? vector? sample)))) + + (let [model (h/in-string (h/cat fn-char? fn-char?)) + sample (tcg/sample (gen model))] + (is (and (every? (partial valid? model) sample) + (every? string? sample)))) + + (let [model (h/alt fn-int? fn-string?)] + (is (every? (partial valid? model) + (tcg/sample (gen model))))) + + (let [model (h/cat fn-int? fn-string?)] + (is (every? (partial valid? model) + (tcg/sample (gen model))))) + + (let [model (h/repeat 2 3 fn-int?)] + (is (every? (partial valid? model) + (tcg/sample (gen model))))) + + (let [model (h/repeat 2 3 (h/cat fn-int? fn-string?))] + (is (every? (partial valid? model) + (tcg/sample (gen model))))) + + (let [model (h/not-inlined (h/cat fn-int?))] + (is (every? (partial valid? model) + (tcg/sample (gen model))))) + + (let [model (h/not-inlined (h/repeat 1 2 fn-int?))] + (is (every? (partial valid? model) + (tcg/sample (gen model))))) + + (let [model (h/let ['int? fn-int? + 'string? fn-string? + 'int-string? (h/cat (h/ref 'int?) (h/ref 'string?))] + (h/repeat 2 3 (h/ref 'int-string?)))] + (is (every? (partial valid? model) + (tcg/sample (gen model))))) + + ;; Budget-based limit on model choice. + (let [model (h/let ['tree (h/alt [:leaf fn-int?] + [:branch (h/vector (h/ref 'tree) + (h/ref 'tree))])] + (h/ref 'tree))] + (is (every? (partial valid? model) + (tcg/sample (gen model))))) + + ;; Budget-based limit on variable set size. + (let [model (h/let ['node (h/set-of (h/ref 'node))] + (h/ref 'node))] + (is (every? (partial valid? model) + (tcg/sample (gen model))))) + + ;; Budget-based limit on variable sequence size. + (let [model (h/let ['node (h/vector-of (h/ref 'node))] + (h/ref 'node))] + (is (every? (partial valid? model) + (tcg/sample (gen model))))) + + ;; Budget-based limit on variable map size. + (let [model (h/let ['node (h/map-of (h/vector fn-int? (h/ref 'node)))] + (h/ref 'node))] + (is (every? (partial valid? model) + (tcg/sample (gen model))))) + + ;; Budget-based limit on optional entries in a map. + (let [model (h/let ['node (-> (h/map [:a fn-int?]) + (h/with-optional-entries [:x (h/ref 'node)] + [:y (h/ref 'node)] + [:z (h/ref 'node)]))] + (h/ref 'node))] + (is (every? (partial valid? model) + (tcg/sample (gen model))))) + + ;;; Budget-based limit on number of occurrences in a repeat. + ;(let [model (h/let ['node (h/repeat 0 1 (h/ref 'node))] + ; (h/ref 'node))] + ; (is (every? (partial valid? model) + ; (tcg/sample (gen model))))) + + ;; Model impossible to generate. + (let [model (h/let ['node (h/map [:a (h/ref 'node)])] + (h/ref 'node))] + (is (thrown? #?(:clj Exception :cljs js/Object) (tcg/sample (gen model))))) + + ;; Model impossible to generate. + (let [model (h/let ['node (h/tuple (h/ref 'node))] + (h/ref 'node))] + (is (thrown? #?(:clj Exception :cljs js/Object) (tcg/sample (gen model))))) + + ;; Model impossible to generate. + (let [model (h/let ['node (h/cat (h/ref 'node))] + (h/ref 'node))] + (is (thrown? #?(:clj Exception :cljs js/Object) (tcg/sample (gen model))))) + + ;; Model impossible to generate. + (let [model (h/let ['node (h/cat (h/ref 'node))] + (h/ref 'node))] + (is (thrown? #?(:clj Exception :cljs js/Object) (tcg/sample (gen model))))) + + (let [model (h/let ['node (h/repeat 1 2 (h/ref 'node))] + (h/ref 'node))] + (is (thrown? #?(:clj Exception :cljs js/Object) (tcg/sample (gen model)))))) + +;; TODO: [later] reuse the cat-ipsum model for parsing the output. + +;; TODO: in the :alt node, introduce a property :occurrence for the generator. +;; TODO: generate models, use them to generate data, should not stack overflow. diff --git a/test-resources/lib_tests/minimallist/util_test.cljc b/test-resources/lib_tests/minimallist/util_test.cljc new file mode 100644 index 00000000..3a0fbd0f --- /dev/null +++ b/test-resources/lib_tests/minimallist/util_test.cljc @@ -0,0 +1,53 @@ +(ns minimallist.util-test + (:require [clojure.test :refer [deftest testing is are]] + [minimallist.util :as util] + [minimallist.helper :as h])) + +(deftest reduce-update-test + (let [m {:a 1 + :b 5} + f (fn [acc elm] + (let [elm10 (* elm 10)] + [(conj acc elm10) elm10]))] + (is (= (-> [[] m] + (util/reduce-update :a f) + (util/reduce-update :b f)) + [[10 50] {:a 10, :b 50}])))) + +(deftest reduce-update-in-test + (let [m {:a {:x 1, :y 2} + :b [3 4 5]} + f (fn [acc elm] + (let [elm10 (* elm 10)] + [(conj acc elm10) elm10]))] + (is (= (-> [[] m] + (util/reduce-update-in [:a :x] f) + (util/reduce-update-in [:b 2] f)) + [[10 50] {:a {:x 10, :y 2}, :b [3 4 50]}])))) + +(deftest reduce-mapv + (let [m {:a {:x 1, :y 2} + :b [3 4 5]} + f (fn [acc elm] + (let [elm10 (* elm 10)] + [(conj acc elm10) elm10]))] + (is (= (util/reduce-update [[] m] :b (partial util/reduce-mapv f)) + [[30 40 50] {:a {:x 1, :y 2}, :b [30 40 50]}])))) + +(deftest iterate-while-different-test + (let [inc-up-to-10 (fn [x] (cond-> x (< x 10) inc))] + (is (= (util/iterate-while-different inc-up-to-10 0 0) 0)) + (is (= (util/iterate-while-different inc-up-to-10 0 5) 5)) + (is (= (util/iterate-while-different inc-up-to-10 0 10) 10)) + (is (= (util/iterate-while-different inc-up-to-10 0 15) 10)) + + (is (= (util/iterate-while-different inc-up-to-10 7 2) 9)) + (is (= (util/iterate-while-different inc-up-to-10 7 3) 10)) + (is (= (util/iterate-while-different inc-up-to-10 7 4) 10)) + + (is (= (util/iterate-while-different inc-up-to-10 12 0) 12)) + (is (= (util/iterate-while-different inc-up-to-10 12 3) 12)) + + (is (= (util/iterate-while-different inc-up-to-10 0 ##Inf) 10)) + (is (= (util/iterate-while-different inc-up-to-10 10 ##Inf) 10)) + (is (= (util/iterate-while-different inc-up-to-10 15 ##Inf) 15)))) diff --git a/test-resources/lib_tests/missing/test/assertions_test.cljc b/test-resources/lib_tests/missing/test/assertions_test.cljc new file mode 100644 index 00000000..9eb4e9e0 --- /dev/null +++ b/test-resources/lib_tests/missing/test/assertions_test.cljc @@ -0,0 +1,12 @@ +(ns missing.test.assertions-test + (:require + [clojure.test :refer [deftest testing is] :as t] + [missing.test.old-methods] + [missing.test.assertions])) + +(deftest a-test + (testing "FIXME, I fail." + 1)) + +(deftest another-test + (testing (is 1))) diff --git a/test-resources/lib_tests/missing/test/old_methods.cljc b/test-resources/lib_tests/missing/test/old_methods.cljc new file mode 100644 index 00000000..dff312a8 --- /dev/null +++ b/test-resources/lib_tests/missing/test/old_methods.cljc @@ -0,0 +1,15 @@ +(ns missing.test.old-methods + (:require [clojure.test :as t] + [missing.test.assertions :refer [register!]])) + +(defmethod t/report #?(:clj :begin-test-var + :cljs [::t/default :begin-test-var]) [_] + ;; BB-TEST-PATCH: remove message to not disturb test output for other libs + #_(println "Begin test var.")) + +(defmethod t/report #?(:clj :end-test-var + :cljs [::t/default :end-test-var]) [_] + ;; BB-TEST-PATCH: remove message to not disturb test output for other libs + #_(println "End test var.")) + +(register! {:throw? false}) diff --git a/test-resources/lib_tests/portal/bench.cljc b/test-resources/lib_tests/portal/bench.cljc new file mode 100644 index 00000000..3263189c --- /dev/null +++ b/test-resources/lib_tests/portal/bench.cljc @@ -0,0 +1,18 @@ +(ns portal.bench + #?(:cljs (:refer-clojure :exclude [simple-benchmark])) + #?(:cljs (:require-macros portal.bench))) + +(defn now [] + #?(:clj (System/currentTimeMillis) + :cljs (.now js/Date))) + +(defmacro simple-benchmark + [bindings expr iterations & {:keys [print-fn] :or {print-fn 'println}}] + (let [expr-str (pr-str expr)] + `(let ~bindings + (dotimes [_# ~iterations] ~expr) + (let [start# (now) + ret# (dotimes [_# ~iterations] ~expr) + end# (now) + elapsed# (- end# start#)] + (~print-fn (str ~iterations " runs, " elapsed# " msecs, " ~expr-str)))))) diff --git a/test-resources/lib_tests/portal/e2e.clj b/test-resources/lib_tests/portal/e2e.clj new file mode 100644 index 00000000..26597322 --- /dev/null +++ b/test-resources/lib_tests/portal/e2e.clj @@ -0,0 +1,32 @@ +(ns portal.e2e + (:require [portal.colors :as c])) + +(defn step [code] + (binding [*out* *err*] + (println "\n==> Enter to execute:" code "\n")) + (read-line) + (prn code)) + +(def pane-titles '("Alice" "Mad Hatter" "The Cake is a Lie")) + +(defn options [] + {:portal.colors/theme + (rand-nth (keys (dissoc c/themes ::c/vs-code-embedded))) + :portal.launcher/window-title + (rand-nth pane-titles)}) + +(defn -main [& args] + (if (= (first args) "web") + (step '(require '[portal.web :as p])) + (step '(require '[portal.api :as p]))) + (step `(do (add-tap #'p/submit) + (p/open ~(options)))) + (step '(tap> :hello-world)) + (step '(p/clear)) + (step '(require '[examples.data :refer [data]])) + (step '(tap> data)) + (step '(p/clear)) + (step '(remove-tap #'p/submit)) + (step '(tap> :hello-world)) + (step '(p/eval-str "(js/alert 1)")) + (step '(p/close))) diff --git a/test-resources/lib_tests/portal/jvm_test.clj b/test-resources/lib_tests/portal/jvm_test.clj new file mode 100644 index 00000000..20553047 --- /dev/null +++ b/test-resources/lib_tests/portal/jvm_test.clj @@ -0,0 +1,23 @@ +(ns portal.jvm-test + (:require [clojure.test :refer [deftest is]] + [portal.api :as p] + [portal.runtime.browser :as browser] + [portal.runtime.index :as index] + [portal.runtime.jvm.client :as client])) + +(defn- headless-chrome-flags [url] + ["--headless" "--disable-gpu" url]) + +(defn- open [f] + (with-redefs [browser/flags f] (p/open))) + +(deftest e2e-jvm + (reset! index/testing? true) + (when-let [portal (open headless-chrome-flags)] + (with-redefs [client/timeout 60000] + (reset! portal 0) + (is (= @portal 0)) + (swap! portal inc) + (is (= @portal 1)))) + (p/close)) + diff --git a/test-resources/lib_tests/portal/runtime/cson_test.cljc b/test-resources/lib_tests/portal/runtime/cson_test.cljc new file mode 100644 index 00000000..c7b5a4ce --- /dev/null +++ b/test-resources/lib_tests/portal/runtime/cson_test.cljc @@ -0,0 +1,172 @@ +(ns portal.runtime.cson-test + (:require [clojure.test :refer [deftest are is]] + #?(:clj [clojure.edn :as edn] + :cljs [cljs.reader :as edn]) + [cognitect.transit :as transit] + [portal.bench :as b] + [portal.runtime.cson :as cson]) + #?(:clj (:import [java.io ByteArrayOutputStream ByteArrayInputStream] + [java.util Date] + [java.util UUID]))) + +(defn- transit-read [^String string] + #?(:clj (-> string + .getBytes + ByteArrayInputStream. + (transit/reader :json) + transit/read) + :cljs (transit/read (transit/reader :json) string))) + +(defn- transit-write [value] + #?(:clj (let [out (ByteArrayOutputStream. 1024)] + (transit/write + (transit/writer out :json {:transform transit/write-meta}) + value) + (.toString out)) + :cljs (transit/write + (transit/writer :json {:transform transit/write-meta}) + value))) + +(defn pass [v] + (cson/read (cson/write v))) + +(deftest simple-values + (are [value] + (= value (pass value)) + nil + 0 + 1.0 + #?(:clj 42N + :cljs (when (exists? js/BigInt) + (js/BigInt "42"))) + \newline + true + false + 'hello + 'hello/world + :hello + :hello/world + "" + "hello" + "hello/world")) + +(deftest escape-strings + (are [value] + (= value (pass value)) + "\n" + "\"" + " \"hello\" ")) + +(deftest basic-collections + (are [value] + (= value (pass value)) + [] + [1 2 3] + {} + {:a :b} + #{} + #{1 2 3} + '() + (list 1 2 3))) + +(def composite-value + ['hello + 'hello/world + '(1 2 3) + "" + 3.14 + true + false + #inst "2021-04-07T22:43:59.393-00:00" + #uuid "1d80bdbb-ab16-47b2-a8bd-068f94950248" + nil + 1 + \h + "data" + {:hello/world :grep} + #{1 2 3}]) + +(deftest composite-collections + (are [value] + (= value (pass value)) + [[[]]] + #{#{#{}}} + {{} {}} + {[] []} + {#{} #{}} + {(list) (list)} + (list [] #{} {}) + composite-value)) + +(deftest special-collections + (are [value] + (= value (pass value)) + (range 10))) + +(deftest seq-collections + (are [value] + (= (seq value) (pass (seq value))) + '(0) + [0] + #{0} + {0 0})) + +(def tagged + [#?(:clj (Date.) + :cljs (js/Date.)) + #?(:clj (UUID/randomUUID) + :cljs (random-uuid)) + (tagged-literal 'tag :value)]) + +(deftest tagged-objects + (doseq [value tagged] + (is (= value (pass value))))) + +(deftest metadata + (doseq [value ['hello {} [] #{}]] + (let [m {:my :meta} + value (with-meta value m)] + (is (= m (meta (pass value))))))) + +(deftest symbol-key-with-meta + (let [m {:a :b} + value {(with-meta 'k m) 'v}] + (is (= value (pass value))) + (is (= m (meta (first (keys (pass value)))))))) + +(deftest cson-over-edn + (is + (-> composite-value + (cson/write {:stringify pr-str}) + (cson/read {:parse edn/read-string}) + (= composite-value)))) + +(def n 10000) +(def v composite-value) + +(def edn + {:parse edn/read-string + :stringify pr-str}) + +(comment + (deftest rich-benchmark + (b/simple-benchmark [] (transit-write v) n) + (b/simple-benchmark [] (cson/write v edn) n) + (b/simple-benchmark [] (cson/write v) n) + + (prn) + + (b/simple-benchmark + [v (transit-write v)] (transit-read v) n) + (b/simple-benchmark + [v (cson/write v edn)] (cson/read v edn) n) + (b/simple-benchmark + [v (cson/write v)] (cson/read v) n))) + +#?(:clj + (deftest java-longs + (is (= 1 (byte 1) (pass (byte 1)))) + (is (= 1 (short 1) (pass (short 1)))) + (is (= 1 (int 1) (pass (int 1)))) + (is (= 1 (long 1) (pass (long 1)))) + (is (= 4611681620380904123 (pass 4611681620380904123))))) diff --git a/test-resources/lib_tests/portal/runtime/fs_test.cljc b/test-resources/lib_tests/portal/runtime/fs_test.cljc new file mode 100644 index 00000000..96c1bef2 --- /dev/null +++ b/test-resources/lib_tests/portal/runtime/fs_test.cljc @@ -0,0 +1,21 @@ +(ns portal.runtime.fs-test + (:require [clojure.test :refer [deftest is]] + [portal.runtime.fs :as fs])) + +(deftest fs + (is (some? (fs/slurp "deps.edn"))) + (let [deps (fs/join (fs/cwd) "deps.edn")] + (is (= (fs/exists deps) deps))) + (is (some? (fs/home))) + (is (some? (seq (fs/paths)))) + (is (contains? + (into #{} (fs/list (fs/cwd))) + (fs/join (fs/cwd) "deps.edn"))) + (let [dir (str "target/" (gensym)) + file (str dir "/" (gensym))] + (fs/mkdir dir) + (fs/spit file "hello") + (is (= (fs/slurp file) "hello")) + (fs/rm dir) + (is (nil? (fs/exists file))) + (is (nil? (fs/exists dir))))) diff --git a/test-resources/lib_tests/portal/test_planck.cljs b/test-resources/lib_tests/portal/test_planck.cljs new file mode 100644 index 00000000..3e7769a9 --- /dev/null +++ b/test-resources/lib_tests/portal/test_planck.cljs @@ -0,0 +1,11 @@ +(ns portal.test-planck + (:require [cljs.test :refer [run-tests]] + [planck.core :refer [exit]] + [portal.runtime.cson-test])) + +(defmethod cljs.test/report [:cljs.test/default :end-run-tests] [m] + (when-not (cljs.test/successful? m) + (exit 1))) + +(defn -main [] + (run-tests 'portal.runtime.cson-test)) diff --git a/test-resources/lib_tests/portal/test_runner.clj b/test-resources/lib_tests/portal/test_runner.clj new file mode 100644 index 00000000..d6c1fb71 --- /dev/null +++ b/test-resources/lib_tests/portal/test_runner.clj @@ -0,0 +1,14 @@ +(ns portal.test-runner + (:require [clojure.test :refer [run-tests]] + [portal.jvm-test] + [portal.runtime.cson-test] + [portal.runtime.fs-test])) + +(defn -main [] + (let [{:keys [fail error]} + (run-tests 'portal.jvm-test + 'portal.runtime.cson-test + 'portal.runtime.fs-test)] + (shutdown-agents) + (System/exit (+ fail error)))) + diff --git a/test-resources/lib_tests/portal/test_runner.cljs b/test-resources/lib_tests/portal/test_runner.cljs new file mode 100644 index 00000000..e4d4d30e --- /dev/null +++ b/test-resources/lib_tests/portal/test_runner.cljs @@ -0,0 +1,14 @@ +(ns portal.test-runner + (:require [cljs.test :refer [run-tests]] + [portal.runtime.cson-test] + [portal.runtime.fs-test])) + +(defmethod cljs.test/report [:cljs.test/default :end-run-tests] [m] + (when-not (cljs.test/successful? m) + (.exit js/process 1))) + +(defn -main [] + (run-tests 'portal.runtime.cson-test + 'portal.runtime.fs-test)) + +(-main) diff --git a/test-resources/lib_tests/progrock/core_test.clj b/test-resources/lib_tests/progrock/core_test.clj new file mode 100644 index 00000000..4b12f6ac --- /dev/null +++ b/test-resources/lib_tests/progrock/core_test.clj @@ -0,0 +1,43 @@ +(ns progrock.core-test + (:require [clojure.test :refer :all] + [clojure.string :as str] + [progrock.core :as pr])) + +(deftest test-progress-bar + (let [bar (pr/progress-bar 50)] + (is (= (:total bar) 50)) + (is (= (:progress bar) 0)) + (is (not (:done? bar))))) + +(deftest test-tick + (let [bar (pr/progress-bar 50)] + (is (= (-> bar pr/tick :progress) 1)) + (is (= (-> bar (pr/tick 16) :progress) 16)) + (is (= (-> bar (pr/tick 5) pr/tick :progress) 6)))) + +(deftest test-done + (let [bar (pr/progress-bar 50)] + (is (-> bar pr/done :done?)))) + +(deftest test-render + (let [bar (pr/progress-bar 50)] + (is (= (pr/render bar) + " 0/50 0% [ ] ETA: --:--")) + (is (= (pr/render (pr/tick bar 25)) + "25/50 50% [========================= ] ETA: 00:00")) + (is (= (pr/render (pr/tick bar 25) {:format "(:bar)", :length 10}) + "(===== )")) + (is (= (pr/render (pr/tick bar 25) {:format "[:bar]", :complete \#, :incomplete \-}) + "[#########################-------------------------]")) + (is (= (pr/render (pr/progress-bar 0)) + "0/0 0% [ ] ETA: --:--")))) + +(deftest test-print + (let [bar (pr/progress-bar 50)] + (is (= (with-out-str (pr/print bar)) + "\r 0/50 0% [ ] ETA: --:--")) + (is (= (with-out-str (pr/print bar {:length 10})) + "\r 0/50 0% [ ] ETA: --:--")) + ;; BB-TEST-PATCH: Make windows compatible + (is (= (str/trim (with-out-str (pr/print (pr/done bar) {:length 10}))) + "0/50 0% [ ] ETA: --:--")))) diff --git a/test-resources/lib_tests/slingshot/slingshot_test.clj b/test-resources/lib_tests/slingshot/slingshot_test.clj index 09938332..f787a862 100644 --- a/test-resources/lib_tests/slingshot/slingshot_test.clj +++ b/test-resources/lib_tests/slingshot/slingshot_test.clj @@ -74,18 +74,19 @@ (mega-try (throw+ exception-1)) (mega-try (throw exception-1)) (try (throw+ exception-1) - (catch Exception e [:class-exception e])) + (catch Exception e [:class-exception e])) (try (throw exception-1) - (catch Exception e [:class-exception e]))))) + (catch Exception e [:class-exception e]))))) (testing "IllegalArgumentException thrown by clojure/core" (is (= :class-iae (first (mega-try (str/replace "foo" 1 1))))))) (testing "catch by java class generically" (is (= [:class-string "fail"] (mega-try (throw+ "fail"))))) + ;; BB-TEST-PATCH: bb has different record internals #_(testing "catch by clojure record type" - (is (= [:class-exception-record exception-record-1] - (mega-try (throw+ exception-record-1))))) + (is (= [:class-exception-record exception-record-1] + (mega-try (throw+ exception-record-1))))) (testing "catch by key is present" (is (= [:key-is-present #{:a-key}] (mega-try (throw+ #{:a-key}))))) diff --git a/test-resources/lib_tests/slingshot/support_test.clj b/test-resources/lib_tests/slingshot/support_test.clj index 12d2c142..9618bd73 100644 --- a/test-resources/lib_tests/slingshot/support_test.clj +++ b/test-resources/lib_tests/slingshot/support_test.clj @@ -46,9 +46,11 @@ (defn stack-trace-fn [] (stack-trace)) +;; BB-TEST-PATCH: Returns jdk.internal.reflect.DelegatingMethodAccessorImpl +;; instead of what's expected #_(deftest test-stack-trace (let [{:keys [methodName className]} (-> (stack-trace-fn) first bean)] - (is (= methodName "invoke")) + (is (.startsWith ^String methodName "invoke")) (is (re-find #"stack_trace_fn" className)))) (deftest test-resolve-local diff --git a/test-resources/lib_tests/swirrl/dogstatsd_test.clj b/test-resources/lib_tests/swirrl/dogstatsd_test.clj new file mode 100644 index 00000000..6ee88cdf --- /dev/null +++ b/test-resources/lib_tests/swirrl/dogstatsd_test.clj @@ -0,0 +1,22 @@ +(ns swirrl.dogstatsd-test + (:require [swirrl.dogstatsd :as sut] + [swirrl.dogstatsd.specs] + [clojure.test :refer [deftest is testing]] + [clojure.spec.test.alpha :as st])) + +(st/instrument) + +(deftest basic-invocation-tests + (testing "Basic metric procedure calls run without error" + (let [client (sut/configure {:endpoint "localhost:8111"})] + + (sut/increment! client ::increment) + (sut/increment! client ::increment 10) + (sut/decrement! client ::decrement) + + (sut/histogram! client ::histogram 10) + (sut/distribution! client ::distribution 10) + (sut/set! client ::set "a-value") + (sut/event! client "event title" "some text here" {}) + + (is true)))) diff --git a/test-resources/lib_tests/table/core_test.clj b/test-resources/lib_tests/table/core_test.clj index fa9d0fe5..336f85e1 100644 --- a/test-resources/lib_tests/table/core_test.clj +++ b/test-resources/lib_tests/table/core_test.clj @@ -15,7 +15,7 @@ +---+---+ | 3 | 4 | +---+---+ - ") "\n") + ") (System/lineSeparator)) (with-out-str (table [["1" "2"] ["3" "4"]]))))) (deftest test-table-with-vecs-in-vec @@ -310,7 +310,7 @@ ") (table-str [[1 2] [:c :d] [:a :b]] :sort true)))) -;; BB-TEST-PATCH: Intermittent failing test +;; TODO: Intermittent failing test #_(deftest test-table-with-sort-option-as-field-name (is (= (unindent diff --git a/test-resources/lib_tests/testdoc/core_test.clj b/test-resources/lib_tests/testdoc/core_test.clj new file mode 100644 index 00000000..c8f68b32 --- /dev/null +++ b/test-resources/lib_tests/testdoc/core_test.clj @@ -0,0 +1,133 @@ +(ns testdoc.core-test + (:require + [clojure.java.io :as io] + [clojure.test :as t] + [testdoc.core :as sut])) + +(defn- repl-styled-success-test-func + "foo bar + + => (+ 1 2 3) + 6 + => (+ 1 2 + => 3 4) + 10 + => *1 + 10 + => (inc *1) + 11" + []) + +(defn- code-first-styled-success-test-func + "foo bar + + (+ 1 2 3) + ;; => 6 + + (+ 1 2 + 3 4) + ;; => 10 + *1 + ;; => 10 + (inc *1) + ;; => 11" + []) + +(defn- repl-styled-partial-success-test-func + "foo bar + + => (+ 1 2 3) + 6 + => (+ 1 2 3 4) + 999" + []) + +(defn- code-first-styled-partial-success-test-func + "foo bar + + (+ 1 2 3) + ;; => 6 + (+ 1 2 3 4) + ;; => 999" + []) + +(t/deftest testdoc-test + (t/testing "repl style" + (t/is (= [{:type :pass :expected 6 :actual 6} + {:type :pass :expected 10 :actual 10} + {:type :pass :expected 10 :actual 10} + {:type :pass :expected 11 :actual 11}] + (->> (sut/testdoc nil #'repl-styled-success-test-func) + (map #(select-keys % [:type :expected :actual])) + (sort-by :expected)))) + + (t/is (= [{:type :pass :expected 6 :actual 6} + {:type :fail :expected 999 :actual 10}] + (->> (sut/testdoc nil #'repl-styled-partial-success-test-func) + (map #(select-keys % [:type :expected :actual])) + (sort-by :expected))))) + + (t/testing "code-first style" + (t/is (= [{:type :pass :expected 6 :actual 6} + {:type :pass :expected 10 :actual 10} + {:type :pass :expected 10 :actual 10} + {:type :pass :expected 11 :actual 11}] + (->> (sut/testdoc nil #'code-first-styled-success-test-func) + (map #(select-keys % [:type :expected :actual])) + (sort-by :expected)))) + + (t/is (= [{:type :pass :expected 6 :actual 6} + {:type :fail :expected 999 :actual 10}] + (->> (sut/testdoc nil #'code-first-styled-partial-success-test-func) + (map #(select-keys % [:type :expected :actual])) + (sort-by :expected)))))) + +(t/deftest testdoc-unsupported-test + (let [[result :as results] (sut/testdoc nil 123)] + (t/is (= 1 (count results))) + (t/is (= :fail (:type result))) + (t/is (re-seq #"^Unsupported document:" (:message result))))) + +(defn plus + "Add a and b + + => (plus 1 2) + 3 + => (plus 2 + => 3) + 5" + [a b] + (+ a b)) + +(t/deftest plus-test + (t/is (testdoc #'plus))) + +(t/deftest plus-string-test + (t/is (testdoc "=> (require '[testdoc.core-test :as ct]) + nil + => (ct/plus 1 2) + 3 + => (ct/plus 2 + => 3) + 5"))) + +(t/deftest nil-value-test + (t/is (= [{:type :fail :message "(= 1 nil)" :expected nil :actual 1}] + (sut/testdoc nil "=> 1 + nil")))) + +(t/deftest unresolved-symbol-test + (let [[err :as res] (sut/testdoc nil " + => (unresolved-fn 10) + 11")] + (t/is (= 1 (count res))) + (t/is (= :fail (:type err))) + (t/is (every? #(some? (get err %)) [:type :message :expected :actual])) + (t/is (= "(= (unresolved-fn 10) 11), [line: 2]" (:message err))))) + +(t/deftest debug-test + (with-out-str + (t/is (testdoc #'sut/debug)))) + +(t/deftest README-test + (t/is (testdoc (slurp (io/file "README.md"))))) diff --git a/test-resources/lib_tests/testdoc/style/code_first_test.clj b/test-resources/lib_tests/testdoc/style/code_first_test.clj new file mode 100644 index 00000000..f3747c9e --- /dev/null +++ b/test-resources/lib_tests/testdoc/style/code_first_test.clj @@ -0,0 +1,26 @@ +(ns testdoc.style.code-first-test + (:require + [clojure.string :as str] + [clojure.test :as t] + [testdoc.style.code-first :as sut])) + +(defn- lines + [ls] + (str/join "\n" ls)) + +(t/deftest parse-doc-test + (t/are [expected in] (= expected (sut/parse-doc (lines in))) + '[[a b]], ["a" ";; => b"] + '[[(a b) c]], ["(a" "b)" ";; => c"] + '[[(a b) c]], ["head" "(a" "b)" ";; => c"] + '[[a b] [c d]], ["a" ";; => b" "c" ";; => d"] + '[], ["a"] + '[[a b]], ["a" ";; => b" "c"] + '[[a b]], ["a" ";; => b" ";; => c"] + '[[a (b c)]], ["a" ";; => [b" ";; => c]"])) + +(t/deftest parse-doc-with-meta-test + (let [ret (sut/parse-doc (lines ["" "a" ";; => 6" "c" ";; => :d"]))] + (t/is (= '[[a 6] [c :d]] ret)) + (t/is (= 2 (-> ret first meta :testdoc.string/line))) + (t/is (= 4 (-> ret second meta :testdoc.string/line))))) diff --git a/test-resources/lib_tests/testdoc/style/repl_test.clj b/test-resources/lib_tests/testdoc/style/repl_test.clj new file mode 100644 index 00000000..8952e314 --- /dev/null +++ b/test-resources/lib_tests/testdoc/style/repl_test.clj @@ -0,0 +1,25 @@ +(ns testdoc.style.repl-test + (:require + [clojure.string :as str] + [clojure.test :as t] + [testdoc.style.repl :as sut])) + +(defn- lines + [ls] + (str/join "\n" ls)) + +(t/deftest parse-doc-test + (t/are [expected in] (= expected (sut/parse-doc (lines in))) + '[[a b]], ["=> a" "b"] + '[[(a b) c]], ["=> (a" "=> b)" "c"] + '[[a b] [c d]], ["=> a" "b" "=> c" "d"] + '[], ["=> a"] + '[[a b]], ["=> a" "b" "=> c"] + '[[a b]], ["=> a" "b" "c"] + '[[a (b c)]], ["=> a" "[b" "c]"])) + +(t/deftest parse-doc-with-meta-test + (let [ret (sut/parse-doc (lines ["" "=> a" "6" "=> c" ":d"]))] + (t/is (= '[[a 6] [c :d]] ret)) + (t/is (= 2 (-> ret first meta :testdoc.string/line))) + (t/is (= 4 (-> ret second meta :testdoc.string/line))))) diff --git a/test-resources/lib_tests/version_clj/compare_test.cljc b/test-resources/lib_tests/version_clj/compare_test.cljc index c7ac75df..3eb0222f 100644 --- a/test-resources/lib_tests/version_clj/compare_test.cljc +++ b/test-resources/lib_tests/version_clj/compare_test.cljc @@ -70,4 +70,13 @@ ;; Some more zero-extension Tests "1-SNAPSHOT" "1.0-SNAPSHOT" 0 "1-alpha" "1-alpha0" 0 + + ;; Prefixed versions + "v1" "v1" 0 + "v1" "v2" -1 + "v1" "v1.1" -1 + "v1.1" "v1.2" -1 + "v1.1" "v2" -1 + "alpaca1.0" "bermuda1.0" -1 )) + diff --git a/test-resources/lib_tests/version_clj/split_test.cljc b/test-resources/lib_tests/version_clj/split_test.cljc index 51cac090..54ae6ab2 100644 --- a/test-resources/lib_tests/version_clj/split_test.cljc +++ b/test-resources/lib_tests/version_clj/split_test.cljc @@ -35,6 +35,10 @@ "0.5.0-alpha.1" [[0 5 0] ["alpha" 1]] "0.5.0-alpha.1" [[0 5 0] ["alpha" 1]] "0.0.3-alpha.8+oryOS.15" [[0 0 3] ["alpha" [8 "+oryos"] 15]] + "v1" [["v" 1]] + "v1.1" [["v" [1 1]]] + "ver1" [["ver" 1]] + "ver1.1" [["ver" [1 1]]] )) (deftest t-split-without-qualifiers diff --git a/test-resources/lib_tests/version_clj/via_use_test.clj b/test-resources/lib_tests/version_clj/via_use_test.clj index f75fa6bd..0d4e7526 100644 --- a/test-resources/lib_tests/version_clj/via_use_test.clj +++ b/test-resources/lib_tests/version_clj/via_use_test.clj @@ -6,6 +6,7 @@ (use 'version-clj.core) +;; BB-TEST-PATCH: This test doesn't exist upstream (deftest sanity-test (is (= [[1 0 0] ["snapshot"]] (version->seq "1.0.0-SNAPSHOT"))) (is (= 0 (version-compare "1.0" "1.0.0"))) diff --git a/test/babashka/bb_edn_test.clj b/test/babashka/bb_edn_test.clj index 26b63846..05942116 100644 --- a/test/babashka/bb_edn_test.clj +++ b/test/babashka/bb_edn_test.clj @@ -1,9 +1,11 @@ (ns babashka.bb-edn-test (:require [babashka.fs :as fs] + [babashka.impl.classpath :as cp] [babashka.impl.common :as common] [babashka.main :as main] [babashka.test-utils :as test-utils] + [borkdude.deps] [clojure.edn :as edn] [clojure.string :as str] [clojure.test :as test :refer [deftest is testing]])) @@ -220,7 +222,10 @@ t1 (System/currentTimeMillis) delta-parallel (- t1 t0)] (is (= tree s)) - (is (< delta-parallel delta-sequential)))))) + (when (>= (doto (-> (Runtime/getRuntime) (.availableProcessors)) + (prn)) + 2) + (is (< delta-parallel delta-sequential))))))) (testing "exception" (test-utils/with-config '{:tasks {a (Thread/sleep 10000) b (do (Thread/sleep 10) @@ -337,20 +342,32 @@ (is (= "uberjar" (:file (main/parse-opts ["uberjar"])))) (finally (fs/delete "uberjar")))))) -(deftest min-bb-version - (when-not test-utils/native? - (vreset! common/bb-edn '{:min-bb-version "300.0.0"}) - (let [sw (java.io.StringWriter.)] - (binding [*err* sw] - (main/main "-e" "nil")) - (is (str/includes? (str sw) - "WARNING: this project requires babashka 300.0.0 or newer, but you have: "))))) +(deftest min-bb-version-test + (fs/with-temp-dir [dir {}] + (let [config (str (fs/file dir "bb.edn"))] + (spit config '{:min-bb-version "300.0.0"}) + (let [sw (java.io.StringWriter.)] + (binding [*err* sw] + (main/main "--config" config "-e" "nil")) + (is (str/includes? (str sw) + "WARNING: this project requires babashka 300.0.0 or newer, but you have: ")))))) -;; TODO: -;; Do we want to support the same parsing as the clj CLI? -;; Or do we want `--aliases :foo:bar` -;; Let's wait for a good use case -#_(deftest alias-deps-test - (test-utils/with-config '{:aliases {:medley {:deps {medley/medley {:mvn/version "1.3.0"}}}}} - (is (= '{1 {:id 1}, 2 {:id 2}} - (bb "-A:medley" "-e" "(require 'medley.core)" "-e" "(medley.core/index-by :id [{:id 1} {:id 2}])"))))) +(deftest classpath-other-bb-edn-test + (fs/with-temp-dir [dir {}] + (let [config (str (fs/file dir "bb.edn"))] + (spit config '{:paths ["src"] + :tasks {cp (prn (babashka.classpath/get-classpath))}}) + (let [out (bb "--config" config "cp") + entries (cp/split-classpath out) + entry (first entries)] + (is (= 1 (count entries))) + (is (= (fs/parent config) (fs/parent entry))) + (is (str/ends-with? entry "src")))))) + +(deftest without-deps-test + (when-not test-utils/native? + (with-redefs [borkdude.deps/-main (fn [& _] + (throw (ex-info "This ain't allowed!" {})))] + (testing "bb.edn without :deps should not require deps.clj" + (test-utils/with-config '{:tasks {a 1}} + (bb "-e" "(+ 1 2 3)")))))) diff --git a/test/babashka/error_test.clj b/test/babashka/error_test.clj index d79d0ba9..fba11c14 100644 --- a/test/babashka/error_test.clj +++ b/test/babashka/error_test.clj @@ -208,9 +208,6 @@ Location: :1:12 1: (let [x 1] (/ x 0)) ^--- Divide by zero ------ Locals ------------------------------------------------------------------- -x: 1 - ----- Stack trace -------------------------------------------------------------- clojure.core// - user - :1:12 @@ -219,13 +216,13 @@ user - :1:12 clojure.lang.ExceptionInfo: Divide by zero {:type :sci/error, :line 1, :column 12, :message \"Divide by zero\","))))) -(deftest macro-locals-print-test - (testing "exception during macro call includes &form and &env locals" - (let [output (try (tu/bb nil "--debug" "(defmacro foo [x] (subs nil 1) `(do ~x ~x)) (foo 1)") - (is false) - (catch Exception e (ex-message e)))] - (is (str/includes? (tu/normalize output) - "----- Error -------------------------------------------------------------------- +(deftest macro-test + (let [output (try (tu/bb nil "--debug" "(defmacro foo [x] (subs nil 1) `(do ~x ~x)) (foo 1)") + (is false) + (catch Exception e (ex-message e))) + output (tu/normalize output)] + (is (str/includes? output + "----- Error -------------------------------------------------------------------- Type: java.lang.NullPointerException Location: :1:19 Phase: macroexpand @@ -234,11 +231,6 @@ Phase: macroexpand 1: (defmacro foo [x] (subs nil 1) `(do ~x ~x)) (foo 1) ^--- ------ Locals ------------------------------------------------------------------- -&form: (foo 1) -&env: {} -x: 1 - ----- Stack trace -------------------------------------------------------------- clojure.core/subs - user/foo - :1:19 @@ -247,7 +239,7 @@ user - :1:45 ----- Exception ---------------------------------------------------------------- clojure.lang.ExceptionInfo: null -{:type :sci/error, :line 1, :column 19,"))))) +{:type :sci/error, :line 1, :column 19")))) (deftest native-stacktrace-test (let [output (try (tu/bb nil "(merge 1 2 3)") diff --git a/test/babashka/impl/repl_test.clj b/test/babashka/impl/repl_test.clj index c82b12ca..49cdab82 100644 --- a/test/babashka/impl/repl_test.clj +++ b/test/babashka/impl/repl_test.clj @@ -50,7 +50,9 @@ (assert-repl "(read-line)hello" "hello") (assert-repl "(read-line)\nhello" "hello") (assert-repl-error "(+ 1 nil)" "NullPointerException") - (assert-repl-error "(/ 1 0) (pst 1)" "Divide by zero\n\tclojure.lang.Numbers")) + (assert-repl-error "(/ 1 0) (pst 1)" "Divide by zero\n\tclojure.lang.Numbers") + (assert-repl-error "(partition (range 5) 3)" + "Don't know how to create ISeq from: java.lang.Long")) ;;;; Scratch diff --git a/test/babashka/java_security_test.clj b/test/babashka/java_security_test.clj index d619a4b2..f7c02ead 100644 --- a/test/babashka/java_security_test.clj +++ b/test/babashka/java_security_test.clj @@ -11,10 +11,12 @@ (clojure.walk/postwalk-replace {::algo algo} '(defn signature [^String s] (let [algorithm (java.security.MessageDigest/getInstance ::algo) - digest (.digest algorithm (.getBytes s))] - (format "%032x" (java.math.BigInteger. 1 digest)))))) + digest (.digest algorithm (.getBytes s)) + size (get {"SHA-256" 64} ::algo 32)] + (format (str "%0" size "x") (java.math.BigInteger. 1 digest)))))) (deftest java-security-test (is (= "49f68a5c8493ec2c0bf489821c21fc3b" (bb (list 'do (signature "MD5") '(signature "hi"))))) - (is (= "c22b5f9178342609428d6f51b2c5af4c0bde6a42" (bb (list 'do (signature "SHA-1") '(signature "hi"))))) - (is (= "8f434346648f6b96df89dda901c5176b10a6d83961dd3c1ac88b59b2dc327aa4" (bb (list 'do (signature "SHA-256") '(signature "hi")))))) + (is (= "c22b5f9178342609428d6f51b2c5af4c0bde6a42" (bb (list 'do (signature "SHA-1") '(signature "hi"))))) + (is (= "8f434346648f6b96df89dda901c5176b10a6d83961dd3c1ac88b59b2dc327aa4" (bb (list 'do (signature "SHA-256") '(signature "hi"))))) + (is (= "035afb1672de25549287fa4f6c108c1269c2a1d2390bf069520a95d1fec25e85" (bb (list 'do (signature "SHA-256") '(signature "654321f5fab07590a9e77e19ac4ccf53c8ab05f232b197432b62f2ec0677651bfc4c04")))))) diff --git a/test/babashka/main_test.clj b/test/babashka/main_test.clj index 7453d769..4dbe6ecb 100644 --- a/test/babashka/main_test.clj +++ b/test/babashka/main_test.clj @@ -18,30 +18,34 @@ :eof nil} (apply test-utils/bb (when (some? input) (str input)) (map str args))))) +(defn parse-opts [args] + (let [[args global-opts] (main/parse-global-opts args)] + (main/parse-opts args global-opts))) + (deftest parse-opts-test (is (= "1667" - (:nrepl (main/parse-opts ["--nrepl-server"])))) + (:nrepl (parse-opts ["--nrepl-server"])))) (is (= "1666" - (:socket-repl (main/parse-opts ["--socket-repl"])))) + (:socket-repl (parse-opts ["--socket-repl"])))) (is (= {:nrepl "1667", :classpath "src"} - (main/parse-opts ["--nrepl-server" "-cp" "src"]))) + (parse-opts ["--nrepl-server" "-cp" "src"]))) (is (= {:nrepl "1667", :classpath "src"} - (main/parse-opts ["-cp" "src" "nrepl-server"]))) + (parse-opts ["-cp" "src" "nrepl-server"]))) (is (= {:socket-repl "1666", :expressions ["123"]} - (main/parse-opts ["--socket-repl" "-e" "123"]))) + (parse-opts ["--socket-repl" "-e" "123"]))) (is (= {:socket-repl "1666", :expressions ["123"]} - (main/parse-opts ["--socket-repl" "1666" "-e" "123"]))) + (parse-opts ["--socket-repl" "1666" "-e" "123"]))) (is (= {:nrepl "1666", :expressions ["123"]} - (main/parse-opts ["--nrepl-server" "1666" "-e" "123"]))) + (parse-opts ["--nrepl-server" "1666" "-e" "123"]))) (is (= {:classpath "src" :uberjar "foo.jar"} - (main/parse-opts ["--classpath" "src" "uberjar" "foo.jar"]))) + (parse-opts ["--classpath" "src" "uberjar" "foo.jar"]))) (is (= {:classpath "src" :uberjar "foo.jar" :debug true} - (main/parse-opts ["--debug" "--classpath" "src" "uberjar" "foo.jar"]))) - (is (= "src" (:classpath (main/parse-opts ["--classpath" "src"])))) - (is (:debug (main/parse-opts ["--debug"]))) + (parse-opts ["--debug" "--classpath" "src" "uberjar" "foo.jar"]))) + (is (= "src" (:classpath (parse-opts ["--classpath" "src"])))) + (is (:debug (parse-opts ["--debug"]))) (is (= 123 (bb nil "(println 123)"))) (is (= 123 (bb nil "-e" "(println 123)"))) (is (= 123 (bb nil "--eval" "(println 123)"))) @@ -54,8 +58,9 @@ (let [v (bb nil "--describe")] (is (:babashka/version v)) (is (:feature/xml v))) - (is (= {:force? true} (main/parse-opts ["--force"]))) - (is (= {:main "foo", :command-line-args '("-h")} (main/parse-opts ["-m" "foo" "-h"])))) + (is (= {:force? true} (parse-opts ["--force"]))) + (is (= {:main "foo", :command-line-args '("-h")} (parse-opts ["-m" "foo" "-h"]))) + (is (= {:main "foo", :command-line-args '("-h")} (parse-opts ["-m" "foo" "--" "-h"])))) (deftest version-test (is (= [1 0 0] (main/parse-version "1.0.0-SNAPSHOT"))) @@ -809,6 +814,10 @@ true"))) (deftest aget-test (is (= 1 (bb nil "(def array-2d (into-array [(int-array [1 2]) (int-array [3 4])])) (aget array-2d 0 0)")))) +(deftest into-array-fallback-test + (is (= :f (bb nil "(first (into-array [:f]))"))) + (is (= :f (bb nil "(first (first (into-array [(into-array [:f])])))")))) + ;;;; Scratch (comment diff --git a/test/babashka/test_utils.clj b/test/babashka/test_utils.clj index 029b6f52..fb55ca3e 100644 --- a/test/babashka/test_utils.clj +++ b/test/babashka/test_utils.clj @@ -47,13 +47,10 @@ (defn bb-jvm [input-or-opts & args] (reset! cp/cp-state nil) (reset! main/env {}) - (if-let [path *bb-edn-path*] - (let [raw (slurp path)] - (vreset! common/bb-edn - (assoc (edn/read-string raw) - :raw raw))) - (vreset! common/bb-edn nil)) - (let [os (java.io.StringWriter.) + (vreset! common/bb-edn nil) + (let [args (cond-> args *bb-edn-path* + (->> (list* "--config" *bb-edn-path* "--deps-root" "."))) + os (java.io.StringWriter.) es (if-let [err (:err input-or-opts)] err (java.io.StringWriter.)) in (if (string? input-or-opts) @@ -75,7 +72,11 @@ (with-in-str input-or-opts (apply main/main args)) (apply main/main args)))] (if (zero? res) - (normalize (str os)) + (do + (let [err (str es)] + (when-not (str/blank? err) + (println err))) ;; flush stderr + (normalize (str os))) (do (println (str os)) (throw (ex-info (str es) @@ -87,14 +88,12 @@ (vars/bindRoot sci/err *err*))))) (defn bb-native [input & args] - (let [res (p/process (into ["./bb"] args) - (cond-> {:in input - :out :string - :err :string} - *bb-edn-path* - (assoc - :extra-env (assoc (into {} (System/getenv)) - "BABASHKA_EDN" *bb-edn-path*)))) + (let [args (cond-> args *bb-edn-path* + (->> (list* "--config" *bb-edn-path* "--deps-root" "."))) + res (p/process (into ["./bb"] args) + {:in input + :out :string + :err :string}) res (deref res) exit (:exit res) error? (pos? exit)] diff --git a/test/babashka/uberjar_test.clj b/test/babashka/uberjar_test.clj index 581a863d..66d94a13 100644 --- a/test/babashka/uberjar_test.clj +++ b/test/babashka/uberjar_test.clj @@ -45,16 +45,6 @@ (is (= "(\"42\")\n" (tu/bb nil "--jar" path "-m" "my.main-main" "42"))) (is (= "(\"42\")\n" (tu/bb nil "--classpath" path "-m" "my.main-main" "42"))) (is (= "(\"42\")\n" (tu/bb nil path "42")))))) - - ; this test fails the windows native test in CI - (when-not main/windows? - (testing "throw on empty classpath" - (let [tmp-file (java.io.File/createTempFile "uber" ".jar") - path (.getPath tmp-file)] - (.deleteOnExit tmp-file) - (is (thrown-with-msg? - Exception #"classpath" - (tu/bb nil "uberjar" path "-m" "my.main-main")))))) (testing "ignore empty entries on classpath" (let [tmp-file (java.io.File/createTempFile "uber" ".jar") path (.getPath tmp-file) @@ -63,3 +53,14 @@ (tu/bb nil "--classpath" empty-classpath "uberjar" path "-m" "my.main-main") ;; Only a manifest entry is added (is (< (count-entries path) 3))))) + +(deftest throw-on-empty-classpath + ;; this test fails the windows native test in CI + (when-not main/windows? + (testing "throw on empty classpath" + (let [tmp-file (java.io.File/createTempFile "uber" ".jar") + path (.getPath tmp-file)] + (.deleteOnExit tmp-file) + (is (thrown-with-msg? + Exception #"classpath" + (tu/bb nil "uberjar" path "-m" "my.main-main"))))))) diff --git a/test/babashka/uberscript_test.clj b/test/babashka/uberscript_test.clj index b7d39683..4fbc1af8 100644 --- a/test/babashka/uberscript_test.clj +++ b/test/babashka/uberscript_test.clj @@ -1,16 +1,25 @@ (ns babashka.uberscript-test (:require [babashka.test-utils :as tu] - [clojure.test :as t :refer [deftest is testing]])) + [clojure.test :as t :refer [deftest is]])) -(deftest uberscript-test +(deftest basic-test (let [tmp-file (java.io.File/createTempFile "uberscript" ".clj")] (.deleteOnExit tmp-file) - (is (empty? (tu/bb nil "--classpath" "test-resources/babashka/src_for_classpath_test" "uberscript" (.getPath tmp-file) "-m" "my.main" ))) + (is (empty? (tu/bb nil "--classpath" "test-resources/babashka/src_for_classpath_test" "uberscript" (.getPath tmp-file) "-m" "my.main"))) (is (= "(\"1\" \"2\" \"3\" \"4\")\n" - (tu/bb nil "--file" (.getPath tmp-file) "1" "2" "3" "4"))) - (testing "order of namespaces is correct" - (tu/bb nil "--classpath" "test-resources/babashka/uberscript/src" "uberscript" (.getPath tmp-file) "-m" "my.main") - (is (= "(\"1\" \"2\" \"3\" \"4\")\n" + (tu/bb nil "--file" (.getPath tmp-file) "1" "2" "3" "4"))))) + +(when-not (= "aarch64" (System/getenv "BABASHKA_ARCH")) + (deftest advanced-test + (let [tmp-file (java.io.File/createTempFile "uberscript" ".clj")] + (.deleteOnExit tmp-file) + ;; we test: + ;; order of namespaces + ;; reader error for ::a/foo is swallowed + ;; pod namespaces can be loaded without a problem + ;; resulting program can be executed + (is (empty? (tu/bb nil "--classpath" "test-resources/babashka/uberscript/src" "uberscript" (.getPath tmp-file) "-m" "my.main"))) + (is (= ":clojure.string/foo\ntrue\n(\"1\" \"2\" \"3\" \"4\")\n" (tu/bb nil "--file" (.getPath tmp-file) "1" "2" "3" "4"))))))