fixing massive fail of issing a pull in wrong directory

COPYING

@@ -1,22 +0,0 @@
-    Copyright (c) 2005 David Lichteblau
-    Copyright (c) 2013 Anton Vodonosov <avodonosov@yandex.ru>
-
-    Permission is hereby granted, free of charge, to any person
-    obtaining a copy of this software and associated documentation files
-    (the "Software"), to deal in the Software without restriction,
-    including without limitation the rights to use, copy, modify, merge,
-    publish, distribute, sublicense, and/or sell copies of the Software,
-    and to permit persons to whom the Software is furnished to do so,
-    subject to the following conditions:
-
-    The above copyright notice and this permission notice shall be
-    included in all copies or substantial portions of the Software.
-
-    THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND,
-    EXPRESS OR IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF
-    MERCHANTABILITY, FITNESS FOR A PARTICULAR PURPOSE AND
-    NONINFRINGEMENT. IN NO EVENT SHALL THE AUTHORS OR COPYRIGHT HOLDERS
-    BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER LIABILITY, WHETHER IN AN
-    ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM, OUT OF OR IN
-    CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN THE
-    SOFTWARE.

package.lisp

@@ -1,77 +0,0 @@
-#+xcvb (module ())
-
-(in-package :cl-user)
-
-#+:abcl
-(eval-when (:compile-toplevel :load-toplevel :execute)
-  (require :gray-streams))
-
-#+cmu
-(eval-when (:compile-toplevel :load-toplevel :execute)
-  (require :gray-streams))
-
-#+allegro
-(eval-when (:compile-toplevel :load-toplevel :execute)
-  (unless (fboundp 'excl:stream-write-string)
-    (require "streamc.fasl")))
-
-#+ecl
-(eval-when (:compile-toplevel :load-toplevel :execute)
-  (gray::redefine-cl-functions))
-
-(macrolet
-    ((frob ()
-       (let ((gray-class-symbols
-              '(#:fundamental-stream
-                #:fundamental-input-stream #:fundamental-output-stream
-                #:fundamental-character-stream #:fundamental-binary-stream
-                #:fundamental-character-input-stream #:fundamental-character-output-stream
-                #:fundamental-binary-input-stream #:fundamental-binary-output-stream))
-             (gray-function-symbols
-              '(#:stream-read-char
-                #:stream-unread-char #:stream-read-char-no-hang
-                #:stream-peek-char #:stream-listen #:stream-read-line
-                #:stream-clear-input #:stream-write-char #:stream-line-column
-                #:stream-start-line-p #:stream-write-string #:stream-terpri
-                #:stream-fresh-line #:stream-finish-output #:stream-force-output
-                #:stream-clear-output #:stream-advance-to-column
-                #:stream-read-byte #:stream-write-byte)))
-	 `(progn
-
-            (defpackage impl-specific-gray
-              (:use :cl)
-              (:import-from
-               #+sbcl :sb-gray
-               #+allegro :excl
-               #+cmu :ext
-               #+(or clisp ecl mocl) :gray
-               #+openmcl :ccl
-               #+lispworks :stream
-               #+abcl :gray-streams
-               #-(or sbcl allegro cmu clisp openmcl lispworks ecl abcl mocl) ...
-               ,@gray-class-symbols
-               ,@gray-function-symbols)
-              (:export
-               ,@gray-class-symbols
-               ,@gray-function-symbols))
-
-            (defpackage :trivial-gray-streams
-              (:use :cl)
-              (:import-from #:impl-specific-gray
-                            ;; We import and re-export only
-                            ;; function symbols;
-                            ;; But we define our own classes
-                            ;; mirroring the gray class hierarchy
-                            ;; of the lisp implementation (this
-                            ;; is necessary to define our methods
-                            ;; for particular generic functions)
-                            ,@gray-function-symbols)
-              (:export ,@gray-class-symbols
-                       ,@gray-function-symbols
-                       ;; extension functions
-                       #:stream-read-sequence
-                       #:stream-write-sequence
-                       #:stream-file-position
-                       ;; deprecated
-                       #:trivial-gray-stream-mixin))))))
-  (frob))

test/package.lisp

@@ -1,6 +0,0 @@
-(defpackage trivial-gray-streams-test 
-  (:use :cl #:trivial-gray-streams)
-  (:shadow #:method)
-  (:export #:run-tests
-           #:failed-test-names))
-

test/run-on-many-lisps.lisp

@@ -1,66 +0,0 @@
-(ql:quickload :trivial-gray-streams)
-(ql:quickload :test-grid-agent)
-(ql:quickload :cl-fad)
-(in-package :cl-user)
-
-(defparameter *abcl* (make-instance 'lisp-exe:abcl
-                                    :java-exe-path "C:\\Program Files\\Java\\jdk1.6.0_26\\bin\\java"
-                                    :abcl-jar-path "C:\\Users\\anton\\unpacked\\abcl\\abcl-bin-1.1.0\\abcl.jar"))
-(defparameter *clisp* (make-instance 'lisp-exe:clisp :exe-path "clisp"))
-(defparameter *ccl-1.8-x86* (make-instance 'lisp-exe:ccl
-                                           :exe-path "C:\\Users\\anton\\unpacked\\ccl\\ccl-1.8-windows\\wx86cl.exe"))
-(defparameter *ccl-1.8-x86-64* (make-instance 'lisp-exe:ccl
-                                              :exe-path "C:\\Users\\anton\\unpacked\\ccl\\ccl-1.8-windows\\wx86cl64.exe"))
-(defparameter *sbcl-1.1.0.45* (make-instance 'lisp-exe:sbcl :exe-path "C:\\Program Files (x86)\\Steel Bank Common Lisp\\1.1.0.45\\run.bat"))
-(defparameter *sbcl-win-branch-64* (make-instance 'lisp-exe:sbcl :exe-path "C:\\Program Files\\Steel Bank Common Lisp\\1.1.0.36.mswinmt.1201-284e340\\run.bat"))
-(defparameter *sbcl-win-branch-32* (make-instance 'lisp-exe:sbcl :exe-path "C:\\Program Files (x86)\\Steel Bank Common Lisp\\1.1.0.36.mswinmt.1201-284e340\\run.bat"))
-(defparameter *ecl-bytecode* (make-instance 'lisp-exe:ecl
-                                            :exe-path "C:\\Users\\anton\\projects\\ecl\\bin\\ecl.exe"
-                                            :compiler :bytecode))
-(defparameter *ecl-lisp-to-c* (make-instance 'lisp-exe:ecl
-                                             :exe-path "C:\\Users\\anton\\projects\\ecl\\bin\\ecl.exe"
-                                             :compiler :lisp-to-c))
-(defparameter *acl* (make-instance 'lisp-exe:acl :exe-path "C:\\Program Files (x86)\\acl90express\\alisp.exe"))
-
-(defun run-on-many-lisps (run-description test-run-dir quicklisp-dir lisps)
-  (ensure-directories-exist test-run-dir)
-  (let ((fasl-root (merge-pathnames "fasl/" test-run-dir)))
-    (labels ((log-name (lisp)
-               (substitute #\- #\.
-                           ;; Substitute dots by hypens if our main process is CCL, it 
-                           ;; prepends the > symbol before dots;
-                           ;; for example: 1.1.0.36.mswinmt.1201-284e340 => 1>.1>.0>.36>.mswinmt.1201-284e340
-                           ;; When we pass such a pathname to another lisps, they can't handle it.
-                           (string-downcase (tg-agent::implementation-identifier lisp))))
-             (fasl-dir (lisp)
-               (merge-pathnames (format nil "~A/" (log-name lisp))
-                                fasl-root))
-             (run (lisp)
-               (let* ((lib-result (tg-agent::proc-run-libtest lisp
-                                                              :trivial-gray-streams
-                                                              run-description
-                                                              (merge-pathnames (log-name lisp) test-run-dir)
-                                                              quicklisp-dir
-                                                              (fasl-dir lisp)))
-                      (status (getf lib-result :status)))
-                 (if (listp status)
-                     (getf status :failed-tests)
-                     status))))
-      (let ((results (mapcar (lambda (lisp)
-                               (list (tg-agent::implementation-identifier lisp)
-                                     (run lisp)))
-                             lisps)))
-        (tg-utils::write-to-file results (merge-pathnames "resutls.lisp" test-run-dir))
-        (cl-fad:delete-directory-and-files fasl-root)
-        results))))
-
-(run-on-many-lisps '(:lib-world "quicklisp 2013-02-17 + trivial-gray-streams.head"
-                     :contact-email "avodonosov@yandex.ru")
-                   "C:\\Users\\anton\\projects\\trivial-gray-streams\\test\\"
-                   (merge-pathnames "quicklisp/" (user-homedir-pathname))
-                   (list *sbcl-1.1.0.45* *sbcl-win-branch-64* *sbcl-win-branch-32*
-                         *abcl*
-                         *clisp*
-                         *ccl-1.8-x86* *ccl-1.8-x86-64*                         
-                         *ecl-bytecode* *ecl-lisp-to-c*
-                         *acl*))

test/test-framework.lisp

@@ -1,60 +0,0 @@
-(in-package :trivial-gray-streams-test)
-
-;;; test framework
-
-#|
-  Used like this:
-
-  (list (test (add) (assert (= 5 (+ 2 2))))
-        (test (mul) (assert (= 4 (* 2 2))))
-        (test (subst) (assert (= 3 (- 4 2)))))
-
-  => ;; list of test results, 2 failed 1 passed
-     (#<TEST-RESULT ADD :FAIL The assertion (= 5 (+ 2 2)) failed.>
-      #<TEST-RESULT MUL :OK>
-      #<TEST-RESULT SUBST :FAIL The assertion (= 3 (- 4 2)) failed.>)
-
-|#
-
-(defclass test-result ()
-  ((name :type symbol
-         :initarg :name
-         :initform (error ":name is requierd")
-         :accessor name)
-   (status :type (or (eql :ok) (eql :fail))
-           :initform :ok
-           :initarg :status
-           :accessor status)
-   (cause :type (or null condition)
-          :initform nil
-          :initarg :cause
-          :accessor cause)))
-
-(defun failed-p (test-result)
-  (eq (status test-result) :fail))
-
-(defmethod print-object ((r test-result) stream)
-  (print-unreadable-object (r stream :type t)
-    (format stream "~S ~S~@[ ~A~]" (name r) (status r) (cause r))))
-
-(defparameter *allow-debugger* nil)
-
-(defun test-impl (name body-fn)
-  (flet ((make-result (status &optional cause)
-           (make-instance 'test-result :name name :status status :cause cause)))
-    (handler-bind ((serious-condition
-                    (lambda (c)
-                      (unless *allow-debugger*
-                        (format t "FAIL: ~A~%" c)
-                        (return-from test-impl                          
-                          (make-result :fail c))))))
-      (format t "Running test ~S... " name)
-      (funcall body-fn)
-      (format t "OK~%")
-      (make-result :ok))))
-
-(defmacro test ((name) &body body)
-  "If the BODY signals a SERIOUS-CONDITION
-this macro returns a failed TEST-RESULT; otherwise
-returns a successfull TEST-RESULT."
-  `(test-impl (quote ,name) (lambda () ,@body)))

test/test.lisp

@@ -1,212 +0,0 @@
-(in-package :trivial-gray-streams-test)
-
-;;; assert-invoked - a tool to check that specified method with parameters has
-;;; been invoked during execution of a code body
-
-(define-condition invoked ()
-  ((method :type (or symbol cons) ;; cons is for (setf method)
-           :accessor method
-           :initarg :method
-           :initform (error ":method is required"))
-   (args :type list
-         :accessor args
-         :initarg :args
-         :initform nil)))
-
-(defun assert-invoked-impl (method args body-fn)
-  (let ((expected-invocation (cons method args))
-        (actual-invocations nil))
-    (handler-bind ((invoked (lambda (i)
-                              (let ((invocation (cons (method i) (args i))))
-                                (when (equalp invocation expected-invocation)
-                                  (return-from assert-invoked-impl nil))
-                                (push invocation actual-invocations)))))
-      (funcall body-fn))
-    (let ((*package* (find-package :keyword))) ; ensures package prefixes are printed
-      (error "expected invocation: ~(~S~) actual: ~{~(~S~)~^, ~}"
-             expected-invocation (reverse actual-invocations)))))
-
-(defmacro assert-invoked ((method &rest args) &body body)
-  "If during execution of the BODY the specified METHOD with ARGS
-hasn't been invoked, signals an ERROR."
-  `(assert-invoked-impl (quote ,method) (list ,@args) (lambda () ,@body)))
-
-(defun invoked (method &rest args)
-  (signal 'invoked :method method :args args))
-
-;;; The tests.
-
-#|
-  We will define a gray stream class, specialise 
-  the gray generic function methods on it and test that the methods
-  are invoked when we call functions from common-lisp package
-  on that stream.
-
-  Some of the gray generic functions are only invoked by default
-  methods of other generic functions:
-
-      cl:format ~t or cl:pprint -> stream-advance-to-column -> stream-line-column
-                                                               stream-write-char
-      cl:fresh-line -> stream-fresh-line -> stream-start-line-p -> stream-line-column
-                                            stream-terpri
-
-
-  If we define our methods for stream-advance-to-column and stream-fresh-line,
-  then stream-start-line-p, stream-terpri, stram-line-column are not invoked.
-
-  Therefore we define another gray stream class. The first class is used
-  for all lower level functions (stream-terpri). The second class
-  is used to test methods for higher level functions (stream-fresh-line).
-|#
-
-(defclass test-stream (fundamental-binary-input-stream
-                       fundamental-binary-output-stream
-                       fundamental-character-input-stream
-                       fundamental-character-output-stream)
-  ())
-
-(defclass test-stream2 (test-stream) ())
-
-(defmethod stream-read-char ((stream test-stream))
-  (invoked 'stream-read-char stream))
-
-(defmethod stream-unread-char ((stream test-stream) char)
-  (invoked 'stream-unread-char stream char))
-
-(defmethod stream-read-char-no-hang ((stream test-stream))
-  (invoked 'stream-read-char-no-hang stream))
-
-(defmethod stream-peek-char ((stream test-stream))
-  (invoked 'stream-peek-char stream))
-
-(defmethod stream-listen ((stream test-stream))
-  (invoked 'stream-listen stream))
-
-(defmethod stream-read-line ((stream test-stream))
-  (invoked 'stream-read-line stream))
-
-(defmethod stream-clear-input ((stream test-stream))
-  (invoked 'stream-clear-input stream))
-
-(defmethod stream-write-char ((stream test-stream) char)
-  (invoked 'stream-write-char stream char))
-
-(defmethod stream-line-column ((stream test-stream))
-  (invoked 'stream-line-column stream))
-
-(defmethod stream-start-line-p ((stream test-stream))
-  (invoked 'stream-start-line-p stream))
-
-(defmethod stream-write-string ((stream test-stream) string &optional start end)
-  (invoked 'stream-write-string stream string start end))
-
-(defmethod stream-terpri ((stream test-stream))
-  (invoked 'stream-terpri stream))
-
-(defmethod stream-fresh-line ((stream test-stream2))
-  (invoked 'stream-fresh-line stream))
-
-(defmethod stream-finish-output ((stream test-stream))
-  (invoked 'stream-finish-output stream))
-
-(defmethod stream-force-output ((stream test-stream))
-  (invoked 'stream-force-output stream))
-
-(defmethod stream-clear-output ((stream test-stream))
-  (invoked 'stream-clear-output stream))
-
-(defmethod stream-advance-to-column ((stream test-stream2) column)
-  (invoked 'stream-advance-to-column stream column))
-
-(defmethod stream-read-byte ((stream test-stream))
-  (invoked 'stream-read-byte stream))
-
-(defmethod stream-write-byte ((stream test-stream) byte)
-  (invoked 'stream-write-byte stream byte))
-
-(defmethod stream-read-sequence ((s test-stream) seq start end &key)
-  (invoked 'stream-read-sequence s seq :start start :end end))
-
-(defmethod stream-write-sequence ((s test-stream) seq start end &key)
-  (invoked 'stream-write-sequence s seq :start start :end end))
-
-(defmethod stream-file-position ((s test-stream))
-  (invoked 'stream-file-position s))
-
-(defmethod (setf stream-file-position) (newval (s test-stream))
-  (invoked '(setf stream-file-position) newval s))
-
-;; Convinience macro, used when we want to name
-;; the test case with the same name as of the gray streams method we test.
-(defmacro test-invoked ((method &rest args) &body body)
-  `(test (,method)
-     (assert-invoked (,method ,@args)
-       ,@body)))
-
-(defun run-tests ()
-  (let ((s (make-instance 'test-stream))
-        (s2 (make-instance 'test-stream2)))
-    (list
-     (test-invoked (stream-read-char s)
-       (read-char s))
-     (test-invoked (stream-unread-char s #\a)
-       (unread-char #\a s))
-     (test-invoked (stream-read-char-no-hang s)
-       (read-char-no-hang s))
-     (test-invoked (stream-peek-char s)
-       (peek-char nil s))
-     (test-invoked (stream-listen s)
-       (listen s))
-     (test-invoked (stream-read-line s)
-       (read-line s))
-     (test-invoked (stream-clear-input s)
-       (clear-input s))
-     (test-invoked (stream-write-char s #\b)
-       (write-char #\b s))
-     (test-invoked (stream-line-column s)
-       (format s "~10,t"))
-     (test-invoked (stream-start-line-p s)
-       (fresh-line s))
-     (test-invoked (stream-write-string s "hello" 1 4)
-       (write-string "hello" s :start 1 :end 4))
-     (test-invoked (stream-terpri s)
-       (fresh-line s))
-     (test-invoked (stream-fresh-line s2)
-       (fresh-line s2))
-     (test-invoked (stream-finish-output s)
-       (finish-output s))
-     (test-invoked (stream-force-output s)
-       (force-output s))
-     (test-invoked (stream-clear-output s)
-       (clear-output s))
-     (test-invoked (stream-advance-to-column s2 10)
-        (format s2 "~10,t"))
-     (test-invoked (stream-read-byte s)
-       (read-byte s))
-     (test-invoked (stream-write-byte s 1)
-       (write-byte 1 s))
-     ;;; extensions
-     (test-invoked (stream-read-sequence s #(1 2) :start 0 :end 1)
-       (read-sequence #(1 2) s :start 0 :end 1))
-     (test-invoked (stream-write-sequence s #(1 2) :start 0 :end 1)
-       (write-sequence #(1 2) s :start 0 :end 1))
-     (test-invoked (stream-file-position s)
-       (file-position s))
-     (test (setf-stream-file-position)
-       (assert-invoked ((setf stream-file-position) 9 s)
-         (file-position s 9))))))
-
-(defun failed-tests (results)
-  (remove-if-not #'failed-p results))
-
-(defun failed-test-names (results)
-  (mapcar (lambda (result)
-            (string-downcase (name result)))
-          (failed-tests results)))
-               
-#|
-(failed-test-names (run-tests))
-
-(setf *allow-debugger* nil))
-
-|#