source: trunk/abcl/test/lisp/abcl/misc-tests.lisp @ 14857

Last change on this file since 14857 was 14857, checked in by Mark Evenson, 5 years ago

[PATCH 5/5] Support FILE-POSITION on string streams.
From cb667c106187443ff2d00bace14f0ee0686fe2fd Mon Sep 17 00:00:00 2001
Adds a custom, seekable writer to be able to go back in the written
output for STRING-OUTPUT-STREAM - the input case is slightly less
complex.
---

build.xml | 1 +
src/org/armedbear/lisp/SeekableStringWriter.java | 140 +++++++++++++++++++++
src/org/armedbear/lisp/StringInputStream.java | 43 ++++++-
src/org/armedbear/lisp/StringOutputStream.java | 35 +++++-
test/lisp/abcl/misc-tests.lisp | 11 +-
.../armedbear/lisp/SeekableStringWriterTest.java | 19 +++
6 files changed, 242 insertions(+), 7 deletions(-)
create mode 100644 src/org/armedbear/lisp/SeekableStringWriter.java
create mode 100644 test/src/org/armedbear/lisp/SeekableStringWriterTest.java

  • Property svn:eol-style set to native
  • Property svn:keywords set to Id
File size: 3.4 KB
Line 
1;;; misc-tests.lisp
2;;;
3;;; Copyright (C) 2005 Peter Graves
4;;; $Id: misc-tests.lisp 14857 2016-09-04 07:01:02Z mevenson $
5;;;
6;;; This program is free software; you can redistribute it and/or
7;;; modify it under the terms of the GNU General Public License
8;;; as published by the Free Software Foundation; either version 2
9;;; of the License, or (at your option) any later version.
10;;;
11;;; This program is distributed in the hope that it will be useful,
12;;; but WITHOUT ANY WARRANTY; without even the implied warranty of
13;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
14;;; GNU General Public License for more details.
15;;;
16;;; You should have received a copy of the GNU General Public License
17;;; along with this program; if not, write to the Free Software
18;;; Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA  02111-1307, USA.
19
20(in-package #:abcl.test.lisp)
21
22(deftest misc.dotimes.1
23  (progn
24    (fmakunbound 'misc.dotimes.1)
25    (defun misc.dotimes.1 ()
26      (let ((sum 0)) (dotimes (i 10) (setq i 42) (incf sum i)) sum))
27    (misc.dotimes.1))
28  420)
29
30(deftest dotimes.1.compiled
31  (progn
32    (fmakunbound 'dotimes.1.compiled)
33    (defun dotimes.1.compiled ()
34      (let ((sum 0)) (dotimes (i 10) (setq i 42) (incf sum i)) sum))
35    (compile 'dotimes.1.compiled)
36    (dotimes.1.compiled))
37  420)
38
39(deftest misc.dotimes.2
40  (progn
41    (fmakunbound 'misc.dotimes.2)
42    (defun misc.dotimes.2 (count)
43      (let ((sum 0)) (dotimes (i count) (setq i 42) (incf sum i)) sum))
44    (misc.dotimes.2 10))
45  420)
46
47(deftest dotimes.2.compiled
48  (progn
49    (fmakunbound 'dotimes.2.compiled)
50    (defun dotimes.2.compiled (count)
51      (let ((sum 0)) (dotimes (i count) (setq i 42) (incf sum i)) sum))
52    (compile 'dotimes.2.compiled)
53    (dotimes.2.compiled 10))
54  420)
55
56(deftest funcall.1
57  (funcall
58   (compile nil (lambda (a b c d e f) (list a b c d e f)))
59   1 2 3 4 5 6)
60  (1 2 3 4 5 6))
61
62(deftest funcall.2
63  (funcall
64   (compile nil (lambda (a b c d e f g) (list a b c d e f g )))
65   1 2 3 4 5 6 7)
66  (1 2 3 4 5 6 7))
67
68(deftest funcall.3
69  (funcall
70   (compile nil (lambda (a b c d e f g h) (list a b c d e f g h)))
71   1 2 3 4 5 6 7 8)
72  (1 2 3 4 5 6 7 8))
73
74(deftest funcall.4
75  (funcall
76   (compile nil (lambda (a b c d e f g h i) (list a b c d e f g h i)))
77   1 2 3 4 5 6 7 8 9)
78  (1 2 3 4 5 6 7 8 9))
79
80(deftest funcall.5
81  (funcall
82   (compile nil (lambda (a b c d e f g h i j) (list a b c d e f g h i j)))
83   1 2 3 4 5 6 7 8 9 10)
84  (1 2 3 4 5 6 7 8 9 10))
85
86(deftest copy-list.1
87  (eq (copy-list nil) nil)
88  t)
89
90(deftest read-from-string.1
91  (read-from-string "(1 2 #-abcl #k(3 4))")
92  (1 2)
93  20)
94
95(deftest read-from-string.2
96  (read-from-string "(1 2 #+nil #k(3 4))")
97  (1 2)
98  19)
99
100;; executed of the compiled expression below
101;; resulted in an error on pre-0.23 versions
102(defstruct mystruct slot)
103(deftest ticket.107
104    (funcall (compile nil
105                      '(lambda ()
106                         (let ((struct (make-mystruct))
107                               x)
108                           (setf (values (mystruct-slot struct)
109                                         x)
110                                 (values 42 2))))))
111  42 2)
112
113(deftest string-output-stream.seekable
114    (string= "Goodbye, World! Something."
115             (let ((stream (make-string-output-stream)))
116               (write-string "Hello, World!   Something." stream)
117               (file-position stream :start)
118               (write-string "Goodbye, World!" stream)
119               (get-output-stream-string stream)))
120  T)
Note: See TracBrowser for help on using the repository browser.