giles
da349b169e
Some checks failed
Test, Build, and Deploy / test-build-deploy (push) Failing after 1m17s
stock.sx — reservation as a precondition the host checks before order-begin! (validate -> begin), keeping the flow pure. available-stock reads catalog stock facts; can-reserve?/reserve-check/reservation-shortfalls gate a cart; effective-available nets out concurrent reservations so orders can't over-reserve; sufficient-stocko is the multidirectional availability query. Total 258/258 across 16 suites. Co-Authored-By: Claude Opus 4.8 (1M context) <noreply@anthropic.com>
123 lines
2.8 KiB
Plaintext
123 lines
2.8 KiB
Plaintext
;; lib/commerce/tests/stock.sx — stock-constrained reservation.
|
|
;; Uses (commerce-test name got expected) provided by conformance.sh.
|
|
|
|
(define
|
|
cat
|
|
(make-catalog
|
|
(list
|
|
(list "widget" 1000 :standard)
|
|
(list "gadget" 2500 :standard))
|
|
(list)
|
|
(list
|
|
(list "widget" :small 5)
|
|
(list "widget" :large 0)
|
|
(list "gadget" :std 12))))
|
|
|
|
;; --- availability ---
|
|
|
|
(commerce-test
|
|
"available-found"
|
|
(available-stock cat "widget" :small)
|
|
5)
|
|
(commerce-test
|
|
"available-zero"
|
|
(available-stock cat "widget" :large)
|
|
0)
|
|
(commerce-test
|
|
"available-absent"
|
|
(available-stock cat "widget" :none)
|
|
0)
|
|
|
|
;; --- per-line reservability ---
|
|
|
|
(commerce-test
|
|
"shortfall-fits"
|
|
(line-shortfall cat (list "widget" :small 5))
|
|
0)
|
|
(commerce-test
|
|
"shortfall-over"
|
|
(line-shortfall cat (list "widget" :small 8))
|
|
3)
|
|
(commerce-test
|
|
"reservable-yes"
|
|
(line-reservable? cat (list "gadget" :std 12))
|
|
true)
|
|
(commerce-test
|
|
"reservable-no"
|
|
(line-reservable? cat (list "widget" :large 1))
|
|
false)
|
|
|
|
;; --- cart-level reservation check ---
|
|
|
|
(commerce-test
|
|
"can-reserve-yes"
|
|
(can-reserve?
|
|
cat
|
|
(list (list "widget" :small 5) (list "gadget" :std 2)))
|
|
true)
|
|
|
|
(commerce-test
|
|
"can-reserve-no"
|
|
(can-reserve? cat (list (list "widget" :small 9)))
|
|
false)
|
|
|
|
(commerce-test
|
|
"shortfalls-detail"
|
|
(reservation-shortfalls
|
|
cat
|
|
(list (list "widget" :small 9) (list "gadget" :std 2)))
|
|
(list {:requested 9 :available 5 :sku "widget" :variant :small :short 4}))
|
|
|
|
(commerce-test
|
|
"reserve-check-ok"
|
|
(reserve-check cat (list (list "gadget" :std 1)))
|
|
:ok)
|
|
|
|
(commerce-test
|
|
"reserve-check-rejected"
|
|
(reserve-check cat (list (list "widget" :large 1)))
|
|
{:shortfalls (list {:requested 1 :available 0 :sku "widget" :variant :large :short 1}) :rejected :insufficient-stock})
|
|
|
|
;; --- reservation view: concurrent holds reduce availability ---
|
|
|
|
(define held (list (list "widget" :small 3)))
|
|
|
|
(commerce-test
|
|
"effective-after-hold"
|
|
(effective-available cat held "widget" :small)
|
|
2)
|
|
(commerce-test
|
|
"effective-other-unaffected"
|
|
(effective-available cat held "gadget" :std)
|
|
12)
|
|
(commerce-test
|
|
"reservable-with-fits"
|
|
(line-reservable-with? cat held (list "widget" :small 2))
|
|
true)
|
|
(commerce-test
|
|
"reservable-with-over"
|
|
(line-reservable-with? cat held (list "widget" :small 3))
|
|
false)
|
|
|
|
;; --- relational availability query (multidirectional) ---
|
|
|
|
(commerce-test
|
|
"sufficient-forward"
|
|
(run*
|
|
x
|
|
(fresh () (sufficient-stocko cat "widget" :small 5) (== x true)))
|
|
(list true))
|
|
|
|
(commerce-test
|
|
"sufficient-forward-over"
|
|
(run*
|
|
x
|
|
(fresh () (sufficient-stocko cat "widget" :small 6) (== x true)))
|
|
(list))
|
|
|
|
;; backward: which variants of widget can supply 1 unit?
|
|
(commerce-test
|
|
"variants-supplying-1"
|
|
(run* v (fresh (q) (stocko cat "widget" v q) (lteo-i 1 q)))
|
|
(list :small))
|