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

« back to all changes in this revision

Viewing changes to ansi-tests/search-string.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:
 
1
;-*- Mode:     Lisp -*-
 
2
;;;; Author:   Paul Dietz
 
3
;;;; Created:  Sun Aug 25 13:06:54 2002
 
4
;;;; Contains: Tests for SEARCH on strings
 
5
 
 
6
(in-package :cl-test)
 
7
 
 
8
(compile-and-load "search-aux.lsp")
 
9
 
 
10
;;; The next test was busted due to to a stupid cut and paste
 
11
;;; error.  The loop terminates immediately, doing nothing
 
12
;;; useful. -- PFD
 
13
#|
 
14
(deftest search-string.1
 
15
  (let ((target *searched-string*)
 
16
        (pat #(a)))
 
17
    (loop for i from 0 to (1- (length target))
 
18
          for tail on target
 
19
          always
 
20
          (let ((pos (search pat tail)))
 
21
            (search-check pat tail pos))))
 
22
  t)
 
23
|#
 
24
 
 
25
(deftest search-string.2
 
26
  (let ((target *searched-string*)
 
27
        (pat #(a)))
 
28
    (loop for i from 1 to (length target)
 
29
          always
 
30
          (let ((pos (search pat target :end2 i :from-end t)))
 
31
            (search-check pat target pos :end2 i :from-end t))))
 
32
  t)
 
33
 
 
34
(deftest search-string.3
 
35
  (let ((target *searched-string*))
 
36
    (loop for pat in *pattern-substrings*
 
37
          for pos = (search pat target)
 
38
          unless (search-check pat target pos)
 
39
          collect pat))
 
40
  nil)
 
41
 
 
42
(deftest search-string.4
 
43
  (let ((target *searched-string*))
 
44
    (loop for pat in *pattern-substrings*
 
45
          for pos = (search pat target :from-end t)
 
46
          unless (search-check pat target pos :from-end t)
 
47
          collect pat))
 
48
  nil)
 
49
 
 
50
(deftest search-string.5
 
51
  (let ((target *searched-string*))
 
52
    (loop for pat in *pattern-substrings*
 
53
          for pos = (search pat target :start2 25 :end2 75)
 
54
          unless (search-check pat target pos :start2 25 :end2 75)
 
55
          collect pat))
 
56
  nil)
 
57
 
 
58
(deftest search-string.6
 
59
  (let ((target *searched-string*))
 
60
    (loop for pat in *pattern-substrings*
 
61
          for pos = (search pat target :from-end t :start2 25 :end2 75)
 
62
          unless (search-check pat target pos :from-end t
 
63
                               :start2 25 :end2 75)
 
64
          collect pat))
 
65
  nil)
 
66
 
 
67
(deftest search-string.7
 
68
  (let ((target *searched-string*))
 
69
    (loop for pat in *pattern-substrings*
 
70
          for pos = (search pat target :start2 20)
 
71
          unless (search-check pat target pos :start2 20)
 
72
          collect pat))
 
73
  nil)
 
74
 
 
75
(deftest search-string.8
 
76
  (let ((target *searched-string*))
 
77
    (loop for pat in *pattern-substrings*
 
78
          for pos = (search pat target :from-end t :start2 20)
 
79
          unless (search-check pat target pos :from-end t
 
80
                               :start2 20)
 
81
          collect pat))
 
82
  nil)
 
83
 
 
84
(deftest search-string.9
 
85
  (flet ((%f (x) (case x ((#\0 a) 'c) ((#\1 b) 'd) (t nil))))
 
86
    (let ((target *searched-string*))
 
87
      (loop for pat in *pattern-sublists*
 
88
            for pos = (search pat target :start2 20 :key #'%f)
 
89
            unless (search-check pat target pos :start2 20 :key #'%f)
 
90
            collect pat)))
 
91
  nil)
 
92
 
 
93
(deftest search-string.10
 
94
  (let ((target *searched-string*))
 
95
    (loop for pat in *pattern-substrings*
 
96
          for pos = (search pat target :start2 20 :test (complement #'eql))
 
97
          unless (search-check pat target pos :start2 20
 
98
                               :test (complement #'eql))
 
99
          collect pat))
 
100
  nil)
 
101
 
 
102
(deftest search-string.11
 
103
  (let ((target *searched-string*))
 
104
    (loop for pat in *pattern-substrings*
 
105
          for pos = (search pat target :from-end t :start2 20 :test-not #'eql)
 
106
          unless (search-check pat target pos :from-end t
 
107
                               :start2 20 :test (complement #'eql))
 
108
          collect pat))
 
109
  nil)
 
110
 
 
111
(deftest search-string.13
 
112
  (let ((target *searched-string*))
 
113
    (loop for pat in *pattern-substrings*
 
114
          when (and (> (length pat) 0)
 
115
                    (let ((pos (search pat target :start1 1
 
116
                                       :test (complement #'eql))))
 
117
                      (not (search-check pat target pos
 
118
                                         :start1 1
 
119
                                         :test (complement #'eql)))))
 
120
          collect pat))
 
121
  nil)
 
122
 
 
123
(deftest search-string.14
 
124
  (let ((target *searched-string*))
 
125
    (loop for pat in *pattern-substrings*
 
126
          when (let ((len (length pat)))
 
127
                 (and (> len 0)
 
128
                      (let ((pos (search pat target :end1 (1- len)
 
129
                                         :test (complement #'eql))))
 
130
                      (not (search-check pat target pos
 
131
                                         :end1 (1- len)
 
132
                                         :test (complement #'eql))))))
 
133
          collect pat))
 
134
  nil)
 
135
 
 
136
(deftest search-string.15
 
137
  (let ((a (make-array '(10) :initial-contents "abbaaababb"
 
138
                       :fill-pointer 5
 
139
                       :element-type 'character)))
 
140
    (values
 
141
     (search "a" a)
 
142
     (search "a" a :from-end t)
 
143
     (search "ab" a)
 
144
     (search "ab" a :from-end t)
 
145
     (search "aba" a)
 
146
     (search "aba" a :from-end t)))
 
147
  0 4 0 0 nil nil)
 
148
 
 
149
(deftest search-string.16
 
150
  (let ((pat (make-array '(3) :initial-contents '(#\a #\b #\a)
 
151
                         :fill-pointer 1))
 
152
        (a "abbaa"))
 
153
    (values
 
154
     (search pat a)
 
155
     (search pat a :from-end t)
 
156
     (progn
 
157
       (setf (fill-pointer pat) 2)
 
158
       (search pat a))
 
159
     (search pat a :from-end t)
 
160
     (progn
 
161
       (setf (fill-pointer pat) 3)
 
162
       (search pat a))
 
163
     (search pat a :from-end t)))
 
164
  0 4 0 0 nil nil)
 
165
 
 
166
;; Order of test, test-not
 
167
 
 
168
(deftest search-string.17
 
169
  (let ((pat "m")
 
170
        (target '"adgmnpq"))
 
171
    (search pat target :test #'char<))
 
172
  4)
 
173
 
 
174
(deftest search-string.18
 
175
  (let ((pat "m")
 
176
        (target '"adgmnpq"))
 
177
    (search pat target :test-not #'char>=))
 
178
  4)
 
 
b'\\ No newline at end of file'