home *** CD-ROM | disk | FTP | other *** search
/ The CDPD Public Domain Collection for CDTV 3 / CDPDIII.bin / pd / programming / gnusmalltalk / t.st < prev    next >
Text File  |  1992-02-16  |  24KB  |  1,200 lines
  1. stdout nextPutAll: ('Welcome to GNU Smalltalk [', Version, ']
  2.  
  3. This file contains a wealth of goodies, not all packaged neatly.
  4. It sort of grows by accretion, so you''re likely to find most
  5. anything in here.
  6. ' ).
  7.  
  8. Smalltalk quitPrimitive!
  9.  
  10. "| q |
  11.     q _ SharedQueue new.
  12.     q nextPut: 'foo'.
  13.     q nextPut: 'bar'.
  14.     q next printNl.
  15.     q next printNl.
  16.     q next printNl   ""Should print no-runnable-proceses""
  17. !
  18. "
  19.  
  20. Object withAllSubclasses do: 
  21.     [ :subclass | (subclass name notNil and: [ subclass comment isNil ])
  22.               ifTrue: [ subclass name print.
  23.                 ' has no comment.' printNl ] 
  24.               ]
  25.  
  26. !
  27.  
  28. Smalltalk quitPrimitive!
  29.  
  30.  
  31.  
  32. !Object methodsFor: 'testing'!
  33.  
  34. test
  35.     | x |
  36.       x _ [ :dummy | "thisContext inspect.
  37.           Smalltalk backtrace."
  38.             thisContext backit ].
  39. "    x inspect."
  40.     x value: 3
  41. !
  42.  
  43. backit
  44.     | n context | 
  45.     n _ 0.
  46.     context _ thisContext.
  47.     [ context notNil ] whileTrue: [ n _ n + 1. context _ context parentContext ].
  48.     context _ thisContext.
  49.     n to: 1 by: -1 do: 
  50.     [ :i | context receiver print.
  51.            '>>' print.
  52.            context selector printNl.
  53.            context _ context parentContext ].
  54. !!
  55.  
  56. !BlockContext methodsFor: 'debugging'!
  57.  
  58. callers
  59.     self inspect.
  60.     caller notNil
  61.     ifTrue: [ caller callers ]
  62. !
  63.  
  64. parentContext
  65.     ^caller
  66. !
  67.  
  68. selector
  69.     ^selector
  70. !
  71.  
  72. receiver
  73.     ^'[] in ', home class name
  74. !!
  75.  
  76. !MethodContext methodsFor: 'debugging'!
  77.  
  78. callers
  79.     self inspect.
  80.     sender notNil 
  81.     ifTrue: [ sender callers ]
  82. !
  83.  
  84. parentContext
  85.     ^sender
  86. !
  87.  
  88. receiver
  89.     ^receiver class name
  90. !
  91.  
  92. selector
  93.     ^selector
  94. !!
  95.  
  96. 3 test!
  97.  
  98. Smalltalk quitPrimitive!
  99.  
  100.  
  101. "| count |
  102.  
  103. SymbolTable do: 
  104.     [ :elt | elt printString.
  105.          "Character nl print
  106.              count _ 0.
  107.              elt notNil ifTrue: [ elt do: [ :x | count _ count + 1 ]].
  108.              count timesRepeat: [ 'x' print ].
  109.              Character nl print" ] !
  110.  
  111.  
  112. Smalltalk quitPrimitive!
  113. "
  114.  
  115. "| d days |
  116. d _ Date new.
  117. 1 to: 70 do:
  118.     [ :year | days _ year * 365.
  119.               days - 5 to: days + 5 do:
  120.          [ :i | d setDays: i.
  121.             d printString ] ]
  122. !
  123.  
  124. Smalltalk quitPrimitive!"
  125.  
  126. Date edit: #computeDateParts:!
  127.  
  128. "| pipe |
  129.     pipe _ FileStream popen: 'lpr -Pelab' dir: 'w'.
  130.     FileStream fileOutOn: pipe.
  131.     FileStream class fileOutOn: pipe.
  132.     pipe close!"
  133.  
  134.  
  135.  
  136. | d days |
  137. d _ Date new.
  138. 1 to: 70 do:
  139.     [ :year | days _ year * 365.
  140.               '----------' printNl.
  141.               days - 5 to: days + 5 do:
  142.          [ :i | d setDays: i.
  143.             d printNl ] ]
  144. !
  145.  
  146. Date today printNl!
  147.  
  148. | f |
  149.     f _ ReadWriteStream on: (String new: 0).
  150.     'foo on you' printOn: f.
  151.     f position: 3.
  152.     '123456789' printOn: f.
  153.     f skip: -1.
  154.     f next printNl.
  155.     f contents printNl.
  156.     f reset.
  157.     'test[]' printOn: f.
  158.     f contents printNl!
  159.  
  160. 16r3F0000000 printNl!
  161.  
  162. Smalltalk quitPrimitive!
  163.  
  164. !Date methodsFor: 'rambo'!
  165.  
  166. computeDateParts: aBlock
  167.     | yearInteger tempDays monthIndex daysInMonth |
  168.     tempDays _ days - (days // 1460) "4*365"
  169.                     + (days // 36500) "100*365"
  170.             - (days // 146000). "400*365"
  171.     yearInteger _ tempDays // 365.
  172.     tempDays _ days - (yearInteger * 365)
  173.             - (yearInteger // 4)
  174.             + (yearInteger // 100)
  175.             - (yearInteger // 400)
  176.             + 1.
  177.     yearInteger _ yearInteger + 1901.
  178.     monthIndex _ 1.
  179.     [ monthIndex < 12
  180.         and: [ daysInMonth _ Date daysInMonthIndex: monthIndex
  181.                               forYear: yearInteger.
  182.                tempDays > daysInMonth ] ] whileTrue:
  183.         [ monthIndex _ monthIndex + 1.
  184.       tempDays _ tempDays - daysInMonth ].
  185.     ^aBlock value: yearInteger value: monthIndex value: tempDays
  186. !!
  187.  
  188. | d days |
  189. d _ Date new.
  190. 1 to: 70 do:
  191.     [ :year | days _ year * 365.
  192.               '----------' printNl.
  193.               days - 5 to: days + 5 do:
  194.          [ :i | d setDays: i.
  195.             d printNl ] ]
  196. !
  197.  
  198. Date today printNl!
  199.  
  200. | f |
  201.     f _ ReadWriteStream on: (String new: 0).
  202.     'foo on you' printOn: f.
  203.     f position: 3.
  204.     '123456789' printOn: f.
  205.     f skip: -1.
  206.     f next printNl.
  207.     f contents printNl.
  208.     f reset.
  209.     'test[]' printOn: f.
  210.     f contents printNl!
  211.  
  212. 16r3F0000000 printNl!
  213.  
  214.  
  215. | d days |
  216. d _ Date new.
  217. 1 to: 70 do:
  218.     [ :year | days _ year * 365.
  219.               '----------' printNl.
  220.               days - 3 to: days + 10 do:
  221.          [ :i | d setDays: i.
  222.             d printNl ] ]
  223. !
  224.  
  225. Date today printNl!
  226.  
  227. | f |
  228.     f _ ReadWriteStream on: (String new: 0).
  229.     'foo on you' printOn: f.
  230.     f position: 3.
  231.     '123456789' printOn: f.
  232.     f skip: -1.
  233.     f next printNl.
  234.     f contents printNl.
  235.     f reset.
  236.     'test[]' printOn: f.
  237.     f contents printNl!
  238.  
  239. Object withAllSubclasses do:
  240.     [ :aClass | aClass fileOutOn: stdout ]!
  241.  
  242. !Bag methodsFor: 'enumerating the elements of a collection'!
  243.  
  244. occurrencesOf: anObject
  245.     ^contents at: anObject ifAbsent: [ ^0 ]
  246. !
  247.  
  248. size
  249.     | count |
  250.     count _ 0.
  251.     contents printNl.
  252.     contents do: [ :element | count _ count + element ].
  253.     ^count
  254. !
  255.  
  256. do: aBlock
  257.     contents associationsDo:
  258.       [ :assoc | assoc value printNl
  259. "  assoc value timesRepeat: [ aBlock value: assoc key ]" ]
  260. !!
  261.  
  262. | b |
  263.     b _ Bag new.
  264.     (b occurrencesOf: 'foo' ) printNl.
  265.     b size printNl.
  266.     b basicSize printNl.
  267.     b add: 'foo'.
  268.     b add: 'bar'.
  269.     b add: 'quem.'.
  270.     b do: [ :value | 'value is ' print. value printNl ]
  271. !
  272.  
  273. !ClassDescription methodsFor: 'filing'!
  274.  
  275. fileOutOn: aFileStream
  276.     | categories |
  277.     categories _ Bag new.
  278.     methodDictionary do:
  279.     [ :method | categories add: (method methodCategory) ].
  280. 'categories....' printNl.
  281.     categories inspect.
  282.     categories do:
  283.         [ :category | category printNl "self emitCategory: category toStream: aFileStream" ]
  284. !!
  285.  
  286. !ClassDescription methodsFor: 'private'!
  287.  
  288. emitCategory: category toStream: aFileStream
  289.     ' methodsFor: ''' printOn: aFileStream.
  290.     category printOn: aFileStream.
  291.     '''
  292.  
  293. '   printOn: aFileStream.
  294.     methodDictionary do:
  295.     [ :method | (method methodCategory) = category
  296.             ifTrue: [ method methodSourceString
  297.                       printOn: aFileStream.
  298.                       '!
  299.  
  300. '                                 printOn: aFileStream ] ].
  301.     '!
  302.  
  303. '   printOn: aFileStream
  304.  
  305. !!
  306.  
  307. Object fileOutOn: stdout!
  308.  
  309.  
  310. "Boolean selectors do: [ :selectors | selectors printNl ].
  311. '
  312. after ' printNl.
  313. Boolean copyCategory: 'basic' from: True.
  314. Boolean selectors do: [ :selectors | selectors printNl ]!"
  315.  
  316. "| method newMethod |
  317.     method _ CompiledMethod compiledMethodAt: #bytecodeAt:.
  318.     'Original' printNl.
  319.     method inspect.
  320.     '
  321.  
  322. Cheap imitation' printNl.
  323.     newMethod _ Object copy: #bytecodeAt:
  324.              from: CompiledMethod
  325.              classified: 'rambo'.
  326.     (Object compiledMethodAt: #bytecodeAt:) methodCategory printNl.
  327.  
  328.     method methodCategory printNl
  329. !
  330.  
  331. Smalltalk quitPrimitive!"
  332.  
  333.  
  334. "| j |
  335.     j _ 0.
  336.     1 to: 20000 do: [ :i | j _ j + i ]!
  337.  
  338. Smalltalk quitPrimitive!"
  339.  
  340. "Smalltalk gcMessage: false!"
  341.  
  342. !ClassDescription methodsFor: 'test'!
  343.  
  344. printSubclassMethods
  345.     | mySubclasses |
  346.     self name printNl.
  347.     instanceVariables notNil
  348.     ifTrue: [ 'Instance variables: ' print.
  349.                   instanceVariables do: [ :var | var print.
  350.                          ' ' print ].
  351.                   Character nl print].
  352.     '-----------------------------------------------' printNl.
  353.     self selectors asSortedCollection do:
  354.     [ :selector |
  355.       (self compiledMethodAt: selector) methodSourceString printNl.
  356.          '' printNl ].
  357.     mySubclasses _ self subclasses asSortedCollection:
  358.                         [ :a :b | (a name isNil or: [ b name isNil ])
  359.                                       ifTrue: [ true ]
  360.                               ifFalse: [ a name <= b name ] ].
  361.     mySubclasses do:
  362.         [ :subclass | subclass class ~~ Metaclass
  363.                     ifTrue: [ subclass printSubclassMethods ] ]
  364. !!
  365.  
  366.  
  367. Object printSubclassMethods!
  368.  
  369. Smalltalk quitPrimitive!
  370. ""
  371. !Collection methodsFor: 'test'!
  372.  
  373. printSorted
  374.     self asSortedCollection do:
  375.         [ :element | '    ' print. element printNl ]
  376. !!
  377. "
  378. Smalltalk at: #BasicClassSelectors put: Class allSelectors!
  379.  
  380. "
  381. !Behavior methodsFor: 'test'!
  382.  
  383. printInheritedSelectors
  384.     | sels |
  385.     sels _ self allSelectors.
  386.     sels removeAll: self selectors.
  387.     sels printSorted
  388. !
  389. "
  390. printNewSelectors
  391.     | sels |
  392.     sels _ self allSelectors.
  393.     sels removeAll: BasicClassSelectors.
  394.     sels printSorted
  395.  
  396. !"!
  397. Smalltalk monitor: true.
  398. Class printInheritedSelectors.
  399. Smalltalk monitor: false.
  400. Smalltalk quitPrimitive!"
  401. "
  402.  
  403. "MetaClass allInstancesDo: [ :inst | '------------' print.
  404.                                     inst print.
  405.                                     inst printNewSelectors.
  406.                     '' print ] !"
  407.  
  408. "| selectorSet newSelectors |
  409. selectorSet _ Set new.
  410. Object withAllSubclasses do:
  411.     [ :subclass | newSelectors _ subclass selectors.
  412.                   '-----------------' print.
  413.                   subclass print.
  414.           newSelectors printSorted.
  415.           '' print.
  416.           selectorSet addAll: newSelectors ].
  417. '****************' print.
  418. 'The set of selectors is...' print.
  419. selectorSet size print.
  420. selectorSet do: [ :elt | elt print ]
  421. !"
  422.  
  423. 'LIVE' printNl!
  424.  
  425. (Object withAllSubclasses asSortedCollection:
  426.     [ :a :b | (a name isNil or: [ b name isNil ])
  427.                 ifTrue: [ true ]
  428.         ifFalse: [ a name <= b name ] ])
  429.     do:
  430.         [ :subclass | 
  431.             subclass class ~~ Metaclass
  432.                 ifTrue: [ '------------------------------------------' printNl.
  433.                       subclass printNl.
  434.                       'inherited selectors' printNl.
  435.                       subclass printInheritedSelectors.
  436.                   '' printNl ]
  437.     ]!
  438.  
  439.  
  440. Smalltalk quitPrimitive!
  441.  
  442.  
  443. "
  444.  
  445.  
  446. "**********************************************************************"
  447.  
  448. ('foo' match: 'foo') printNl.
  449. ('foo' match: 'FoO') printNl.
  450. ('#oo' match: 'Foo') printNl.
  451. ('###' match: 'que') printNl.
  452. 'should be false ' print.       ('###' match: 'quem') printNl.
  453. 'should be false ' print.       ('###' match: 'bo') printNl.
  454. 'should be true  ' print.    ('* string' match: 'any string') printNl.
  455. 'should be true  ' print.    ('*.st' match: 'filename.st') printNl.
  456. 'should be true  ' print.    ('foo.*' match: 'foo.bar') printNl.
  457. 'should be true  ' print.    ('foo.*' match: 'foo.') printNl.
  458. 'should be true  ' print.    ('*' match: 'foo.') printNl.
  459. 'should be true  ' print.    ('*' match: '') printNl.
  460. 'should be true  ' print.    ('***' match: '') printNl.
  461. 'should be true  ' print.    ('*.st' match: '.st') printNl.
  462. 'should be true  ' print.    ('*#*' match: '.st') printNl.
  463. 'should be true  ' print.    ('*#*' match: '.s') printNl.
  464. 'should be true  ' print.    ('*#*' match: 's') printNl.
  465. 'should be false ' print.    ('*.st' match: '.s') printNl.
  466. 'should be false ' print.    ('*#*' match: '') printNl!
  467.  
  468. Smalltalk quitPrimitive!
  469.  
  470. | j |
  471.     j _ 0.
  472.     1 to: 1000 do:
  473.         [ :i | j _ j + i ]!
  474.  
  475. Smalltalk quitPrimitive!
  476.  
  477. 300 timesRepeat:
  478.     [ String new: 20000 ].
  479. 'Foo ' printNl!
  480.     
  481.  
  482. "Smalltalk quitPrimitive!"
  483.  
  484. !Object methodsFor: 'testing'!
  485.  
  486. quem
  487.     ^1 + 2
  488. !!
  489.  
  490. !Symbol methodsFor: 'testing'!
  491. quem
  492.     ^1 + 2
  493. !!
  494.  
  495. ((Object compiledMethodAt: #quem) = (Object compiledMethodAt: #quem)) printNl."
  496.  
  497.  
  498. (LinkedList compiledMethodAt: #addLast:) inspect.
  499. (CompiledMethod compiledMethodAt: #inspect) inspect.
  500. (Integer compiledMethodAt: #+) inspect.
  501.  
  502. (Stream compiledMethodAt: #next) methodSourceString printNl!
  503. (LinkedList compiledMethodAt: #addLast:) methodSourceString printNl!
  504.  
  505. Smalltalk at: #quem put: (['foo' printNl. Processor yield ] newProcess)!
  506. Smalltalk at: #proc2 put: (['process2' printNl. Processor yield. 
  507.  'Hi again from proc 2' printNl. Processor yield ] newProcess)!
  508. ['process3' printNl. Processor yield ] fork!
  509.  
  510. quem resume.
  511. proc2 resume!
  512.  
  513. 'Yielding...' printNl.
  514. Processor yield!
  515.  
  516. "proc2 terminate."
  517. 'Back to main' printNl.
  518. Processor yield.
  519.  
  520. 'Back to main from second yield' printNl.
  521.  
  522. Smalltalk at: #rambo
  523.           put: ([ :arg1 :arg2 | arg2 printNl". Processor yield" ]
  524.                 newProcessWith: #('foo on you' 'and your mother'))!
  525.  
  526. rambo resume!
  527. Processor yield!
  528.  
  529.  
  530. Smalltalk quitPrimitive!
  531.  
  532. !Object methodsFor: 'debugging'!
  533.  
  534. !
  535.  
  536. !Behavior methodsFor: 'test'!
  537.  
  538. !
  539.  
  540. !ClassDescription methodsFor: 'debug'!
  541.  
  542. printClass
  543.     | instVarNames instVars instVal |
  544.     instanceVariables printNl.
  545.     instVarNames _ self instanceVariableString.
  546.     instVars _ (TokenStream on: instVarNames) contents.
  547.     self printNl.
  548.     1 to: instVars size do:
  549.         [ :i | '  ' print.
  550.            (instVars at: i) print.
  551.            ': ' print.
  552.            instVal _ self instVarAt: i.
  553.            (instVal isKindOf: Dictionary)
  554.                    ifTrue: [ instVal printNl "'a ' print.
  555.                      instVal class print.
  556.                      ' with ' print.
  557.                      instVal size print.
  558.                  ' elements' printNl" ]
  559.                ifFalse: [ instVal printNl ] ]
  560. !!
  561.  
  562. !Metaclass class methodsFor: 'basic'!
  563.  
  564. !
  565.  
  566. !Metaclass  methodsFor: 'basic'!
  567.  
  568. !
  569.  
  570. | newMeta |
  571. newMeta _ Metaclass subclassOf: Object class.
  572. (newMeta class whichClassIncludesSelector: #new) printNl.
  573. newMeta name: 'Rambo'
  574.     environment: Smalltalk
  575.         subclassOf: Object
  576.     instanceVariableNames: 'john paul  george  
  577. ringo '
  578.     variable: false
  579.         words: true
  580.         pointers: true
  581.         classVariableNames: 'charlie davey'
  582.         poolDictionaries: ''
  583.         category: ''
  584.         comment: 'no comment'
  585.         changed: false ".
  586. newMeta print"!
  587.  
  588. Collection inspect!
  589. Rambo inspect!
  590. Rambo new inspect!
  591.  
  592. "Smalltalk system: 'mail jb'!
  593. Smalltalk system: 'ls -lt  *.st'!"
  594.  
  595. "12500000000000000000000000000000000.0 print.
  596.  
  597. 0.0625 print.
  598. 0.125 print.
  599. 0.25 print.
  600. 0.5 print.
  601. 0.12345678901234 print.
  602.  
  603. 0.0 print.
  604. 1.0 print.
  605. 2.0 print.
  606. 3345678912345678.0 print!"
  607.  
  608. "Behavior defineCFunc: 'marli'
  609.          withSelectorArgs: 'doMarli: anInteger'
  610.      forClass: Object
  611.      returning: #void
  612.      args: #(int).
  613. nil doMarli: 3!"
  614.  
  615. "| addr |
  616.     addr _ Memory addressOf: 'Quem? and your mother'.
  617.     (WordMemory at: addr) print. Character nl print.
  618.     addr _ addr + 8.
  619.     (Character value: (ByteMemory at: addr)) print.
  620.     Character nl print
  621. !"
  622.  
  623. "(ByteMemory at: 16r2000) print. Character nl print.
  624. (ByteMemory at: 16r2001) print. Character nl print.
  625. (ByteMemory at: 16r2002) print. Character nl print.
  626. (ByteMemory at: 16r2003) print. Character nl print!"
  627.  
  628.  
  629. "
  630. | l |
  631.     l _ LinkedList new.
  632.     l add: (Link new).
  633.     l add: (Link new).
  634.     l add: (Link new).
  635.     l store
  636. !"
  637.  
  638. "3.5 print. ' ' print!
  639. 3.5e5 print. ' ' print!"
  640.  
  641. "!Object methodsFor: 'test'!"
  642.  
  643. "testComp
  644.     Object compile: (FileStream open: 'test.st' mode: 'r')"
  645. "    Object compile: 'rambo ''Hi there'' print'"
  646. "!!"
  647.  
  648. "nil testComp.
  649. nil rambo!
  650. "
  651.  
  652. | d |
  653. Smalltalk monitor: true.
  654. d _ Date new.
  655. 10000 to: 10050 do:
  656.     [ :i | d setDays: i.
  657.            d storeString.
  658.            "Character nl print" ]
  659. . Smalltalk monitor: false
  660. !
  661.  
  662. | s |
  663. "Smalltalk monitor: true."
  664.     s _ Bag new.
  665.     s add: #quem.
  666.     s add: #zoneball.
  667.     s add: #quem.
  668.     s add: #juma withOccurrences: 20.
  669.     s print.
  670.     s store.
  671. "    s add: #quem.
  672.     s add: #juma."
  673. "    s add: 12345.
  674.     'after adding ' print."
  675. "    s add: 'wont you please break that record' ."
  676. "    s add: $c."
  677.     s printOn: stdout.
  678.     stdout nextPut: Character nl.
  679.     s storeOn: stdout
  680. ". Smalltalk monitor: false"
  681. !
  682. "| f |
  683.     f _ FileStream open: 'foo.test' mode: 'w'.
  684.     f nextPutAll: 'this is a test of your mother'.
  685.     f nextPut: Character nl.
  686.     f close
  687. !
  688.  
  689. | f |
  690.     f _ FileStream open: 'foo.test' mode: 'r'.
  691.     [ f atEnd ] whileFalse:
  692.         [ f next print ].
  693.     f position: 0.
  694.     [ f atEnd ] whileFalse:
  695.         [ f next print ].
  696.     f close
  697. !
  698. "
  699.  
  700. !Set methodsFor: 'testing'!
  701.  
  702. printSet
  703.     1 to: self basicSize do: [ :i | 'at ' print.
  704.                                     i print.
  705.                     (self basicAt: i) print. ]
  706. !
  707.  
  708. findNilBefore: index
  709.     "Finds the first nil element before index and returns the index of that
  710.      nil.  If there is no nil element, index is returned."
  711.     | size count i |
  712.     count _ size _ self basicSize.
  713.     i _ index.
  714.     [ count > 0 ]
  715.         whileTrue:
  716.         [ i _ i - 2 \\ size + 1. "step backward w/wrap through elements"
  717.               (self basicAt: i) isNil ifTrue: [ ^i ].
  718.           count _ count - 1 ].
  719.     ^index + 1
  720. !!
  721.  
  722. Smalltalk quitPrimitive!
  723.  
  724. !Collection methodsFor: 'test'!
  725.  
  726. printSorted
  727.     self asSortedCollection do:
  728.         [ :element | element print ]
  729. !!
  730.  
  731. Smalltalk at: #BasicClassSelectors put: Class allSelectors!
  732.  
  733.  
  734. !Behavior methodsFor: 'test'!
  735.  
  736. printInheritedSelectors
  737.     | sels |
  738.     sels _ self allSelectors.
  739.     sels removeAll: self selectors.
  740.     sels printSorted
  741. !
  742.  
  743. printNewSelectors
  744.     | sels |
  745.     sels _ self allSelectors.
  746.     sels removeAll: BasicClassSelectors.
  747.     sels printSorted
  748.  
  749. !!
  750.  
  751. "Smalltalk monitor: true.
  752. Class printInheritedSelectors.
  753. Smalltalk monitor: false.
  754. Smalltalk quitPrimitive!"
  755.  
  756. "MetaClass allInstancesDo: [ :inst | '------------' print.
  757.                                     inst print.
  758.                                     inst printNewSelectors.
  759.                     '' print ] !"
  760.  
  761. | selectorSet newSelectors |
  762. selectorSet _ Set new.
  763. Object withAllSubclasses do:
  764.     [ :subclass | newSelectors _ subclass selectors.
  765.                   '-----------------' print.
  766.                   subclass print.
  767.           newSelectors printSorted.
  768.           '' print.
  769.           selectorSet addAll: newSelectors ].
  770. '****************' print.
  771. 'The set of selectors is...' print.
  772. selectorSet size print.
  773. selectorSet do: [ :elt | elt print ]
  774. !
  775.  
  776. Smalltalk quitPrimitive!
  777.  
  778.  
  779. (Object withAllSubclasses "asSortedCollection:
  780.     [ :a :b | (a name isNil or: [ b name isNil ])
  781.                 ifTrue: [ true ]
  782.         ifFalse: [ a name <= b name ] ]")
  783.     do:
  784.         [ :subclass | 
  785.             subclass class ~~ MetaClass
  786.                 ifTrue: [ '------------------------------------------' print.
  787.                       subclass print.
  788.                       'inherited selectors' print.
  789.                       subclass printInheritedSelectors.
  790.                   '' print ]
  791.     ]!
  792. "
  793. !Object methodsFor: 'test'!
  794.  
  795. printElements
  796.     self do: [ :element | element print ]
  797. !
  798.  
  799. "counter | i total |
  800.     total _ i _ 0.
  801.     [i <= self] whileTrue:
  802.     [ total _ total + i.
  803.       i _ i + 1 ].
  804.     ^total
  805. !
  806.  
  807. timer | i |
  808.     i _ 0.
  809.     [i < self] whileTrue: [ i _ i + 1 ]
  810. "
  811.  
  812. count2
  813.     | sum |
  814.     sum _ 0.
  815.     1 to: self do: [ :i | sum _ sum + i ].
  816.     ^sum
  817. !
  818.  
  819. myTest
  820.     ^12 factorial
  821.  
  822. !!
  823.  
  824. !Integer methodsFor: 'test'!
  825.  
  826. factorial
  827.     self > 0 ifTrue: [ self * (self - 1) factorial ]
  828.              ifFalse: [ ^self error: 'factorial of a small number' ]
  829. !!
  830.  
  831. ^Symbol allInstances size!
  832.  
  833. Smalltalk quitPrimitive!
  834.  
  835. "^Date yearAsDays: 1904!
  836.  
  837.  
  838.  
  839. 1850 to: 2050 do:
  840.     [ :year | year print.
  841.               (Date leapYear: year) print ]!"
  842.  
  843. | s |
  844.     s _ WriteStream on: (String new: 0).
  845.     s nextPutAll: 'name'.
  846.     s tab.
  847.     s nextPutAll: 'city'.
  848.     s reset.
  849.     s nextPutAll: 'foo'.
  850.     s setToEnd.
  851.     s nl.
  852.     s nextPutAll: 'quem?'.
  853.     s workingSize print.
  854.     ^s contents
  855. !
  856.  
  857.  
  858.  
  859.  
  860. | s str|
  861.     str _ WriteStream on: (String new: 5).
  862.     s _ #(foo bar baz quem juma zoneball).
  863.     s do: [ :sym | str nextPutAll: sym , ' ' ].
  864.     ^str contents
  865. "    s _ s inject: '' into: [ :str :atom | str , atom , ' ' ].
  866.     s size print.
  867.     s grow.
  868.     s size print.
  869.     s print"
  870. !
  871.  
  872. | t |
  873.     t _ #(foo bar baz).
  874.     t _ t , #(quem juma).
  875.     t do: [ :element | element print ]!
  876.  
  877.  
  878. "
  879. Smalltalk at: #children put: SortedCollection new!
  880.  
  881.  
  882. ^children add: #Joe!
  883. ^children add: #Bill!
  884. ^children add: #Alice!
  885. ^children printElements!
  886. ^children add: #Sam!
  887. ^(children sortBlock: [ :a :b | a > b ]) printElements!
  888. ^children add: #Henrietta!
  889. ^children printElements!
  890. "
  891. | t |
  892.     t _ SortedCollection new.
  893.     t add: 'foo'.
  894.     t add: 'bar'.
  895.     t add: 'dinner'.
  896.     t add: 'in'.
  897.     t add: 'the'.
  898.     t add: 'diner'.
  899.     t add: 'nothing'.
  900.     t add: 'could'.
  901.     t add: 'be'.
  902.     t add: 'finer'.
  903.     "1 to: t size do: [ :i | i print. (t at: i ) print ]."
  904.     t sortBlock: [ :a :b | a > b ].
  905.     1 to: t size do: [ :i | i print. (t at: i ) print ].
  906. !
  907.  
  908.  
  909.  
  910. 600 to: 1000 do:
  911.     [ :i | i print.
  912.            i asObject print ]!
  913.  
  914.  
  915. ^(Bag with: #foo with: #foo ) occurrencesOf: #foo!
  916.  
  917.  
  918. "
  919. Smalltalk at: #Test put: Dictionary new.
  920. Smalltalk at: #X put: 0!
  921. X _ Bag new!
  922. ^X occurrencesOf: 3!
  923. ^X add: 3!
  924.  
  925. Test at: #jeff put: 1.
  926. Test at: #steve put: 5.
  927. Test at: #jiz put: 99!
  928. ^Test at: #jeff!
  929. ^Test at: #steve!
  930. ^Test at: #jiz!
  931.  
  932.  
  933. X _ Test collect: [ :elt | elt * 2 ]!
  934. ^X occurrencesOf: 1!
  935. ^X occurrencesOf: 2!
  936. ^X occurrencesOf: 5!
  937. ^X occurrencesOf: 10!
  938. ^X occurrencesOf: 99!
  939. ^X occurrencesOf: 99*2!
  940. ^X size!
  941. "
  942. "
  943. ^Test at: #blockA put: [ 'this is a test' ]!
  944. ^Test at: #blockB put: [ 'hello from block b' ]!
  945. ^Test at: #juma put: 'hello jeff!!!'!
  946. ^Test size!
  947. ^Test at: #juma!
  948.  
  949. ^(Test at: #blockB) value!
  950. ^(Test at: #blockA) value!
  951.  
  952. ^Test removeKey: #juma!
  953. ^Test size!
  954. ^Test removeKey: #juma!
  955. "
  956.  
  957. "^Test _ Bag new!
  958.  
  959. ^Test add: #quem!
  960. ^Test size!
  961. ^Test basicSize!
  962. "
  963.  
  964. "
  965. ^Test _ Set new!
  966.  
  967. ^'test'!
  968. ^Test basicSize!
  969.  
  970. ^Test findObjectIndex: #foo!
  971. ^Test species!
  972.  
  973. ^Test add: #quem!
  974. ^Test add: #juma!
  975.  
  976. ^Test size!
  977. ^Test grow!
  978. ^Test add: #juma2!
  979. ^Test add: #juma3!
  980.  
  981. ^Test size!
  982. ^Test basicSize!
  983.  
  984. ^Test findObjectIndex: #juma2!
  985. ^Test remove: #juma2!
  986. ^Test findObjectIndex: #juma2!
  987. ^Test basicAt: (Test findObjectIndex: #juma2)!
  988. ^Test size!
  989. ^Test occurrencesOf: #juma2!
  990. ^Test occurrencesOf: #juma3!
  991. ^Test remove: #juma2!"
  992.  
  993. "^3 * 4.0!
  994.  
  995. ^Float pi!
  996.  
  997. ^'QuemonYour:Mother:' asSymbol!
  998.  
  999. ^3 zoneball!
  1000.  
  1001. ^#FoobarOnYouBar asUppercase!
  1002.  
  1003. []!
  1004.  
  1005. ^[] value!
  1006.  
  1007. ^3 count2!
  1008. ^4 count2!"
  1009.  
  1010. "
  1011. !Object methodsFor: 'test'!
  1012.  
  1013. dictTest
  1014.     | d |
  1015.     d _ Dictionary new.
  1016.     d at: #foo put: #bar.
  1017.     d at: #quem put: #juma.
  1018.     d at: #barf put: 'your mama'.
  1019.     ^d at self     
  1020. !!"
  1021.  
  1022.  
  1023.  
  1024. "Smalltalk at: #poolDict1 put: Dictionary new!
  1025. Smalltalk at: #poolDict2 put: Dictionary new!
  1026.  
  1027. poolDict1 at: #pd1foo put: 'foo'!
  1028. poolDict1 at: #pd1bar put: #bar!
  1029.  
  1030. poolDict2 at: #pd2baz put: 'bazola'!
  1031. poolDict2 at: #pd2barn put: #fred! 
  1032.  
  1033.  
  1034. Object subclass: #Rambo
  1035.     instanceVariableNames: 'foo bar'
  1036.     classVariableNames: 'guinea pigs'
  1037.     poolDictionaries: 'poolDict1'
  1038.     category: ''!
  1039.  
  1040. !Rambo methodsFor: 'test'!
  1041.  
  1042. xxx
  1043.    pd1foo _ 3.
  1044.    ^pd1bar testMessage: pd2barn + pd2baz
  1045. !
  1046.  
  1047. ramboTest
  1048.     foo _ 3.
  1049.     bar _ 7.
  1050.     ^foo + bar
  1051. !
  1052.  
  1053. initPigs: guineaArg and: pigsArg
  1054.     guinea _ guineaArg.
  1055.     pigs _ pigsArg
  1056. !
  1057.  
  1058. foof
  1059.     ^foo
  1060. !
  1061.  
  1062. barf
  1063.     ^bar
  1064. !
  1065.  
  1066. returnGuinea
  1067.     ^guinea
  1068. !
  1069.  
  1070. returnPigs
  1071.     ^pigs
  1072.  
  1073. !!
  1074.  
  1075. Rambo subclass: #Rocky
  1076.     instanceVariableNames: 'quem juma'
  1077.     classVariableNames: ''
  1078.     poolDictionaries: 'poolDict2'
  1079.     category: ''!
  1080.  
  1081. !Rocky methodsFor: 'test'!
  1082.  
  1083. xxx
  1084.    pd1foo _ 3.
  1085.    ^pd1bar testMessage: pd2barn + pd2baz
  1086. !
  1087.  
  1088. ramboTest
  1089.     foo _ 12.
  1090.     bar _ 3.
  1091.     ^foo + bar
  1092. !
  1093.  
  1094.  
  1095. quem: arg
  1096.     quem _ arg
  1097. !
  1098.  
  1099. quem
  1100.     ^quem
  1101. !
  1102.  
  1103. juma: arg
  1104.    juma _ arg
  1105. !
  1106.  
  1107. juma
  1108.     ^juma
  1109.  
  1110. !!
  1111. "
  1112.  
  1113. "Smalltalk at: #testVar put: Rambo new!"
  1114.  
  1115. "^#barf dictTest!
  1116. ^#foo dictTest!
  1117. ^#quem dictTest!"
  1118.  
  1119.  
  1120.  
  1121. "^2 arrayTest!"
  1122.  
  1123.  
  1124.  
  1125. "^nil atest2!"
  1126.  
  1127. "   ^$C = ('FUBAR' at: 3) !"
  1128.  
  1129. "^1000 counter !"
  1130.  
  1131. "^16rA + 16rA !
  1132.  
  1133. ^$C !
  1134.  
  1135. ^#foo:bar:baz: !
  1136. ^'this is a test string
  1137. I wonder how this will print' !"
  1138.  
  1139. "100000 timer!"
  1140.     
  1141.  
  1142.  
  1143. "^3 < 4 ifTrue: [^#foobar] !"
  1144.  
  1145. "
  1146. !Boolean methodsFor: 'test'!
  1147. quem: bar juma: baz
  1148.     bar _ #foon:barn:.
  1149.     baz _ 3.
  1150. !
  1151.  
  1152. marli
  1153.     true when: [3 < (Smalltalk at: #foo)] do: #quem:bar:.
  1154.     Smalltalk at: #foo put: 3
  1155.  
  1156. !!
  1157.  
  1158. !String methodsFor: 'your mother'!
  1159. xxx: arg
  1160.     self < arg ifTrue: [^false].
  1161.     (self = arg and: [arg + 1 > 3]) ifTrue: [^#foo]
  1162. !!
  1163.  
  1164. "
  1165.  
  1166. "playing with dates!Date methodsFor: 'rambo'!
  1167.  
  1168. computeDateParts: aBlock
  1169.     | trialYearInteger yearInteger tempDays monthIndex daysInMonth offset |
  1170.     trialYearInteger _ (days // 365).
  1171.     offset _ (trialYearInteger // 4) - (trialYearInteger // 100) + (trialYearInteger // 400).
  1172. ""yearInteger print. 
  1173. ' Days: ' print. days print. 
  1174. ' year ' print. (yearInteger * 365) print.
  1175. ' offset ' print. offset printNl.""
  1176.     yearInteger _ trialYearInteger.
  1177.     tempDays _ days - (yearInteger * 365).
  1178. '>>> Days: ' print. tempDays print. 
  1179. ' offset ' print. offset printNl.
  1180.  
  1181.     tempDays < offset
  1182. ""    (days - offset) < (yearInteger * 365)""
  1183.         ifTrue: [ yearInteger _ yearInteger - 1 ]
  1184.     ifFalse: [ tempDays _ tempDays - offset ].
  1185. ""     
  1186.     yearInteger _ (days - offset) // 365.
  1187.     yearInteger = trialYearInteger
  1188.         ifTrue: [ tempDays _ tempDays - offset ].""
  1189.     yearInteger _ yearInteger + 1901.
  1190.     monthIndex _ 1.
  1191.     [ monthIndex < 12
  1192.         and: [ daysInMonth _ Date daysInMonthIndex: monthIndex
  1193.                               forYear: yearInteger.
  1194.                tempDays >= daysInMonth ] ] whileTrue:
  1195.         [ monthIndex _ monthIndex + 1.
  1196.       tempDays _ tempDays - daysInMonth ].
  1197.     ^aBlock value: yearInteger value: monthIndex value: tempDays + 1
  1198. !!
  1199. "
  1200.