parent
387f90ed92
commit
bf41fee58d
|
@ -11,6 +11,7 @@
|
||||||
(load-relative "letrec.rktl")
|
(load-relative "letrec.rktl")
|
||||||
(load-relative "procs.rktl")
|
(load-relative "procs.rktl")
|
||||||
(load-relative "stx.rktl")
|
(load-relative "stx.rktl")
|
||||||
|
(load-relative "linklet.rktl")
|
||||||
(load-relative "module.rktl")
|
(load-relative "module.rktl")
|
||||||
(load-relative "submodule.rktl")
|
(load-relative "submodule.rktl")
|
||||||
(load-relative "stxparam.rktl")
|
(load-relative "stxparam.rktl")
|
||||||
|
|
26
pkgs/racket-test-core/tests/racket/linklet.rktl
Normal file
26
pkgs/racket-test-core/tests/racket/linklet.rktl
Normal file
|
@ -0,0 +1,26 @@
|
||||||
|
|
||||||
|
(load-relative "loadtest.rktl")
|
||||||
|
|
||||||
|
(Section 'linklet)
|
||||||
|
|
||||||
|
(require racket/linklet)
|
||||||
|
|
||||||
|
;; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
|
||||||
|
|
||||||
|
(let ()
|
||||||
|
(define l (compile-linklet '(linklet
|
||||||
|
()
|
||||||
|
()
|
||||||
|
4)))
|
||||||
|
(test #t linklet? l)
|
||||||
|
(test #t instance? (instantiate-linklet l '()))
|
||||||
|
(test 4 instantiate-linklet l '() (make-instance 'l))
|
||||||
|
|
||||||
|
(err/rt-test (instantiate-linklet l) exn:fail:contract:arity?)
|
||||||
|
(err/rt-test (instantiate-linklet l '#()))
|
||||||
|
(err/rt-test (instantiate-linklet l (list 5)))
|
||||||
|
(err/rt-test (instantiate-linklet l '() 5)))
|
||||||
|
|
||||||
|
;; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
|
||||||
|
|
||||||
|
(report-errs)
|
|
@ -697,8 +697,18 @@
|
||||||
[(linklet import-instances target-instance)
|
[(linklet import-instances target-instance)
|
||||||
(instantiate-linklet linklet import-instances target-instance #f)]
|
(instantiate-linklet linklet import-instances target-instance #f)]
|
||||||
[(linklet import-instances target-instance use-prompt?)
|
[(linklet import-instances target-instance use-prompt?)
|
||||||
|
(unless (linklet? linklet)
|
||||||
|
(raise-argument-error 'instantiate-linklet "linklet?" linklet))
|
||||||
|
(let loop ([l import-instances])
|
||||||
|
(unless (null? l)
|
||||||
|
(if (and (pair? l)
|
||||||
|
(instance? (car l)))
|
||||||
|
(loop (cdr l))
|
||||||
|
(raise-argument-error 'instantiate-linklet "(listof instance?)" import-instances))))
|
||||||
(cond
|
(cond
|
||||||
[target-instance
|
[target-instance
|
||||||
|
(unless (instance? target-instance)
|
||||||
|
(raise-argument-error 'instantiate-linklet "(or/c instance? #f)" target-instance))
|
||||||
;; Instantiate into the given instance and return the
|
;; Instantiate into the given instance and return the
|
||||||
;; result of the linklet body:
|
;; result of the linklet body:
|
||||||
(with-continuation-mark
|
(with-continuation-mark
|
||||||
|
|
|
@ -593,7 +593,7 @@ static Scheme_Object *instantiate_linklet(int argc, Scheme_Object **argv)
|
||||||
scheme_wrong_contract("instantiate-linklet", "linklet?", 0, argc, argv);
|
scheme_wrong_contract("instantiate-linklet", "linklet?", 0, argc, argv);
|
||||||
|
|
||||||
l = argv[1];
|
l = argv[1];
|
||||||
while (!SCHEME_NULLP(l)) {
|
while (SCHEME_PAIRP(l)) {
|
||||||
if (!SAME_TYPE(SCHEME_TYPE(SCHEME_CAR(l)), scheme_instance_type))
|
if (!SAME_TYPE(SCHEME_TYPE(SCHEME_CAR(l)), scheme_instance_type))
|
||||||
break;
|
break;
|
||||||
l = SCHEME_CDR(l);
|
l = SCHEME_CDR(l);
|
||||||
|
|
Loading…
Reference in New Issue
Block a user