check-expect running

compiler/kernel-primitives.rkt

@@ -73,6 +73,13 @@
                                     'make-struct-field-mutator
                                     
                                     'gensym
+                                    'srcloc
+                                    'make-srcloc
+                                    'srcloc-source
+                                    'srcloc-line
+                                    'srcloc-column
+                                    'srcloc-position
+                                    'srcloc-span
                                     ))
 (define-predicate KernelPrimitiveName? KernelPrimitiveName)
 

examples/checking.rkt

@@ -1,7 +1,7 @@
 #lang planet dyoo/whalesong
 
 (define (greet name)
-  (string-append "hello" name))
+  (string-append "hello " name))
 
 (check-expect (greet "danny") "hello danny")
 (check-expect (greet "huh") "this should fail")

lang/check-expect/check-expect.rkt

@@ -37,7 +37,7 @@
          #'(accumulate-test!
             (lambda ()
               (check-expect* 'stx
-                             (srcloc 'id offset line column span)
+                             (srcloc 'id line column offset span)
                              (lambda () test)
                              (lambda () expected))))))]))
     
@@ -91,11 +91,17 @@
          #t]
         [else
          (printf "check-expect: actual value ~s differs from ~s, the expected value\n" test-value expected-value)
-         ;(newline)
+         (display-location a-loc)
-         ;(display-location test-datum a-loc)
          #f])))
 
 
+(define (display-location a-loc)
+  (printf "  at: ~s, line ~s, column ~s\n"
+          (srcloc-source a-loc)
+          (srcloc-line a-loc)
+          (srcloc-column a-loc)))
+  
+
 ;; (define (check-within* test-datum a-loc test-thunk expected-thunk delta-thunk)
 ;;   ;(with-handlers ([void
 ;;   ;                   (lambda (exn)

lang/kernel.rkt

@@ -166,7 +166,17 @@
          (rename-out [kernel:apply apply])
          call-with-values
 
-         gensym)
+         gensym
+
+
+         srcloc
+         make-srcloc
+         srcloc?
+         srcloc-source
+         srcloc-line
+         srcloc-column
+         srcloc-position
+         srcloc-span)
 
 
 (define (-identity x) x)
@@ -443,18 +453,7 @@ char=?
 
   make-reader-graph
   make-placeholder
-  placeholder-set!
+  placeholder-set!)
-
-
-  srcloc
-  make-srcloc
-  srcloc?
-  srcloc-id
-  srcloc-line
-  srcloc-column
-  srcloc-position
-  srcloc-span
-  )