mirror/guile
mirror/guile
1
Fork 0
mirror of https://git.savannah.gnu.org/git/guile.git synced 2025-04-30 03:40:34 +02:00
Code Activity

Remove obsolete rtl tests

Browse source 
* 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:
Andy Wingo 2018-01-10 07:58:02 +01:00
parent e2a06249ef
commit 97301efca4
1 changed files with 1 additions and 144 deletions
Download patch file Download diff file Expand all files Collapse all files

145
test-suite/tests/rtl.test
View file

@ -1,6 +1,6 @@
;;;; 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
;;;; modify it under the terms of the GNU Lesser General Public
@ -134,42 +134,6 @@ a procedure."
(end-program)))))
(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"
(assert-equal 42
(let ((call ;; (lambda (x) (x))
@ -234,113 +198,6 @@ a procedure."
(end-program)))))
(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"
(let ((return-3 (assemble-program
'((begin-program return-3 ((name . return-3)))