This is an automated email from the git hooks/post-receive script. It was generated because a ref change was pushed to the repository containing the project "GNU Guile".
http://git.savannah.gnu.org/cgit/guile.git/commit/?id=4cbe4d72aab9723d57b9cd779fc99e76b545802e The branch, master has been updated via 4cbe4d72aab9723d57b9cd779fc99e76b545802e (commit) from c271065e542fc527313d5fb08ef0aaddabb42e72 (commit) Those revisions listed above that are new to this repository have not appeared on any other notification email; so we list those revisions in full, below. - Log ----------------------------------------------------------------- commit 4cbe4d72aab9723d57b9cd779fc99e76b545802e Author: Andy Wingo <[email protected]> Date: Tue Apr 15 22:00:30 2014 +0200 Fix rtl tests * module/system/vm/assembler.scm (write-arities): Add a diagnostic. * test-suite/tests/rtl.test: Fix tests to emit "definition" instructions. ----------------------------------------------------------------------- Summary of changes: module/system/vm/assembler.scm | 2 ++ test-suite/tests/rtl.test | 17 +++++++++++++++-- 2 files changed, 17 insertions(+), 2 deletions(-) diff --git a/module/system/vm/assembler.scm b/module/system/vm/assembler.scm index bed2bf7..8bbe1d9 100644 --- a/module/system/vm/assembler.scm +++ b/module/system/vm/assembler.scm @@ -1481,6 +1481,8 @@ procedure with label @var{rw-init}. @var{rw-init} may be false. If (define (write-arities asm metas headers names-port strtab) (define (write-header pos low-pc high-pc offset flags nreq nopt nlocals) + (unless (<= (+ nreq nopt) nlocals) + (error "forgot to emit definition instructions?")) (bytevector-u32-set! headers pos (* low-pc 4) (asm-endianness asm)) (bytevector-u32-set! headers (+ pos 4) (* high-pc 4) (asm-endianness asm)) (bytevector-u32-set! headers (+ pos 8) offset (asm-endianness asm)) diff --git a/test-suite/tests/rtl.test b/test-suite/tests/rtl.test index 2ee418a..082e44f 100644 --- a/test-suite/tests/rtl.test +++ b/test-suite/tests/rtl.test @@ -1,6 +1,6 @@ ;;;; Low-level tests of the bytecode assembler -*- mode: scheme; coding: utf-8; -*- ;;;; -;;;; Copyright (C) 2010, 2011, 2012, 2013 Free Software Foundation, Inc. +;;;; Copyright (C) 2010, 2011, 2012, 2013, 2014 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 @@ -104,6 +104,7 @@ a procedure." '((begin-program countdown ((name . countdown))) (begin-standard-arity (x) 4 #f) + (definition x 1) (br fix-body) (label loop-head) (br-if-= 2 1 #f out) @@ -140,6 +141,7 @@ a procedure." (begin-program accum ((name . accum))) (begin-standard-arity (x) 4 #f) + (definition x 1) (free-ref 2 0 0) (box-ref 3 2) (add 3 3 1) @@ -159,6 +161,7 @@ a procedure." '((begin-program call ((name . call))) (begin-standard-arity (f) 7 #f) + (definition f 1) (mov 5 1) (call 5 1) (receive 2 5 7) @@ -173,6 +176,7 @@ a procedure." '((begin-program call-with-3 ((name . call-with-3))) (begin-standard-arity (f) 7 #f) + (definition f 1) (mov 5 1) (load-constant 6 3) (call 5 2) @@ -189,6 +193,7 @@ a procedure." '((begin-program call ((name . call))) (begin-standard-arity (f) 2 #f) + (definition f 1) (mov 0 1) (tail-call 1) (end-arity) @@ -201,6 +206,7 @@ a procedure." '((begin-program call-with-3 ((name . call-with-3))) (begin-standard-arity (f) 2 #f) + (definition f 1) (mov 0 1) ;; R0 <- R1 (load-constant 1 3) ;; R1 <- 3 (tail-call 2) @@ -225,6 +231,7 @@ a procedure." (begin-program sqrt-trampoline ((name . sqrt-trampoline))) (begin-standard-arity (x) 3 #f) + (definition x 1) (cached-toplevel-box 2 sqrt-scope sqrt #t) (box-ref 0 2) (tail-call 2) @@ -278,6 +285,7 @@ a procedure." (begin-program sqrt-trampoline ((name . sqrt-trampoline))) (begin-standard-arity (x) 3 #f) + (definition x 1) (cached-module-box 2 (guile) sqrt #t #t) (box-ref 0 2) (tail-call 2) @@ -342,7 +350,7 @@ a procedure." (end-arity) (end-program)))))) -(with-test-prefix "simply procedure arity" +(with-test-prefix "simple procedure arity" (pass-if-equal "#<procedure foo ()>" (object->string (assemble-program @@ -357,6 +365,8 @@ a procedure." (assemble-program '((begin-program foo ((name . foo))) (begin-standard-arity (x y) 3 #f) + (definition x 1) + (definition y 2) (load-constant 1 42) (return 1) (end-arity) @@ -367,6 +377,9 @@ a procedure." (assemble-program '((begin-program foo ((name . foo))) (begin-opt-arity (x) (y) z 4 #f) + (definition x 1) + (definition y 2) + (definition z 3) (load-constant 1 42) (return 1) (end-arity) hooks/post-receive -- GNU Guile
