diff options
-rw-r--r-- | doc/ref/api-control.texi | 7 | ||||
-rw-r--r-- | libguile/values.c | 25 | ||||
-rw-r--r-- | libguile/values.h | 1 | ||||
-rw-r--r-- | test-suite/standalone/Makefile.am | 7 | ||||
-rw-r--r-- | test-suite/standalone/test-scm-values.c | 69 |
5 files changed, 109 insertions, 0 deletions
diff --git a/doc/ref/api-control.texi b/doc/ref/api-control.texi index c1502b032..559677874 100644 --- a/doc/ref/api-control.texi +++ b/doc/ref/api-control.texi @@ -785,6 +785,13 @@ the current implementation that object shares structure with @var{args}, so @var{args} should not be modified subsequently. @end deffn +@deffn {C Function} scm_c_value_ref (values, idx) +Returns the value at the position specified by @var{idx} in +@var{values}. Note that @var{values} will ordinarily be a +multiple-values object, but it need not be. Any other object +represents a single value (itself), and is handled appropriately. +@end deffn + @rnindex call-with-values @deffn {Scheme Procedure} call-with-values producer consumer Calls its @var{producer} argument with no values and a diff --git a/libguile/values.c b/libguile/values.c index ab7773141..9c9e5ff6d 100644 --- a/libguile/values.c +++ b/libguile/values.c @@ -67,6 +67,31 @@ print_values (SCM obj, SCM pwps) return SCM_UNSPECIFIED; } +SCM +scm_c_value_ref (SCM obj, size_t idx) +{ + if (SCM_LIKELY (SCM_VALUESP (obj))) + { + SCM values = scm_struct_ref (obj, SCM_INUM0); + size_t i = idx; + while (SCM_LIKELY (scm_is_pair (values))) + { + if (i == 0) + return SCM_CAR (values); + values = SCM_CDR (values); + i--; + } + } + else if (idx == 0) + return obj; + + scm_error (scm_out_of_range_key, + "scm_c_value_ref", + "Too few values in ~S to access index ~S", + scm_list_2 (obj, scm_from_unsigned_integer (idx)), + scm_list_1 (scm_from_unsigned_integer (idx))); +} + SCM_DEFINE (scm_values, "values", 0, 0, 1, (SCM args), "Delivers all of its arguments to its continuation. Except for\n" diff --git a/libguile/values.h b/libguile/values.h index 65ad8a119..5f79855be 100644 --- a/libguile/values.h +++ b/libguile/values.h @@ -33,6 +33,7 @@ SCM_API SCM scm_values_vtable; SCM_INTERNAL void scm_i_extract_values_2 (SCM obj, SCM *p1, SCM *p2); SCM_API SCM scm_values (SCM args); +SCM_API SCM scm_c_value_ref (SCM values, size_t idx); SCM_INTERNAL void scm_init_values (void); #endif /* SCM_VALUES_H */ diff --git a/test-suite/standalone/Makefile.am b/test-suite/standalone/Makefile.am index 08d249c48..d8cfafa25 100644 --- a/test-suite/standalone/Makefile.am +++ b/test-suite/standalone/Makefile.am @@ -189,6 +189,13 @@ test_scm_to_latin1_string_LDADD = $(LIBGUILE_LDADD) check_PROGRAMS += test-scm-to-latin1-string TESTS += test-scm-to-latin1-string +# test-scm-values +test_scm_values_SOURCES = test-scm-values.c +test_scm_values_CFLAGS = ${test_cflags} +test_scm_values_LDADD = $(LIBGUILE_LDADD) +check_PROGRAMS += test-scm-values +TESTS += test-scm-values + if HAVE_SHARED_LIBRARIES # test-extensions diff --git a/test-suite/standalone/test-scm-values.c b/test-suite/standalone/test-scm-values.c new file mode 100644 index 000000000..ece62dab6 --- /dev/null +++ b/test-suite/standalone/test-scm-values.c @@ -0,0 +1,69 @@ +/* Copyright (C) 2012 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 + */ + +#ifdef HAVE_CONFIG_H +# include <config.h> +#endif + +#include <assert.h> +#include <libguile.h> +#include <stdlib.h> +#include <string.h> + +static void +test_scm_c_value_ref_on_multiple_values () +{ + SCM values = scm_values (scm_list_3 (scm_from_latin1_string ("foo"), + scm_from_latin1_string ("bar"), + scm_from_latin1_string ("baz"))); + + char *foo = scm_to_latin1_string (scm_c_value_ref (values, 0)); + char *bar = scm_to_latin1_string (scm_c_value_ref (values, 1)); + char *baz = scm_to_latin1_string (scm_c_value_ref (values, 2)); + + assert (strcmp (foo, "foo") == 0); + assert (strcmp (bar, "bar") == 0); + assert (strcmp (baz, "baz") == 0); + + free (foo); + free (bar); + free (baz); +} + +static void +test_scm_c_value_ref_on_a_single_value () +{ + SCM value = scm_from_latin1_string ("foo"); + char *foo = scm_to_latin1_string (scm_c_value_ref (value, 0)); + assert (strcmp (foo, "foo") == 0); + free (foo); +} + +static void +tests (void *data, int argc, char **argv) +{ + test_scm_c_value_ref_on_multiple_values (); + test_scm_c_value_ref_on_a_single_value (); +} + +int +main (int argc, char *argv[]) +{ + scm_boot_guile (argc, argv, tests, NULL); + return 0; +} |