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:
parent
d7418e60a5
commit
b86d230932
3 changed files with 61 additions and 64 deletions
|
@ -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;
|
||||
}
|
||||
|
|
Loading…
Add table
Add a link
Reference in a new issue