File exhaustion,bugfixes + some test changes/readditions
Lendvai Attila
Attila.Lendvai at netvisor.hu
Mon Aug 2 13:51:09 PDT 2004
Hi!
Here's a diff, please take a look and apply if you find it useful.
Bye,
- 101
-------------- next part --------------
Index: src/lib/external.slate
===================================================================
RCS file: /var/lib/cvs/slate/slate/src/lib/external.slate,v
retrieving revision 1.1
diff -c -r1.1 external.slate
*** src/lib/external.slate 2 Aug 2004 05:00:38 -0000 1.1
--- src/lib/external.slate 2 Aug 2004 20:45:05 -0000
***************
*** 200,218 ****
].
s@(ExternalResource ReadStream traits) next: n putInto: seq startingAt: start
! [| bytes |
bytes: (ByteArray newSize: n).
! s next: n putInto: bytes startingAt: 0.
bytes doWithIndex:
[| :byte :index |
seq at: start + index put: (byte as: s elementType)].
! n
].
s@(ExternalResource ReadStream traits) next: n putInto: seq@(ByteArray traits) startingAt: start
! [
! s resource read: n startingAt: start into: seq.
! n
].
ExternalResource traits addPrototype: #WriteStream
--- 200,220 ----
].
s@(ExternalResource ReadStream traits) next: n putInto: seq startingAt: start
! [| bytes bytesRead |
bytes: (ByteArray newSize: n).
! bytesRead: (s next: n putInto: bytes startingAt: 0).
bytes doWithIndex:
[| :byte :index |
seq at: start + index put: (byte as: s elementType)].
! bytesRead
].
s@(ExternalResource ReadStream traits) next: n putInto: seq@(ByteArray traits) startingAt: start
! [| bytesRead |
! bytesRead: (s resource read: n startingAt: start into: seq).
! bytesRead < n
! ifTrue: [s exhausted].
! bytesRead
].
ExternalResource traits addPrototype: #WriteStream
Index: src/lib/matrix.slate
===================================================================
RCS file: /var/lib/cvs/slate/slate/src/lib/matrix.slate,v
retrieving revision 1.1
diff -c -r1.1 matrix.slate
*** src/lib/matrix.slate 2 Aug 2004 05:14:52 -0000 1.1
--- src/lib/matrix.slate 2 Aug 2004 20:45:05 -0000
***************
*** 1,5 ****
! requires: {#Array}.
! provides: {#Matrix. #BandMatrix}.
"A basic linear algebra system."
prototypes addPrototype: #AbstractMatrix derivedFrom: {Cloneable}.
--- 1,6 ----
! "requires: {#Array}.
! provides: {#Matrix. #BandMatrix}."
!
"A basic linear algebra system."
prototypes addPrototype: #AbstractMatrix derivedFrom: {Cloneable}.
Index: src/lib/test.slate
===================================================================
RCS file: /var/lib/cvs/slate/slate/src/lib/test.slate,v
retrieving revision 1.1
diff -c -r1.1 test.slate
*** src/lib/test.slate 2 Aug 2004 05:14:52 -0000 1.1
--- src/lib/test.slate 2 Aug 2004 20:45:05 -0000
***************
*** 1,16 ****
! requires: {#Set. #ExtensibleArray. #Condition. #Error}.
provides: {#TestCase. #TestResult. #TestResource. #TestSuite}.
"This defines a basic testing framework in the absence of proper condition-
! handling and other features needed for a full unit-test suite."
prototypes ensureDelegatedNamespace: #testing.
"The category for testing-related functionality."
! testing ensureNamespace: #Tests.
"Where the actual test data is stored."
testing addPrototype: #TestFailure derivedFrom: {Warning}.
! TestFailure traits addPrototype: #Foo derivedFrom: {Restart}.
testing addPrototype: #TestCase derivedFrom: {Cloneable}.
"A TestCase is a Command representing the future running of a test case.
--- 1,52 ----
! "requires: {#Set. #ExtensibleArray. #Condition. #Error}.
provides: {#TestCase. #TestResult. #TestResource. #TestSuite}.
+ "
"This defines a basic testing framework in the absence of proper condition-
! handling and other features needed for a full unit-test suite.
!
! TODO
! - print assertion failure descriptions
! - remove logFailure?/replace with exception printing
! "
prototypes ensureDelegatedNamespace: #testing.
"The category for testing-related functionality."
!
! testing ensureNamespace: #UnitTests.
"Where the actual test data is stored."
+ testing ensureNamespace: #RegressionTests.
+ "Where regression tests are stored."
+
+ testing@(testing) runAllTests
+ "Run all tests in any namespace down from here. (With a strange recursion)"
+ [| runnerBlock |
+ runnerBlock:
+ [| :ns |
+ ns slotValuesDo:
+ [| :value |
+ (value is: Namespace)
+ ifTrue: [runnerBlock applyWith: value]
+ ifFalse:
+ [
+ (value is: TestCase) ifTrue:
+ [| result |
+ Console writer print: ('Running test \'' ; value printName ; '\'') paddingUntil: 30.
+ "Console writer ensureColumnAtLeast: 20."
+ "Console writer print: ('Running test \'' ; 'xxx' ; '\'') paddingUntil: 30."
+ Console writer ; (value runSuite printString).
+ Console writer newLine.
+ ].
+ ].
+ ].
+ ].
+ runnerBlock applyWith: UnitTests.
+ runnerBlock applyWith: RegressionTests.
+ ].
+
testing addPrototype: #TestFailure derivedFrom: {Warning}.
! "TestFailure traits addPrototype: #Foo derivedFrom: {Restart}."
testing addPrototype: #TestCase derivedFrom: {Cloneable}.
"A TestCase is a Command representing the future running of a test case.
***************
*** 40,45 ****
--- 76,92 ----
newCase
].
+ tc@(TestCase traits) suite
+ [
+ overrideThis
+ ].
+
+ tc@(TestCase traits) runSuite
+ [| suite |
+ suite: tc suite.
+ suite run
+ ].
+
tc@(TestCase traits) assert: _ at True
[tc].
***************
*** 52,58 ****
[
bool
ifFalse: [tc logFailure: descr.
! (TestFailure newDescription: descr) signal]
].
tc@(TestCase traits) deny: bool description: descr
--- 99,105 ----
[
bool
ifFalse: [tc logFailure: descr.
! tc signalFailureDescription: descr]
].
tc@(TestCase traits) deny: bool description: descr
***************
*** 70,90 ****
tc assert: block do
].
! tc@(TestCase traits) executeShould: block inScopeOf: cond
"Answers whether executing the block raises the given condition."
[
block on: cond do: [| :c | ^ True].
-
False
].
tc@(TestCase traits) should: block raise: cond
[
! tc assert: (tc executeShould: block inScopeOf: cond)
].
tc@(TestCase traits) should: block raise: cond description: descr
[
! tc assert: (tc executeShould: block inScopeOf: cond) description: descr
].
tc@(TestCase traits) should: block description: descr
--- 117,137 ----
tc assert: block do
].
! tc@(TestCase traits) executionOf: block raises: cond
"Answers whether executing the block raises the given condition."
[
block on: cond do: [| :c | ^ True].
False
].
+
tc@(TestCase traits) should: block raise: cond
[
! tc assert: (tc executionOf: block raises: cond)
].
tc@(TestCase traits) should: block raise: cond description: descr
[
! tc assert: (tc executionOf: block raises: cond) description: descr
].
tc@(TestCase traits) should: block description: descr
***************
*** 99,105 ****
tc@(TestCase traits) shouldnt: block raise: cond
[
! tc deny: (tc executeShould: block inScopeOf: cond)
].
tc@(TestCase traits) shouldnt: block description: descr
--- 146,152 ----
tc@(TestCase traits) shouldnt: block raise: cond
[
! tc deny: (tc executionOf: block raises: cond)
].
tc@(TestCase traits) shouldnt: block description: descr
***************
*** 282,292 ****
tr@(TestResult traits) printOn: s
[
tr runCount printOn: s.
! s ; ' run, '.
tr passedCount printOn: s.
! s ; ' passed, '.
tr failureCount printOn: s.
! s ; ' failed, '.
tr errorCount printOn: s.
s ; ' error'.
tr errorCount > 1 ifTrue: [s nextPut: $s].
--- 329,339 ----
tr@(TestResult traits) printOn: s
[
tr runCount printOn: s.
! s ; ' run,\t'.
tr passedCount printOn: s.
! s ; ' passed,\t'.
tr failureCount printOn: s.
! s ; ' failed,\t'.
tr errorCount printOn: s.
s ; ' error'.
tr errorCount > 1 ifTrue: [s nextPut: $s].
***************
*** 299,308 ****
--- 346,357 ----
passed: ([[tc runCase. True]
on: TestFailure
do: [| :failure |
+ failure describe.
result failures include: tc.
failure exit: False]]
on: Error do: [| :error |
result errors include: tc.
+ error describe.
error exit: False]).
passed ifTrue: [result passed include: tc]
].
***************
*** 377,381 ****
].
- Tests addSlot: #CurrentUnit.
- "The slot for activating the most-recently loaded test suite."
--- 426,428 ----
Index: src/lib/tokenizer.slate
===================================================================
RCS file: /var/lib/cvs/slate/slate/src/lib/tokenizer.slate,v
retrieving revision 1.2
diff -c -r1.2 tokenizer.slate
*** src/lib/tokenizer.slate 2 Aug 2004 18:15:22 -0000 1.2
--- src/lib/tokenizer.slate 2 Aug 2004 20:45:06 -0000
***************
*** 1,5 ****
! requires: {#ReadStream}.
! provides: {#Tokenizer}.
prototypes addPrototype: #Tokenizer derivedFrom: {StreamProcessor}.
"A stream that collects characters and emits words separated by
--- 1,5 ----
! "requires: {#ReadStream}.
! provides: {#Tokenizer}."
prototypes addPrototype: #Tokenizer derivedFrom: {StreamProcessor}.
"A stream that collects characters and emits words separated by
***************
*** 37,43 ****
s@(Tokenizer traits) isAtEnd
[
! [s skipSeparators] on: Exhaustion do: [| :c | ^ True].
s source isAtEnd
].
--- 37,43 ----
s@(Tokenizer traits) isAtEnd
[
! [s skipSeparators] on: Stream Exhaustion do: [| :c | ^ True].
s source isAtEnd
].
***************
*** 56,66 ****
s@(Tokenizer traits) next
[| result |
result: s source arrayType newEmpty writer.
! [[s skipSeparators.
[result nextPut: s source next.
s isSeparator: s source peek]
! whileFalse]
! breakOn: Exhaustion]
! ensure: [result position isZero ifTrue: [s exhausted]].
! result contents
].
--- 56,66 ----
s@(Tokenizer traits) next
[| result |
result: s source arrayType newEmpty writer.
! [s skipSeparators.
[result nextPut: s source next.
s isSeparator: s source peek]
! whileFalse
! ] breakOn: Stream Exhaustion.
! result position isZero ifTrue: [s exhausted].
! result contents
].
Index: tests/init.slate
===================================================================
RCS file: /var/lib/cvs/slate/slate/tests/init.slate,v
retrieving revision 1.1
diff -c -r1.1 init.slate
*** tests/init.slate 27 Jul 2004 18:00:56 -0000 1.1
--- tests/init.slate 2 Aug 2004 20:45:06 -0000
***************
*** 1,6 ****
! load: 'bootstrap/test.slate'.
! load: 'bootstrap/tokenizer.slate'.
! load: 'bootstrap/matrix.slate'.
load: 'tests/regression/wordcount.slate'.
load: 'tests/dictionary.slate'.
--- 1,6 ----
! load: 'src/lib/test.slate'.
! load: 'src/lib/tokenizer.slate'.
! load: 'src/lib/matrix.slate'.
load: 'tests/regression/wordcount.slate'.
load: 'tests/dictionary.slate'.
More information about the Slate
mailing list