;; 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)