;;; -*- Mode: Scheme -*-

;;;; Boyer-Moore Fixed-Pattern Search Algorithm
;;;; Tests

;;; This code is written by Taylor R. Campbell and placed in the Public
;;; Domain.  All warranties are disclaimed.

(define-test-suite boyer-moore-tests
  "Boyer-Moore fixed-pattern search algorithm")

;;; We could test the last occurrence table here, but each last
;;; occurrence table to check against requires two-hundred fifty-six
;;; elements, and the code to compute the tables is trivial, so I'll
;;; skip it.

(define-test-suite (bm-tests.prefix-table boyer-moore-tests)
  "Computing prefix tables")

(define-test-case bm-tests.prefix-table 0 ()
  (test-equal '#(0)
    (compute-bm-prefix-table "a" 0 1)))

(define-test-case bm-tests.prefix-table 1 ()
  (test-equal '#(0 0)
    (compute-bm-prefix-table "ab" 0 2)))

(define-test-case bm-tests.prefix-table 2 ()
  (test-equal '#(0 1)
    (compute-bm-prefix-table "aa" 0 2)))

(define-test-case bm-tests.prefix-table 3 ()
  (test-equal '#(0 0 0 0 1 2 3 1 2)
    (compute-bm-prefix-table "abcdabcab" 0 9)))

(define-test-case bm-tests.prefix-table 4 ()
  (test-equal '#(0 0 0 1 2 0 0 1 2)
    (compute-bm-prefix-table "bacbadcba" 0 9)))

(define-test-suite (bm-tests.max-suffix boyer-moore-tests)
  "Computing the maximum suffix shift of a pattern")

(define-test-case bm-tests.max-suffix 0 ()
  (test-eqv 1
    (compute-bm-max-suffix "a" 0 1)))

(define-test-case bm-tests.max-suffix 1 ()
  (test-eqv 2
    (compute-bm-max-suffix "ab" 0 2)))

(define-test-case bm-tests.max-suffix 2 ()
  (test-eqv 1
    (compute-bm-max-suffix "aa" 0 2)))

(define-test-case bm-tests.max-suffix 3 ()
  (test-eqv 7
    (compute-bm-max-suffix "abcdabcab" 0 9)))

(define-test-suite (bm-tests.good-suffix-table boyer-moore-tests)
  "Computing the good suffix table of a pattern")

(define (test-bm-good-suffix-table* pattern start end)
  (let ((length (- end start)))
    (compute-bm-good-suffix-table
     length
     (compute-bm-max-suffix pattern start end)
     (compute-bm-prefix-table (vector-8b-reverse pattern start end)
                              0
                              length))))

(define (test-bm-good-suffix-table pattern)
  (test-bm-good-suffix-table* pattern 0 (vector-8b-length pattern)))

(define-test-case bm-tests.good-suffix-table 0 ()
  (test-equal '#(1)
    (test-bm-good-suffix-table "a")))

(define-test-case bm-tests.good-suffix-table 1 ()
  (test-equal '#(1 1)
    (test-bm-good-suffix-table "aa")))

(define-test-case bm-tests.good-suffix-table 2 ()
  (test-equal '#(2 1)
    (test-bm-good-suffix-table "ab")))

(define-test-case bm-tests.good-suffix-table 2 ()
  (test-equal '#(2 1)
    (test-bm-good-suffix-table* "xaby" 1 3)))

(define-test-case bm-tests.good-suffix-table 3 ()
  (test-equal '#(7 7 7 7 7 7 3 3 1)
    (test-bm-good-suffix-table* "fooabcdabcabbar" 3 12)))

(define-test-case bm-tests.good-suffix-table 4 ()
  (test-equal '#(7 7 7 7 7 4 4 4 1)
    (test-bm-good-suffix-table* "rabbacbadcbaoof" 3 12)))

(define-test-case bm-tests.good-suffix-table 5 ()
  (test-equal '#(16 16 16 16 16 16 16 16 16 16 16 16 16 16 16 10 10 10 1)
    (test-bm-good-suffix-table "BARfooBARbazquuxBAR")))

(define-test-suite (bm-tests.search boyer-moore-tests)
  "Applying the search algorithm")

(define (test-bm-search search cache pattern instance)
  (search instance 0 (vector-8b-length instance)
          (cache pattern 0 (vector-8b-length pattern))))

(define (test-bm-forward-search pattern instance)
  (test-bm-search vector-8b-search-forward/bm
                  vector-8b-forward-search-cache/bm
                  pattern instance))

(define (test-bm-backward-search pattern instance)
  (test-bm-search vector-8b-search-backward/bm
                  vector-8b-backward-search-cache/bm
                  pattern instance))

(define (test-bm-forward-search* pattern instance)
  (test-bm-search vector-8b-search-forward*/bm
                  vector-8b-forward-search-cache/bm
                  pattern instance))

(define (test-bm-backward-search* pattern instance)
  (test-bm-search vector-8b-search-backward*/bm
                  vector-8b-backward-search-cache/bm
                  pattern instance))

(define-test-suite (bm-tests.search-forward bm-tests.search)
  "Single-occurrence forward search")

(define-test-case bm-tests.search-forward 0 ()
  (test-eqv 2
    (test-bm-forward-search "a" "cbabcbabc")))

(define-test-case bm-tests.search-forward 1 ()
  (test-eqv 1
    (test-bm-forward-search "bab" "cbabcbabc")))

(define-test-case bm-tests.search-forward 2 ()
  (test-eqv 4
    (test-bm-forward-search "barbaz" "fooobarbazquuxbazot")))

(define-test-case bm-tests.search-forward 3 ()
  (test-eqv 18
    (test-bm-forward-search "abcdabcab" "xbcdabcababcdabxababcdabcabx")))

(define-test-suite (bm-tests.search-backward bm-tests.search)
  "Single-occurrence backward search")

(define-test-case bm-tests.search-backward 0 ()
  (test-eqv 6
    (test-bm-backward-search "a" "cbabcbabc")))

(define-test-case bm-tests.search-backward 1 ()
  (test-eqv 5
    (test-bm-backward-search "bab" "cbabcbabc")))

(define-test-case bm-tests.search-backward 2 ()
  (test-eqv 4
    (test-bm-backward-search "barbaz" "fooobarbazquuxbazot")))

(define-test-case bm-tests.search-backward 3 ()
  (test-eqv 18
    (test-bm-backward-search "abcdabcab" "xbcdabcababcdabxababcdabcabx")))

(define-test-suite (bm-tests.search-forward* bm-tests.search)
  "Multiple-occurrence forward search")

(define-test-case bm-tests.search-forward* 0 ()
  (test-equal '(0 1 2 3 4 5)
    (test-bm-forward-search* "a" "aaaaaa")))

(define-test-case bm-tests.search-forward* 1 ()
  (test-equal '(0 1 2 3 4)
    (test-bm-forward-search* "aa" "aaaaaa")))

(define-test-case bm-tests.search-forward* 2 ()
  (test-equal '(0 2 4)
    (test-bm-forward-search* "ab" "ababab")))

(define-test-case bm-tests.search-forward* 3 ()
  (test-equal '(4 10)
    (test-bm-forward-search* "abab" "abacababaxababx")))

(define-test-case bm-tests.search-forward* 4 ()
  (test-equal '(6 24)
    (test-bm-forward-search* "barbaz" "foooazbarbazquuxzotarbazbarbaz")))

(define-test-suite (bm-tests.search-backward* bm-tests.search)
  "Multiple-occurrence backward search")

(define-test-case bm-tests.search-backward* 0 ()
  (test-equal '(5 4 3 2 1 0)
    (test-bm-backward-search* "a" "aaaaaa")))

(define-test-case bm-tests.search-backward* 1 ()
  (test-equal '(4 3 2 1 0)
    (test-bm-backward-search* "aa" "aaaaaa")))

(define-test-case bm-tests.search-backward* 2 ()
  (test-equal '(4 2 0)
    (test-bm-backward-search* "ab" "ababab")))

(define-test-case bm-tests.search-backward* 3 ()
  (test-equal '(10 4)
    (test-bm-backward-search* "abab" "abacababaxababx")))

(define-test-case bm-tests.search-backward* 4 ()
  (test-equal '(24 6)
    (test-bm-backward-search* "barbaz" "foooazbarbazquuxzotarbazbarbaz")))