[Guile-commits] GNU Guile branch, master, updated. release_1-9-8-84-g9f07451

[Andy Wingo]

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=9f0745183605c4f2997b95c421637678ca5e5e2a

The branch, master has been updated
       via  9f0745183605c4f2997b95c421637678ca5e5e2a (commit)
       via  c6a32a2cd59190dcf17c7fb3022588f56079a03e (commit)
      from  8fc43b12c71789030d9058fea8b6eff5490dec27 (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 9f0745183605c4f2997b95c421637678ca5e5e2a
Author: Andy Wingo <address@hidden>
Date:   Thu Mar 11 22:36:15 2010 +0100

    add abort to unknown prompt test
    
    * libguile/control.c (scm_c_abort): Change error string if a prompt
      isn't found.
    
    * test-suite/tests/control.test ("abort to unknown prompt"): New test.

commit c6a32a2cd59190dcf17c7fb3022588f56079a03e
Author: Andy Wingo <address@hidden>
Date:   Thu Mar 11 22:31:29 2010 +0100

    remove internal treatment of default prompt tag, it seems there was no need
    
    * libguile/control.h (scm_sys_default_prompt_tag):
    * libguile/control.c (scm_init_control): Remove the logic that defined
      %default-prompt-tag.
      (scm_c_abort): Remove check for default prompt tag, it wasn't useful.
    
    * libguile/throw.c (sym_pre_init_catch_tag): Define as the pre-init
      prompt tag.
      (pre_init_catch, pre_init_throw): Use sym_pre_init_catch_tag.
    
    * module/ice-9/boot-9.scm (default-prompt-tag): Define as a simple
      value, not a fluid. Perhaps we can expose it as a fluid later.

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

Summary of changes:
 libguile/control.c            |   19 ++-----------------
 libguile/control.h            |    3 ---
 libguile/throw.c              |    7 +++++--
 module/ice-9/boot-9.scm       |    7 +++++--
 test-suite/tests/control.test |    4 ++++
 5 files changed, 16 insertions(+), 24 deletions(-)

diff --git a/libguile/control.c b/libguile/control.c
index 7e51e1e..bb35fdf 100644
--- a/libguile/control.c
+++ b/libguile/control.c
@@ -28,8 +28,6 @@
 
 
 
-SCM scm_sys_default_prompt_tag;
-
 
 SCM
 scm_c_make_prompt (SCM k, SCM *fp, SCM *sp, scm_t_uint8 *abort_ip,
@@ -207,19 +205,9 @@ scm_c_abort (SCM vm, SCM tag, size_t n, SCM *argv, 
scm_t_int64 cookie)
         }
     }
   
-  /* If we didn't find anything, print a message and abort the process
-     right here.  If you don't want this, establish a catch-all around
-     any code that might throw up. */
+  /* If we didn't find anything, raise an error. */
   if (scm_is_false (prompt))
-    {
-      if (scm_is_eq (tag, scm_fluid_ref (scm_sys_default_prompt_tag)))
-        {
-          fprintf (stderr, "No prompt found for abort to default prompt 
tag!\n");
-          abort ();
-        }
-      else
-        scm_misc_error ("abort", "abort to unknown tag", scm_list_1 (tag));
-    }
+    scm_misc_error ("abort", "Abort to unknown prompt", scm_list_1 (tag));
 
   cont = reify_partial_continuation (vm, prompt, winds, cookie);
 
@@ -285,9 +273,6 @@ void
 scm_init_control (void)
 {
 #include "libguile/control.x"
-  scm_sys_default_prompt_tag = scm_make_fluid ();
-  scm_fluid_set_x (scm_sys_default_prompt_tag, scm_gensym (SCM_UNDEFINED));
-  scm_c_define ("%default-prompt-tag", scm_sys_default_prompt_tag);
 }
 
 /*
diff --git a/libguile/control.h b/libguile/control.h
index 74a1329..bbc4c20 100644
--- a/libguile/control.h
+++ b/libguile/control.h
@@ -41,9 +41,6 @@ struct scm_prompt_registers
 };
 
 
-SCM_INTERNAL SCM scm_sys_default_prompt_tag;
-
-
 SCM_INTERNAL SCM scm_c_make_prompt (SCM k, SCM *fp, SCM *sp,
                                     scm_t_uint8 *abort_ip,
                                     scm_t_uint8 escape_only_p,
diff --git a/libguile/throw.c b/libguile/throw.c
index 04bcba8..595e3be 100644
--- a/libguile/throw.c
+++ b/libguile/throw.c
@@ -498,6 +498,9 @@ scm_ithrow (SCM key, SCM args, int noreturn SCM_UNUSED)
 /* Unfortunately we have to support catch and throw before boot-9 has, um,
    booted. So here are lame versions, which will get replaced with their scheme
    equivalents. */
+
+SCM_SYMBOL (sym_pre_init_catch_tag, "%pre-init-catch-tag");
+
 static SCM
 pre_init_catch (SCM tag, SCM thunk, SCM handler, SCM pre_unwind_handler)
 {
@@ -510,7 +513,7 @@ pre_init_catch (SCM tag, SCM thunk, SCM handler, SCM 
pre_unwind_handler)
     abort ();
 
   vm = scm_the_vm ();
-  prompt = scm_c_make_prompt (scm_fluid_ref (scm_sys_default_prompt_tag),
+  prompt = scm_c_make_prompt (sym_pre_init_catch_tag,
                               SCM_VM_DATA (vm)->fp, SCM_VM_DATA (vm)->sp,
                               SCM_VM_DATA (vm)->ip, 1, -1, scm_i_dynwinds ());
   scm_i_set_dynwinds (scm_cons (prompt, SCM_PROMPT_DYNWINDS (prompt)));
@@ -532,7 +535,7 @@ pre_init_catch (SCM tag, SCM thunk, SCM handler, SCM 
pre_unwind_handler)
 static SCM
 pre_init_throw (SCM args)
 {
-  return scm_at_abort (scm_fluid_ref (scm_sys_default_prompt_tag), args);
+  return scm_at_abort (sym_pre_init_catch_tag, args);
 }
 
 void
diff --git a/module/ice-9/boot-9.scm b/module/ice-9/boot-9.scm
index 49127b0..5c777f4 100644
--- a/module/ice-9/boot-9.scm
+++ b/module/ice-9/boot-9.scm
@@ -48,10 +48,13 @@
 ;; Define delimited continuation operators, and implement catch and throw in
 ;; terms of them.
 
-(define (default-prompt-tag)
-  (fluid-ref %default-prompt-tag))
 (define (make-prompt-tag . stem)
   (gensym (if (pair? stem) (car stem) "prompt")))
+(define default-prompt-tag
+  ;; not sure if we should expose this to the user as a fluid
+  (let ((%default-prompt-tag (make-prompt-tag)))
+    (lambda ()
+      %default-prompt-tag)))
 
 (define (call-with-prompt tag thunk handler)
   (@prompt tag (thunk) handler))
diff --git a/test-suite/tests/control.test b/test-suite/tests/control.test
index 9937910..b3ab707 100644
--- a/test-suite/tests/control.test
+++ b/test-suite/tests/control.test
@@ -221,3 +221,7 @@
                    (lambda (k x) x))
                 (lambda (k) k))))
       (k))))
+
+(with-test-prefix "abort to unknown prompt"
+  (pass-if-exception "foo" '(misc-error . "^Abort to unknown prompt")
+                     (abort-to-prompt 'does-not-exist)))


hooks/post-receive
-- 
GNU Guile