1 /* Copyright (C) 2004, 2005, 2008 Free Software Foundation, Inc.
3 * This library is free software; you can redistribute it and/or
4 * modify it under the terms of the GNU Lesser General Public
5 * License as published by the Free Software Foundation; either
6 * version 2.1 of the License, or (at your option) any later version.
8 * This library is distributed in the hope that it will be useful,
9 * but WITHOUT ANY WARRANTY; without even the implied warranty of
10 * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
11 * Lesser General Public License for more details.
13 * You should have received a copy of the GNU Lesser General Public
14 * License along with this library; if not, write to the Free Software
15 * Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA
22 /* This blob per the Autoconf manual (under "Particular Functions"), updated
23 to match that of Gnulib. */
27 # elif defined __GNUC__
28 # define alloca __builtin_alloca
30 # define alloca __alloca
31 # elif defined _MSC_VER
33 # define alloca _alloca
39 void *alloca (size_t);
53 void set_flag (void *data);
58 void check_flag1 (const char *msg, void (*func)(void), int val);
59 SCM check_flag1_body (void *data);
60 SCM return_tag (void *data, SCM tag, SCM args);
61 void check_cont (int rewindable);
62 SCM check_cont_body (void *data);
63 void close_port (SCM port);
64 void delete_file (void *data);
65 void check_ports (void);
66 void check_fluid (void);
68 int flag1, flag2, flag3;
77 /* FUNC1 should leave flag1 zero.
83 scm_dynwind_begin (0);
85 scm_dynwind_unwind_handler (set_flag, &flag1, 0);
89 /* FUNC2 should set flag1.
95 scm_dynwind_begin (0);
97 scm_dynwind_unwind_handler (set_flag, &flag1, SCM_F_WIND_EXPLICITLY);
101 /* FUNC3 should set flag1.
107 scm_dynwind_begin (0);
109 scm_dynwind_unwind_handler (set_flag, &flag1, 0);
110 scm_misc_error ("func3", "gratuitous error", SCM_EOL);
114 /* FUNC4 should set flag1.
120 scm_dynwind_begin (0);
122 scm_dynwind_unwind_handler (set_flag, &flag1, SCM_F_WIND_EXPLICITLY);
123 scm_misc_error ("func4", "gratuitous error", SCM_EOL);
128 check_flag1_body (void *data)
130 void (*f)(void) = (void (*)(void))data;
132 return SCM_UNSPECIFIED;
136 return_tag (void *data, SCM tag, SCM args)
142 check_flag1 (const char *tag, void (*func)(void), int val)
144 scm_internal_catch (SCM_BOOL_T,
145 check_flag1_body, func,
149 printf ("%s failed\n", tag);
155 check_cont_body (void *data)
157 scm_t_dynwind_flags flags = (data? SCM_F_DYNWIND_REWINDABLE : 0);
161 scm_dynwind_begin (flags);
163 val = scm_make_continuation (&first);
169 check_cont (int rewindable)
173 res = scm_internal_catch (SCM_BOOL_T,
174 check_cont_body, (void *)(long)rewindable,
177 /* RES is now either the created continuation, the value passed to
178 the continuation, or a catch-tag, such as 'misc-error.
181 if (scm_is_true (scm_procedure_p (res)))
183 /* a continuation, invoke it */
184 scm_call_1 (res, SCM_BOOL_F);
186 else if (scm_is_false (res))
188 /* the result of invoking the continuation, dynwind must be
192 printf ("continuation not blocked\n");
197 /* the catch tag, dynwind must not have been rewindable. */
200 printf ("continuation didn't work\n");
206 close_port (SCM port)
208 scm_close_port (port);
212 delete_file (void *data)
214 unlink ((char *)data);
220 #define FILENAME_TEMPLATE "/check-ports.XXXXXX"
222 const char *tmpdir = getenv ("TMPDIR");
227 filename = (char *) alloca (strlen (tmpdir) +
228 sizeof (FILENAME_TEMPLATE) + 1);
229 strcpy (filename, tmpdir);
230 strcat (filename, FILENAME_TEMPLATE);
232 if (mktemp (filename) == NULL)
235 scm_dynwind_begin (0);
237 SCM port = scm_open_file (scm_from_locale_string (filename),
238 scm_from_locale_string ("w"));
239 scm_dynwind_unwind_handler_with_scm (close_port, port,
240 SCM_F_WIND_EXPLICITLY);
242 scm_dynwind_current_output_port (port);
243 scm_write (scm_version (), SCM_UNDEFINED);
247 scm_dynwind_begin (0);
249 SCM port = scm_open_file (scm_from_locale_string (filename),
250 scm_from_locale_string ("r"));
252 scm_dynwind_unwind_handler_with_scm (close_port, port,
253 SCM_F_WIND_EXPLICITLY);
254 scm_dynwind_unwind_handler (delete_file, filename, SCM_F_WIND_EXPLICITLY);
256 scm_dynwind_current_input_port (port);
257 res = scm_read (SCM_UNDEFINED);
258 if (scm_is_false (scm_equal_p (res, scm_version ())))
260 printf ("ports didn't work\n");
265 #undef FILENAME_TEMPLATE
271 SCM f = scm_make_fluid ();
274 scm_fluid_set_x (f, scm_from_int (12));
276 scm_dynwind_begin (0);
277 scm_dynwind_fluid (f, scm_from_int (13));
278 x = scm_fluid_ref (f);
281 if (!scm_is_eq (x, scm_from_int (13)))
283 printf ("setting fluid didn't work\n");
287 if (!scm_is_eq (scm_fluid_ref (f), scm_from_int (12)))
289 printf ("resetting fluid didn't work\n");
295 inner_main (void *data, int argc, char **argv)
297 check_flag1 ("func1", func1, 0);
298 check_flag1 ("func2", func2, 1);
299 check_flag1 ("func3", func3, 1);
300 check_flag1 ("func4", func4, 1);
313 main (int argc, char **argv)
315 scm_boot_guile (argc, argv, inner_main, 0);