test-suite/standalone/test-unwind.c

   1 /* Copyright (C) 2004, 2005, 2008, 2009, 2010, 2013 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
  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 {
  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
  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
  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
 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
 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);
 132       exit (EXIT_FAILURE);
 133     }
 134 }
 135
 136 SCM
 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
 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
 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 {
 200 #define FILENAME_TEMPLATE "/check-ports.XXXXXX"
 201   char *filename;
 202   const char *tmpdir = getenv ("TMPDIR");
 203 #ifdef __MINGW32__
 204   extern int mkstemp (char *);
 205
 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
 214   if (tmpdir == NULL)
 215     tmpdir = "/tmp";
 216 #endif
 217
 218   filename = alloca (strlen (tmpdir) + sizeof (FILENAME_TEMPLATE) + 1);
 219   strcpy (filename, tmpdir);
 220   strcat (filename, FILENAME_TEMPLATE);
 221
 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))
 225     exit (EXIT_FAILURE);
 226
 227   scm_dynwind_begin (0);
 228   {
 229     SCM port = scm_open_file (scm_from_locale_string (filename),
 230                               scm_from_locale_string ("w"));
 231     scm_dynwind_unwind_handler_with_scm (close_port, port,
 232                                        SCM_F_WIND_EXPLICITLY);
 233
 234     scm_dynwind_current_output_port (port);
 235     scm_write (scm_version (), SCM_UNDEFINED);
 236   }
 237   scm_dynwind_end ();
 238
 239   scm_dynwind_begin (0);
 240   {
 241     SCM port = scm_open_file (scm_from_locale_string (filename),
 242                               scm_from_locale_string ("r"));
 243     SCM res;
 244     scm_dynwind_unwind_handler_with_scm (close_port, port,
 245                                        SCM_F_WIND_EXPLICITLY);
 246     scm_dynwind_unwind_handler (delete_file, filename, SCM_F_WIND_EXPLICITLY);
 247
 248     scm_dynwind_current_input_port (port);
 249     res = scm_read (SCM_UNDEFINED);
 250     if (scm_is_false (scm_equal_p (res, scm_version ())))
 251       {
 252         printf ("ports didn't work\n");
 253         exit (EXIT_FAILURE);
 254       }
 255   }
 256   scm_dynwind_end ();
 257 #undef FILENAME_TEMPLATE
 258 }
 259
 260 void
 261 check_fluid ()
 262 {
 263   SCM f = scm_make_fluid ();
 264   SCM x;
 265
 266   scm_fluid_set_x (f, scm_from_int (12));
 267
 268   scm_dynwind_begin (0);
 269   scm_dynwind_fluid (f, scm_from_int (13));
 270   x = scm_fluid_ref (f);
 271   scm_dynwind_end ();
 272
 273   if (!scm_is_eq (x, scm_from_int (13)))
 274     {
 275       printf ("setting fluid didn't work\n");
 276       exit (EXIT_FAILURE);
 277     }
 278
 279   if (!scm_is_eq (scm_fluid_ref (f), scm_from_int (12)))
 280     {
 281       printf ("resetting fluid didn't work\n");
 282       exit (EXIT_FAILURE);
 283     }
 284 }
 285
 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
 297   check_ports ();
 298
 299   check_fluid ();
 300
 301   exit (EXIT_SUCCESS);
 302 }
 303
 304 int
 305 main (int argc, char **argv)
 306 {
 307   scm_boot_guile (argc, argv, inner_main, 0);
 308   return 0;
 309 }