David Krentzlin avatar David Krentzlin committed dbb2a19

add have-matcher

Comments (0)

Files changed (3)

missbehave-matchers.scm

   calls
   raise
   make-error-matcher
+  have has have-matcher
   )
 
 (import chicken scheme extras data-structures irregex ports)
-(require-extension missbehave advice (only srfi-1 every))
+(require-extension missbehave advice (only srfi-1 every) (only sequences size))
 
 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
 ;; Procedure-Expections
 ;; Have/Has
 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
 
+(define-syntax has
+  (syntax-rules ()
+    ((_ argument +more-arguments ...)
+     (have argument +more-arguments ...))))
+
+(define-syntax have
+  (syntax-rules ()
+    ((_ amount procedure-or-sugar)
+     (if (procedure? (quote procedure-or-sugar))
+         (have-matcher amount procedure-or-sugar (quote procedure-or-sugar))
+         (have-matcher amount (quote procedure-or-sugar) (quote procedure-or-sugar))))))
+
+(define (have-matcher expected-amount procedure-or-sugar procedure-or-sugar-name #!key (compare =))
+  (let ((actual-amount #f))
+    (matcher
+     (check (subject)
+            (let* ((collection (if (procedure? procedure-or-sugar) (procedure-or-sugar (force subject)) (force subject)))
+                   (item-amount (size collection)))
+              (set! actual-amount item-amount)
+              (compare item-amount expected-amount)))
+   
+     (message (form subject negate)
+              (if negate
+                  (sprintf "Didn't expect ~A ~A" expected-amount procedure-or-sugar-name)
+                  (sprintf "Expected ~A ~A but found ~A"  expected-amount procedure-or-sugar-name actual-amount))))))
+
+
+
 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
 ;; raise
 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
  (license "MIT")
  (hidden)
  (doc-from-wiki)
- (needs args fmt advice miscmacros)
+ (needs args fmt advice miscmacros sequences)
  (test-depends test)
  (files ".hgignore" ".rvmrc" "Gemfile" "Gemfile.lock" "behave.scm" "cucumber.yml" "features/behave.feature" "features/error_reporting.feature" "features/step_definitions/steps.rb" "features/support/env.rb" "features/tags.feature" "missbehave-matchers.scm" "missbehave-stubs.scm" "missbehave.meta" "missbehave.release-info" "missbehave.scm" "missbehave.setup" "spec/failures.scm" "spec/self-running.scm" "spec/spec.scm" "spec/test.scm" "tests/run.scm"))
 (test-group "Match-string"
             (test-matcher "(match-string)" (match-string "test") '(: (+ any))'(: (+ digit)) "Expected (quote (: (+ digit))) to match \"test\""))
 
-(test-group "Have-matcher")
+
+(define (numbers ls) ls)
+
+(test-group "Have-matcher"
+            (test-matcher "list (have 3 items)" (has 3 items) '(1 2 3) '() "Expected 3 items but found 0")
+            (test-matcher "list (has 1 procedure-call)" (has 3 numbers) '(1 2 3) '() "Expected 3 numbers but found 0")
+            (test-matcher "string (has 5 characters)" (has 5 characters) "12345" "" "Expected 5 characters but found 0"))
 
 
 (test-group "Error matchers"
Tip: Filter by directory path e.g. /media app.js to search for public/media/app.js.
Tip: Use camelCasing e.g. ProjME to search for ProjectModifiedEvent.java.
Tip: Filter by extension type e.g. /repo .js to search for all .js files in the /repo directory.
Tip: Separate your search with spaces e.g. /ssh pom.xml to search for src/ssh/pom.xml.
Tip: Use ↑ and ↓ arrow keys to navigate and return to view the file.
Tip: You can also navigate files with Ctrl+j (next) and Ctrl+k (previous) and view the file with Ctrl+o.
Tip: You can also navigate files with Alt+j (next) and Alt+k (previous) and view the file with Alt+o.