1 /* Copyright (C) 2004, 2005, 2008, 2009, 2010, 2013, 2019 Free Software Foundation, Inc.
2 *
3 * This library is free software; you can redistribute it and/or
4 * modify it under the terms of the GNU Lesser General Public License
5 * as published by the Free Software Foundation; either version 3 of
6 * the License, or (at your option) any later version.
7 *
8 * This library is distributed in the hope that it will be useful, but
9 * 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.
12 *
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
16 * 02110-1301 USA
17 */
18
19 #if HAVE_CONFIG_H
20 # include <config.h>
21 #endif
22
23 #include <alloca.h>
24
25 #include <libguile.h>
26 #include <stdlib.h>
27 #include <stdio.h>
28 #include <unistd.h>
29
30 #ifdef HAVE_STRING_H
31 # include <string.h>
32 #endif
33
34
35 void set_flag (void *data);
36 void func1 (void);
37 void func2 (void);
38 void func3 (void);
39 void func4 (void);
40 void check_flag1 (const char *msg, void (*func)(void), int val);
41 SCM check_flag1_body (void *data);
42 SCM return_tag (void *data, SCM tag, SCM args);
43 void check_cont (int rewindable);
44 SCM check_cont_body (void *data);
45 void close_port (SCM port);
46 void delete_file (void *data);
47 void check_ports (void);
48 void check_fluid (void);
49
50 int flag1, flag2, flag3;
51
52 void
set_flag(void * data)53 set_flag (void *data)
54 {
55 int *f = (int *)data;
56 *f = 1;
57 }
58
59 /* FUNC1 should leave flag1 zero.
60 */
61
62 void
func1()63 func1 ()
64 {
65 scm_dynwind_begin (0);
66 flag1 = 0;
67 scm_dynwind_unwind_handler (set_flag, &flag1, 0);
68 scm_dynwind_end ();
69 }
70
71 /* FUNC2 should set flag1.
72 */
73
74 void
func2()75 func2 ()
76 {
77 scm_dynwind_begin (0);
78 flag1 = 0;
79 scm_dynwind_unwind_handler (set_flag, &flag1, SCM_F_WIND_EXPLICITLY);
80 scm_dynwind_end ();
81 }
82
83 /* FUNC3 should set flag1.
84 */
85
86 void
func3()87 func3 ()
88 {
89 scm_dynwind_begin (0);
90 flag1 = 0;
91 scm_dynwind_unwind_handler (set_flag, &flag1, 0);
92 scm_misc_error ("func3", "gratuitous error", SCM_EOL);
93 scm_dynwind_end ();
94 }
95
96 /* FUNC4 should set flag1.
97 */
98
99 void
func4()100 func4 ()
101 {
102 scm_dynwind_begin (0);
103 flag1 = 0;
104 scm_dynwind_unwind_handler (set_flag, &flag1, SCM_F_WIND_EXPLICITLY);
105 scm_misc_error ("func4", "gratuitous error", SCM_EOL);
106 scm_dynwind_end ();
107 }
108
109 SCM
check_flag1_body(void * data)110 check_flag1_body (void *data)
111 {
112 void (*f)(void) = (void (*)(void))data;
113 f ();
114 return SCM_UNSPECIFIED;
115 }
116
117 SCM
return_tag(void * data,SCM tag,SCM args)118 return_tag (void *data, SCM tag, SCM args)
119 {
120 return tag;
121 }
122
123 void
check_flag1(const char * tag,void (* func)(void),int val)124 check_flag1 (const char *tag, void (*func)(void), int val)
125 {
126 scm_internal_catch (SCM_BOOL_T,
127 check_flag1_body, func,
128 return_tag, NULL);
129 if (flag1 != val)
130 {
131 printf ("%s failed\n", tag);
132 exit (EXIT_FAILURE);
133 }
134 }
135
136 SCM
check_cont_body(void * data)137 check_cont_body (void *data)
138 {
139 scm_t_dynwind_flags flags = (data? SCM_F_DYNWIND_REWINDABLE : 0);
140 SCM val;
141
142 scm_dynwind_begin (flags);
143 val = scm_c_eval_string ("(call/cc (lambda (k) k))");
144 scm_dynwind_end ();
145 return val;
146 }
147
148 void
check_cont(int rewindable)149 check_cont (int rewindable)
150 {
151 SCM res;
152
153 res = scm_internal_catch (SCM_BOOL_T,
154 check_cont_body, (void *)(long)rewindable,
155 return_tag, NULL);
156
157 /* RES is now either the created continuation, the value passed to
158 the continuation, or a catch-tag, such as 'misc-error.
159 */
160
161 if (scm_is_true (scm_procedure_p (res)))
162 {
163 /* a continuation, invoke it */
164 scm_call_1 (res, SCM_BOOL_F);
165 }
166 else if (scm_is_false (res))
167 {
168 /* the result of invoking the continuation, dynwind must be
169 rewindable */
170 if (rewindable)
171 return;
172 printf ("continuation not blocked\n");
173 exit (EXIT_FAILURE);
174 }
175 else
176 {
177 /* the catch tag, dynwind must not have been rewindable. */
178 if (!rewindable)
179 return;
180 printf ("continuation didn't work\n");
181 exit (EXIT_FAILURE);
182 }
183 }
184
185 void
close_port(SCM port)186 close_port (SCM port)
187 {
188 scm_close_port (port);
189 }
190
191 void
delete_file(void * data)192 delete_file (void *data)
193 {
194 unlink ((char *)data);
195 }
196
197 void
check_ports()198 check_ports ()
199 {
200 #define FILENAME_TEMPLATE "/check-ports.XXXXXX"
201 char *filename;
202 const char *tmpdir = getenv ("TMPDIR");
203 int fd;
204 #ifdef __MINGW32__
205 extern int mkstemp (char *);
206
207 /* On Windows neither $TMPDIR nor /tmp can be relied on. */
208 if (tmpdir == NULL)
209 tmpdir = getenv ("TEMP");
210 if (tmpdir == NULL)
211 tmpdir = getenv ("TMP");
212 if (tmpdir == NULL)
213 tmpdir = "/";
214 #else
215 if (tmpdir == NULL)
216 tmpdir = "/tmp";
217 #endif
218
219 filename = alloca (strlen (tmpdir) + sizeof (FILENAME_TEMPLATE) + 1);
220 strcpy (filename, tmpdir);
221 strcat (filename, FILENAME_TEMPLATE);
222
223 /* Sanity check: Make sure that `filename' is actually writeable.
224 We used to use mktemp(3), but that is now considered a security risk. */
225 fd = mkstemp (filename);
226 if (fd < 0)
227 exit (EXIT_FAILURE);
228 close (fd);
229
230 scm_dynwind_begin (0);
231 {
232 SCM port = scm_open_file (scm_from_locale_string (filename),
233 scm_from_locale_string ("w"));
234 scm_dynwind_unwind_handler_with_scm (close_port, port,
235 SCM_F_WIND_EXPLICITLY);
236
237 scm_dynwind_current_output_port (port);
238 scm_write (scm_version (), SCM_UNDEFINED);
239 }
240 scm_dynwind_end ();
241
242 scm_dynwind_begin (0);
243 {
244 SCM port = scm_open_file (scm_from_locale_string (filename),
245 scm_from_locale_string ("r"));
246 SCM res;
247 scm_dynwind_unwind_handler_with_scm (close_port, port,
248 SCM_F_WIND_EXPLICITLY);
249 scm_dynwind_unwind_handler (delete_file, filename, SCM_F_WIND_EXPLICITLY);
250
251 scm_dynwind_current_input_port (port);
252 res = scm_read (SCM_UNDEFINED);
253 if (scm_is_false (scm_equal_p (res, scm_version ())))
254 {
255 printf ("ports didn't work\n");
256 exit (EXIT_FAILURE);
257 }
258 }
259 scm_dynwind_end ();
260 #undef FILENAME_TEMPLATE
261 }
262
263 void
check_fluid()264 check_fluid ()
265 {
266 SCM f = scm_make_fluid ();
267 SCM x;
268
269 scm_fluid_set_x (f, scm_from_int (12));
270
271 scm_dynwind_begin (0);
272 scm_dynwind_fluid (f, scm_from_int (13));
273 x = scm_fluid_ref (f);
274 scm_dynwind_end ();
275
276 if (!scm_is_eq (x, scm_from_int (13)))
277 {
278 printf ("setting fluid didn't work\n");
279 exit (EXIT_FAILURE);
280 }
281
282 if (!scm_is_eq (scm_fluid_ref (f), scm_from_int (12)))
283 {
284 printf ("resetting fluid didn't work\n");
285 exit (EXIT_FAILURE);
286 }
287 }
288
289 static void
inner_main(void * data,int argc,char ** argv)290 inner_main (void *data, int argc, char **argv)
291 {
292 check_flag1 ("func1", func1, 0);
293 check_flag1 ("func2", func2, 1);
294 check_flag1 ("func3", func3, 1);
295 check_flag1 ("func4", func4, 1);
296
297 check_cont (0);
298 check_cont (1);
299
300 check_ports ();
301
302 check_fluid ();
303
304 exit (EXIT_SUCCESS);
305 }
306
307 int
main(int argc,char ** argv)308 main (int argc, char **argv)
309 {
310 scm_boot_guile (argc, argv, inner_main, 0);
311 return 0;
312 }
313