/[gcl]/gcl/ansi-tests/substitute-if.lsp
ViewVC logotype

Diff of /gcl/ansi-tests/substitute-if.lsp

Parent Directory Parent Directory | Revision Log Revision Log | View Patch Patch

revision 1.9 by pfdietz, Sat Jan 17 22:34:46 2004 UTC revision 1.10 by pfdietz, Thu Sep 23 13:28:54 2004 UTC
# Line 292  Line 292 
292      result)      result)
293    #(a b z c b))    #(a b z c b))
294    
295    (deftest substitute-if-vector.32
296      (let* ((v1 (copy-seq #(a b c d a b c d a b c d a b c d)))
297             (v2 (make-array '(8) :displaced-to v1
298                             :displaced-index-offset 3)))
299        (values
300         (substitute-if 'x (is-eql-p 'c) v2 :count 1)
301         v1))
302      #(d a b x d a b c)
303      #(a b c d a b c d a b c d a b c d))
304    
305    (deftest substitute-if-vector.33
306      (let* ((v1 (copy-seq #(a b c d a b c d a b c d a b c d)))
307             (v2 (make-array '(8) :displaced-to v1
308                             :displaced-index-offset 3)))
309        (values
310         (substitute-if 'x (is-eql-p 'c) v2 :count 1 :from-end t)
311         v1))
312      #(d a b c d a b x)
313      #(a b c d a b c d a b c d a b c d))
314    
315  ;;; Tests on strings  ;;; Tests on strings
316    
317  (deftest substitute-if-string.1  (deftest substitute-if-string.1
# Line 691  Line 711 
711           result))           result))
712    "01a2342015")    "01a2342015")
713    
714  (deftest substitute-if-bit-vector.26  (deftest substitute-if-string.26
715      (do-special-strings
716       (s "xyzabcxyzabc" nil)
717       (assert (string= (substitute-if #\! (is-eql-p #\a) s) "xyz!bcxyz!bc"))
718       (assert (string= (substitute-if #\! (is-eql-p #\a) s :count 1) "xyz!bcxyzabc"))
719       (assert (string= (substitute-if #\! (is-eql-p #\a) s :count 1 :from-end t) "xyzabcxyz!bc"))
720       (assert (string= s "xyzabcxyzabc")))
721      nil)
722    
723    ;;; More bit vector tests
724    
725    (deftest substitute-if-bit-vector.22
726    (let* ((orig #*00111001011010110)    (let* ((orig #*00111001011010110)
727           (x (copy-seq orig))           (x (copy-seq orig))
728           (result (substitute-if 1 (is-eql-p 1) x :key #'1+)))           (result (substitute-if 1 (is-eql-p 1) x :key #'1+)))
# Line 699  Line 730 
730           result))           result))
731    #*11111111111111111)    #*11111111111111111)
732            
733  (deftest substitute-if-bit-vector.27  (deftest substitute-if-bit-vector.23
734    (let* ((orig #*00111001011010110)    (let* ((orig #*00111001011010110)
735           (x (copy-seq orig))           (x (copy-seq orig))
736           (result (substitute-if 1 (is-eql-p 1) x :key #'1+ :start 1 :end 10)))           (result (substitute-if 1 (is-eql-p 1) x :key #'1+ :start 1 :end 10)))
# Line 707  Line 738 
738           result))           result))
739    #*01111111111010110)    #*01111111111010110)
740    
741  (deftest substitute-if-bit-vector.30  (deftest substitute-if-bit-vector.24
742    (let* ((x (make-array '(10) :initial-contents '(0 1 0 1 1 0 1 1 0 1)    (let* ((x (make-array '(10) :initial-contents '(0 1 0 1 1 0 1 1 0 1)
743                         :fill-pointer 5 :element-type 'bit))                         :fill-pointer 5 :element-type 'bit))
744           (result (substitute-if 1 #'zerop x)))           (result (substitute-if 1 #'zerop x)))
745      result)      result)
746    #*11111)    #*11111)
747    
748  (deftest substitute-if-bit-vector.31  (deftest substitute-if-bit-vector.25
749    (let* ((x (make-array '(10) :initial-contents '(0 1 0 1 1 0 1 1 0 1)    (let* ((x (make-array '(10) :initial-contents '(0 1 0 1 1 0 1 1 0 1)
750                         :fill-pointer 5 :element-type 'bit))                         :fill-pointer 5 :element-type 'bit))
751           (result (substitute-if 1 #'zerop x :from-end t)))           (result (substitute-if 1 #'zerop x :from-end t)))
752      result)      result)
753    #*11111)    #*11111)
754    
755  (deftest substitute-if-bit-vector.32  (deftest substitute-if-bit-vector.26
756    (let* ((x (make-array '(10) :initial-contents '(0 1 0 1 1 0 1 1 0 1)    (let* ((x (make-array '(10) :initial-contents '(0 1 0 1 1 0 1 1 0 1)
757                         :fill-pointer 5 :element-type 'bit))                         :fill-pointer 5 :element-type 'bit))
758           (result (substitute-if 1 #'zerop x :count 1)))           (result (substitute-if 1 #'zerop x :count 1)))
759      result)      result)
760    #*11011)    #*11011)
761    
762  (deftest substitute-if-bit-vector.33  (deftest substitute-if-bit-vector.27
763    (let* ((x (make-array '(10) :initial-contents '(0 1 0 1 1 0 1 1 0 1)    (let* ((x (make-array '(10) :initial-contents '(0 1 0 1 1 0 1 1 0 1)
764                         :fill-pointer 5 :element-type 'bit))                         :fill-pointer 5 :element-type 'bit))
765           (result (substitute-if 1 #'zerop x :from-end t :count 1)))           (result (substitute-if 1 #'zerop x :from-end t :count 1)))
766      result)      result)
767    #*01111)    #*01111)
768    
769    ;;; Order of evaluation tests
770    
771  (deftest substitute-if.order.1  (deftest substitute-if.order.1
772    (let ((i 0) a b c d e f g h)    (let ((i 0) a b c d e f g h)
773      (values      (values

Legend:
Removed from v.1.9  
changed lines
  Added in v.1.10

savannah-hackers-public@gnu.org
ViewVC Help
Powered by ViewVC 1.1.26