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

...

Browse Source 
original commit: d8c9b4fefec67ccd98893041fb4fe332f864820b
This commit is contained in:
Robby Findler 1999-08-09 03:33:25 +00:00
parent 91a2b41155
commit a70c022355
2 changed files with 3 additions and 44 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

46
collects/tests/framework/load.ss
View File

@ -21,13 +21,12 @@
pred pred
'(parameterize ([current-namespace (make-namespace 'mred)]) '(parameterize ([current-namespace (make-namespace 'mred)])
(require-library "tests.ss" "framework") (require-library "tests.ss" "framework")
(require-library "mred-interfaces.ss" "framework")
(eval (eval
'(define-values/invoke-unit/sig '(define-values/invoke-unit/sig
((unit test : framework:test^)) ((unit test : framework:test^))
(compound-unit/sig (compound-unit/sig
(import) (import)
(link [mred : mred-interfaces^ (mred-interfaces@)] (link [mred : mred^ (mred@)]
[keys : framework:keys^ ((require-library "keys.ss" "framework"))] [keys : framework:keys^ ((require-library "keys.ss" "framework"))]
[test : framework:test^ ((require-library "testr.ss" "framework") mred keys)]) [test : framework:test^ ((require-library "testr.ss" "framework") mred keys)])
(export (unit test))))) (export (unit test)))))
@ -42,47 +41,17 @@
(global-defined-value 'test:run-one) (global-defined-value 'test:run-one)
(global-defined-value 'test:button-push) (global-defined-value 'test:button-push)
(void))) (void)))
(test
'mred-interfacess.ss
pred
'(parameterize ([current-namespace (make-namespace 'mred)])
(require-library "mred-interfacess.ss" "framework")
(global-defined-value 'mred-interfaces^)
(void)))
(test
'mred-interfaces.ss
pred
'(parameterize ([current-namespace (make-namespace 'mred)])
(require-library "mred-interfaces.ss" "framework")
(global-defined-value 'mred-interfaces^)
(global-defined-value 'mred-interfaces@)
(void)))
(test
'mred-interfaces.ss/gen
(lambda (x) x)
'(parameterize ([current-namespace (make-namespace 'mred)])
(require-library "invoke.ss")
(require-library "mred-interfaces.ss" "framework")
(eval
'(let ([orig-button% button%])
(define-values/invoke-unit/sig mred-interfaces^ mred-interfaces@)
(let ([first-button% button%])
(define-values/invoke-unit/sig mred-interfaces^ mred-interfaces@)
(let ([second-button% button%])
(and (eq? second-button% first-button%)
(not (eq? first-button% orig-button%)))))))))
(test (test
'frameworkr.ss 'frameworkr.ss
pred pred
'(parameterize ([current-namespace (make-namespace 'mred)]) '(parameterize ([current-namespace (make-namespace 'mred)])
(require-library "frameworks.ss" "framework") (require-library "frameworks.ss" "framework")
(require-library "mred-interfaces.ss" "framework")
(eval (eval
'(define-values/invoke-unit/sig '(define-values/invoke-unit/sig
framework^ framework^
(compound-unit/sig (compound-unit/sig
(import) (import)
(link [mred : mred-interfaces^ (mred-interfaces@)] (link [mred : mred^ (mred@)]
[core : mzlib:core^ ((require-library "corer.ss"))] [core : mzlib:core^ ((require-library "corer.ss"))]
[framework : framework^ ((require-library "frameworkr.ss" "framework") core mred)]) [framework : framework^ ((require-library "frameworkr.ss" "framework") core mred)])
(export (open framework))))) (export (open framework)))))
@ -113,17 +82,6 @@
((global-defined-value 'pretty-print-print-line) np) ((global-defined-value 'pretty-print-print-line) np)
(require-library "framework.ss" "framework") (require-library "framework.ss" "framework")
(eq? np ((global-defined-value 'pretty-print-print-line)))))) (eq? np ((global-defined-value 'pretty-print-print-line))))))
(test
'framework.ss/test.ss
(lambda (x) x)
'(parameterize ([current-namespace (make-namespace 'mred)])
(let ([orig-button% (global-defined-value 'button%)])
(require-library "test.ss" "framework")
(let* ([test-button% (global-defined-value 'button%)])
(require-library "framework.ss" "framework")
(let* ([fw-button% (global-defined-value 'button%)])
(and (eq? fw-button% test-button%)
(not (eq? fw-button% orig-button%))))))))
(load-framework-automatically old-load-framework-automatically?)) (load-framework-automatically old-load-framework-automatically?))

1
collects/tests/framework/main.ss
View File

@ -2,6 +2,7 @@
(require-library "cores.ss") (require-library "cores.ss")
(require-library "cmdlines.ss") (require-library "cmdlines.ss")
(require-library "macro.ss") (require-library "macro.ss")
(require-library "function.ss")
(unless (file-exists? (build-path (current-load-relative-directory) "receive-sexps-port.ss")) (unless (file-exists? (build-path (current-load-relative-directory) "receive-sexps-port.ss"))
(call-with-output-file (build-path (current-load-relative-directory) "receive-sexps-port.ss") (call-with-output-file (build-path (current-load-relative-directory) "receive-sexps-port.ss")