← Back to branch summary

~ubuntu-branches/ubuntu/quantal/gclcvs/quantal

« back to all changes in this revision

Viewing changes to ansi-tests/search-aux.lsp

  • Committer: Bazaar Package Importer
  • Author(s): Camm Maguire
  • Date: 2004-06-24 15:13:46 UTC
  • Revision ID: james.westby@ubuntu.com-20040624151346-xh0xaaktyyp7aorc
Tags: 2.7.0-26
C_GC_OFFSET is 2 on m68k-linux

Show diffs side-by-side

added added

removed removed

Lines of Context:
ansi-tests/search-aux.lsp
 
1
;-*- Mode:     Lisp -*-
 
2
;;;; Author:   Paul Dietz
 
3
;;;; Created:  Sat Aug 24 07:22:10 2002
 
4
;;;; Contains: Aux. functions for testing SEARCH
 
5
 
 
6
(in-package :cl-test)
 
7
 
 
8
(defparameter *searched-list*
 
9
  '(b b a b b b b b b b a b a b b b a b a b b b a a a a b a a b a a a a a
 
10
      a b a b b a b a a b a a a b b a a b a a a a b b a b a b a a a b a b
 
11
      b a b a a b b b b b a a a a a b a b b b b b a b a b b a b a b))
 
12
 
 
13
(defparameter *pattern-sublists*
 
14
  (remove-duplicates
 
15
   (let* ((s *searched-list*) (len (length s)))
 
16
     (loop for x from 0 to 8 nconc
 
17
           (loop for y from 0 to (- len x)
 
18
                 collect (subseq s y (+ y x)))))
 
19
   :test #'equal))
 
20
 
 
21
(defparameter *searched-vector*
 
22
  (make-array (length *searched-list*)
 
23
              :initial-contents *searched-list*))
 
24
 
 
25
(defparameter *pattern-subvectors*
 
26
  (mapcar #'(lambda (x) (apply #'vector x)) *pattern-sublists*))
 
27
 
 
28
(defparameter *searched-bitvector*
 
29
  #*1101111111010111010111000010010000001011010010001100100001101010001011010011111000001011111010110101)
 
30
 
 
31
(defparameter *pattern-subbitvectors*
 
32
  (remove-duplicates
 
33
   (let* ((s *searched-bitvector*) (len (length s)))
 
34
     (loop for x from 0 to 8 nconc
 
35
           (loop for y from 0 to (- len x)
 
36
                 collect (subseq s y (+ y x)))))
 
37
   :test #'equalp))
 
38
 
 
39
(defparameter *searched-string*
 
40
  "1101111111010111010111000010010000001011010010001100100001101010001011010011111000001011111010110101")
 
41
 
 
42
(defparameter *pattern-substrings*
 
43
  (remove-duplicates
 
44
   (let* ((s *searched-string*) (len (length s)))
 
45
     (loop for x from 0 to 8 nconc
 
46
           (loop for y from 0 to (- len x)
 
47
                 collect (subseq s y (+ y x)))))
 
48
   :test #'equalp))
 
49
 
 
50
(defun subseq-equalp (seq1 seq2 start1 start2 len &key (test #'equalp))
 
51
  (assert
 
52
   (and
 
53
    (>= start1 0)
 
54
    (>= start2 0)
 
55
    (<= (+ start1 len) (length seq1))
 
56
    (<= (+ start2 len) (length seq2))))
 
57
  (setq test (coerce test 'function))
 
58
  (if (and (listp seq1) (listp seq2))
 
59
      (loop for i from 0 to (1- len)
 
60
            for e1 in (nthcdr start1 seq1)
 
61
            for e2 in (nthcdr start2 seq2)
 
62
            always (funcall test e1 e2))
 
63
    (loop for i from 0 to (1- len)
 
64
          always
 
65
          (funcall (the function test)
 
66
                   (elt seq1 (+ start1 i))
 
67
                   (elt seq2 (+ start2 i))))))
 
68
 
 
69
(defun search-check (pattern searched pos
 
70
                             &key (start1 0) (end1 nil) (start2 0) (end2 nil)
 
71
                             key from-end (test #'equalp))
 
72
  (unless end1 (setq end1 (length pattern)))
 
73
  (unless end2 (setq end2 (length searched)))
 
74
  (assert (<= start1 end1))
 
75
  (assert (<= start2 end2))
 
76
  (let* ((plen (- end1 start1)))
 
77
    (when key
 
78
      (setq pattern (map 'list key pattern))
 
79
      (setq searched (map 'list key searched)))
 
80
    (if pos
 
81
        (and
 
82
         (subseq-equalp searched pattern pos start1 plen :test test)
 
83
         (if from-end
 
84
             (loop for i from (1+ pos) to (- end2 plen)
 
85
                   never
 
86
                   (subseq-equalp searched pattern i start1 plen :test test))
 
87
           (loop for i from start2 to (1- pos)
 
88
                 never
 
89
                 (subseq-equalp searched pattern i start1 plen :test test))))
 
90
      (loop for i from start2 to (- end2 plen)
 
91
            never (subseq-equalp searched pattern i start1 plen :test test)))))
 
92
 
 
93