Use scm_from_int instead of SCM_MAKINUM and scm_is_eq instead
[bpt/guile.git] / test-suite / standalone / test-unwind.c
CommitLineData
3c8fb18e
MV
1#include <libguile.h>
2#include <stdlib.h>
3#include <stdio.h>
c05d0e8f 4#include <unistd.h>
3c8fb18e
MV
5
6void set_flag (void *data);
7void func1 (void);
8void func2 (void);
9void func3 (void);
10void func4 (void);
11void check_flag1 (const char *msg, void (*func)(void), int val);
12SCM check_flag1_body (void *data);
13SCM return_tag (void *data, SCM tag, SCM args);
14void check_cont (int rewindable);
15SCM check_cont_body (void *data);
c05d0e8f
MV
16void close_port (SCM port);
17void delete_file (void *data);
18void check_ports (void);
8843e1fa 19void check_fluid (void);
3c8fb18e
MV
20
21int flag1, flag2, flag3;
22
23void
24set_flag (void *data)
25{
26 int *f = (int *)data;
27 *f = 1;
28}
29
30/* FUNC1 should leave flag1 zero.
31 */
32
33void
34func1 ()
35{
8843e1fa 36 scm_frame_begin (0);
3c8fb18e 37 flag1 = 0;
f1da8e4e 38 scm_frame_unwind_handler (set_flag, &flag1, 0);
8843e1fa 39 scm_frame_end ();
3c8fb18e
MV
40}
41
42/* FUNC2 should set flag1.
43 */
44
45void
46func2 ()
47{
8843e1fa 48 scm_frame_begin (0);
3c8fb18e 49 flag1 = 0;
f1da8e4e 50 scm_frame_unwind_handler (set_flag, &flag1, SCM_F_WIND_EXPLICITLY);
8843e1fa 51 scm_frame_end ();
3c8fb18e
MV
52}
53
54/* FUNC3 should set flag1.
55 */
56
57void
58func3 ()
59{
8843e1fa 60 scm_frame_begin (0);
3c8fb18e 61 flag1 = 0;
f1da8e4e 62 scm_frame_unwind_handler (set_flag, &flag1, 0);
3c8fb18e 63 scm_misc_error ("func3", "gratuitous error", SCM_EOL);
8843e1fa 64 scm_frame_end ();
3c8fb18e
MV
65}
66
67/* FUNC4 should set flag1.
68 */
69
70void
71func4 ()
72{
8843e1fa 73 scm_frame_begin (0);
3c8fb18e 74 flag1 = 0;
f1da8e4e 75 scm_frame_unwind_handler (set_flag, &flag1, SCM_F_WIND_EXPLICITLY);
3c8fb18e 76 scm_misc_error ("func4", "gratuitous error", SCM_EOL);
8843e1fa 77 scm_frame_end ();
3c8fb18e
MV
78}
79
80SCM
81check_flag1_body (void *data)
82{
83 void (*f)(void) = (void (*)(void))data;
84 f ();
85 return SCM_UNSPECIFIED;
86}
87
88SCM
89return_tag (void *data, SCM tag, SCM args)
90{
91 return tag;
92}
93
94void
95check_flag1 (const char *tag, void (*func)(void), int val)
96{
97 scm_internal_catch (SCM_BOOL_T,
98 check_flag1_body, func,
99 return_tag, NULL);
100 if (flag1 != val)
101 {
102 printf ("%s failed\n", tag);
103 exit (1);
104 }
105}
106
107SCM
108check_cont_body (void *data)
109{
110 scm_t_frame_flags flags = (data? SCM_F_FRAME_REWINDABLE : 0);
111 int first;
112 SCM val;
113
8843e1fa 114 scm_frame_begin (flags);
3c8fb18e
MV
115
116 val = scm_make_continuation (&first);
8843e1fa 117 scm_frame_end ();
3c8fb18e
MV
118 return val;
119}
120
121void
122check_cont (int rewindable)
123{
124 SCM res;
125
126 res = scm_internal_catch (SCM_BOOL_T,
127 check_cont_body, (void *)rewindable,
128 return_tag, NULL);
129
130 /* RES is now either the created continuation, the value passed to
131 the continuation, or a catch-tag, such as 'misc-error.
132 */
133
66dd7f14 134 if (scm_is_true (scm_procedure_p (res)))
3c8fb18e
MV
135 {
136 /* a continuation, invoke it */
137 scm_call_1 (res, SCM_BOOL_F);
138 }
66dd7f14 139 else if (scm_is_false (res))
3c8fb18e
MV
140 {
141 /* the result of invoking the continuation, frame must be
142 rewindable */
143 if (rewindable)
144 return;
145 printf ("continuation not blocked\n");
146 exit (1);
147 }
148 else
149 {
150 /* the catch tag, frame must not have been rewindable. */
151 if (!rewindable)
152 return;
153 printf ("continuation didn't work\n");
154 exit (1);
155 }
156}
c05d0e8f
MV
157
158void
159close_port (SCM port)
160{
161 scm_close_port (port);
162}
163
164void
165delete_file (void *data)
166{
167 unlink ((char *)data);
168}
169
170void
171check_ports ()
172{
173 char filename[] = "/tmp/check-ports.XXXXXX";
174
175 if (mktemp (filename) == NULL)
176 exit (1);
177
8843e1fa 178 scm_frame_begin (0);
c05d0e8f
MV
179 {
180 SCM port = scm_open_file (scm_str2string (filename),
181 scm_str2string ("w"));
f1da8e4e
MV
182 scm_frame_unwind_handler_with_scm (close_port, port,
183 SCM_F_WIND_EXPLICITLY);
c05d0e8f 184
8843e1fa 185 scm_frame_current_output_port (port);
c05d0e8f
MV
186 scm_write (scm_version (), SCM_UNDEFINED);
187 }
8843e1fa 188 scm_frame_end ();
c05d0e8f 189
8843e1fa 190 scm_frame_begin (0);
c05d0e8f
MV
191 {
192 SCM port = scm_open_file (scm_str2string (filename),
193 scm_str2string ("r"));
194 SCM res;
f1da8e4e
MV
195 scm_frame_unwind_handler_with_scm (close_port, port,
196 SCM_F_WIND_EXPLICITLY);
197 scm_frame_unwind_handler (delete_file, filename, SCM_F_WIND_EXPLICITLY);
c05d0e8f 198
8843e1fa 199 scm_frame_current_input_port (port);
c05d0e8f 200 res = scm_read (SCM_UNDEFINED);
66dd7f14 201 if (scm_is_false (scm_equal_p (res, scm_version ())))
c05d0e8f
MV
202 {
203 printf ("ports didn't work\n");
204 exit (1);
205 }
206 }
8843e1fa 207 scm_frame_end ();
c05d0e8f 208}
8843e1fa
MV
209
210void
211check_fluid ()
212{
213 SCM f = scm_make_fluid ();
214 SCM x;
215
79e9bca7 216 scm_fluid_set_x (f, scm_from_int (12));
8843e1fa
MV
217
218 scm_frame_begin (0);
79e9bca7 219 scm_frame_fluid (f, scm_from_int (13));
8843e1fa
MV
220 x = scm_fluid_ref (f);
221 scm_frame_end ();
222
79e9bca7 223 if (!scm_is_eq (x, scm_from_int (13)))
8843e1fa
MV
224 {
225 printf ("setting fluid didn't work\n");
226 exit (1);
227 }
228
79e9bca7 229 if (!scm_is_eq (scm_fluid_ref (f), scm_from_int (12)))
8843e1fa
MV
230 {
231 printf ("resetting fluid didn't work\n");
232 exit (1);
233 }
234}
235
3c8fb18e
MV
236static void
237inner_main (void *data, int argc, char **argv)
238{
239 check_flag1 ("func1", func1, 0);
240 check_flag1 ("func2", func2, 1);
241 check_flag1 ("func3", func3, 1);
242 check_flag1 ("func4", func4, 1);
243
244 check_cont (0);
245 check_cont (1);
246
c05d0e8f
MV
247 check_ports ();
248
8843e1fa
MV
249 check_fluid ();
250
3c8fb18e
MV
251 exit (0);
252}
253
254int
255main (int argc, char **argv)
256{
257 scm_boot_guile (argc, argv, inner_main, 0);
258 return 0;
259}