home *** CD-ROM | disk | FTP | other *** search
/ RISC DISC 1 / RISC_DISC_1.iso / pd_share / code / smalltalk / test / class < prev    next >
Encoding:
Text File  |  1991-09-13  |  3.7 KB  |  178 lines
  1. "Tests the class hierarchy"
  2.  
  3. "======================================================================
  4. |
  5. | Copyright (C) 1988, 1989  Steven B. Byrne.
  6. | All rights reserved.
  7. |
  8.  ======================================================================"
  9.  
  10. ^Array new: 5!
  11.  
  12. ^Array!
  13.  
  14. ^Metaclass!    "should be Metaclass"
  15. ^Metaclass class!
  16. ^Metaclass class class!    "should be Metaclass, since the metaclass of metaclass
  17.              is a metaclass"
  18. ^Object!
  19. ^Object class!        "should be Object class"
  20. ^Object class class!     "should be MetaClass"
  21.  
  22. ^nil!
  23. ^nil class!
  24.  
  25. ^true!
  26. ^true class!
  27.  
  28.  
  29. "Test creating classes at runtime
  30.  
  31. I apologize for the apparent lack of professionalism in the choice
  32. of variable and method names here."
  33.  
  34. Object subclass: #Rambo
  35.     instanceVariableNames: 'foo bar'
  36.     classVariableNames: 'guinea pigs'
  37.     poolDictionaries: ''
  38.     category: ''!
  39.  
  40. !Rambo methodsFor: 'test'!
  41.  
  42. "Assign some instance variables and return a result"
  43. ramboTest
  44.     foo _ 3.
  45.     bar _ 7.
  46.     ^foo + bar
  47. !
  48.  
  49. "Assign to class variables"
  50. initPigs: guineaArg and: pigsArg
  51.     guinea _ guineaArg.
  52.     pigs _ pigsArg
  53. !
  54.  
  55.  
  56. "inspect instance variables"
  57.  
  58. foof
  59.     ^foo
  60. !
  61.  
  62. barf
  63.     ^bar
  64. !
  65.  
  66.  
  67. "inspect class variables"
  68.  
  69. returnGuinea
  70.     ^guinea
  71. !
  72.  
  73. returnPigs
  74.     ^pigs
  75.  
  76. !!
  77.  
  78.  
  79.  
  80. Smalltalk at: #testVar put: (Rambo new)!
  81.  
  82. ^testVar foof!            "should be nil (it hasn't been initialized)"
  83. ^testVar barf!            "should be nil (it hasn't been initialized)"
  84. ^testVar returnGuinea!        "should be nil (it hasn't been initialized)"
  85. ^testVar returnPigs!        "should be nil (it hasn't been initialized)"
  86. ^Rambo new returnPigs!        "should be nil"
  87. ^Rambo new returnGuinea!    "should be nil"
  88.  
  89. ^testVar ramboTest!        "should be 10"
  90.  
  91. ^testVar barf!            "should now be set to 7"
  92.  
  93. ^testVar foof!            "should new be set to 3"
  94.  
  95. testVar initPigs: 'squeeky' and: 'junior'!
  96.                 "nil is returned, we just set some global
  97.                  variables"
  98.  
  99. ^testVar returnPigs!        "should return 'junior'"
  100. ^testVar returnGuinea!        "should return 'squeeky'"
  101.  
  102. "Test that class variables really affect all instances"
  103. ^Rambo new returnPigs!        "all instances now return 'junior'"
  104. ^Rambo new returnGuinea!    "all instances now return 'squeeky'"
  105.  
  106.  
  107.  
  108. "Create a subclass of a created class to test variable and method inheritance"
  109.  
  110. Rambo subclass: #Rocky
  111.     instanceVariableNames: 'quem juma'
  112.     classVariableNames: ''
  113.     poolDictionaries: ''
  114.     category: ''!
  115.  
  116. !Rocky methodsFor: 'test'!
  117.  
  118. ramboTest
  119.     foo _ 12.
  120.     bar _ 3.
  121.     ^foo + bar
  122. !
  123.  
  124.  
  125. quem: arg
  126.     quem _ arg
  127. !
  128.  
  129. quem
  130.     ^quem
  131. !
  132.  
  133. juma: arg
  134.    juma _ arg
  135. !
  136.  
  137. juma
  138.     ^juma
  139.  
  140. !!
  141.  
  142. ^Rocky new returnGuinea!    "should return 'squeeky' by inheritance"
  143. ^Rocky new returnPigs!        "should return 'junior' by inheritance"
  144.  
  145. ^Rocky new quem!        "should return nil (not initialized)"
  146. ^Rocky new juma!        "should return nil (not initialized)"
  147.  
  148. "Test overriding of methods"
  149. testVar _ Rocky new.
  150. ^testVar ramboTest!        "should return 15, and set some inst vars"
  151.  
  152. "Set the instance variables"
  153. testVar quem: 'zoneball'.    
  154. testVar juma: #theJumaSymbol!    "should return nil"
  155.  
  156. ^testVar foof!            "should return 12"
  157. ^testVar barf!            "should return 3"
  158. ^testVar quem!            "should return 'zoneball'"
  159. ^testVar juma!            "should return #theJumaSymbol"
  160.  
  161. "Test setting class variables from subclass"
  162. ^(Rocky new) initPigs: 'frisky' and: 'radar'!
  163.                 "should return instance of Rocky"
  164.  
  165. "+++ work in tests involving Dudley (Milkdud) and Speedy too+++"
  166.  
  167. "Test subclass access to class variables"
  168. ^Rocky new returnGuinea!    "should return 'frisky'"
  169. ^Rocky new returnPigs!        "should return 'radar'"
  170.  
  171. "Test class access to class variables that were modified from subclass"
  172. ^Rambo new returnGuinea!    "should return 'frisky'"
  173. ^Rambo new returnPigs!        "should return 'radar'"
  174.  
  175. "Make sure that the existing instance also sees the change in class vars"
  176. ^testVar returnPigs!        "should return 'radar'"
  177.  
  178.