mirror of
https://git.savannah.gnu.org/git/guile.git
synced 2025-04-29 19:30:36 +02:00
This includes <assert.h>, <ctype.h>, <errno.h>, <float.h>, <iso646.h>, <limits.h>, <locale.h>, <math.h>, <setjmp.h>, <signal.h>, <stdarg.h>, <stddef.h>, <stdio.h>, <stdlib.h>, <string.h>, <time.h>, <wchar.h>, and <wctype.h>. * configure.ac: don't check for <limits.h>, <string.h>, <time.h>, <assert.h>. Remove AC_INCLUDES_DEFAULT macro * libguile/bytevectors.c: include <limits.h>, remove HAVE_LIMITS_H * libguile/filesys.c: include <string.h>, remove HAVE_STRING_H * libguile/fports.c: include <string.h>, remove HAVE_STRING_H * libguile/gen-scmconfig.c: remove HAVE_LIMITS_H, HAVE_TIME_H, STDC_HEADERS Remove SCM_HAVE_STDC_HEADERS * libguile/hash.c: include <wchar.h>, remove HAVE_WCHAR_H * libguile/net_db.c: include <string.h>, remove HAVE_STRING_H * libguile/numbers.h: remove SCM_HAVE_STDC_HEADERS * libguile/regex-posix.c: include <wchar.h>, remove HAVE_WCHAR_H (fixup_multibyte_match): always defined (scm_regexp_exec): use fixup_multibyte_match * libguile/scmsigs.c: remove STDC_HEADERS * libguile/socket.c: include <string.h>, remove HAVE_STRING_H * test-suite/standalone/test-unwind.c: include <string.h>, remove HAVE_STRING_H
309 lines
6.4 KiB
C
309 lines
6.4 KiB
C
/* Copyright 2004-2005,2008-2010,2013,2018-2019
|
|
Free Software Foundation, Inc.
|
|
|
|
This file is part of Guile.
|
|
|
|
Guile 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.
|
|
|
|
Guile 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 Guile. If not, see
|
|
<https://www.gnu.org/licenses/>. */
|
|
|
|
#if HAVE_CONFIG_H
|
|
# include <config.h>
|
|
#endif
|
|
|
|
#include <alloca.h>
|
|
|
|
#include <libguile.h>
|
|
#include <stdlib.h>
|
|
#include <stdio.h>
|
|
#include <unistd.h>
|
|
#include <string.h>
|
|
|
|
void set_flag (void *data);
|
|
void func1 (void);
|
|
void func2 (void);
|
|
void func3 (void);
|
|
void func4 (void);
|
|
void check_flag1 (const char *msg, void (*func)(void), int val);
|
|
SCM check_flag1_body (void *data);
|
|
SCM return_tag (void *data, SCM tag, SCM args);
|
|
void check_cont (int rewindable);
|
|
SCM check_cont_body (void *data);
|
|
void close_port (SCM port);
|
|
void delete_file (void *data);
|
|
void check_ports (void);
|
|
void check_fluid (void);
|
|
|
|
int flag1, flag2, flag3;
|
|
|
|
void
|
|
set_flag (void *data)
|
|
{
|
|
int *f = (int *)data;
|
|
*f = 1;
|
|
}
|
|
|
|
/* FUNC1 should leave flag1 zero.
|
|
*/
|
|
|
|
void
|
|
func1 ()
|
|
{
|
|
scm_dynwind_begin (0);
|
|
flag1 = 0;
|
|
scm_dynwind_unwind_handler (set_flag, &flag1, 0);
|
|
scm_dynwind_end ();
|
|
}
|
|
|
|
/* FUNC2 should set flag1.
|
|
*/
|
|
|
|
void
|
|
func2 ()
|
|
{
|
|
scm_dynwind_begin (0);
|
|
flag1 = 0;
|
|
scm_dynwind_unwind_handler (set_flag, &flag1, SCM_F_WIND_EXPLICITLY);
|
|
scm_dynwind_end ();
|
|
}
|
|
|
|
/* FUNC3 should set flag1.
|
|
*/
|
|
|
|
void
|
|
func3 ()
|
|
{
|
|
scm_dynwind_begin (0);
|
|
flag1 = 0;
|
|
scm_dynwind_unwind_handler (set_flag, &flag1, 0);
|
|
scm_misc_error ("func3", "gratuitous error", SCM_EOL);
|
|
scm_dynwind_end ();
|
|
}
|
|
|
|
/* FUNC4 should set flag1.
|
|
*/
|
|
|
|
void
|
|
func4 ()
|
|
{
|
|
scm_dynwind_begin (0);
|
|
flag1 = 0;
|
|
scm_dynwind_unwind_handler (set_flag, &flag1, SCM_F_WIND_EXPLICITLY);
|
|
scm_misc_error ("func4", "gratuitous error", SCM_EOL);
|
|
scm_dynwind_end ();
|
|
}
|
|
|
|
SCM
|
|
check_flag1_body (void *data)
|
|
{
|
|
void (*f)(void) = (void (*)(void))data;
|
|
f ();
|
|
return SCM_UNSPECIFIED;
|
|
}
|
|
|
|
SCM
|
|
return_tag (void *data, SCM tag, SCM args)
|
|
{
|
|
return tag;
|
|
}
|
|
|
|
void
|
|
check_flag1 (const char *tag, void (*func)(void), int val)
|
|
{
|
|
scm_internal_catch (SCM_BOOL_T,
|
|
check_flag1_body, func,
|
|
return_tag, NULL);
|
|
if (flag1 != val)
|
|
{
|
|
printf ("%s failed\n", tag);
|
|
exit (EXIT_FAILURE);
|
|
}
|
|
}
|
|
|
|
SCM
|
|
check_cont_body (void *data)
|
|
{
|
|
scm_t_dynwind_flags flags = (data? SCM_F_DYNWIND_REWINDABLE : 0);
|
|
SCM val;
|
|
|
|
scm_dynwind_begin (flags);
|
|
val = scm_c_eval_string ("(call/cc (lambda (k) k))");
|
|
scm_dynwind_end ();
|
|
return val;
|
|
}
|
|
|
|
void
|
|
check_cont (int rewindable)
|
|
{
|
|
SCM res;
|
|
|
|
res = scm_internal_catch (SCM_BOOL_T,
|
|
check_cont_body, (void *)(long)rewindable,
|
|
return_tag, NULL);
|
|
|
|
/* RES is now either the created continuation, the value passed to
|
|
the continuation, or a catch-tag, such as 'misc-error.
|
|
*/
|
|
|
|
if (scm_is_true (scm_procedure_p (res)))
|
|
{
|
|
/* a continuation, invoke it */
|
|
scm_call_1 (res, SCM_BOOL_F);
|
|
}
|
|
else if (scm_is_false (res))
|
|
{
|
|
/* the result of invoking the continuation, dynwind must be
|
|
rewindable */
|
|
if (rewindable)
|
|
return;
|
|
printf ("continuation not blocked\n");
|
|
exit (EXIT_FAILURE);
|
|
}
|
|
else
|
|
{
|
|
/* the catch tag, dynwind must not have been rewindable. */
|
|
if (!rewindable)
|
|
return;
|
|
printf ("continuation didn't work\n");
|
|
exit (EXIT_FAILURE);
|
|
}
|
|
}
|
|
|
|
void
|
|
close_port (SCM port)
|
|
{
|
|
scm_close_port (port);
|
|
}
|
|
|
|
void
|
|
delete_file (void *data)
|
|
{
|
|
unlink ((char *)data);
|
|
}
|
|
|
|
void
|
|
check_ports ()
|
|
{
|
|
#define FILENAME_TEMPLATE "/check-ports.XXXXXX"
|
|
char *filename;
|
|
const char *tmpdir = getenv ("TMPDIR");
|
|
int fd;
|
|
#ifdef __MINGW32__
|
|
extern int mkstemp (char *);
|
|
|
|
/* On Windows neither $TMPDIR nor /tmp can be relied on. */
|
|
if (tmpdir == NULL)
|
|
tmpdir = getenv ("TEMP");
|
|
if (tmpdir == NULL)
|
|
tmpdir = getenv ("TMP");
|
|
if (tmpdir == NULL)
|
|
tmpdir = "/";
|
|
#else
|
|
if (tmpdir == NULL)
|
|
tmpdir = "/tmp";
|
|
#endif
|
|
|
|
filename = alloca (strlen (tmpdir) + sizeof (FILENAME_TEMPLATE) + 1);
|
|
strcpy (filename, tmpdir);
|
|
strcat (filename, FILENAME_TEMPLATE);
|
|
|
|
/* Sanity check: Make sure that `filename' is actually writeable.
|
|
We used to use mktemp(3), but that is now considered a security risk. */
|
|
fd = mkstemp (filename);
|
|
if (fd < 0)
|
|
exit (EXIT_FAILURE);
|
|
close (fd);
|
|
|
|
scm_dynwind_begin (0);
|
|
{
|
|
SCM port = scm_open_file (scm_from_locale_string (filename),
|
|
scm_from_locale_string ("w"));
|
|
scm_dynwind_unwind_handler_with_scm (close_port, port,
|
|
SCM_F_WIND_EXPLICITLY);
|
|
|
|
scm_dynwind_current_output_port (port);
|
|
scm_write (scm_version (), SCM_UNDEFINED);
|
|
}
|
|
scm_dynwind_end ();
|
|
|
|
scm_dynwind_begin (0);
|
|
{
|
|
SCM port = scm_open_file (scm_from_locale_string (filename),
|
|
scm_from_locale_string ("r"));
|
|
SCM res;
|
|
scm_dynwind_unwind_handler_with_scm (close_port, port,
|
|
SCM_F_WIND_EXPLICITLY);
|
|
scm_dynwind_unwind_handler (delete_file, filename, SCM_F_WIND_EXPLICITLY);
|
|
|
|
scm_dynwind_current_input_port (port);
|
|
res = scm_read (SCM_UNDEFINED);
|
|
if (scm_is_false (scm_equal_p (res, scm_version ())))
|
|
{
|
|
printf ("ports didn't work\n");
|
|
exit (EXIT_FAILURE);
|
|
}
|
|
}
|
|
scm_dynwind_end ();
|
|
#undef FILENAME_TEMPLATE
|
|
}
|
|
|
|
void
|
|
check_fluid ()
|
|
{
|
|
SCM f = scm_make_fluid ();
|
|
SCM x;
|
|
|
|
scm_fluid_set_x (f, scm_from_int (12));
|
|
|
|
scm_dynwind_begin (0);
|
|
scm_dynwind_fluid (f, scm_from_int (13));
|
|
x = scm_fluid_ref (f);
|
|
scm_dynwind_end ();
|
|
|
|
if (!scm_is_eq (x, scm_from_int (13)))
|
|
{
|
|
printf ("setting fluid didn't work\n");
|
|
exit (EXIT_FAILURE);
|
|
}
|
|
|
|
if (!scm_is_eq (scm_fluid_ref (f), scm_from_int (12)))
|
|
{
|
|
printf ("resetting fluid didn't work\n");
|
|
exit (EXIT_FAILURE);
|
|
}
|
|
}
|
|
|
|
static void
|
|
inner_main (void *data, int argc, char **argv)
|
|
{
|
|
check_flag1 ("func1", func1, 0);
|
|
check_flag1 ("func2", func2, 1);
|
|
check_flag1 ("func3", func3, 1);
|
|
check_flag1 ("func4", func4, 1);
|
|
|
|
check_cont (0);
|
|
check_cont (1);
|
|
|
|
check_ports ();
|
|
|
|
check_fluid ();
|
|
|
|
exit (EXIT_SUCCESS);
|
|
}
|
|
|
|
int
|
|
main (int argc, char **argv)
|
|
{
|
|
scm_boot_guile (argc, argv, inner_main, 0);
|
|
return 0;
|
|
}
|