commerce: stock-constrained reservation (19 tests) — Phase 5 ext
Some checks failed
Test, Build, and Deploy / test-build-deploy (push) Failing after 1m17s
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>
This commit is contained in:
122
lib/commerce/tests/stock.sx
Normal file
122
lib/commerce/tests/stock.sx
Normal file
@@ -0,0 +1,122 @@
|
||||
;; 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))
|
||||
Reference in New Issue
Block a user