guile18/test-suite/standalone/test-unwind.c

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