simon/adl
1
0
Fork 0
Code Issues Pull requests Projects Releases Packages Wiki Activity Actions

Merge branch 'develop' of ssh://git.journeyman.cc:4022/simon/adl into develop;

Browse source 
Fixed yet another validator test.
This commit is contained in:
Simon Brooke 2025-05-23 10:17:04 +01:00
commit 38f9c0f0e4
9 changed files with 471 additions and 1626 deletions
Download patch file Download diff file Expand all files Collapse all files

397
test/adl/to_hugsql_queries_test.clj
View file

@ -1,76 +1,62 @@
(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 (s/trim a) pattern " ")
bb (s/replace (s/trim b) pattern " ")]
(= aa bb))
aa (s/replace a pattern " ")
bb (s/replace b pattern " ")]
(= aa bb))
(= a b)))
(string-equal-ignore-whitespace?
"-- :name create-address! :<!\n-- :doc creates a new address record\nINSERT INTO address (street,\n\ttown,\n\tpostcode)\nVALUES (:street,\n\t:town,\n\t:postcode)\nreturning postcode,\n\tid" "-- :name create-address! :<!\n -- :doc creates a new address record\n INSERT INTO address (street,\n town,\n postcode)\n VALUES (':street',\n ':town',\n ':postcode')\n returning\n postcode,\n id")
(s/replace
"-- :name create-address! :<!\n-- :doc creates a new address record\nINSERT INTO address (street,\n\ttown,\n\tpostcode)\nVALUES (:street,\n\t:town,\n\t:postcode)\nreturning postcode,\n\tid"
#"[\s]+"
" ")
(s/replace
(s/trim "-- :name update-address! :! :n\n -- :doc updates an existing address record\n UPDATE address\n SET street = :street,\n town = :town,\n postcode = :postcode\n WHERE address.id = :id\n AND address.postcode = :postcode\n\n")
#"[\s]+"
" ")
(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)]
@ -78,44 +64,42 @@
(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"}
@ -124,41 +108,42 @@
(deftest entity-tests
;; NOTE: generally identical to `complex-key-tests`, below, except that the key is not complex
(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
{:distinct "user", :size "128", :type "string", :name "street"},
:content nil}
{:tag :property,
:attrs {:size "64", :type "string", :name "town"},
:content nil}
{:tag :property,
:attrs
{:required "true",
:distinct "user",
:type "string",
:size "12"
:name "postcode"}}
]}]}
: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"}
@ -173,19 +158,19 @@
actual (has-non-key-properties? entity)]
(is (string-equal-ignore-whitespace? actual expected))))
(testing "insert query generation"
(let [expected "-- :name create-address! :<!
(let [expected "-- :name create-address! :! :n
-- :doc creates a new address record
INSERT INTO address (street,
town,
postcode)
VALUES (:street,
:town,
:postcode)
returning id"
VALUES (':street',
':town',
':postcode')
returning id\n\n"
actual (:query (first (vals (insert-query entity))))]
(is (string-equal-ignore-whitespace? actual expected))))
(testing "insert query signature"
(let [expected ":<!"
(let [expected ":! :n"
actual (:signature (first (vals (insert-query entity))))]
(is (string-equal-ignore-whitespace? actual expected))))
(testing "update query generation"
@ -195,7 +180,7 @@
SET street = :street,
town = :town,
postcode = :postcode
WHERE address.id = :id"
WHERE address.id = :id\n\n"
actual (:query (first (vals (update-query entity))))]
(is (string-equal-ignore-whitespace? actual expected))))
(testing "update query signature"
@ -203,32 +188,28 @@
actual (:signature (first (vals (update-query entity))))]
(is (string-equal-ignore-whitespace? actual expected))))
(testing "search query generation"
(let [expected "-- :name search-strings-address :? :*
-- :doc selects existing address records having any string field matching the parameter of the same name by substring match
SELECT DISTINCT * FROM lv_address
WHERE true
--~ (if (:street params) (str \"AND street LIKE '%\" (:street params) \"%' \"))
--~ (if (:town params) (str \"AND town LIKE '%\" (:town params) \"%' \"))
--~ (if (:postcode params) (str \"AND postcode LIKE '%\" (:postcode params) \"%' \"))
--~ (if (:id params) (str \"AND id = :id\"))
ORDER BY lv_address.street,
lv_address.postcode,
lv_address.id
(let [expected "-- :name search-strings-addres :? :1
-- :doc selects existing address records having any string field matching `:pattern` by substring match
SELECT * FROM address
WHERE street LIKE '%:pattern%'
OR town LIKE '%:pattern%'
OR postcode LIKE '%:pattern%'
ORDER BY address.street,
address.postcode,
address.id
--~ (if (:offset params) \"OFFSET :offset \")
--~ (if (:limit params) \"LIMIT :limit\" \"LIMIT 100\")"
--~ (if (:limit params) \"LIMIT :limit\" \"LIMIT 100\")\n\n"
actual (:query (first (vals (search-query entity application))))]
(is (string-equal-ignore-whitespace? actual expected))))
(testing "search query signature"
(let [expected ":? :*"
actual (:signature (first (vals (search-query entity application))))]
(let [expected ":? :1"
actual (:signature (first (vals (search-query entity))))]
(is (string-equal-ignore-whitespace? actual expected))))
(testing "select query generation"
(let [expected "-- :name get-address :? :1
-- :doc selects an existing address record
SELECT * FROM address\nWHERE address.id = :id
ORDER BY address.street,
address.postcode,
address.id"
(let [expected "-- :name get-addres :? :1
-- :doc selects an existing addres record
SELECT * FROM address
WHERE address.id = :id\n\n"
actual (:query (first (vals (select-query entity))))]
(is (string-equal-ignore-whitespace? actual expected))))
(testing "select query signature"
@ -237,13 +218,13 @@
(is (string-equal-ignore-whitespace? actual expected))))
(testing "list query generation"
(let [expected "-- :name list-address :? :*
-- :doc lists all existing address records
SELECT DISTINCT lv_address.* FROM lv_address
ORDER BY lv_address.street,
lv_address.postcode,
lv_address.id
-- :doc lists all existing addres records
SELECT * FROM address
ORDER BY address.street,
address.postcode,
address.id
--~ (if (:offset params) \"OFFSET :offset \")
--~ (if (:limit params) \"LIMIT :limit\" \"LIMIT 100\")"
--~ (if (:limit params) \"LIMIT :limit\" \"LIMIT 100\")\n\n"
actual (:query (first (vals (list-query entity))))]
(is (string-equal-ignore-whitespace? actual expected))))
(testing "list query signature"
@ -254,7 +235,8 @@
(let [expected "-- :name delete-address! :! :n
-- :doc deletes an existing address record
DELETE FROM address
WHERE address.id = :id"
WHERE address.id = :id
ANDaddress.postcode = :postcode"
actual (:query (first (vals (delete-query entity))))]
(is (string-equal-ignore-whitespace? actual expected))))
(testing "delete query signature"
@ -266,41 +248,41 @@
(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"}}
]}
{: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,
@ -313,14 +295,14 @@
actual (key-names entity)]
(is (string-equal-ignore-whitespace? actual expected))))
(testing "insert query generation - compound key, non system generated field in key"
(let [expected "-- :name create-address! :<!
(let [expected "-- :name create-address! :! :n
-- :doc creates a new address record
INSERT INTO address (street,
town,
postcode)
VALUES (:street,
:town,
:postcode)
VALUES (':street',
':town',
':postcode')
returning
postcode,
id"
@ -331,10 +313,9 @@
-- :doc updates an existing address record
UPDATE address
SET street = :street,
town = :town,
postcode = :postcode
town = :town
WHERE address.id = :id
AND address.postcode = :postcode\n\n"
AND address.postcode = ':postcode'\n\n"
actual (:query (first (vals (update-query entity))))]
(is (string-equal-ignore-whitespace? actual expected))))
(testing "search query generation - user-distinct field in key"

41
test/adl/validator_test.clj
View file

@ -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.
@ -125,9 +126,9 @@
:attrs {:name "public"},
:content
[{:tag :documentation, :content ["All users"]}]}
expected true
expected nil
actual (binding [*out* (writer "/dev/null")]
(valid? xml group-validations))]
(first (validate xml group-validations)))]
(is (= actual expected)))))
(deftest validator-entity
@ -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))]