--- /dev/null
+CC = gcc
+CFLAGS = -g `guile-config compile`
+
+all: strings
+
+strings: strings.o testlib.o
+ ${CC} ${CFLAGS} ${LDFLAGS} -o strings strings.o testlib.o \
+ `guile-config link`
+
+strings.o: strings.c testlib.h
+testlib.o: testlib.c testlib.h
+
+
+clean:
+ rm -f strings
+ rm -f *.o
--- /dev/null
+This directory contains tests for Guile's C API. At the moment, the
+test suite doesn't have any way to run these automatically --- we need
+to 1) figure out how to run the compiler, and 2) figure out how to
+integrate results from C tests into the test suite statistics.
+
+Nonetheless, it's better to have this code accumulating here than
+someplace else where nobody can find it.
--- /dev/null
+/* strings.c --- test the Guile C API's string handling functions
+ Jim Blandy <jimb@red-bean.com> --- August 1999 */
+
+#include <guile/gh.h>
+
+#include "testlib.h"
+
+static int
+string_equal (SCM str, char *lit)
+{
+ int len = strlen (lit);
+
+ return (SCM_LENGTH (str) == len
+ && ! memcmp (SCM_ROCHARS (str), lit, len));
+}
+
+void
+test_gh_set_substr ()
+{
+ test_context_t cx = test_enter_context ("gh_set_substr");
+ SCM string;
+
+ string = gh_str02scm ("Free, darnit!");
+ test_pass_if ("make a string", gh_string_p (string));
+
+ gh_set_substr ("dammit", string, 6, 6);
+ test_pass_if ("gh_set_substr from literal",
+ string_equal (string, "Free, dammit!"));
+
+ /* Make sure that we can use the string itself as a source.
+
+ I guess this behavior isn't really visible, since the GH API
+ doesn't provide any direct access to the string contents. But I
+ think it should, eventually. You can't write efficient string
+ code if you have to copy the string just to look at it. */
+
+ /* Copy a substring to an overlapping region to its right. */
+ gh_set_substr (SCM_CHARS (string), string, 4, 6);
+ test_pass_if ("gh_set_substr shifting right",
+ string_equal (string, "FreeFree, it!"));
+
+ string = gh_str02scm ("Free, darnit!");
+ test_pass_if ("make another string", gh_string_p (string));
+
+ /* Copy a substring to an overlapping region to its left. */
+ gh_set_substr (SCM_CHARS (string) + 6, string, 2, 6);
+ test_pass_if ("gh_set_substr shifting right",
+ string_equal (string, "Frdarnitrnit!"));
+
+ test_restore_context (cx);
+}
+
+void
+main_prog (int argc, char *argv[])
+{
+ test_context_t strings = test_enter_context ("strings.c");
+
+ test_gh_set_substr ();
+
+ test_restore_context (strings);
+
+ exit (test_summarize ());
+}
+
+int
+main (int argc, char *argv[])
+{
+ gh_enter (argc, argv, main_prog);
+ return 0;
+}
--- /dev/null
+/* testlib.c --- reporting test results
+ Jim Blandy <jimb@red-bean.com> --- August 1999 */
+
+#include <stdlib.h>
+#include <stdio.h>
+
+#include "testlib.h"
+
+
+\f
+/* Dying. */
+
+static void
+fatal (char *message)
+{
+ fprintf (stderr, "%s\n", message);
+ exit (1);
+}
+
+\f
+/* Contexts. */
+
+/* If it gets deeper than this, that's probably an error, right? */
+#define MAX_NESTING 10
+
+int depth = 0;
+char *context_name_stack[MAX_NESTING];
+int marker;
+int context_marker_stack[MAX_NESTING];
+
+test_context_t
+test_enter_context (char *name)
+{
+ if (depth >= MAX_NESTING)
+ fatal ("test contexts nested too deeply");
+
+ /* Generate a unique marker value for this context. */
+ marker++;
+
+ context_name_stack[depth] = name;
+ context_marker_stack[depth] = marker;
+
+ depth++;
+
+ return marker;
+}
+
+void
+test_restore_context (test_context_t context)
+{
+ if (depth <= 0)
+ fatal ("attempt to leave outermost context");
+
+ depth--;
+
+ /* Make sure that we're exiting the same context we last entered. */
+ if (context_marker_stack[depth] != context)
+ fatal ("contexts not nested properly");
+}
+
+\f
+/* Reporting results. */
+
+int count_passes, count_fails;
+
+static void
+print_test_name (char *name)
+{
+ int i;
+
+ for (i = 0; i < depth; i++)
+ printf ("%s: ", context_name_stack[i]);
+
+ printf ("%s", name);
+}
+
+static void
+print_result (char *result, char *name)
+{
+ printf ("%s: ", result);
+ print_test_name (name);
+ putchar ('\n');
+}
+
+void
+test_pass (char *name)
+{
+ print_result ("PASS", name);
+ count_passes++;
+}
+
+void
+test_fail (char *name)
+{
+ print_result ("FAIL", name);
+ count_fails++;
+}
+
+void
+test_pass_if (char *name, int condition)
+{
+ (condition ? test_pass : test_fail) (name);
+}
+
+\f
+/* Printing a summary. */
+
+/* Print a summary of the reported test results. Return zero if
+ no failures occurred, one otherwise. */
+
+int
+test_summarize ()
+{
+ putchar ('\n');
+
+ printf ("passes: %d\n", count_passes);
+ printf ("failures: %d\n", count_fails);
+ printf ("total tests: %d\n", count_passes + count_fails);
+
+ return (count_fails != 0);
+}
--- /dev/null
+/* testlib.h --- reporting test results
+ Jim Blandy <jimb@red-bean.com> --- August 1999 */
+
+#ifndef TESTLIB_H
+#define TESTLIB_H
+
+extern void test_pass (char *name);
+extern void test_fail (char *name);
+extern void test_pass_if (char *name, int condition);
+
+/* We need a way to keep track of what groups of tests we're currently
+ within. A call to test_enter_context assures that future tests
+ will be reported with a name prefixed by NAME, until we call
+ test_restore_context with the value it returned.
+
+ Calls to test_enter_context and test_restore_context should be
+ properly nested; passing the context around allows them to detect
+ mismatches.
+
+ It is the caller's responsibility to free NAME after exiting the
+ context. (This is trivial if you're passing string literals to
+ test_enter_context.) */
+
+typedef int test_context_t;
+extern test_context_t test_enter_context (char *name);
+extern void test_restore_context (test_context_t context);
+
+#endif /* TESTLIB_H */
HCoop / bpt / guile.git / commitdiff