From mboxrd@z Thu Jan 1 00:00:00 1970 Path: news.gmane.org!not-for-mail From: Han-Wen Nienhuys Newsgroups: gmane.lisp.guile.devel Subject: [PATCH] experimental lookupcar based coverage testing. Date: Thu, 18 Jan 2007 20:48:13 +0100 Message-ID: <45AFCEFD.5030203@xs4all.nl> Reply-To: hanwen@xs4all.nl NNTP-Posting-Host: lo.gmane.org Mime-Version: 1.0 Content-Type: text/plain; charset=ISO-8859-1 Content-Transfer-Encoding: 7bit X-Trace: sea.gmane.org 1169149725 1967 80.91.229.12 (18 Jan 2007 19:48:45 GMT) X-Complaints-To: usenet@sea.gmane.org NNTP-Posting-Date: Thu, 18 Jan 2007 19:48:45 +0000 (UTC) Original-X-From: guile-devel-bounces+guile-devel=m.gmane.org@gnu.org Thu Jan 18 20:48:43 2007 Return-path: Envelope-to: guile-devel@m.gmane.org Original-Received: from lists.gnu.org ([199.232.76.165]) by lo.gmane.org with esmtp (Exim 4.50) id 1H7dFR-0003jH-Qo for guile-devel@m.gmane.org; Thu, 18 Jan 2007 20:48:34 +0100 Original-Received: from localhost ([127.0.0.1] helo=lists.gnu.org) by lists.gnu.org with esmtp (Exim 4.43) id 1H7dFS-00079c-LW for guile-devel@m.gmane.org; Thu, 18 Jan 2007 14:48:34 -0500 Original-Received: from mailman by lists.gnu.org with tmda-scanned (Exim 4.43) id 1H7dFP-00079L-Ru for guile-devel@gnu.org; Thu, 18 Jan 2007 14:48:31 -0500 Original-Received: from exim by lists.gnu.org with spam-scanned (Exim 4.43) id 1H7dFO-000790-VQ for guile-devel@gnu.org; Thu, 18 Jan 2007 14:48:31 -0500 Original-Received: from [199.232.76.173] (helo=monty-python.gnu.org) by lists.gnu.org with esmtp (Exim 4.43) id 1H7dFO-00078x-T6 for guile-devel@gnu.org; Thu, 18 Jan 2007 14:48:30 -0500 Original-Received: from [80.91.229.2] (helo=ciao.gmane.org) by monty-python.gnu.org with esmtps (TLS-1.0:RSA_AES_256_CBC_SHA:32) (Exim 4.52) id 1H7dFN-0000Vv-Uj for guile-devel@gnu.org; Thu, 18 Jan 2007 14:48:30 -0500 Original-Received: from list by ciao.gmane.org with local (Exim 4.43) id 1H7dFB-0000hH-O7 for guile-devel@gnu.org; Thu, 18 Jan 2007 20:48:17 +0100 Original-Received: from muurbloem.xs4all.nl ([213.84.26.127]) by main.gmane.org with esmtp (Gmexim 0.1 (Debian)) id 1AlnuQ-0007hv-00 for ; Thu, 18 Jan 2007 20:48:17 +0100 Original-Received: from hanwen by muurbloem.xs4all.nl with local (Gmexim 0.1 (Debian)) id 1AlnuQ-0007hv-00 for ; Thu, 18 Jan 2007 20:48:17 +0100 X-Injected-Via-Gmane: http://gmane.org/ Original-To: guile-devel@gnu.org Original-Lines: 257 Original-X-Complaints-To: usenet@sea.gmane.org X-Gmane-NNTP-Posting-Host: muurbloem.xs4all.nl User-Agent: Thunderbird 1.5.0.9 (X11/20061219) X-BeenThere: guile-devel@gnu.org X-Mailman-Version: 2.1.5 Precedence: list List-Id: "Developers list for Guile, the GNU extensibility library" List-Unsubscribe: , List-Archive: List-Post: List-Help: List-Subscribe: , Original-Sender: guile-devel-bounces+guile-devel=m.gmane.org@gnu.org Errors-To: guile-devel-bounces+guile-devel=m.gmane.org@gnu.org Xref: news.gmane.org gmane.lisp.guile.devel:6441 Archived-At: Hi, See attached patch. This still has rough edges. For some reason, I don't catch the memoization of display to #. Also, I'm looking at the orig_x , since the sub-expressions that are used inside DEVAL don't have source properties. ** (define (x a b) (let* ((z (+ a b))) (if (<= z 3) (display "YES") (x (1- a) b)))) (display "HOI\n") (set-test-flag #t) (display (x 1 12)) (display (x 1 12)) (set-test-flag #f) (hash-fold (lambda (key val acc) (display (list key val)) #t) #t (get-coverage-table)) ** yields: (gdb) r [Thread debugging using libthread_db enabled] [New Thread -1208576320 (LWP 29195)] HOI YES#YES#coverage: called 3 times (x.scm #(#f #f #f #t #f #t #f #t)) Program exited normally. (gdb) ** The line coverage: called 3 times proves that it succeeds in not introducing significant penalties. --- libguile/eval.c | 119 +++++++++++++++++++++++++++++++++++++++++++++++++++++- 1 files changed, 116 insertions(+), 3 deletions(-) diff --git a/libguile/eval.c b/libguile/eval.c index 26d90f1..21c891c 100644 --- a/libguile/eval.c +++ b/libguile/eval.c @@ -99,6 +99,72 @@ static SCM *scm_lookupcar1 (SCM vloc, SCM genv, int check); static SCM unmemoize_builtin_macro (SCM expr, SCM env); static void eval_letrec_inits (SCM env, SCM init_forms, SCM **init_values_eol); +SCM scm_set_test_flag (SCM); +SCM scm_get_coverage_table (void); +int test_flag; + + + +/* coverage + */ +static SCM scm_i_coverage_hash_table; +static int cov_count; +#define NOTICE_COVERAGE(x,origx) (x) + +static SCM +scm_notice_coverage (SCM x, SCM origx) +{ + if (!test_flag) + return x; + + cov_count ++; + SCM source = scm_source_properties (origx); + if (scm_is_pair (source)) + { + SCM line = scm_source_property (origx, scm_sym_line); + SCM file = scm_source_property (origx, scm_sym_filename); + SCM vec = SCM_BOOL_F; + int cline = 0; + + if (!scm_i_coverage_hash_table) + { + scm_i_coverage_hash_table = + scm_gc_protect_object (scm_c_make_hash_table (93)); + } + + if (!scm_is_string (file) + || !scm_is_integer (line)) + return x; + + vec = scm_hashv_ref (scm_i_coverage_hash_table, + file, SCM_BOOL_F); + cline = scm_to_int (line); + if (!scm_is_vector (vec) + || scm_c_vector_length (vec) < cline) + { + SCM newvec = scm_c_make_vector (cline + 1, + SCM_BOOL_F); + if (scm_is_vector (vec)) + { + int k = 0; + int veclen = scm_c_vector_length (vec); + + for (; k < veclen; k++) + scm_c_vector_set_x (newvec, k, + scm_c_vector_ref (vec, k)); + } + vec = newvec; + + scm_hashv_set_x (scm_i_coverage_hash_table, file, vec); + } + + scm_c_vector_set_x (vec, cline, SCM_BOOL_T); + + } + + return x; +} + /* {Syntax Errors} @@ -2675,6 +2741,17 @@ static SCM deval (SCM x, SCM env); ? SCM_CAR (x) \ : *scm_lookupcar ((x), (env), 1))))) +#define EVALCAR_COVERAGE(x, env) \ + (SCM_IMP (SCM_CAR (x)) \ + ? SCM_I_EVALIM (SCM_CAR (x), (env)) \ + : (SCM_VARIABLEP (SCM_CAR (x)) \ + ? SCM_VARIABLE_REF (SCM_CAR (x)) \ + : (scm_is_pair (SCM_CAR (x)) \ + ? CEVAL (SCM_CAR (x), (env)) \ + : (!scm_is_symbol (SCM_CAR (x)) \ + ? SCM_CAR (x) \ + : *scm_lookupcar (NOTICE_COVERAGE(x,origx), (env), 1))))) + scm_i_pthread_mutex_t source_mutex; @@ -2996,6 +3073,9 @@ scm_eval_body (SCM code, SCM env) */ #ifndef DEVAL +#undef NOTICE_COVERAGE +#define NOTICE_COVERAGE(x,o) (x) + #define SCM_APPLY scm_apply #define PREP_APPLY(proc, args) @@ -3009,6 +3089,9 @@ scm_eval_body (SCM code, SCM env) #else /* !DEVAL */ +#undef NOTICE_COVERAGE +#define NOTICE_COVERAGE(x,y) scm_notice_coverage(x,y) + #undef CEVAL #define CEVAL deval /* Substitute all uses of ceval */ @@ -3235,6 +3318,8 @@ static SCM CEVAL (SCM x, SCM env) { SCM proc, arg1; + SCM origx = x; + #ifdef DEVAL scm_t_debug_frame debug; scm_t_debug_info *debug_info_end; @@ -3266,7 +3351,7 @@ CEVAL (SCM x, SCM env) #ifdef DEVAL goto start; #endif - + (void) origx; loop: #ifdef DEVAL SCM_CLEAR_ARGSREADY (debug); @@ -4196,7 +4281,7 @@ dispatch: /* must handle macros by here */ x = SCM_CDR (x); if (scm_is_pair (x)) - arg1 = EVALCAR (x, env); + arg1 = EVALCAR_COVERAGE (x, env); else scm_wrong_num_args (proc); #ifdef DEVAL @@ -5649,6 +5734,35 @@ SCM_DEFINE (scm_force, "force", 1, 0, 0, #undef FUNC_NAME +SCM_DEFINE (scm_set_test_flag, "set-test-flag", 1, 0, 0, + (SCM val), + "") +#define FUNC_NAME s_scm_set_test_flag +{ + test_flag = (val == SCM_BOOL_T); + return SCM_UNSPECIFIED; +} +#undef FUNC_NAME + +#include + +SCM_DEFINE (scm_get_coverage_table, "get-coverage-table", 0, 0, 0, + (void), + "") +#define FUNC_NAME s_scm_get_coverage_table +{ + if (scm_i_coverage_hash_table == NULL) + return SCM_BOOL_F; + + SCM x = scm_i_coverage_hash_table; + scm_i_coverage_hash_table = 0; + scm_gc_unprotect_object (x); + printf ("coverage: called %d times\n", cov_count); + return x; +} +#undef FUNC_NAME + + SCM_DEFINE (scm_promise_p, "promise?", 1, 0, 0, (SCM obj), "Return true if @var{obj} is a promise, i.e. a delayed computation\n" @@ -5978,7 +6092,6 @@ SCM_DEFINE (scm_eval, "eval", 2, 0, 0, #define DEVAL #include "eval.c" - #if (SCM_ENABLE_DEPRECATED == 1) /* Deprecated in guile 1.7.0 on 2004-03-29. */ -- 1.4.4.2 -- Han-Wen Nienhuys - hanwen@xs4all.nl - http://www.xs4all.nl/~hanwen _______________________________________________ Guile-devel mailing list Guile-devel@gnu.org http://lists.gnu.org/mailman/listinfo/guile-devel