/test/passenger_pane/NuBacon/bacon_should.nu

  1(class BaconShould is NSObject
  2  (ivar (id) object
  3        (id) negated
  4        (id) descriptionBuffer
  5  )
  6  
  7  (- (id) initWithObject:(id)object is
  8    (self init) ;; TODO check if it's nil
  9    (set @object object)
 10    (set @negated nil)
 11    (set @descriptionBuffer "")
 12    self
 13  )
 14  
 15  (- (id) object is
 16    @object
 17  )
 18  
 19  (- (id) should is
 20    self
 21  )
 22  
 23  (- (id) should:(id)block is
 24    (self satisfy:nil block:block)
 25  )
 26  
 27  (- (id) not is
 28    (set @negated t)
 29    (@descriptionBuffer appendString:" not")
 30    self
 31  )
 32  
 33  (- (id) not:(id)block is
 34    (set @negated t)
 35    (@descriptionBuffer appendString:" not")
 36    (self satisfy:nil block:block)
 37  )
 38  
 39  (- (id) be is
 40    (@descriptionBuffer appendString:" be")
 41    self
 42  )
 43  
 44  (- (id) a is
 45    (@descriptionBuffer appendString:" a")
 46    self
 47  )
 48  
 49  (- (id) an is
 50    (@descriptionBuffer appendString:" an")
 51    self
 52  )
 53  
 54  (- (id) satisfy:(id)description block:(id)block is
 55    ($BaconSummary addRequirement)
 56    (unless description (set description "satisfy `#{block}'"))
 57    (set description "expected `#{@object}' to#{@descriptionBuffer} #{description}")
 58    (set passed (block @object))
 59    (if (passed)
 60      (then
 61        (if (@negated)
 62          (throw ((BaconError alloc) initWithDescription:description))
 63        )
 64      )
 65      (else
 66        (unless (@negated)
 67          (throw ((BaconError alloc) initWithDescription:description))
 68        )
 69      )
 70    )
 71  )
 72  
 73  (- (id) be:(id)value is
 74    (if (send value isKindOfClass:NuBlock)
 75      (then
 76        (self satisfy:"be `#{value}'" block:value)
 77      )
 78      (else
 79        (self satisfy:"be `#{value}'" block:(do (object)
 80          (eq object value)
 81        ))
 82      )
 83    )
 84  )
 85  
 86  (- (id) a:(id)value is
 87    (if (send value isKindOfClass:NuBlock)
 88      (then
 89        (self satisfy:"a `#{value}'" block:value)
 90      )
 91      (else
 92        (self satisfy:"a `#{value}'" block:(do (object)
 93          (eq object value)
 94        ))
 95      )
 96    )
 97  )
 98  
 99  (- (id) equal:(id)value is
100    (self satisfy:"equal `#{value}'" block:(do (object)
101      (eq object value)
102    ))
103  )
104  
105  (- (id) closeTo:(id)otherValue is
106    (self closeTo:otherValue delta:0.00001)
107  )
108  
109  (- (id) closeTo:(id)otherValue delta:(id)delta is
110    (if (eq (otherValue class) NuCell)
111      (then
112        (set otherValues (otherValue array))
113        (self satisfy:"close to `#{otherValue}'" block:(do (values)
114          (set result t)
115          (values eachWithIndex:(do (value index)
116            (set otherValue (otherValues objectAtIndex:index))
117            (set result (and result (and (>= otherValue (- value delta)) (<= otherValue (+ value delta)))))
118          ))
119          result
120        ))
121      )
122      (else
123        (self satisfy:"close to `#{otherValue}'" block:(do (value)
124          (and (>= otherValue (- value delta)) (<= otherValue (+ value delta)))
125        ))
126      )
127    )
128  )
129  
130  (- (id) match:(id)regexp is
131    (self satisfy:"match /#{(regexp pattern)}/" block:(do (string)
132      (regexp findInString:string)
133    ))
134  )
135  
136  (- (id) change:(id)valueBlock by:(id)delta is
137    (self satisfy:"change `#{(send valueBlock body)}' by `#{delta}'" block:(do (changeBlock)
138      (set before (call valueBlock))
139      (call changeBlock)
140      (eq (+ before delta) (call valueBlock))
141    ))
142  )
143  
144  (- (id) change:(id)valueBlock is
145    (self satisfy:"change `#{(send valueBlock body)}'" block:(do (changeBlock)
146      (set before (call valueBlock))
147      (call changeBlock)
148      (not (eq before (call valueBlock)))
149    ))
150  )
151  
152  (- (id) raise is
153    (set result nil)
154    (self satisfy:"raise any exception" block:(do (block)
155      (try
156        (call block)
157        (catch (e)
158          (set result e)
159          t
160        )
161        nil
162      )
163    ))
164    result
165  )
166  
167  (- (id) raise:(id)exceptionName is
168    (set result nil)
169    (self satisfy:"raise an exception of type `#{exceptionName}'" block:(do (block)
170      (try
171        (call block)
172        (catch (e)
173          (set result e)
174          (eq (e name) exceptionName)
175        )
176      )
177    ))
178    result
179  )
180  
181  (- (id) handleUnknownMessage:(id)methodName withContext:(id)context is
182    (set name ((first methodName) stringValue))
183    (set args (cdr methodName))
184    (set description name)
185    (if (args) (then (set description "#{description}#{args}")))
186    (if (@object respondsToSelector:name)
187      (then
188        ; forward the message as-is
189        (self satisfy:description block:(do (object)
190          (object sendMessage:methodName withContext:context)
191        ))
192      )
193      (else
194        (set predicate "is#{((name substringToIndex:1) uppercaseString)}#{(name substringFromIndex:1)}")
195        (if (@object respondsToSelector:predicate)
196          (then
197            ; forward the predicate version of the message with the args
198            (self satisfy:description block:(do (object)
199              (set symbol ((NuSymbolTable sharedSymbolTable) symbolWithString:predicate))
200              (sendMessageWithList object (append (list symbol) (cdr methodName)))
201            ))
202          )
203          (else
204            (set parts ((regex "([A-Z][a-z]*)") splitString:name))
205            (set firstPart (parts objectAtIndex:0))
206            (set firstPart (firstPart stringByAppendingString:"s"))
207            (parts replaceObjectAtIndex:0 withObject:firstPart)
208            (set thirdPersonForm (parts componentsJoinedByString:""))
209            (if (@object respondsToSelector:thirdPersonForm)
210              (then
211                ; example: respondsToSelector: is matched as respondToSelector:
212                (self satisfy:description block:(do (object)
213                  (set symbol ((NuSymbolTable sharedSymbolTable) symbolWithString:thirdPersonForm))
214                  (sendMessageWithList object (append (list symbol) (cdr methodName)))
215                ))
216              )
217              (else
218                ; the object does not respond to any of the messages
219                (super handleUnknownMessage:methodName withContext:context)
220              )
221            )
222          )
223        )
224      )
225    )
226  )
227)