Lots of work on trying to get all validator tests to pass.
Three still fail, but substantial progress. The to-husql-queries tests are failing much worse, but are not a current target (nor is the validator, frankly, but it irks me that it is so broken)
This commit is contained in:
parent
5af9a7349c
commit
b944aa6bf1
6 changed files with 677 additions and 639 deletions
|
|
@ -1,109 +1,104 @@
|
|||
(ns adl.to-hugsql-queries-test
|
||||
(:require [clojure.string :as s]
|
||||
[clojure.test :refer :all]
|
||||
[adl.to-hugsql-queries :refer :all]
|
||||
[adl-support.utils :refer :all]))
|
||||
[clojure.test :refer [deftest is testing]]
|
||||
[adl.to-hugsql-queries :refer [delete-query insert-query list-query order-by-clause search-query select-query update-query]]
|
||||
[adl-support.utils :refer [child-with-tag has-non-key-properties? has-primary-key? key-names]]))
|
||||
|
||||
(defn string-equal-ignore-whitespace?
|
||||
"I don't want unit tests to fail just because emitted whitespace changes."
|
||||
[a b]
|
||||
(if
|
||||
(and
|
||||
(string? a)
|
||||
(string? b))
|
||||
(let
|
||||
(and
|
||||
(string? a)
|
||||
(string? b))
|
||||
(let
|
||||
[pattern #"[\s]+"
|
||||
aa (s/replace a pattern " ")
|
||||
bb (s/replace b pattern " ")]
|
||||
(= aa bb))
|
||||
(= aa bb))
|
||||
(= a b)))
|
||||
|
||||
(deftest order-by-tests
|
||||
(let [application {:tag :application,
|
||||
:attrs {:version "0.1.1", :name "test-app"},
|
||||
:content
|
||||
[{:tag :entity,
|
||||
:attrs {:name "address"},
|
||||
:content
|
||||
[{:tag :key,
|
||||
:attrs nil,
|
||||
:content
|
||||
[{:tag :property,
|
||||
:attrs
|
||||
{:immutable "true",
|
||||
:required "true",
|
||||
:distinct "system",
|
||||
:type "integer",
|
||||
:name "id"},
|
||||
:content
|
||||
[{:tag :generator, :attrs {:action "native"}, :content nil}]}
|
||||
{:tag :property,
|
||||
:attrs
|
||||
{:immutable "true",
|
||||
:required "true",
|
||||
:distinct "all",
|
||||
:generator "assigned"
|
||||
:type "string",
|
||||
:size "12"
|
||||
:name "postcode"},
|
||||
:content
|
||||
[{:tag :generator, :attrs {:action "native"}, :content nil}]}
|
||||
]}
|
||||
{:tag :property,
|
||||
:attrs
|
||||
{:distinct "user", :size "128", :type "string", :name "street"},
|
||||
:content nil}
|
||||
{:tag :property,
|
||||
:attrs {:size "64", :type "string", :name "town"},
|
||||
:content nil}
|
||||
]}]}
|
||||
:attrs {:version "0.1.1", :name "test-app"},
|
||||
:content
|
||||
[{:tag :entity,
|
||||
:attrs {:name "address"},
|
||||
:content
|
||||
[{:tag :key,
|
||||
:attrs nil,
|
||||
:content
|
||||
[{:tag :property,
|
||||
:attrs
|
||||
{:immutable "true",
|
||||
:required "true",
|
||||
:distinct "system",
|
||||
:type "integer",
|
||||
:name "id"},
|
||||
:content
|
||||
[{:tag :generator, :attrs {:action "native"}, :content nil}]}
|
||||
{:tag :property,
|
||||
:attrs
|
||||
{:immutable "true",
|
||||
:required "true",
|
||||
:distinct "all",
|
||||
:generator "assigned"
|
||||
:type "string",
|
||||
:size "12"
|
||||
:name "postcode"},
|
||||
:content
|
||||
[{:tag :generator, :attrs {:action "native"}, :content nil}]}]}
|
||||
{:tag :property,
|
||||
:attrs
|
||||
{:distinct "user", :size "128", :type "string", :name "street"},
|
||||
:content nil}
|
||||
{:tag :property,
|
||||
:attrs {:size "64", :type "string", :name "town"},
|
||||
:content nil}]}]}
|
||||
entity (child-with-tag application :entity)]
|
||||
(testing "user distinct properties should provide the default ordering"
|
||||
(testing "user distinct properties should provide the default ordering"
|
||||
(let [expected
|
||||
"ORDER BY address.street, address.postcode, address.id"
|
||||
actual (order-by-clause entity)]
|
||||
(is (string-equal-ignore-whitespace? actual expected))))))
|
||||
|
||||
|
||||
(deftest keys-name-extraction-tests
|
||||
(let [application {:tag :application,
|
||||
:attrs {:version "0.1.1", :name "test-app"},
|
||||
:content
|
||||
[{:tag :entity,
|
||||
:attrs {:name "address"},
|
||||
:content
|
||||
[{:tag :key,
|
||||
:attrs nil,
|
||||
:content
|
||||
[{:tag :property,
|
||||
:attrs
|
||||
{:immutable "true",
|
||||
:required "true",
|
||||
:distinct "system",
|
||||
:type "integer",
|
||||
:name "id"},
|
||||
:content
|
||||
[{:tag :generator, :attrs {:action "native"}, :content nil}]}
|
||||
{:tag :property,
|
||||
:attrs
|
||||
{:immutable "true",
|
||||
:required "true",
|
||||
:distinct "all",
|
||||
:generator "assigned"
|
||||
:type "string",
|
||||
:size "12"
|
||||
:name "postcode"},
|
||||
:content
|
||||
[{:tag :generator, :attrs {:action "native"}, :content nil}]}
|
||||
]}
|
||||
{:tag :property,
|
||||
:attrs
|
||||
{:distinct "user", :size "128", :type "string", :name "street"},
|
||||
:content nil}
|
||||
{:tag :property,
|
||||
:attrs {:size "64", :type "string", :name "town"},
|
||||
:content nil}
|
||||
]}]}
|
||||
(let [application {:tag :application,
|
||||
:attrs {:version "0.1.1", :name "test-app"},
|
||||
:content
|
||||
[{:tag :entity,
|
||||
:attrs {:name "address"},
|
||||
:content
|
||||
[{:tag :key,
|
||||
:attrs nil,
|
||||
:content
|
||||
[{:tag :property,
|
||||
:attrs
|
||||
{:immutable "true",
|
||||
:required "true",
|
||||
:distinct "system",
|
||||
:type "integer",
|
||||
:name "id"},
|
||||
:content
|
||||
[{:tag :generator, :attrs {:action "native"}, :content nil}]}
|
||||
{:tag :property,
|
||||
:attrs
|
||||
{:immutable "true",
|
||||
:required "true",
|
||||
:distinct "all",
|
||||
:generator "assigned"
|
||||
:type "string",
|
||||
:size "12"
|
||||
:name "postcode"},
|
||||
:content
|
||||
[{:tag :generator, :attrs {:action "native"}, :content nil}]}]}
|
||||
{:tag :property,
|
||||
:attrs
|
||||
{:distinct "user", :size "128", :type "string", :name "street"},
|
||||
:content nil}
|
||||
{:tag :property,
|
||||
:attrs {:size "64", :type "string", :name "town"},
|
||||
:content nil}]}]}
|
||||
entity (child-with-tag application :entity)]
|
||||
(testing "keys name extraction"
|
||||
(let [expected #{"id" "postcode"}
|
||||
|
|
@ -113,43 +108,41 @@
|
|||
|
||||
(deftest entity-tests
|
||||
(let [application {:tag :application,
|
||||
:attrs {:version "0.1.1", :name "test-app"},
|
||||
:content
|
||||
[{:tag :entity,
|
||||
:attrs {:name "address"},
|
||||
:content
|
||||
[{:tag :key,
|
||||
:attrs nil,
|
||||
:content
|
||||
[{:tag :property,
|
||||
:attrs
|
||||
{:immutable "true",
|
||||
:required "true",
|
||||
:distinct "system",
|
||||
:type "integer",
|
||||
:name "id"},
|
||||
:content
|
||||
[{:tag :generator, :attrs {:action "native"}, :content nil}]}
|
||||
{:tag :property,
|
||||
:attrs
|
||||
{:immutable "true",
|
||||
:required "true",
|
||||
:distinct "all",
|
||||
:generator "assigned"
|
||||
:type "string",
|
||||
:size "12"
|
||||
:name "postcode"},
|
||||
:content
|
||||
[{:tag :generator, :attrs {:action "native"}, :content nil}]}
|
||||
]}
|
||||
{:tag :property,
|
||||
:attrs
|
||||
{:distinct "user", :size "128", :type "string", :name "street"},
|
||||
:content nil}
|
||||
{:tag :property,
|
||||
:attrs {:size "64", :type "string", :name "town"},
|
||||
:content nil}
|
||||
]}]}
|
||||
:attrs {:version "0.1.1", :name "test-app"},
|
||||
:content
|
||||
[{:tag :entity,
|
||||
:attrs {:name "address"},
|
||||
:content
|
||||
[{:tag :key,
|
||||
:attrs nil,
|
||||
:content
|
||||
[{:tag :property,
|
||||
:attrs
|
||||
{:immutable "true",
|
||||
:required "true",
|
||||
:distinct "system",
|
||||
:type "integer",
|
||||
:name "id"},
|
||||
:content
|
||||
[{:tag :generator, :attrs {:action "native"}, :content nil}]}
|
||||
{:tag :property,
|
||||
:attrs
|
||||
{:immutable "true",
|
||||
:required "true",
|
||||
:distinct "all",
|
||||
:generator "assigned"
|
||||
:type "string",
|
||||
:size "12"
|
||||
:name "postcode"},
|
||||
:content
|
||||
[{:tag :generator, :attrs {:action "native"}, :content nil}]}]}
|
||||
{:tag :property,
|
||||
:attrs
|
||||
{:distinct "user", :size "128", :type "string", :name "street"},
|
||||
:content nil}
|
||||
{:tag :property,
|
||||
:attrs {:size "64", :type "string", :name "town"},
|
||||
:content nil}]}]}
|
||||
entity (child-with-tag application :entity)]
|
||||
(testing "keys name extraction"
|
||||
(let [expected #{"id"}
|
||||
|
|
@ -248,49 +241,45 @@
|
|||
(testing "delete query signature"
|
||||
(let [expected ":! :n"
|
||||
actual (:signature (first (vals (delete-query entity))))]
|
||||
(is (string-equal-ignore-whitespace? actual expected))))
|
||||
|
||||
))
|
||||
(is (string-equal-ignore-whitespace? actual expected))))))
|
||||
|
||||
(deftest complex-key-tests
|
||||
(let [application {:tag :application,
|
||||
:attrs {:version "0.1.1", :name "test-app"},
|
||||
:content
|
||||
[{:tag :entity,
|
||||
:attrs {:name "address"},
|
||||
:content
|
||||
[{:tag :key,
|
||||
:attrs nil,
|
||||
:content
|
||||
[{:tag :property,
|
||||
:attrs
|
||||
{:immutable "true",
|
||||
:required "true",
|
||||
:distinct "system",
|
||||
:type "integer",
|
||||
:name "id"},
|
||||
:content
|
||||
[{:tag :generator, :attrs {:action "native"}, :content nil}]}
|
||||
{:tag :property,
|
||||
:attrs
|
||||
{:immutable "true",
|
||||
:required "true",
|
||||
:distinct "all",
|
||||
:generator "assigned"
|
||||
:type "string",
|
||||
:size "12"
|
||||
:name "postcode"},
|
||||
:content
|
||||
[{:tag :generator, :attrs {:action "native"}, :content nil}]}
|
||||
]}
|
||||
{:tag :property,
|
||||
:attrs
|
||||
{:distinct "user", :size "128", :type "string", :name "street"},
|
||||
:content nil}
|
||||
{:tag :property,
|
||||
:attrs {:size "64", :type "string", :name "town"},
|
||||
:content nil}
|
||||
]}]}
|
||||
:attrs {:version "0.1.1", :name "test-app"},
|
||||
:content
|
||||
[{:tag :entity,
|
||||
:attrs {:name "address"},
|
||||
:content
|
||||
[{:tag :key,
|
||||
:attrs nil,
|
||||
:content
|
||||
[{:tag :property,
|
||||
:attrs
|
||||
{:immutable "true",
|
||||
:required "true",
|
||||
:distinct "system",
|
||||
:type "integer",
|
||||
:name "id"},
|
||||
:content
|
||||
[{:tag :generator, :attrs {:action "native"}, :content nil}]}
|
||||
{:tag :property,
|
||||
:attrs
|
||||
{:immutable "true",
|
||||
:required "true",
|
||||
:distinct "all",
|
||||
:generator "assigned"
|
||||
:type "string",
|
||||
:size "12"
|
||||
:name "postcode"},
|
||||
:content
|
||||
[{:tag :generator, :attrs {:action "native"}, :content nil}]}]}
|
||||
{:tag :property,
|
||||
:attrs
|
||||
{:distinct "user", :size "128", :type "string", :name "street"},
|
||||
:content nil}
|
||||
{:tag :property,
|
||||
:attrs {:size "64", :type "string", :name "town"},
|
||||
:content nil}]}]}
|
||||
entity (child-with-tag application :entity)]
|
||||
(testing "user distinct properties should provide the default ordering"
|
||||
(let [expected "ORDER BY address.street,
|
||||
|
|
|
|||
|
|
@ -1,9 +1,10 @@
|
|||
(ns adl.validator-test
|
||||
(:require [clojure.java.io :refer [writer]]
|
||||
[clojure.test :refer :all]
|
||||
[clojure.xml :refer [parse]]
|
||||
[adl.validator :refer :all]
|
||||
[bouncer.core :refer [valid?]]))
|
||||
(:require
|
||||
[adl.validator :refer :all]
|
||||
[bouncer.core :refer [valid? validate]]
|
||||
[clojure.java.io :refer [writer]]
|
||||
[clojure.test :refer :all]
|
||||
[clojure.xml :refer [parse]]))
|
||||
|
||||
;; OK, so where we're up to: documentation breaks validation of the
|
||||
;; element that contains it if the documentation is non-empty.
|
||||
|
|
@ -262,9 +263,9 @@
|
|||
:name "id"},
|
||||
:content
|
||||
[{:tag :generator, :attrs {:action "native"}, :content nil}]}]}
|
||||
expected true
|
||||
actual (binding [*out* (writer "/dev/null")]
|
||||
(valid? xml key-validations))]
|
||||
expected nil
|
||||
actual (first (binding [*out* (writer "/dev/null")]
|
||||
(validate xml key-validations)))]
|
||||
(is (= actual expected)))))
|
||||
|
||||
(deftest validator-property
|
||||
|
|
@ -340,14 +341,14 @@
|
|||
(deftest validator-option
|
||||
(testing "Validation of option element"
|
||||
(let [xml {:tag :option,
|
||||
:attrs {:value "Female"},
|
||||
:content
|
||||
[{:tag :prompt,
|
||||
:attrs {:locale "fr-FR", :prompt "Femme"},
|
||||
:content nil}
|
||||
{:tag :prompt,
|
||||
:attrs {:locale "en-GB", :prompt "Female"},
|
||||
:content nil}]}
|
||||
:attrs {:value "Female"},
|
||||
:content
|
||||
[{:tag :prompt,
|
||||
:attrs {:locale "fr-FR", :prompt "Femme"},
|
||||
:content nil}
|
||||
{:tag :prompt,
|
||||
:attrs {:locale "en-GB", :prompt "Female"},
|
||||
:content nil}]}
|
||||
expected true
|
||||
actual (binding [*out* (writer "/dev/null")]
|
||||
(valid? xml option-validations))]
|
||||
|
|
@ -378,8 +379,8 @@
|
|||
(deftest validator-page
|
||||
(testing "Validation of page element"
|
||||
(let [xml {:tag :page,
|
||||
:attrs {:properties "all", :name "inspect-person"},
|
||||
:content nil}
|
||||
:attrs {:properties "all", :name "inspect-person"},
|
||||
:content nil}
|
||||
expected true
|
||||
actual (binding [*out* (writer "/dev/null")]
|
||||
(valid? xml page-validations))]
|
||||
|
|
|
|||
Loading…
Add table
Add a link
Reference in a new issue