guile-commits
[Top][All Lists]
Advanced

[Date Prev][Date Next][Thread Prev][Thread Next][Date Index][Thread Index]

[Guile-commits] GNU Guile branch, master, updated. release_1-9-2-68-gd5e


From: Neil Jerram
Subject: [Guile-commits] GNU Guile branch, master, updated. release_1-9-2-68-gd5ed380
Date: Fri, 21 Aug 2009 21:08:15 +0000

This is an automated email from the git hooks/post-receive script. It was
generated because a ref change was pushed to the repository containing
the project "GNU Guile".

http://git.savannah.gnu.org/cgit/guile.git/commit/?id=d5ed380ec83a2f42cacc40697717679bf03e6857

The branch, master has been updated
       via  d5ed380ec83a2f42cacc40697717679bf03e6857 (commit)
       via  1b872adf2e7d2a1e3e92f869e77f7810d4356e35 (commit)
       via  67a967348acc662c7d0a9844504c0d017619be99 (commit)
       via  916f175fb40cd20ee48f808b21d7a6a32d12dd17 (commit)
      from  5f5f251895818a8dec3acfc3832012088d07a7ee (commit)

Those revisions listed above that are new to this repository have
not appeared on any other notification email; so we list those
revisions in full, below.

- Log -----------------------------------------------------------------
commit d5ed380ec83a2f42cacc40697717679bf03e6857
Author: Neil Jerram <address@hidden>
Date:   Tue Aug 4 19:11:21 2009 +0100

    Remove trailing whitespace

commit 1b872adf2e7d2a1e3e92f869e77f7810d4356e35
Author: Neil Jerram <address@hidden>
Date:   Tue Aug 4 18:57:18 2009 +0100

    Fix set-source-properties so that the special source properties work
    
    * libguile/srcprop.c (scm_set_source_properties_x): Look for the special
      source properties, save them off, and then construct a srcprops object
      using them.

commit 67a967348acc662c7d0a9844504c0d017619be99
Author: Neil Jerram <address@hidden>
Date:   Tue Aug 4 18:54:50 2009 +0100

    In srcprop.c change all occurrences of "plist" to "alist"
    
    As with the previous commit, this is to avoid any suggestion that
    the source properties API uses the property list format, i.e.
    (key1 value1 key2 value2 ...).
    
    Also remove scm_srcprops_to_plist () from the API.  It doesn't have any
    external usefulness and has never documented.

commit 916f175fb40cd20ee48f808b21d7a6a32d12dd17
Author: Neil Jerram <address@hidden>
Date:   Tue Aug 4 15:40:06 2009 +0100

    Minor improvements to doc on source properties
    
    In particular avoid any suggestion that the API uses the
    property list format, i.e. (key1 value1 key2 value2 ...),
    as opposed to the alist format that it actually does use.

-----------------------------------------------------------------------

Summary of changes:
 doc/ref/api-debug.texi        |   18 +++---
 libguile/srcprop.c            |  139 ++++++++++++++++++++++++++++++-----------
 libguile/srcprop.h            |    2 -
 test-suite/tests/srcprop.test |   42 ++++++++++++-
 4 files changed, 152 insertions(+), 49 deletions(-)

diff --git a/doc/ref/api-debug.texi b/doc/ref/api-debug.texi
index 28dc732..42e0676 100644
--- a/doc/ref/api-debug.texi
+++ b/doc/ref/api-debug.texi
@@ -283,9 +283,9 @@ runs a script non-interactively.
 The following procedures can be used to access and set the source
 properties of read expressions.
 
address@hidden {Scheme Procedure} set-source-properties! obj plist
address@hidden {C Function} scm_set_source_properties_x (obj, plist)
-Install the association list @var{plist} as the source property
address@hidden {Scheme Procedure} set-source-properties! obj alist
address@hidden {C Function} scm_set_source_properties_x (obj, alist)
+Install the association list @var{alist} as the source property
 list for @var{obj}.
 @end deffn
 
@@ -302,12 +302,12 @@ Return the source property association list of @var{obj}.
 
 @deffn {Scheme Procedure} source-property obj key
 @deffnx {C Function} scm_source_property (obj, key)
-Return the source property specified by @var{key} from
address@hidden's source property list.
+Return the property specified by @var{key} from @var{obj}'s source
+properties.
 @end deffn
 
 In practice there are only two ways that you should use the ability to
-set an expression's source breakpoints.
+set an expression's source properties.
 
 @itemize
 @item
@@ -330,9 +330,9 @@ involved in a backtrace or error report.
 
 If you are looking for a way to attach arbitrary information to an
 expression other than these properties, you should use
address@hidden instead (@pxref{Object Properties}), because
-that will avoid bloating the source property hash table, which is really
-only intended for the specific purposes described in this section.
address@hidden instead (@pxref{Object Properties}).  That
+will avoid bloating the source property hash table, which is really
+only intended for the debugging purposes just described.
 
 
 @node Decoding Memoized Source Expressions
diff --git a/libguile/srcprop.c b/libguile/srcprop.c
index efa0b7f..8fa0393 100644
--- a/libguile/srcprop.c
+++ b/libguile/srcprop.c
@@ -68,7 +68,7 @@ SCM_GLOBAL_SYMBOL (scm_sym_breakpoint, "breakpoint");
  * car = tag
  * cbr = pos
  * ccr = copy
- * cdr = plist 
+ * cdr = alist
  */
 
 #define SRCPROPSP(p) (SCM_SMOB_PREDICATE (scm_tc16_srcprops, (p)))
@@ -77,7 +77,7 @@ SCM_GLOBAL_SYMBOL (scm_sym_breakpoint, "breakpoint");
 #define SRCPROPLINE(p) (SRCPROPPOS(p) >> 12)
 #define SRCPROPCOL(p) (SRCPROPPOS(p) & 0x0fffL)
 #define SRCPROPCOPY(p) (SCM_CELL_OBJECT(p,2))
-#define SRCPROPPLIST(p) (SCM_CELL_OBJECT_3(p))
+#define SRCPROPALIST(p) (SCM_CELL_OBJECT_3(p))
 #define SETSRCPROPBRK(p) \
  (SCM_SET_SMOB_FLAGS ((p), \
                       SCM_SMOB_FLAGS (p) | SCM_SOURCE_PROPERTY_FLAG_BREAK))
@@ -89,9 +89,11 @@ SCM_GLOBAL_SYMBOL (scm_sym_breakpoint, "breakpoint");
 #define SETSRCPROPLINE(p, l) SETSRCPROPPOS (p, l, SRCPROPCOL (p))
 #define SETSRCPROPCOL(p, c) SETSRCPROPPOS (p, SRCPROPLINE (p), c)
 #define SETSRCPROPCOPY(p, c) (SCM_SET_CELL_WORD(p, 2, c))
-#define SETSRCPROPPLIST(p, l) (SCM_SET_CELL_WORD(p, 3, l))
+#define SETSRCPROPALIST(p, l) (SCM_SET_CELL_WORD(p, 3, l))
 
 
+static SCM scm_srcprops_to_alist (SCM obj);
+
 
 scm_t_bits scm_tc16_srcprops;
 
@@ -99,7 +101,7 @@ static SCM
 srcprops_mark (SCM obj)
 {
   scm_gc_mark (SRCPROPCOPY (obj));
-  return SRCPROPPLIST (obj);
+  return SRCPROPALIST (obj);
 }
 
 static int
@@ -108,7 +110,7 @@ srcprops_print (SCM obj, SCM port, scm_print_state *pstate)
   int writingp = SCM_WRITINGP (pstate);
   scm_puts ("#<srcprops ", port);
   SCM_SET_WRITINGP (pstate, 1);
-  scm_iprin1 (scm_srcprops_to_plist (obj), port, pstate);
+  scm_iprin1 (scm_srcprops_to_alist (obj), port, pstate);
   SCM_SET_WRITINGP (pstate, writingp);
   scm_putc ('>', port);
   return 1;
@@ -124,57 +126,57 @@ scm_c_source_property_breakpoint_p (SCM form)
 
 
 /*
- * We remember the last file name settings, so we can share that plist
+ * We remember the last file name settings, so we can share that alist
  * entry.  This works because scm_set_source_property_x does not use
- * assoc-set! for modifying the plist.
+ * assoc-set! for modifying the alist.
  *
  * This variable contains a protected cons, whose cdr is the cached
- * plist
+ * alist
  */
-static SCM scm_last_plist_filename;
+static SCM scm_last_alist_filename;
 
 SCM
-scm_make_srcprops (long line, int col, SCM filename, SCM copy, SCM plist)
+scm_make_srcprops (long line, int col, SCM filename, SCM copy, SCM alist)
 {
   if (!SCM_UNBNDP (filename))
     {
-      SCM old_plist = plist;
+      SCM old_alist = alist;
 
       /*
        have to extract the acons, and operate on that, for
        thread safety.
        */
-      SCM last_acons = SCM_CDR (scm_last_plist_filename);
-      if (old_plist == SCM_EOL
+      SCM last_acons = SCM_CDR (scm_last_alist_filename);
+      if (old_alist == SCM_EOL
          && SCM_CDAR (last_acons) == filename)
        {
-         plist = last_acons;
+         alist = last_acons;
        }
       else
        {
-         plist = scm_acons (scm_sym_filename, filename, plist);
-         if (old_plist == SCM_EOL)
-           SCM_SETCDR (scm_last_plist_filename, plist);
+         alist = scm_acons (scm_sym_filename, filename, alist);
+         if (old_alist == SCM_EOL)
+           SCM_SETCDR (scm_last_alist_filename, alist);
        }
     }
   
   SCM_RETURN_NEWSMOB3 (scm_tc16_srcprops,
                       SRCPROPMAKPOS (line, col),
                       copy,
-                      plist);
+                      alist);
 }
 
 
-SCM
-scm_srcprops_to_plist (SCM obj)
+static SCM
+scm_srcprops_to_alist (SCM obj)
 {
-  SCM plist = SRCPROPPLIST (obj);
+  SCM alist = SRCPROPALIST (obj);
   if (!SCM_UNBNDP (SRCPROPCOPY (obj)))
-    plist = scm_acons (scm_sym_copy, SRCPROPCOPY (obj), plist);
-  plist = scm_acons (scm_sym_column, scm_from_int (SRCPROPCOL (obj)), plist);
-  plist = scm_acons (scm_sym_line, scm_from_int (SRCPROPLINE (obj)), plist);
-  plist = scm_acons (scm_sym_breakpoint, scm_from_bool (SRCPROPBRK (obj)), 
plist);
-  return plist;
+    alist = scm_acons (scm_sym_copy, SRCPROPCOPY (obj), alist);
+  alist = scm_acons (scm_sym_column, scm_from_int (SRCPROPCOL (obj)), alist);
+  alist = scm_acons (scm_sym_line, scm_from_int (SRCPROPLINE (obj)), alist);
+  alist = scm_acons (scm_sym_breakpoint, scm_from_bool (SRCPROPBRK (obj)), 
alist);
+  return alist;
 }
 
 SCM_DEFINE (scm_source_properties, "source-properties", 1, 0, 0, 
@@ -190,7 +192,7 @@ SCM_DEFINE (scm_source_properties, "source-properties", 1, 
0, 0,
     SCM_WRONG_TYPE_ARG (1, obj);
   p = scm_hashq_ref (scm_source_whash, obj, SCM_EOL);
   if (SRCPROPSP (p))
-    return scm_srcprops_to_plist (p);
+    return scm_srcprops_to_alist (p);
   else
     /* list from set-source-properties!, or SCM_EOL for not found */
     return p;
@@ -200,20 +202,83 @@ SCM_DEFINE (scm_source_properties, "source-properties", 
1, 0, 0,
 /* Perhaps this procedure should look through an alist
    and try to make a srcprops-object...? */
 SCM_DEFINE (scm_set_source_properties_x, "set-source-properties!", 2, 0, 0,
-            (SCM obj, SCM plist),
-           "Install the association list @var{plist} as the source property\n"
+            (SCM obj, SCM alist),
+           "Install the association list @var{alist} as the source property\n"
            "list for @var{obj}.")
 #define FUNC_NAME s_scm_set_source_properties_x
 {
   SCM handle;
+  long line = 0, col = 0;
+  SCM fname = SCM_UNDEFINED, copy = SCM_UNDEFINED, breakpoint = SCM_BOOL_F;
+  SCM others = SCM_EOL;
+  SCM *others_cdrloc = &others;
+  int need_srcprops = 0;
+  SCM tail, key;
+
   SCM_VALIDATE_NIM (1, obj);
   if (SCM_MEMOIZEDP (obj))
     obj = SCM_MEMOIZED_EXP (obj);
   else if (!scm_is_pair (obj))
     SCM_WRONG_TYPE_ARG(1, obj);
-  handle = scm_hashq_create_handle_x (scm_source_whash, obj, plist);
-  SCM_SETCDR (handle, plist);
-  return plist;
+
+  tail = alist;
+  while (!scm_is_null (tail))
+    {
+      key = SCM_CAAR (tail);
+      if (scm_is_eq (key, scm_sym_line))
+       {
+         line = scm_to_long (SCM_CDAR (tail));
+         need_srcprops = 1;
+       }
+      else if (scm_is_eq (key, scm_sym_column))
+       {
+         col = scm_to_long (SCM_CDAR (tail));
+         need_srcprops = 1;
+       }
+      else if (scm_is_eq (key, scm_sym_filename))
+       {
+         fname = SCM_CDAR (tail);
+         need_srcprops = 1;
+       }
+      else if (scm_is_eq (key, scm_sym_copy))
+       {
+         copy = SCM_CDAR (tail);
+         need_srcprops = 1;
+       }
+      else if (scm_is_eq (key, scm_sym_breakpoint))
+       {
+         breakpoint = SCM_CDAR (tail);
+         need_srcprops = 1;
+       }
+      else
+       {
+         /* Do we allocate here, or clobber the caller's alist?
+
+            Source properties aren't supposed to be used for anything
+            except the special properties above, so the mainline case
+            is that we never execute this else branch, and hence it
+            doesn't matter much.
+
+            We choose allocation here, as that seems safer.
+         */
+         *others_cdrloc = scm_cons (scm_cons (key, SCM_CDAR (tail)),
+                                    SCM_EOL);
+         others_cdrloc = SCM_CDRLOC (*others_cdrloc);
+       }
+      tail = SCM_CDR (tail);
+    }
+  if (need_srcprops)
+    {
+      alist = scm_make_srcprops (line, col, fname, copy, others);
+      if (scm_is_true (breakpoint))
+       SETSRCPROPBRK (alist);
+    }
+  else
+    alist = others;
+
+  handle = scm_hashq_create_handle_x (scm_source_whash, obj, alist);
+  SCM_SETCDR (handle, alist);
+  return alist;
 }
 #undef FUNC_NAME
 
@@ -231,15 +296,15 @@ SCM_DEFINE (scm_source_property, "source-property", 2, 0, 
0,
     SCM_WRONG_TYPE_ARG (1, obj);
   p = scm_hashq_ref (scm_source_whash, obj, SCM_EOL);
   if (!SRCPROPSP (p))
-    goto plist;
+    goto alist;
   if      (scm_is_eq (scm_sym_breakpoint, key)) p = scm_from_bool (SRCPROPBRK 
(p));
   else if (scm_is_eq (scm_sym_line,       key)) p = scm_from_int (SRCPROPLINE 
(p));
   else if (scm_is_eq (scm_sym_column,     key)) p = scm_from_int (SRCPROPCOL 
(p));
   else if (scm_is_eq (scm_sym_copy,       key)) p = SRCPROPCOPY (p);
   else
     {
-      p = SRCPROPPLIST (p);
-    plist:
+      p = SRCPROPALIST (p);
+    alist:
       p = scm_assoc (key, p);
       return (SCM_NIMP (p) ? SCM_CDR (p) : SCM_BOOL_F);
     }
@@ -315,7 +380,7 @@ SCM_DEFINE (scm_set_source_property_x, 
"set-source-property!", 3, 0, 0,
   else
     {
       if (SRCPROPSP (p))
-       SETSRCPROPPLIST (p, scm_acons (key, datum, SRCPROPPLIST (p)));
+       SETSRCPROPALIST (p, scm_acons (key, datum, SRCPROPALIST (p)));
       else
        SCM_WHASHSET (scm_source_whash, h, scm_acons (key, datum, p));
     }
@@ -334,7 +399,7 @@ scm_init_srcprop ()
   scm_source_whash = scm_make_weak_key_hash_table (scm_from_int (2047));
   scm_c_define ("source-whash", scm_source_whash);
 
-  scm_last_plist_filename
+  scm_last_alist_filename
     = scm_permanent_object (scm_cons (SCM_EOL,
                                      scm_acons (SCM_EOL, SCM_EOL, SCM_EOL)));
 
diff --git a/libguile/srcprop.h b/libguile/srcprop.h
index 2a27e04..89063be 100644
--- a/libguile/srcprop.h
+++ b/libguile/srcprop.h
@@ -64,13 +64,11 @@ SCM_API SCM scm_sym_breakpoint;
 
 
 SCM_API int scm_c_source_property_breakpoint_p (SCM form);
-SCM_API SCM scm_srcprops_to_plist (SCM obj);
 SCM_API SCM scm_make_srcprops (long line, int col, SCM fname, SCM copy, SCM 
plist);
 SCM_API SCM scm_source_property (SCM obj, SCM key);
 SCM_API SCM scm_set_source_property_x (SCM obj, SCM key, SCM datum);
 SCM_API SCM scm_source_properties (SCM obj);
 SCM_API SCM scm_set_source_properties_x (SCM obj, SCM props);
-SCM_API void scm_finish_srcprop (void);
 SCM_INTERNAL void scm_init_srcprop (void);
 
 #if SCM_ENABLE_DEPRECATED == 1
diff --git a/test-suite/tests/srcprop.test b/test-suite/tests/srcprop.test
index 8ec2989..17d8ae2 100644
--- a/test-suite/tests/srcprop.test
+++ b/test-suite/tests/srcprop.test
@@ -36,11 +36,51 @@
       (not (null? (source-properties s))))))
 
 ;;;
+;;; set-source-property!
+;;;
+
+(with-test-prefix "set-source-property!"
+  (read-enable 'positions)
+
+  (pass-if "setting the breakpoint property works"
+    (let ((s (read (open-input-string "(+ 3 4)"))))
+      (set-source-property! s 'breakpoint #t)
+      (let ((current-trap-opts (evaluator-traps-interface))
+           (current-debug-opts (debug-options-interface))
+           (trap-called #f))
+       (trap-set! enter-frame-handler (lambda _ (set! trap-called #t)))
+       (trap-enable 'traps)
+       (debug-enable 'debug)
+       (debug-enable 'breakpoints)
+       (with-traps (lambda ()
+                     (primitive-eval s)))
+       (evaluator-traps-interface current-trap-opts)
+       (debug-options-interface current-debug-opts)
+       trap-called))))
+
+;;;
 ;;; set-source-properties!
 ;;;
 
 (with-test-prefix "set-source-properties!"
   (read-enable 'positions)
+
+  (pass-if "setting the breakpoint property works"
+    (let ((s (read (open-input-string "(+ 3 4)"))))
+      (set-source-properties! s '((breakpoint #t)))
+      (let ((current-trap-opts (evaluator-traps-interface))
+           (current-debug-opts (debug-options-interface))
+           (trap-called #f))
+       (trap-set! enter-frame-handler (lambda _ (set! trap-called #t)))
+       (trap-enable 'traps)
+       (debug-enable 'debug)
+       (debug-enable 'breakpoints)
+       (with-traps (lambda ()
+                     (primitive-eval s)))
+       (evaluator-traps-interface current-trap-opts)
+       (debug-options-interface current-debug-opts)
+       trap-called)))
+
   (let ((s (read (open-input-string "(1 . 2)"))))
     
     (with-test-prefix "copied props"
@@ -48,7 +88,7 @@
        (let ((t (cons 3 4)))
          (set-source-properties! t (source-properties s))
          (number? (source-property t 'line))))
-      
+
       (pass-if "visible to source-properties"
        (let ((t (cons 3 4)))
          (set-source-properties! t (source-properties s))


hooks/post-receive
-- 
GNU Guile




reply via email to

[Prev in Thread] Current Thread [Next in Thread]