mirror of
https://git.savannah.gnu.org/git/guile.git
synced 2025-04-30 11:50:28 +02:00
Remove obsolete rtl tests
* test-suite/tests/rtl.test (accum, cached-toplevel-ref) (cached-toplevel-set!, cached-module-ref, cached-module-set!): Remove tests that use box instructions. These tests have done their time and now aren't of much value.
This commit is contained in:
parent
e2a06249ef
commit
97301efca4
1 changed files with 1 additions and 144 deletions
|
@ -1,6 +1,6 @@
|
||||||
;;;; Low-level tests of the bytecode assembler -*- mode: scheme; coding: utf-8; -*-
|
;;;; Low-level tests of the bytecode assembler -*- mode: scheme; coding: utf-8; -*-
|
||||||
;;;;
|
;;;;
|
||||||
;;;; Copyright (C) 2010, 2011, 2012, 2013, 2014, 2015, 2017 Free Software Foundation, Inc.
|
;;;; Copyright (C) 2010-2015, 2017-2018 Free Software Foundation, Inc.
|
||||||
;;;;
|
;;;;
|
||||||
;;;; This library is free software; you can redistribute it and/or
|
;;;; This library is free software; you can redistribute it and/or
|
||||||
;;;; modify it under the terms of the GNU Lesser General Public
|
;;;; modify it under the terms of the GNU Lesser General Public
|
||||||
|
@ -134,42 +134,6 @@ a procedure."
|
||||||
(end-program)))))
|
(end-program)))))
|
||||||
(sumto 1000))))
|
(sumto 1000))))
|
||||||
|
|
||||||
(with-test-prefix "accum"
|
|
||||||
(assert-equal (+ 1 2 3)
|
|
||||||
(let ((make-accum
|
|
||||||
(assemble-program
|
|
||||||
;; 0: elt
|
|
||||||
;; 1: tail
|
|
||||||
;; 2: head
|
|
||||||
'((begin-program make-accum
|
|
||||||
((name . make-accum)))
|
|
||||||
(begin-standard-arity () 3 #f)
|
|
||||||
(load-constant 1 0)
|
|
||||||
(box 1 1)
|
|
||||||
(make-closure 0 accum 1)
|
|
||||||
(free-set! 0 1 0)
|
|
||||||
(mov 1 0)
|
|
||||||
(return-values 2)
|
|
||||||
(end-arity)
|
|
||||||
(end-program)
|
|
||||||
(begin-program accum
|
|
||||||
((name . accum)))
|
|
||||||
(begin-standard-arity (x) 4 #f)
|
|
||||||
(definition closure 0 scm)
|
|
||||||
(definition x 1 scm)
|
|
||||||
(free-ref 1 3 0)
|
|
||||||
(box-ref 0 1)
|
|
||||||
(add 0 0 2)
|
|
||||||
(box-set! 1 0)
|
|
||||||
(mov 2 0)
|
|
||||||
(return-values 2)
|
|
||||||
(end-arity)
|
|
||||||
(end-program)))))
|
|
||||||
(let ((accum (make-accum)))
|
|
||||||
(accum 1)
|
|
||||||
(accum 2)
|
|
||||||
(accum 3)))))
|
|
||||||
|
|
||||||
(with-test-prefix "call"
|
(with-test-prefix "call"
|
||||||
(assert-equal 42
|
(assert-equal 42
|
||||||
(let ((call ;; (lambda (x) (x))
|
(let ((call ;; (lambda (x) (x))
|
||||||
|
@ -234,113 +198,6 @@ a procedure."
|
||||||
(end-program)))))
|
(end-program)))))
|
||||||
(call-with-3 (lambda (x) (* x 2))))))
|
(call-with-3 (lambda (x) (* x 2))))))
|
||||||
|
|
||||||
(with-test-prefix "cached-toplevel-ref"
|
|
||||||
(assert-equal 5.0
|
|
||||||
(let ((get-sqrt-trampoline
|
|
||||||
(assemble-program
|
|
||||||
'((begin-program get-sqrt-trampoline
|
|
||||||
((name . get-sqrt-trampoline)))
|
|
||||||
(begin-standard-arity () 2 #f)
|
|
||||||
(current-module 0)
|
|
||||||
(cache-current-module! 0 sqrt-scope)
|
|
||||||
(load-static-procedure 0 sqrt-trampoline)
|
|
||||||
(return-values 2)
|
|
||||||
(end-arity)
|
|
||||||
(end-program)
|
|
||||||
|
|
||||||
(begin-program sqrt-trampoline
|
|
||||||
((name . sqrt-trampoline)))
|
|
||||||
(begin-standard-arity (x) 3 #f)
|
|
||||||
(definition closure 0 scm)
|
|
||||||
(definition x 1 scm)
|
|
||||||
(cached-toplevel-box 0 sqrt-scope sqrt #t)
|
|
||||||
(box-ref 2 0)
|
|
||||||
(tail-call 2)
|
|
||||||
(end-arity)
|
|
||||||
(end-program)))))
|
|
||||||
((get-sqrt-trampoline) 25.0))))
|
|
||||||
|
|
||||||
(define *top-val* 0)
|
|
||||||
|
|
||||||
(with-test-prefix "cached-toplevel-set!"
|
|
||||||
(let ((prev *top-val*))
|
|
||||||
(assert-equal (1+ prev)
|
|
||||||
(let ((make-top-incrementor
|
|
||||||
(assemble-program
|
|
||||||
'((begin-program make-top-incrementor
|
|
||||||
((name . make-top-incrementor)))
|
|
||||||
(begin-standard-arity () 2 #f)
|
|
||||||
(current-module 0)
|
|
||||||
(cache-current-module! 0 top-incrementor)
|
|
||||||
(load-static-procedure 0 top-incrementor)
|
|
||||||
(return-values 2)
|
|
||||||
(end-arity)
|
|
||||||
(end-program)
|
|
||||||
|
|
||||||
(begin-program top-incrementor
|
|
||||||
((name . top-incrementor)))
|
|
||||||
(begin-standard-arity () 3 #f)
|
|
||||||
(cached-toplevel-box 1 top-incrementor *top-val* #t)
|
|
||||||
(box-ref 0 1)
|
|
||||||
(add/immediate 0 0 1)
|
|
||||||
(box-set! 1 0)
|
|
||||||
(return-values 1)
|
|
||||||
(end-arity)
|
|
||||||
(end-program)))))
|
|
||||||
((make-top-incrementor))
|
|
||||||
*top-val*))))
|
|
||||||
|
|
||||||
(with-test-prefix "cached-module-ref"
|
|
||||||
(assert-equal 5.0
|
|
||||||
(let ((get-sqrt-trampoline
|
|
||||||
(assemble-program
|
|
||||||
'((begin-program get-sqrt-trampoline
|
|
||||||
((name . get-sqrt-trampoline)))
|
|
||||||
(begin-standard-arity () 2 #f)
|
|
||||||
(load-static-procedure 0 sqrt-trampoline)
|
|
||||||
(return-values 2)
|
|
||||||
(end-arity)
|
|
||||||
(end-program)
|
|
||||||
|
|
||||||
(begin-program sqrt-trampoline
|
|
||||||
((name . sqrt-trampoline)))
|
|
||||||
(begin-standard-arity (x) 3 #f)
|
|
||||||
(definition closure 0 scm)
|
|
||||||
(definition x 1 scm)
|
|
||||||
(cached-module-box 0 (guile) sqrt #t #t)
|
|
||||||
(box-ref 2 0)
|
|
||||||
(tail-call 2)
|
|
||||||
(end-arity)
|
|
||||||
(end-program)))))
|
|
||||||
((get-sqrt-trampoline) 25.0))))
|
|
||||||
|
|
||||||
(with-test-prefix "cached-module-set!"
|
|
||||||
(let ((prev *top-val*))
|
|
||||||
(assert-equal (1+ prev)
|
|
||||||
(let ((make-top-incrementor
|
|
||||||
(assemble-program
|
|
||||||
'((begin-program make-top-incrementor
|
|
||||||
((name . make-top-incrementor)))
|
|
||||||
(begin-standard-arity () 2 #f)
|
|
||||||
(load-static-procedure 0 top-incrementor)
|
|
||||||
(return-values 2)
|
|
||||||
(end-arity)
|
|
||||||
(end-program)
|
|
||||||
|
|
||||||
(begin-program top-incrementor
|
|
||||||
((name . top-incrementor)))
|
|
||||||
(begin-standard-arity () 3 #f)
|
|
||||||
(cached-module-box 1 (tests bytecode) *top-val* #f #t)
|
|
||||||
(box-ref 0 1)
|
|
||||||
(add/immediate 0 0 1)
|
|
||||||
(box-set! 1 0)
|
|
||||||
(mov 1 0)
|
|
||||||
(return-values 2)
|
|
||||||
(end-arity)
|
|
||||||
(end-program)))))
|
|
||||||
((make-top-incrementor))
|
|
||||||
*top-val*))))
|
|
||||||
|
|
||||||
(with-test-prefix "debug contexts"
|
(with-test-prefix "debug contexts"
|
||||||
(let ((return-3 (assemble-program
|
(let ((return-3 (assemble-program
|
||||||
'((begin-program return-3 ((name . return-3)))
|
'((begin-program return-3 ((name . return-3)))
|
||||||
|
|
Loading…
Add table
Add a link
Reference in a new issue