diff options
author | Andy Wingo <wingo@pobox.com> | 2013-10-17 23:13:56 +0200 |
---|---|---|
committer | Andy Wingo <wingo@pobox.com> | 2013-10-17 23:20:32 +0200 |
commit | 1d94a35d69994bdbfd5dcb2c5f2af951152735a5 (patch) | |
tree | 0c215ad933945a58ba85e8092ac8b7dc758d7bcb /module/system/vm/coverage.scm | |
parent | 0bd6b1cae194ccc5b698b67257154e42933c43e5 (diff) | |
download | guile-1d94a35d69994bdbfd5dcb2c5f2af951152735a5.tar.gz |
(system vm coverage) works with RTL programs
* module/system/vm/coverage.scm (hashq-proc, assq-proc)
(program-sources*, closed-over-procedures, coverage-data->lcov): Work
with RTl procedures.
Diffstat (limited to 'module/system/vm/coverage.scm')
-rw-r--r-- | module/system/vm/coverage.scm | 35 |
1 files changed, 25 insertions, 10 deletions
diff --git a/module/system/vm/coverage.scm b/module/system/vm/coverage.scm index 268d2112a..1ca8fee79 100644 --- a/module/system/vm/coverage.scm +++ b/module/system/vm/coverage.scm @@ -1,6 +1,6 @@ ;;; -*- mode: scheme; coding: utf-8; -*- ;;; -;;; Copyright (C) 2010 Free Software Foundation, Inc. +;;; Copyright (C) 2010, 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 @@ -48,17 +48,28 @@ (define (hashq-proc proc n) ;; Return the hash of PROC's objcode. - (hashq (program-objcode proc) n)) + (if (rtl-program? proc) + (hashq (rtl-program-code proc) n) + (hashq (program-objcode proc) n))) (define (assq-proc proc alist) ;; Instead of really looking for PROC in ALIST, look for the objcode of PROC. ;; IOW the alist is indexed by procedures, not objcodes, but those procedures ;; are taken as an arbitrary representative of all the procedures (closures) ;; sharing that objcode. This can significantly reduce memory consumption. - (let ((code (program-objcode proc))) - (find (lambda (pair) - (eq? code (program-objcode (car pair)))) - alist))) + (if (rtl-program? proc) + (let ((code (rtl-program-code proc))) + (find (lambda (pair) + (let ((proc (car pair))) + (and (rtl-program? proc) + (eqv? code (rtl-program-code proc))))) + alist)) + (let ((code (program-objcode proc))) + (find (lambda (pair) + (let ((proc (car pair))) + (and (program? proc) + (eq? code (program-objcode proc))))) + alist)))) (define (with-code-coverage vm thunk) "Run THUNK, a zero-argument procedure, using VM; instrument VM to collect code @@ -211,7 +222,7 @@ particular closure was executed." (define (program-sources* data proc) ;; A memoizing version of `program-sources'. (or (hashq-ref (data-procedure->sources data) proc) - (and (program? proc) + (and (or (program? proc) (rtl-program? proc)) (let ((sources (program-sources proc)) (p->s (data-procedure->sources data)) (f->p (data-file->procedures data))) @@ -310,9 +321,13 @@ was loaded at the time DATA was collected." ;; Return the list of procedures PROC closes over, PROC included. (let loop ((proc proc) (result '())) - (if (and (program? proc) (not (memq proc result))) + (if (and (or (program? proc) (rtl-program? proc)) (not (memq proc result))) (fold loop (cons proc result) - (append (vector->list (or (program-objects proc) #())) + ;; FIXME: Include statically nested procedures for RTL + ;; programs. + (append (if (program? proc) + (vector->list (or (program-objects proc) #())) + '()) (program-free-variables proc))) result))) @@ -329,7 +344,7 @@ gathered, even if their code was not executed." (define (dump-function proc) ;; Dump source location and basic coverage data for PROC. - (and (program? proc) + (and (or (program? proc) (rtl-program? proc)) (let ((sources (program-sources* data proc))) (and (pair? sources) (let* ((line (source:line-for-user (car sources))) |