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