diff --git a/LOG b/LOG index 64c1cf99a3..cf0db40a3f 100644 --- a/LOG +++ b/LOG @@ -576,3 +576,9 @@ added a batch script for locating Visual Studio's vcredist merge modules, updated installer paths and names. wininstall/* +- fixed np-normalize-context pass to process trivs list in mvset forms + in tail and predicate context and added regression tests. Thanks to + @marcomaggi for reporting the bug and @yjqww6 for providing a + simplified test and finding the initial solution. + cpnanopass.ss, + 3.ms diff --git a/mats/3.ms b/mats/3.ms index ab1e794204..2410d66d9e 100644 --- a/mats/3.ms +++ b/mats/3.ms @@ -2049,6 +2049,26 @@ (let () (import $mrvs-double-call) (double-call 'a))) + + ; regression testing for handling mvset in tail context + (call-with-values + (lambda () + (call-with-values + (lambda () + (+ (random 1) 7)) + list)) + (lambda l (equal? l '((7))))) + + ; regression testing for handling mvset in predicate context + (if (call-with-values + (lambda () + (call-with-values + (lambda () + (+ (random 1) 7)) + list)) + (lambda l (equal? l '((7))))) + #t + #f) ) (mat let-values diff --git a/s/cpnanopass.ss b/s/cpnanopass.ss index 3bd6777f06..9f23cb2e72 100644 --- a/s/cpnanopass.ss +++ b/s/cpnanopass.ss @@ -9756,7 +9756,7 @@ (tail (mvcall ,info ,mdcl ,t0? ,t1 ... (,t* ...))) (true))] [(set! ,[lvalue] ,[rhs]) `(seq (set! ,lvalue ,rhs) (true))] - [(mvset ,info (,mdcl ,[t0?] ,[t1] ...) (,t* ...) ((,x** ...) ,interface* ,l*) ...) + [(mvset ,info (,mdcl ,[t0?] ,[t1] ...) (,[t*] ...) ((,x** ...) ,interface* ,l*) ...) `(seq (mvset ,info (,mdcl ,t0? ,t1 ...) (,t* ...) ((,x** ...) ,interface* ,l*) ...) (true))] @@ -9826,7 +9826,7 @@ (guard (info-call-error? info) (fx< (debug-level) 2)) `(mvcall ,info ,mdcl ,t0? ,t1 ... (,t* ...))] [(set! ,[lvalue] ,[rhs]) `(seq (set! ,lvalue ,rhs) ,(%constant svoid))] - [(mvset ,info (,mdcl ,[t0?] ,[t1] ...) (,t* ...) ((,x** ...) ,interface* ,l*) ...) + [(mvset ,info (,mdcl ,[t0?] ,[t1] ...) (,[t*] ...) ((,x** ...) ,interface* ,l*) ...) `(seq (mvset ,info (,mdcl ,t0? ,t1 ...) (,t* ...) ((,x** ...) ,interface* ,l*) ...) ,(%constant svoid))]