test-unwind.c 6.4 KB

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