;-*- Mode:     Lisp -*-
;;;; Author:   Paul Dietz
;;;; Created:  Tue Nov 26 20:01:27 2002
;;;; Contains: Aux. functions for subseq tests

(in-package :cl-test)

(defun subseq-list.4-body ()
  (block done
    (let ((x (loop for i from 0 to 19 collect i)))
      (loop
       for i from 0 to 20 do
       (loop
	for j from i to 20 do
	(let ((y (subseq x i j)))
	  (loop
	   for e in y and k from i to (1- j) do
	   (unless (eqlt e k) (return-from done nil)))))))
    t))

(defun subseq-list.5-body ()
  (block done
    (let ((x (loop for i from 0 to 29 collect i)))
      (loop
       for i from 0 to 30 do
       (unless (equalt (subseq x i)
		       (loop for j from i to 29 collect j))
	 (return-from done nil))))
    t))

(defun subseq-list.6-body ()
  (let* ((x (make-list 100))
	 (z (loop for e on x collect e))
	 (y (subseq x 0)))
    (loop
     for e on x
     and f on y
     and g in z do
     (when (or (not (eqt g e))
	       (not (eqlt (car e) (car f)))
	       (car e)
	       (eqt e f))
       (return nil))
     finally (return t))))

(defun subseq-vector.1-body ()
  (block nil
  (let* ((x (make-sequence 'vector 10 :initial-element 'a))
	 (y (subseq x 4 8)))
    (unless (every #'(lambda (e) (eqt e 'a)) x)
      (return 1))
    (unless (every #'(lambda (e) (eqt e 'a)) y)
      (return 2))
    (unless (eqlt (length x) 10) (return 3))
    (unless (eqlt (length y) 4)  (return 4))
    (loop for i from 0 to 9 do (setf (elt x i) 'b))
    (unless (every #'(lambda (e) (eqt e 'a)) y)
      (return 5))
    (loop for i from 0 to 3 do (setf (elt y i) 'c))
    (or
     (not (not (every #'(lambda (e) (eqt e 'b)) x)))
     6))))

(defun subseq-vector.2-body ()
  (block nil
  (let* ((x (make-sequence '(vector fixnum) 10 :initial-element 1))
	 (y (subseq x 4 8)))
    (unless (every #'(lambda (e) (eqlt e 1)) x)
      (return 1))
    (unless (every #'(lambda (e) (eqlt e 1)) y)
      (return 2))
    (unless (eqlt (length x) 10) (return 3))
    (unless (eqlt (length y) 4)  (return 4))
    (loop for i from 0 to 9 do (setf (elt x i) 2))
    (unless (every #'(lambda (e) (eqlt e 1)) y)
      (return 5))
    (loop for i from 0 to 3 do (setf (elt y i) 3))
    (or
     (not (not (every #'(lambda (e) (eqlt e 2)) x)))
     6))))

(defun subseq-vector.3-body ()
  (block nil
  (let* ((x (make-sequence '(vector single-float) 10 :initial-element 1.0))
	 (y (subseq x 4 8)))
    (unless (every #'(lambda (e) (= e 1.0)) x)
      (return 1))
    (unless (every #'(lambda (e) (= e 1.0)) y)
      (return 2))
    (unless (eqlt (length x) 10) (return 3))
    (unless (eqlt (length y) 4)  (return 4))
    (loop for i from 0 to 9 do (setf (elt x i) 2.0))
    (unless (every #'(lambda (e) (= e 1.0)) y)
      (return 5))
    (loop for i from 0 to 3 do (setf (elt y i) 3.0))
    (or
     (not (not (every #'(lambda (e) (= e 2.0)) x)))
     6))))

(defun subseq-vector.4-body ()
  (block nil
  (let* ((x (make-sequence '(vector double-float) 10 :initial-element 1.0d0))
	 (y (subseq x 4 8)))
    (unless (every #'(lambda (e) (= e 1.0)) x)
      (return 1))
    (unless (every #'(lambda (e) (= e 1.0)) y)
      (return 2))
    (unless (eqlt (length x) 10) (return 3))
    (unless (eqlt (length y) 4)  (return 4))
    (loop for i from 0 to 9 do (setf (elt x i) 2.0d0))
    (unless (every #'(lambda (e) (= e 1.0)) y)
      (return 5))
    (loop for i from 0 to 3 do (setf (elt y i) 3.0d0))
    (or
     (not (not (every #'(lambda (e) (= e 2.0)) x)))
     6))))

(defun subseq-vector.5-body ()
  (block nil
  (let* ((x (make-sequence '(vector short-float) 10 :initial-element 1.0s0))
	 (y (subseq x 4 8)))
    (unless (every #'(lambda (e) (= e 1.0)) x)
      (return 1))
    (unless (every #'(lambda (e) (= e 1.0)) y)
      (return 2))
    (unless (eqlt (length x) 10) (return 3))
    (unless (eqlt (length y) 4)  (return 4))
    (loop for i from 0 to 9 do (setf (elt x i) 2.0s0))
    (unless (every #'(lambda (e) (= e 1.0)) y)
      (return 5))
    (loop for i from 0 to 3 do (setf (elt y i) 3.0s0))
    (or
     (not (not (every #'(lambda (e) (= e 2.0)) x)))
     6))))

(defun subseq-vector.6-body ()
  (block nil
  (let* ((x (make-sequence '(vector long-float) 10 :initial-element 1.0l0))
	 (y (subseq x 4 8)))
    (unless (every #'(lambda (e) (= e 1.0)) x)
      (return 1))
    (unless (every #'(lambda (e) (= e 1.0)) y)
      (return 2))
    (unless (eqlt (length x) 10) (return 3))
    (unless (eqlt (length y) 4)  (return 4))
    (loop for i from 0 to 9 do (setf (elt x i) 2.0l0))
    (unless (every #'(lambda (e) (= e 1.0)) y)
      (return 5))
    (loop for i from 0 to 3 do (setf (elt y i) 3.0l0))
    (or
     (not (not (every #'(lambda (e) (= e 2.0)) x)))
     6))))

(defun subseq-string.1-body ()
  (let* ((s1 "abcdefgh")
	 (len (length s1)))
    (loop for start from 0 below len
	  always
	  (string= (subseq s1 start)
		   (coerce (loop for i from start to (1- len)
				 collect (elt s1 i))
			   'string)))))

(defun subseq-string.2-body ()
  (let* ((s1 "abcdefgh")
	 (len (length s1)))
    (loop for start from 0 below len
	  always
	  (loop for end from (1+ start) to len
		always
		(string= (subseq s1 start end)
			 (coerce (loop for i from start below end
				       collect (elt s1 i))
				 'string))))))

(defun subseq-string.3-body ()
  (let* ((s1 (make-array '(10) :initial-contents "abcdefghij"
			 :fill-pointer 8
			 :element-type 'character))
	 (len (length s1)))
    (and
     (eqlt len 8)
     (loop for start from 0 below len
	  always
	  (string= (subseq s1 start)
		   (coerce (loop for i from start to (1- len)
				 collect (elt s1 i))
			   'string)))
     (loop for start from 0 below len
	   always
	   (loop for end from (1+ start) to len
		 always
		 (string= (subseq s1 start end)
			  (coerce (loop for i from start below end
					collect (elt s1 i))
				  'string)))))))
(defun subseq-bit-vector.1-body ()
  (let* ((s1 #*11001000)
	 (len (length s1)))
    (loop for start from 0 below len
	  always
	  (equalp (subseq s1 start)
		  (coerce (loop for i from start to (1- len)
				collect (elt s1 i))
			  'bit-vector)))))

(defun subseq-bit-vector.2-body ()
  (let* ((s1 #*01101011)
	 (len (length s1)))
    (loop for start from 0 below len
	  always
	  (loop for end from (1+ start) to len
		always
		(equalp (subseq s1 start end)
			(coerce (loop for i from start below end
				      collect (elt s1 i))
				'bit-vector))))))

(defun subseq-bit-vector.3-body ()
  (let* ((s1 (make-array '(10) :initial-contents #*1101100110
			 :fill-pointer 8
			 :element-type 'bit))
	 (len (length s1)))
    (and
     (eqlt len 8)
     (loop for start from 0 below len
	  always
	  (equalp (subseq s1 start)
		  (coerce (loop for i from start to (1- len)
				collect (elt s1 i))
			  'bit-vector)))
     (loop for start from 0 below len
	   always
	   (loop for end from (1+ start) to len
		 always
		 (equalp (subseq s1 start end)
			 (coerce (loop for i from start below end
				       collect (elt s1 i))
				 'bit-vector)))))))