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

Fix test for values, and simplify test case. (#1525)

Browse Source 
Repairs 7c22c42c7.
This commit is contained in:
Sam Tobin-Hochstadt 2016-11-21 11:02:56 -05:00 committed by GitHub
parent 4902b5e10c
commit c5cce7aa7b
2 changed files with 8 additions and 25 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

29
pkgs/racket-test-core/tests/racket/optimize.rktl
View File

@ -6394,32 +6394,15 @@
;; Regression test to check that `values` is ;; Regression test to check that `values` is
;; handled correctly for estimating clock advances ;; handled correctly for estimating clock advances
(module triggers-optimizer-clock-estimation racket/base (module triggers-optimizer-clock-estimation '#%kernel
(require (for-syntax racket/base))
(define (in-naturals0 n) (define-values (make-sequence) (lambda (_) 3))
(in-naturals n))
;; restrict for/xyz to simple form and name it for/xyz0 (define-values (string>) (lambda (s) s))
(define-syntax (define-for stx)
(syntax-case stx ()
[(_ for/xyz0 for/xyz cleanup)
#'(define-syntax (for/xyz0 stx)
(syntax-case stx ()
[(_ ((clause0.x clause0.range)) body)
#`(cleanup
(for/xyz ((clause0.x (string> clause0.range)))
;; the following line exists only so that coverage doesn't hilite x0 x ...
clause0.x
body))]))]))
(define-for for/list0 for/list values) (values
(let-values (((_1 _2) (make-sequence (string>))))
(define (string> s) (void))))
(if (string? s) (string->list s) s))
(void
(for/list0 ((dropping-which-one (in-naturals0))) 1)))
;; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;

4
racket/src/racket/src/optimize.c
View File

@ -2815,7 +2815,7 @@ static int is_noncapturing_primitive(Scheme_Object *rator, int n)
t = (((Scheme_Primitive_Proc *)rator)->pp.flags & SCHEME_PRIM_OTHER_TYPE_MASK); t = (((Scheme_Primitive_Proc *)rator)->pp.flags & SCHEME_PRIM_OTHER_TYPE_MASK);
if (!n && (t == SCHEME_PRIM_TYPE_PARAMETER)) if (!n && (t == SCHEME_PRIM_TYPE_PARAMETER))
return 1; return 1;
if (SAME_TYPE(rator, scheme_values_proc)) if (SAME_OBJ(rator, scheme_values_proc))
return 1; return 1;
} }
@ -2829,7 +2829,7 @@ static int is_nonsaving_primitive(Scheme_Object *rator, int n)
opt = ((Scheme_Prim_Proc_Header *)rator)->flags & SCHEME_PRIM_OPT_MASK; opt = ((Scheme_Prim_Proc_Header *)rator)->flags & SCHEME_PRIM_OPT_MASK;
if (opt >= SCHEME_PRIM_OPT_IMMEDIATE) if (opt >= SCHEME_PRIM_OPT_IMMEDIATE)
return 1; return 1;
if (SAME_TYPE(rator, scheme_values_proc)) if (SAME_OBJ(rator, scheme_values_proc))
return 1; return 1;
} }