summaryrefslogtreecommitdiff
path: root/t/t4018
diff options
context:
space:
mode:
Diffstat (limited to 't/t4018')
-rw-r--r--t/t4018/scheme-class7
-rw-r--r--t/t4018/scheme-def4
-rw-r--r--t/t4018/scheme-def-variant4
-rw-r--r--t/t4018/scheme-define-slash-public7
-rw-r--r--t/t4018/scheme-define-syntax8
-rw-r--r--t/t4018/scheme-define-variant4
-rw-r--r--t/t4018/scheme-library11
-rw-r--r--t/t4018/scheme-local-define4
-rw-r--r--t/t4018/scheme-module6
-rw-r--r--t/t4018/scheme-top-level-define4
-rw-r--r--t/t4018/scheme-user-defined-define6
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)))))))