diff options
Diffstat (limited to 't/t4018')
-rw-r--r-- | t/t4018/scheme-class | 7 | ||||
-rw-r--r-- | t/t4018/scheme-def | 4 | ||||
-rw-r--r-- | t/t4018/scheme-def-variant | 4 | ||||
-rw-r--r-- | t/t4018/scheme-define-slash-public | 7 | ||||
-rw-r--r-- | t/t4018/scheme-define-syntax | 8 | ||||
-rw-r--r-- | t/t4018/scheme-define-variant | 4 | ||||
-rw-r--r-- | t/t4018/scheme-library | 11 | ||||
-rw-r--r-- | t/t4018/scheme-local-define | 4 | ||||
-rw-r--r-- | t/t4018/scheme-module | 6 | ||||
-rw-r--r-- | t/t4018/scheme-top-level-define | 4 | ||||
-rw-r--r-- | t/t4018/scheme-user-defined-define | 6 |
11 files changed, 65 insertions, 0 deletions
diff --git a/t/t4018/scheme-class b/t/t4018/scheme-class new file mode 100644 index 0000000000..e5e07b43fb --- /dev/null +++ b/t/t4018/scheme-class @@ -0,0 +1,7 @@ +(define book-class% + (class* () object% RIGHT + (field (pages 5)) + (field (ChangeMe 5)) + (define/public (letters) + (* pages 500)) + (super-new))) diff --git a/t/t4018/scheme-def b/t/t4018/scheme-def new file mode 100644 index 0000000000..1e2673da96 --- /dev/null +++ b/t/t4018/scheme-def @@ -0,0 +1,4 @@ +(def (some-func x y z) RIGHT + (let ((a x) + (b y)) + (ChangeMe a b))) diff --git a/t/t4018/scheme-def-variant b/t/t4018/scheme-def-variant new file mode 100644 index 0000000000..d857a61d64 --- /dev/null +++ b/t/t4018/scheme-def-variant @@ -0,0 +1,4 @@ +(defmethod {print point} RIGHT + (lambda (self) + (with ((point x y) self) + (printf "{ChangeMe x:~a y:~a}~n" x y)))) diff --git a/t/t4018/scheme-define-slash-public b/t/t4018/scheme-define-slash-public new file mode 100644 index 0000000000..39a93a1600 --- /dev/null +++ b/t/t4018/scheme-define-slash-public @@ -0,0 +1,7 @@ +(define bar-class% + (class object% + (field (info 5)) + (define/public (foo) RIGHT + (+ info 42) + (* info ChangeMe)) + (super-new))) diff --git a/t/t4018/scheme-define-syntax b/t/t4018/scheme-define-syntax new file mode 100644 index 0000000000..7d5e99e0fc --- /dev/null +++ b/t/t4018/scheme-define-syntax @@ -0,0 +1,8 @@ +(define-syntax define-test-suite RIGHT + (syntax-rules () + ((_ suite-name (name test) ChangeMe ...) + (define suite-name + (let ((tests + `((name . ,test) ...))) + (lambda () + (run-suite 'suite-name tests))))))) diff --git a/t/t4018/scheme-define-variant b/t/t4018/scheme-define-variant new file mode 100644 index 0000000000..911708854d --- /dev/null +++ b/t/t4018/scheme-define-variant @@ -0,0 +1,4 @@ +(define* (some-func x y z) RIGHT + (let ((a x) + (b y)) + (ChangeMe a b))) diff --git a/t/t4018/scheme-library b/t/t4018/scheme-library new file mode 100644 index 0000000000..82ea3df510 --- /dev/null +++ b/t/t4018/scheme-library @@ -0,0 +1,11 @@ +(library (my-helpers id-stuff) RIGHT + (export find-dup) + (import (ChangeMe)) + (define (find-dup l) + (and (pair? l) + (let loop ((rest (cdr l))) + (cond + [(null? rest) (find-dup (cdr l))] + [(bound-identifier=? (car l) (car rest)) + (car rest)] + [else (loop (cdr rest))]))))) diff --git a/t/t4018/scheme-local-define b/t/t4018/scheme-local-define new file mode 100644 index 0000000000..bc6d8aebbe --- /dev/null +++ b/t/t4018/scheme-local-define @@ -0,0 +1,4 @@ +(define (higher-order) + (define local-function RIGHT + (lambda (x) + (car "this is" "ChangeMe")))) diff --git a/t/t4018/scheme-module b/t/t4018/scheme-module new file mode 100644 index 0000000000..edfae0ebf7 --- /dev/null +++ b/t/t4018/scheme-module @@ -0,0 +1,6 @@ +(module A RIGHT + (export with-display-exception) + (extern (display-exception display-exception ChangeMe)) + (def (with-display-exception thunk) + (with-catch (lambda (e) (display-exception e (current-error-port)) e) + thunk))) diff --git a/t/t4018/scheme-top-level-define b/t/t4018/scheme-top-level-define new file mode 100644 index 0000000000..624743c22b --- /dev/null +++ b/t/t4018/scheme-top-level-define @@ -0,0 +1,4 @@ +(define (some-func x y z) RIGHT + (let ((a x) + (b y)) + (ChangeMe a b))) diff --git a/t/t4018/scheme-user-defined-define b/t/t4018/scheme-user-defined-define new file mode 100644 index 0000000000..35fe7cc9bf --- /dev/null +++ b/t/t4018/scheme-user-defined-define @@ -0,0 +1,6 @@ +(define-test-suite record\ case-tests RIGHT + (record-case-1 (lambda (fail) + (let ((a (make-foo 1 2))) + (record-case a + ((bar x) (ChangeMe)) + ((foo a b) (+ a b))))))) |