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