commerce: stacking precedence + best-price selection + backward query (16 tests) — Phase 2 done
Some checks are pending
Test, Build, and Deploy / test-build-deploy (push) Waiting to run
Some checks are pending
Test, Build, and Deploy / test-build-deploy (push) Waiting to run
stack.sx — precedence as a separate selection layer, not in the rules. Exclusivity = unordered code pairs; valid-stackings enumerates every legal subset of applicable promos; best-stacking deterministically picks max total discount (stable on ties); stacking-by-totalo answers "which legal stacking yields total D?" backward. Member vs guest falls out of applicable-promos. Completes Phase 2. Total 99/99 across 6 suites. Co-Authored-By: Claude Opus 4.8 (1M context) <noreply@anthropic.com>
This commit is contained in:
127
lib/commerce/tests/stack.sx
Normal file
127
lib/commerce/tests/stack.sx
Normal file
@@ -0,0 +1,127 @@
|
||||
;; lib/commerce/tests/stack.sx — stacking precedence, exclusivity, best price.
|
||||
;; Uses (commerce-test name got expected) provided by conformance.sh.
|
||||
|
||||
(define
|
||||
pcat
|
||||
(make-catalog
|
||||
(list
|
||||
(list "widget" 1000 :standard)
|
||||
(list "book" 800 :zero-rated)
|
||||
(list "tea" 1000 :reduced))
|
||||
(list)
|
||||
(list)))
|
||||
|
||||
(define gctx (make-pricing-context pcat (list) :uk :guest))
|
||||
(define mctx (make-pricing-context pcat (list) :uk :member))
|
||||
|
||||
(define
|
||||
cart
|
||||
(list
|
||||
(list "widget" :none 3)
|
||||
(list "book" :none 1)
|
||||
(list "tea" :none 6)))
|
||||
|
||||
(define
|
||||
ruleset
|
||||
(list
|
||||
(list :percent "TEN" :standard 1000)
|
||||
(list :percent "TWENTY" :standard 2000)
|
||||
(list :fixed "FIVER" 5000 500)
|
||||
(list :bundle "B3T" "tea" 3)
|
||||
(list :member "MEM" :standard 2500)))
|
||||
|
||||
;; The three standard-class discounts are mutually exclusive.
|
||||
(define
|
||||
exclusions
|
||||
(list (list "TEN" "TWENTY") (list "TEN" "MEM") (list "TWENTY" "MEM")))
|
||||
|
||||
;; --- exclusivity predicates ---
|
||||
|
||||
(commerce-test
|
||||
"excluded-pair-direct"
|
||||
(excluded-pair? exclusions "TEN" "TWENTY")
|
||||
true)
|
||||
(commerce-test
|
||||
"excluded-pair-symmetric"
|
||||
(excluded-pair? exclusions "TWENTY" "TEN")
|
||||
true)
|
||||
(commerce-test
|
||||
"excluded-pair-none"
|
||||
(excluded-pair? exclusions "TEN" "FIVER")
|
||||
false)
|
||||
(commerce-test
|
||||
"compatible-yes"
|
||||
(compatible? exclusions (list "FIVER" "B3T" "TWENTY"))
|
||||
true)
|
||||
(commerce-test
|
||||
"compatible-no"
|
||||
(compatible? exclusions (list "TEN" "TWENTY" "B3T"))
|
||||
false)
|
||||
|
||||
;; --- powerset + valid stackings ---
|
||||
|
||||
(commerce-test
|
||||
"powerset-size"
|
||||
(len (powerset (list 1 2 3 4)))
|
||||
16)
|
||||
|
||||
(define gappl (applicable-promos gctx cart ruleset))
|
||||
|
||||
(commerce-test "applicable-guest-count" (len gappl) 4)
|
||||
|
||||
;; 16 subsets minus the 4 containing both TEN and TWENTY = 12 legal.
|
||||
(commerce-test
|
||||
"valid-stackings-count"
|
||||
(len (valid-stackings exclusions gappl))
|
||||
12)
|
||||
|
||||
(commerce-test
|
||||
"stacking-total"
|
||||
(stacking-total (list (list "TWENTY" 600) (list "B3T" 2000)))
|
||||
2600)
|
||||
|
||||
;; --- best price (deterministic selection) ---
|
||||
|
||||
(commerce-test
|
||||
"best-discount-guest"
|
||||
(best-promo-discount gctx cart ruleset exclusions)
|
||||
3100)
|
||||
(commerce-test
|
||||
"best-codes-guest"
|
||||
(best-promo-codes gctx cart ruleset exclusions)
|
||||
(list "TWENTY" "FIVER" "B3T"))
|
||||
|
||||
;; exclusivity holds: the cheaper conflicting code is dropped.
|
||||
(commerce-test
|
||||
"best-excludes-ten"
|
||||
(some
|
||||
(fn (c) (= c "TEN"))
|
||||
(best-promo-codes gctx cart ruleset exclusions))
|
||||
false)
|
||||
|
||||
;; --- member vs guest ---
|
||||
|
||||
(commerce-test
|
||||
"best-discount-member"
|
||||
(best-promo-discount mctx cart ruleset exclusions)
|
||||
3250)
|
||||
(commerce-test
|
||||
"best-codes-member"
|
||||
(best-promo-codes mctx cart ruleset exclusions)
|
||||
(list "FIVER" "B3T" "MEM"))
|
||||
|
||||
;; --- best price backward query (the showcase) ---
|
||||
|
||||
(commerce-test
|
||||
"stacking-by-total-backward"
|
||||
(run*
|
||||
codes
|
||||
(stacking-by-totalo (valid-stackings exclusions gappl) codes 3100))
|
||||
(list (list "TWENTY" "FIVER" "B3T")))
|
||||
|
||||
;; --- edge: no applicable promos ---
|
||||
|
||||
(commerce-test
|
||||
"best-empty"
|
||||
(best-promo-discount gctx empty-cart ruleset exclusions)
|
||||
0)
|
||||
Reference in New Issue
Block a user