[PATCH] experimental lookupcar based coverage testing.

[PATCH] experimental lookupcar based coverage testing.

[Han-Wen Nienhuys]

Hi,

See attached patch. This still has rough edges. For some reason, I
don't catch the memoization of display to #<proc: display>.

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#<unspecified>YES#<unspecified>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;
+
+
+\f
+/* 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;
+}
+
 \f
 
 /* {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 <stdio.h>
+
+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

Re: [PATCH] experimental lookupcar based coverage testing.

[Kevin Ryde]

Han-Wen Nienhuys <hanwen@xs4all.nl> writes:
>
> See attached patch.

Sounds worryingly specific to what you're doing.  Perhaps something
which was just a hook to each function call made (by the debug
evaluator), with the memoized and unmemoized form if that's necessary.

> +int test_flag;

An entry in the debug-options struct?


_______________________________________________
Guile-devel mailing list
Guile-devel@gnu.org
http://lists.gnu.org/mailman/listinfo/guile-devel

Re: [PATCH] experimental lookupcar based coverage testing.

[Han-Wen Nienhuys]

Kevin Ryde escreveu:
> Han-Wen Nienhuys <hanwen@xs4all.nl> writes:
>> See attached patch.
> 
> Sounds worryingly specific to what you're doing.  Perhaps something
> which was just a hook to each function call made (by the debug
> evaluator), with the memoized and unmemoized form if that's necessary.

Since it is run only once for each memoization, it's not a problem performance
wise to have the actual recording routine in Scheme routine, but it 
would need some more careful setting up of traps.

(trap-enable 'memoization)

?

-- 
 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

Re: [PATCH] experimental lookupcar based coverage testing.

[Kevin Ryde]

Han-Wen Nienhuys <hanwen@xs4all.nl> writes:
>
> (trap-enable 'memoization)
> ?

My remark on "test_flag" was just that set-test-flag sounds like it
could be anything, and could perhaps be more cleanly handled in the
debug-options.  trap-options would be also ok.


_______________________________________________
Guile-devel mailing list
Guile-devel@gnu.org
http://lists.gnu.org/mailman/listinfo/guile-devel

Re: [PATCH] experimental lookupcar based coverage testing.

[Han-Wen Nienhuys]

Han-Wen Nienhuys escreveu:
> Hi,
> 
> See attached patch. This still has rough edges. For some reason, I
> don't catch the memoization of display to #<proc: display>.

This is fixed in attached patch. 

This code
****************
(define (x a b)
  (let*
      ((z (+ a b)))

    (if (>= z 3)
	(begin
	  (write z
		 (current-output-port))
	  (x (1- a) b))
	(write "YES" (current-output-port))
	)

))

(set-test-flag #t)

(x 1 7)
(do
    ((i 0 (1+ i)))
    ((> i 5))

  (display i) 
  )

(set-test-flag #f)

(hash-fold
 (lambda (key val acc)
   (display-coverage key val)
   #t)
 #t
 (get-coverage-table))
****************

yields

****************
876543"YES"012345
coverage: called 17 times
        : (define (x a b)
        :   (let*
#t      :       ((z (+ a b)))
        : 
#t      :     (if (>= z 3)
        :       (begin
#t      :         (write z
#t      :                (current-output-port))
#t      :         (x (1- a) b))
#t      :       (write "YES" (current-output-port))
        :       )
        : 
        : ))
        : 
        : (set-test-flag #t)
        : 
#t      : (x 1 7)
#t      : (do
#t      :     ((i 0 (1+ i)))
#t      :     ((> i 5))
        : 
#t      :   (display i) 
        :   )
        : 
#t      : (set-test-flag #f)
****************


patch: 

diff --git a/libguile/eval.c b/libguile/eval.c
index 26d90f1..9067670 100644
--- a/libguile/eval.c
+++ b/libguile/eval.c
@@ -99,6 +99,70 @@ 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;
+
+
+\f
+/* coverage
+ */
+static SCM scm_i_coverage_hash_table;
+static int cov_count; 
+#define NOTICE_COVERAGE(x) 
+
+static void
+scm_notice_coverage (SCM origx)
+{
+  if (!test_flag)
+    return ;
+
+  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;
+      
+      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);
+
+    }
+}
+
 \f
 
 /* {Syntax Errors}
@@ -2996,6 +3060,9 @@ scm_eval_body (SCM code, SCM env)
  */
 
 #ifndef DEVAL
+#undef NOTICE_COVERAGE
+#define NOTICE_COVERAGE(x) 
+
 
 #define SCM_APPLY scm_apply
 #define PREP_APPLY(proc, args)
@@ -3009,6 +3076,9 @@ scm_eval_body (SCM code, SCM env)
 
 #else /* !DEVAL */
 
+#undef NOTICE_COVERAGE
+#define NOTICE_COVERAGE(x) scm_notice_coverage(x)
+
 #undef CEVAL
 #define CEVAL deval	/* Substitute all uses of ceval */
 
@@ -3024,7 +3094,7 @@ scm_eval_body (SCM code, SCM env)
 do { \
   SCM_SET_ARGSREADY (debug);\
   if (scm_check_apply_p && SCM_TRAPS_P)\
-    if (SCM_APPLY_FRAME_P || (SCM_TRACE_P && PROCTRACEP (proc)))\
+    if (SCM_APPLY_FRAME_P || (SCM_TRACE_P && SCM_PROCTRACEP (proc)))\
       {\
 	SCM tmp, tail = scm_from_bool(SCM_TRACED_FRAME_P (debug)); \
 	SCM_SET_TRACED_FRAME (debug); \
@@ -3235,6 +3305,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 +3338,7 @@ CEVAL (SCM x, SCM env)
 #ifdef DEVAL
   goto start;
 #endif
-
+  (void) origx;
 loop:
 #ifdef DEVAL
   SCM_CLEAR_ARGSREADY (debug);
@@ -4031,6 +4103,7 @@ dispatch:
 		goto dispatch;
 	      }
 	    proc = *location;
+	    NOTICE_COVERAGE(origx);
 	  }
 
 	  if (SCM_MACROP (proc))
@@ -4095,7 +4168,9 @@ dispatch:
 	    }
 	}
       else
-        proc = SCM_CAR (x);
+	{
+	  proc = SCM_CAR (x);
+	}
 
       if (SCM_MACROP (proc))
 	goto handle_a_macro;
@@ -4111,6 +4186,7 @@ dispatch:
    * level.  If the number of arguments does not match the number of arguments
    * that are allowed to be passed to proc, also an error on the scheme level
    * will be signalled.  */
+
   PREP_APPLY (proc, SCM_EOL);
   if (scm_is_null (SCM_CDR (x))) {
     ENTER_APPLY;
@@ -4199,6 +4275,8 @@ dispatch:
     arg1 = EVALCAR (x, env);
   else
     scm_wrong_num_args (proc);
+  
+
 #ifdef DEVAL
   debug.info->a.args = scm_list_1 (arg1);
 #endif
@@ -5649,6 +5727,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 <stdio.h>
+
+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 +6085,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.  */



-- 
 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

Re: [PATCH] experimental lookupcar based coverage testing.

[Ludovic Courtès]

Hi,

Han-Wen Nienhuys <hanwen@xs4all.nl> writes:

> See attached patch. This still has rough edges. For some reason, I
> don't catch the memoization of display to #<proc: display>.

Overall, as Kevin suggested, I'd be more in favor of using the existing
trap mechanism (possibly extending it if it doesn't provide enough
information to trap handlers).  However, as you already said, the trap
mechanism is damn slow.  I guess it is mostly slow because the evaluator
is slow, but the trap mechanism itself may be optimizable, too.

If you look at `ENTER_APPLY' around line 3025, it makes at least two
function calls: `scm_make_debugobj ()' and `scm_call_3 ()'.  The former
is a one-line function and should really be inlined.  The latter
introduces unnecessary overhead since it ends up calling `SCM_APPLY ()'
which in turns necessarily jumps to the `scm_tcs_closures' case since
trap handlers are always closures.  Thus, at the very least,
`scm_call_3 ()' should be replaced by `SCM_APPLY ()'.

These small optimizations would certainly be worthwhile, although
perhaps not sufficient.

Thanks,
Ludovic.


_______________________________________________
Guile-devel mailing list
Guile-devel@gnu.org
http://lists.gnu.org/mailman/listinfo/guile-devel

Re: [PATCH] experimental lookupcar based coverage testing.

[Han-Wen Nienhuys]

Ludovic Courtès escreveu:
>> See attached patch. This still has rough edges. For some reason, I
>> don't catch the memoization of display to #<proc: display>.
> 
> Overall, as Kevin suggested, I'd be more in favor of using the existing
> trap mechanism (possibly extending it if it doesn't provide enough
> information to trap handlers).  However, as you already said, the trap
> mechanism is damn slow.  I guess it is mostly slow because the evaluator
> is slow, but the trap mechanism itself may be optimizable, too.
> 
> If you look at `ENTER_APPLY' around line 3025, it makes at least two
> function calls: `scm_make_debugobj ()' and `scm_call_3 ()'.  The former
> is a one-line function and should really be inlined.  The latter
> introduces unnecessary overhead since it ends up calling `SCM_APPLY ()'
> which in turns necessarily jumps to the `scm_tcs_closures' case since
> trap handlers are always closures.  Thus, at the very least,
> `scm_call_3 ()' should be replaced by `SCM_APPLY ()'.
> 
> These small optimizations would certainly be worthwhile, although
> perhaps not sufficient.

I have doubts whether this can ever be good enough. For effective
coverage analysis, you have a to run an entire test-suite with
coverage enabled.  Eg. for lilypond, the entire test-suite takes 5
minutes on a 1.6ghz Core duo (single thread), when running
normally. That is a lot of Scheme code, and if for every frame-enter
or apply, a piece of user code is called, that will be an enormous
slowdown.

The real problem is not setting up the trap for calling, but rather 
the fact that it 

 - is called for every evaluation (for coverage, it needs to be done
only once)

 - is user-code, ie. something as simple as

  (car x)

(which is just a couple of instructions) will expand into

   (begin
    (vector-set! 
     (hash-ref coverage-table
      (source-property (frame-source (last-frame continuation))
       'filename))
     (source-property (frame-source (last-frame continuation)) 'line)
     #t)
    (car x))

which would likely be a couple of orders of magnitude slower.
  
Of course, the patch that I posted is ad-hoc, because it hardcodes the
coverage analysis in eval.c.  If it were to be included, I propose
something like

 (trap-set! 'memoize-symbol
            record-coverage)
 (trap-enable 'memoize-symbol)

which would be possible with a generic, and quite minimal extension to
eval.

However, I'd like some feedback on the approach before reworking the
ad-hoc patch into a real one.



-- 
 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

Re: [PATCH] experimental lookupcar based coverage testing.

[Ludovic Courtès]

Hi,

Han-Wen Nienhuys <hanwen@xs4all.nl> writes:

> I have doubts whether this can ever be good enough. For effective
> coverage analysis, you have a to run an entire test-suite with
> coverage enabled.  Eg. for lilypond, the entire test-suite takes 5
> minutes on a 1.6ghz Core duo (single thread), when running
> normally. That is a lot of Scheme code, and if for every frame-enter
> or apply, a piece of user code is called, that will be an enormous
> slowdown.

Yes, that would still be a significant slowdown.

What I meant is that there are roughly two approaches that can be taken
to tackle such issues: (i) extend the C code base in ad hoc ways that
allow the reduction of performance penalties in the specific use case
that is addressed, and (ii) keep the C code base to a bare minimum but
fast enough that specific mechanisms can be implemented atop, in Scheme.
I agree that Guile has always favored the first approach, but I think it
has a number of drawbacks in the long term (e.g., code complexity, lack
of flexibility and hackability).

> The real problem is not setting up the trap for calling, but rather 
> the fact that it 
>
>  - is called for every evaluation (for coverage, it needs to be done
> only once)

Right.

> Of course, the patch that I posted is ad-hoc, because it hardcodes the
> coverage analysis in eval.c.  If it were to be included, I propose
> something like
>
>  (trap-set! 'memoize-symbol
>             record-coverage)
>  (trap-enable 'memoize-symbol)
>
> which would be possible with a generic, and quite minimal extension to
> eval.

Indeed, this looks less specific and more flexible.  I'd personally
prefer this approach.

Thanks,
Ludovic.


_______________________________________________
Guile-devel mailing list
Guile-devel@gnu.org
http://lists.gnu.org/mailman/listinfo/guile-devel

Re: [PATCH] experimental lookupcar based coverage testing.

[Han-Wen Nienhuys]

Ludovic Courtès escreveu:
>> Of course, the patch that I posted is ad-hoc, because it hardcodes the
>> coverage analysis in eval.c.  If it were to be included, I propose
>> something like
>>
>>  (trap-set! 'memoize-symbol
>>             record-coverage)
>>  (trap-enable 'memoize-symbol)
>>
>> which would be possible with a generic, and quite minimal extension to
>> eval.
> 
> Indeed, this looks less specific and more flexible.  I'd personally
> prefer this approach.

This is now in CVS, along with a couple of other changes. 

The following code demonstrates the use of this interface.

***

(define coverage-table (make-hash-table 57))
(use-modules (ice-9 rdelim)
	     (ice-9 format))


(define (read-lines port)
  (string-split (read-delimited "" port) #\newline))

(define (display-coverage file vec)
  (let*
      ((lines (read-lines (open-file file "r"))))

    (do
	((i 0 (1+ i))
	 (l lines (cdr l)))
	((or (null? l) (>= i (vector-length vec))))

      (display (format #f "~8a: ~a\n"
		       (if (vector-ref vec i)
			   "#t"
			   "") (car l))))))

(define (show-coverage)
  (newline)
  (hash-fold
   (lambda (key val acc)
     (display-coverage key val)
     #t)
   #t
   coverage-table))

(define (record-coverage key cont exp env)
  (let*
      ((name (source-property exp 'filename))
       (line (source-property exp 'line))
       (vec (and name (hashv-ref coverage-table name #f)))
       (veclen (and vec (vector-length vec)))
       (veccopy (lambda (src dst)
		  (vector-move-left! src 0 (vector-length src)
				     dst 0)
		  dst)))

    (if (and line name)
	(begin
	  (if (or (not vec) (>= line (vector-length vec)))
	      (set! vec
		    (hashv-set! coverage-table name
				(if vec
				    (veccopy vec (make-vector (1+ line) #f))
				    (make-vector (1+ line) #f)))))

	  (display (vector-length vec))
	  (vector-set! vec line #t))
    )))

(trap-set! memoize-symbol-handler record-coverage)
(trap-enable 'memoize-symbol)

***


-- 
 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

Re: [PATCH] experimental lookupcar based coverage testing.

[Ludovic Courtès]

Hi,

Han-Wen Nienhuys <hanwen@xs4all.nl> writes:

> This is now in CVS, along with a couple of other changes. 

Thanks!

Just a minor note: Could you make sure you follow the GNU style for,
e.g., comments [0]?

One could argue it's poor man's coverage test since, unlike with `gcov',
one cannot know how many times a specific source line of code was
executed.  It's also quite dependent on the current implementation of
the evaluator and memoization.  But I agree that it's still a very
useful tool.  ;-)

Ludovic.

[0] http://www.gnu.org/prep/standards/html_node/Comments.html#Comments



_______________________________________________
Guile-devel mailing list
Guile-devel@gnu.org
http://lists.gnu.org/mailman/listinfo/guile-devel

Re: [PATCH] experimental lookupcar based coverage testing.

[Han-Wen Nienhuys]

Ludovic Courtès escreveu:
> Hi,
> 
> Han-Wen Nienhuys <hanwen@xs4all.nl> writes:
> 
>> This is now in CVS, along with a couple of other changes. 
> 
> Thanks!
> 
> Just a minor note: Could you make sure you follow the GNU style for,
> e.g., comments [0]?

can you be more specific?  According to the URL that you posted, all GUILE
multiline comments are non-GNU conformant, wrt. the opening * on each line.
 

-- 
 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

Re: [PATCH] experimental lookupcar based coverage testing.

[Ludovic Courtès]

Hi,

Han-Wen Nienhuys <hanwen@xs4all.nl> writes:

> can you be more specific?  According to the URL that you posted, all GUILE
> multiline comments are non-GNU conformant, wrt. the opening * on each line.

Yes, the `*' opening on each line (many comments in Guile have it, not
all), the empty first and last lines as in:

  /*
   hello
   */

The comment in srcprop.c:61 is also a bit terse IMO.  ;-)

Thanks,
Ludovic.


_______________________________________________
Guile-devel mailing list
Guile-devel@gnu.org
http://lists.gnu.org/mailman/listinfo/guile-devel