[Guile-commits] GNU Guile branch, master, updated. release_1-9-8-41-gce4c9a6

[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=ce4c9a6d00a647892e25d24d703f328afb4be9c3

The branch, master has been updated
       via  ce4c9a6d00a647892e25d24d703f328afb4be9c3 (commit)
       via  0404c97dc904272ec8a55cacbe639dc52de2830e (commit)
       via  c8df99730a6d2eaaaa6bd1216c4c7394a691ee7f (commit)
       via  211fcbc8cdfb0834a6675dc8454994472ed7ce3f (commit)
      from  3ccee39194a2ae967eb12dd9c0adceeddb305646 (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 ce4c9a6d00a647892e25d24d703f328afb4be9c3
Author: Andy Wingo <address@hidden>
Date:   Wed Feb 24 23:33:20 2010 +0100

    start of tests for (ice-9 control)
    
    * test-suite/Makefile.am:
    * test-suite/tests/control.test: Add the beginnings of a delimited
      continuations test suite.

commit 0404c97dc904272ec8a55cacbe639dc52de2830e
Author: Andy Wingo <address@hidden>
Date:   Wed Feb 24 23:32:04 2010 +0100

    fix symbol initialization in vm.c
    
    * libguile/vm.c (scm_bootstrap_vm): Fix case in which some symbols
      wouldn't be initialized by the time they were needed.

commit c8df99730a6d2eaaaa6bd1216c4c7394a691ee7f
Author: Andy Wingo <address@hidden>
Date:   Wed Feb 24 23:20:38 2010 +0100

    (ice-9 control) fixes
    
    * module/ice-9/control.scm (%): Fix to allow tagged and default-tagged
      prompts.
      (abort): Re-export.

commit 211fcbc8cdfb0834a6675dc8454994472ed7ce3f
Author: Andy Wingo <address@hidden>
Date:   Wed Feb 24 23:19:41 2010 +0100

    fix escape-only prompts
    
    * libguile/control.c (scm_c_make_prompt): Whoops, set the escape-only
      flag properly here.

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

Summary of changes:
 libguile/control.c            |    2 +-
 libguile/vm.c                 |   12 +++++++---
 module/ice-9/control.scm      |   10 +++++++-
 test-suite/Makefile.am        |    1 +
 test-suite/tests/control.test |   46 +++++++++++++++++++++++++++++++++++++++++
 5 files changed, 64 insertions(+), 7 deletions(-)
 create mode 100644 test-suite/tests/control.test

diff --git a/libguile/control.c b/libguile/control.c
index 05a8dab..9f23f30 100644
--- a/libguile/control.c
+++ b/libguile/control.c
@@ -41,7 +41,7 @@ scm_c_make_prompt (SCM vm, SCM k, scm_t_uint8 escape_only_p,
 
   tag = scm_tc7_prompt;
   if (escape_only_p)
-    tag |= SCM_F_PROMPT_ESCAPE;
+    tag |= (SCM_F_PROMPT_ESCAPE<<8);
   ret = scm_words (tag, 5);
 
   regs = scm_gc_malloc_pointerless (sizeof (*regs), "prompt registers");
diff --git a/libguile/vm.c b/libguile/vm.c
index eb11cd0..f53aaf5 100644
--- a/libguile/vm.c
+++ b/libguile/vm.c
@@ -293,10 +293,9 @@ vm_reinstate_partial_continuation (SCM vm, SCM cont, SCM 
intwinds,
  * VM Internal functions
  */
 
-SCM_SYMBOL (sym_vm_run, "vm-run");
-SCM_SYMBOL (sym_vm_error, "vm-error");
-SCM_SYMBOL (sym_keyword_argument_error, "keyword-argument-error");
-SCM_SYMBOL (sym_debug, "debug");
+/* Unfortunately we can't snarf these: snarfed things are only loaded up from
+   (system vm vm), which might not be loaded before an error happens. */
+static SCM sym_vm_run, sym_vm_error, sym_keyword_argument_error, sym_debug;
 
 void
 scm_i_vm_print (SCM x, SCM port, scm_print_state *pstate)
@@ -753,6 +752,11 @@ scm_bootstrap_vm (void)
   scm_c_register_extension ("libguile", "scm_init_vm",
                             (scm_t_extension_init_func)scm_init_vm, NULL);
 
+  sym_vm_run = scm_from_locale_string ("vm-run");
+  sym_vm_error = scm_from_locale_string ("vm-error");
+  sym_keyword_argument_error = scm_from_locale_string 
("keyword-argument-error");
+  sym_debug = scm_from_locale_string ("debug");
+
 #ifdef VM_ENABLE_PRECISE_STACK_GC_SCAN
   vm_stack_gc_kind =
     GC_new_kind (GC_new_free_list (),
diff --git a/module/ice-9/control.scm b/module/ice-9/control.scm
index a621e8d..482a24e 100644
--- a/module/ice-9/control.scm
+++ b/module/ice-9/control.scm
@@ -19,7 +19,7 @@
 ;;; Code:
 
 (define-module (ice-9 control)
-  #:re-export (prompt)
+  #:re-export (prompt abort)
   #:export (% control))
 
 ;; the same as abort.
@@ -29,4 +29,10 @@
 (define-syntax %
   (syntax-rules ()
     ((_ expr handler)
-     (prompt (lambda () expr) handler))))
+     (prompt (fluid-ref %default-prompt-tag)
+             (lambda () expr)
+             handler))
+    ((_ tag expr handler)
+     (prompt tag
+             (lambda () expr)
+             handler))))
diff --git a/test-suite/Makefile.am b/test-suite/Makefile.am
index 3d6bf80..36afa25 100644
--- a/test-suite/Makefile.am
+++ b/test-suite/Makefile.am
@@ -31,6 +31,7 @@ SCM_TESTS = tests/alist.test                  \
            tests/c-api.test                    \
            tests/chars.test                    \
            tests/common-list.test              \
+           tests/control.test                  \
            tests/continuations.test            \
            tests/elisp.test                    \
            tests/elisp-compiler.test           \
diff --git a/test-suite/tests/control.test b/test-suite/tests/control.test
new file mode 100644
index 0000000..fab2f60
--- /dev/null
+++ b/test-suite/tests/control.test
@@ -0,0 +1,46 @@
+;;;;                                                          -*- scheme -*-
+;;;; control.test --- test suite for delimited continuations
+;;;;
+;;;; Copyright (C) 2010 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
+;;;; License as published by the Free Software Foundation; either
+;;;; version 3 of the License, or (at your option) any later version.
+;;;; 
+;;;; This library is distributed in the hope that it will be useful,
+;;;; but WITHOUT ANY WARRANTY; without even the implied warranty of
+;;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
+;;;; Lesser General Public License for more details.
+;;;; 
+;;;; You should have received a copy of the GNU Lesser General Public
+;;;; License along with this library; if not, write to the Free Software
+;;;; Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 
USA
+
+(define-module (test-suite test-control)
+  #:use-module (ice-9 control)
+  #:use-module (test-suite lib))
+
+
+(define default-tag (fluid-ref %default-prompt-tag))
+
+
+(with-test-prefix "escape-only continuations"
+  (pass-if "no values, normal exit"
+    (equal? '()
+            (call-with-values
+                (lambda ()
+                  (% default-tag
+                     (values)
+                     (lambda (k . args)
+                       (error "unexpected exit" args))))
+              list)))
+  (pass-if "no values, normal exit"
+    (equal? '()
+            (% default-tag
+               (begin
+                 (abort default-tag)
+                 (error "unexpected exit"))
+               (lambda (k . args)
+                 args)))))
+


hooks/post-receive
-- 
GNU Guile