suzanne.soy/whalesong
1
0
Fork 0
Code Issues Pull Requests Actions Packages Projects Releases Wiki Activity

adding check-expect

Browse Source
This commit is contained in:
Danny Yoo 2011-08-31 18:26:06 -04:00
parent 5a9b1a1eea
commit cb94b0ee7e
6 changed files with 120 additions and 12 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

8
examples/checking.rkt Normal file
View File

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

6
js-assembler/runtime-src/baselib-check.js
View File

@ -238,7 +238,9 @@
'placeholder');
var checkSrcloc = makeCheckArgumentType(
baselib.srclocs.isSrcloc,
'srcloc');
//////////////////////////////////////////////////////////////////////
@ -275,6 +277,6 @@
exports.checkByte = checkByte;
exports.checkBoolean = checkBoolean;
exports.checkPlaceholder = checkPlaceholder;
exports.checkSrcloc = checkSrcloc;
}(this.plt.baselib));

70
js-assembler/runtime-src/baselib-primitives.js
View File

@ -83,6 +83,7 @@
var checkMutableBox = baselib.check.checkMutableBox;
var checkInspector = baselib.check.checkInspector;
var checkPlaceholder = baselib.check.checkPlaceholder;
var checkSrcloc = baselib.check.checkSrcloc;
//////////////////////////////////////////////////////////////////////
@ -1285,7 +1286,7 @@
1,
function(MACHINE) {
var n = checkInteger(MACHINE, 'even?', 0);
return baselib.numbers.equals(0, baselib.numbers.modulo(n, 2))
return baselib.numbers.equals(0, baselib.numbers.modulo(n, 2));
});
installPrimitiveProcedure(
@ -1293,7 +1294,7 @@
1,
function(MACHINE) {
var n = checkInteger(MACHINE, 'odd?', 0);
return baselib.numbers.equals(1, baselib.numbers.modulo(n, 2))
return baselib.numbers.equals(1, baselib.numbers.modulo(n, 2));
});
@ -1987,6 +1988,71 @@
installPrimitiveProcedure(
'srcloc',
5,
function(MACHINE) {
var source = MACHINE.env[MACHINE.env.length - 1];
var line = checkNatural(MACHINE, 'srcloc', 1);
var column = checkNatural(MACHINE, 'srcloc', 2);
var position = checkNatural(MACHINE, 'srcloc', 3);
var span = checkNatural(MACHINE, 'srcloc', 4);
return baselib.srclocs.makeSrcloc(source, line, column, position, span);
});
installPrimitiveProcedure(
'make-srcloc',
5,
function(MACHINE) {
var source = MACHINE.env[MACHINE.env.length - 1];
var line = checkNatural(MACHINE, 'make-srcloc', 1);
var column = checkNatural(MACHINE, 'make-srcloc', 2);
var position = checkNatural(MACHINE, 'make-srcloc', 3);
var span = checkNatural(MACHINE, 'make-srcloc', 4);
return baselib.srclocs.makeSrcloc(source, line, column, position, span);
});
installPrimitiveProcedure(
'srcloc?',
1,
function(MACHINE) {
return baselib.srclocs.isSrcloc(MACHINE.env[MACHINE.env.length - 1]);
});
installPrimitiveProcedure(
'srcloc-source',
1,
function(MACHINE) {
return baselib.srclocs.srclocSource(checkSrcloc(MACHINE, 'srcloc-source', 0));
});
installPrimitiveProcedure(
'srcloc-line',
1,
function(MACHINE) {
return baselib.srclocs.srclocLine(checkSrcloc(MACHINE, 'srcloc-line', 0));
});
installPrimitiveProcedure(
'srcloc-column',
1,
function(MACHINE) {
return baselib.srclocs.srclocColumn(checkSrcloc(MACHINE, 'srcloc-column', 0));
});
installPrimitiveProcedure(
'srcloc-position',
1,
function(MACHINE) {
return baselib.srclocs.srclocPosition(checkSrcloc(MACHINE, 'srcloc-position', 0));
});
installPrimitiveProcedure(
'srcloc-span',
1,
function(MACHINE) {
return baselib.srclocs.srclocSpan(checkSrcloc(MACHINE, 'srcloc-span', 0));
});
exports['Primitives'] = Primitives;
exports['installPrimitiveProcedure'] = installPrimitiveProcedure;
exports['installPrimitiveClosure'] = installPrimitiveClosure;

6
lang/check-expect/check-expect.rkt
View File

@ -1,9 +1,9 @@
#lang s-exp "../kernel.rkt"
#lang s-exp "../base.rkt"
(require (for-syntax racket/base))
(provide check-expect
check-within
;check-within
;check-error
run-tests)
@ -37,7 +37,7 @@
#'(accumulate-test!
(lambda ()
(check-expect* 'stx
(make-location 'id offset line column span)
(srcloc 'id offset line column span)
(lambda () test)
(lambda () expected))))))]))

12
lang/kernel.rkt
View File

@ -444,7 +444,17 @@ char=?
make-reader-graph
make-placeholder
placeholder-set!
)
srcloc
make-srcloc
srcloc?
srcloc-id
srcloc-line
srcloc-column
srcloc-position
srcloc-span
)

30
lang/whalesong.rkt
View File

@ -1,13 +1,35 @@
#lang s-exp "kernel.rkt"
;; Acts like the "Pretty Big" kind of language; has several features turned on by default.
;; These include:
;;
;; * Automatically running tests
;; * Annotating all applications so they produce stack traces on error
;; * Adding the "shared" form by default.
(require "base.rkt"
"private/traced-app.rkt"
"private/shared.rkt")
"private/shared.rkt"
"check-expect/check-expect.rkt"
(for-syntax racket/base))
;; Programs written in Whalesong will have tracing enabled by default.
;; If you don't want this, write in whalesong/base instead.
(provide (except-out (all-from-out "base.rkt")
#%app)
(rename-out [traced-app #%app])
shared)
#%app
#%module-begin)
(rename-out [traced-app #%app]
[my-module-begin #%module-begin])
shared
(except-out (all-from-out "check-expect/check-expect.rkt")
run-tests))
(define-syntax (my-module-begin stx)
(syntax-case stx ()
[(_ body ...)
(syntax/loc stx
(#%module-begin body ...
(run-tests)))]))