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

coverage: Add test for applicable structs.

Browse source 
* test-suite/tests/coverage.test ("procedure-execution-count")["applicable
  struct"]: New test.
This commit is contained in:
Ludovic Courtès 2012-05-16 00:04:07 +02:00
parent 2de74cb56e
commit 1a6ff60da8
1 changed files with 11 additions and 1 deletions
Download patch file Download diff file Expand all files Collapse all files

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

@ -1,6 +1,6 @@
;;;; coverage.test --- Code coverage. -*- mode: scheme; coding: utf-8; -*- ;;;; coverage.test --- Code coverage. -*- mode: scheme; coding: utf-8; -*-
;;;; ;;;;
;;;; Copyright (C) 2010, 2011 Free Software Foundation, Inc. ;;;; Copyright (C) 2010, 2011, 2012 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
@ -216,6 +216,16 @@
(= 3 result) (= 3 result)
(not (procedure-execution-count data proc)))))) (not (procedure-execution-count data proc))))))
(pass-if "applicable struct"
(let* ((<box> (make-struct <applicable-struct-vtable> 0 'pw))
(proc (lambda args (length args)))
(b (make-struct <box> 0 proc)))
(let-values (((data result)
(with-code-coverage %test-vm b)))
(and (coverage-data? data)
(= 0 result)
(= (procedure-execution-count data proc) 1)))))
(pass-if "called from C" (pass-if "called from C"
;; The `scm_call_N' functions use the VM returned by `the-vm'. This ;; The `scm_call_N' functions use the VM returned by `the-vm'. This
;; test makes sure that they get to use %TEST-VM. ;; test makes sure that they get to use %TEST-VM.