1
Fork 0
mirror of https://git.savannah.gnu.org/git/guile.git synced 2025-05-18 18:40:22 +02:00

SRFI-1: Rewrite break' and break!' in Scheme.

This partially reverts commit 6e9f3c2676
(Tue May 3 2005).

* module/srfi/srfi-1.scm (break, break!): New procedures.

* srfi/srfi-1.c (scm_srfi1_break, scm_srfi1_break_x): Rewrite as
  proxies to the corresponding Scheme procedures.

* test-suite/standalone/test-srfi-1.c (failure): New function.
  (tests): Add `scm_srfi1_break' test.  Use `failure'.
This commit is contained in:
Ludovic Courtès 2010-08-27 15:43:30 +02:00
parent d7418e60a5
commit b86d230932
3 changed files with 61 additions and 64 deletions

View file

@ -27,10 +27,18 @@
#include <stdlib.h>
static void
failure (const char *proc, SCM result)
{
scm_simple_format (scm_current_error_port (),
scm_from_locale_string ("`~S' failed: ~S~%"),
scm_list_2 (scm_from_locale_symbol (proc), result));
}
static void *
tests (void *data)
{
SCM times, lst, result;
SCM times, negative_p, lst, result;
scm_init_srfi_1 ();
@ -41,9 +49,27 @@ tests (void *data)
result = scm_srfi1_fold (times, scm_from_int (1), lst, scm_list_1 (lst));
if (scm_to_int (result) == 36)
* (int *) data = EXIT_SUCCESS;
{
negative_p = SCM_VARIABLE_REF (scm_c_lookup ("negative?"));
result = scm_srfi1_break (negative_p,
scm_list_3 (scm_from_int (1),
scm_from_int (2),
scm_from_int (-1)));
if (SCM_VALUESP (result))
/* There's no API to access the values, so assume this is OK. */
* (int *) data = EXIT_SUCCESS;
else
{
failure ("break", result);
* (int *) data = EXIT_FAILURE;
}
}
else
* (int *) data = EXIT_FAILURE;
{
failure ("fold", result);
* (int *) data = EXIT_FAILURE;
}
return data;
}