mirror/guile
mirror/guile
1
Fork 0
mirror of https://git.savannah.gnu.org/git/guile.git synced 2025-06-11 22:31:12 +02:00
Code Activity

tests: Don't rely on `scm_call_2' being visible.

Browse source 
* test-suite/tests/coverage.test ("procedure-execution-count")["called
  from C"]: Throw 'unresolved when `scm_call_2' cannot be resolved.
  Reported by Eli Zaretskii <eliz@gnu.org>.
This commit is contained in:
Ludovic Courtès 2013-06-16 20:58:10 +02:00
parent ee49b1684b
commit 41f2f14bd9
1 changed files with 17 additions and 14 deletions
Download patch file Download diff file Expand all files Collapse all files

31
test-suite/tests/coverage.test
View file

@ -1,6 +1,6 @@
;;;; coverage.test --- Code coverage. -*- mode: scheme; coding: utf-8; -*-
;;;;
;;;; Copyright (C) 2010, 2011, 2012 Free Software Foundation, Inc.
;;;; Copyright (C) 2010, 2011, 2012, 2013 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
@ -230,19 +230,22 @@
;; The `scm_call_N' functions use the VM returned by `the-vm'. This
;; test makes sure that they get to use %TEST-VM.
(let ((proc (code "foo.scm" "(lambda (x y) (+ x y))"))
(call (pointer->procedure '*
(dynamic-func "scm_call_2"
(dynamic-link))
'(* * *))))
(let-values (((data result)
(with-code-coverage %test-vm
(lambda ()
(call (make-pointer (object-address proc))
(make-pointer (object-address 1))
(make-pointer (object-address 2)))))))
(and (coverage-data? data)
(= (object-address 3) (pointer-address result))
(= (procedure-execution-count data proc) 1)))))
(call (false-if-exception ; can we resolve `scm_call_2'?
(pointer->procedure '*
(dynamic-func "scm_call_2"
(dynamic-link))
'(* * *)))))
(if call
(let-values (((data result)
(with-code-coverage %test-vm
(lambda ()
(call (make-pointer (object-address proc))
(make-pointer (object-address 1))
(make-pointer (object-address 2)))))))
(and (coverage-data? data)
(= (object-address 3) (pointer-address result))
(= (procedure-execution-count data proc) 1)))
(throw 'unresolved))))
(pass-if "called from eval"
(let-values (((data result)