commerce: stock-constrained reservation (19 tests) — Phase 5 ext
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:
2026-06-07 12:31:19 +00:00
parent a9d8711101
commit da349b169e
6 changed files with 249 additions and 8 deletions

122
lib/commerce/tests/stock.sx Normal file
View 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))