test-suite/standalone/test-unwind.c

   1 #include <libguile.h>
   2 #include <stdlib.h>
   3 #include <stdio.h>
   4 #include <unistd.h>
   5
   6 void set_flag (void *data);
   7 void func1 (void);
   8 void func2 (void);
   9 void func3 (void);
  10 void func4 (void);
  11 void check_flag1 (const char *msg, void (*func)(void), int val);
  12 SCM check_flag1_body (void *data);
  13 SCM return_tag (void *data, SCM tag, SCM args);
  14 void check_cont (int rewindable);
  15 SCM check_cont_body (void *data);
  16 void close_port (SCM port);
  17 void delete_file (void *data);
  18 void check_ports (void);
  19 void check_fluid (void);
  20
  21 int flag1, flag2, flag3;
  22
  23 void
  24 set_flag (void *data)
  25 {
  26   int *f = (int *)data;
  27   *f = 1;
  28 }
  29
  30 /* FUNC1 should leave flag1 zero.
  31  */
  32
  33 void
  34 func1 ()
  35 {
  36   scm_frame_begin (0);
  37   flag1 = 0;
  38   scm_frame_unwind_handler (set_flag, &flag1, 0);
  39   scm_frame_end ();
  40 }
  41
  42 /* FUNC2 should set flag1.
  43  */
  44
  45 void
  46 func2 ()
  47 {
  48   scm_frame_begin (0);
  49   flag1 = 0;
  50   scm_frame_unwind_handler (set_flag, &flag1, SCM_F_WIND_EXPLICITLY);
  51   scm_frame_end ();
  52 }
  53
  54 /* FUNC3 should set flag1.
  55  */
  56
  57 void
  58 func3 ()
  59 {
  60   scm_frame_begin (0);
  61   flag1 = 0;
  62   scm_frame_unwind_handler (set_flag, &flag1, 0);
  63   scm_misc_error ("func3", "gratuitous error", SCM_EOL);
  64   scm_frame_end ();
  65 }
  66
  67 /* FUNC4 should set flag1.
  68  */
  69
  70 void
  71 func4 ()
  72 {
  73   scm_frame_begin (0);
  74   flag1 = 0;
  75   scm_frame_unwind_handler (set_flag, &flag1, SCM_F_WIND_EXPLICITLY);
  76   scm_misc_error ("func4", "gratuitous error", SCM_EOL);
  77   scm_frame_end ();
  78 }
  79
  80 SCM
  81 check_flag1_body (void *data)
  82 {
  83   void (*f)(void) = (void (*)(void))data;
  84   f ();
  85   return SCM_UNSPECIFIED;
  86 }
  87
  88 SCM
  89 return_tag (void *data, SCM tag, SCM args)
  90 {
  91   return tag;
  92 }
  93
  94 void
  95 check_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
 107 SCM
 108 check_cont_body (void *data)
 109 {
 110   scm_t_frame_flags flags = (data? SCM_F_FRAME_REWINDABLE : 0);
 111   int first;
 112   SCM val;
 113
 114   scm_frame_begin (flags);
 115
 116   val = scm_make_continuation (&first);
 117   scm_frame_end ();
 118   return val;
 119 }
 120
 121 void
 122 check_cont (int rewindable)
 123 {
 124   SCM res;
 125
 126   res = scm_internal_catch (SCM_BOOL_T,
 127                             check_cont_body, (void *)(long)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
 134   if (scm_is_true (scm_procedure_p (res)))
 135     {
 136       /* a continuation, invoke it */
 137       scm_call_1 (res, SCM_BOOL_F);
 138     }
 139   else if (scm_is_false (res))
 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 }
 157
 158 void
 159 close_port (SCM port)
 160 {
 161   scm_close_port (port);
 162 }
 163
 164 void
 165 delete_file (void *data)
 166 {
 167   unlink ((char *)data);
 168 }
 169
 170 void
 171 check_ports ()
 172 {
 173   char filename[] = "/tmp/check-ports.XXXXXX";
 174
 175   if (mktemp (filename) == NULL)
 176     exit (1);
 177
 178   scm_frame_begin (0);
 179   {
 180     SCM port = scm_open_file (scm_from_locale_string (filename),
 181                               scm_from_locale_string ("w"));
 182     scm_frame_unwind_handler_with_scm (close_port, port,
 183                                        SCM_F_WIND_EXPLICITLY);
 184
 185     scm_frame_current_output_port (port);
 186     scm_write (scm_version (), SCM_UNDEFINED);
 187   }
 188   scm_frame_end ();
 189
 190   scm_frame_begin (0);
 191   {
 192     SCM port = scm_open_file (scm_from_locale_string (filename),
 193                               scm_from_locale_string ("r"));
 194     SCM res;
 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);
 198
 199     scm_frame_current_input_port (port);
 200     res = scm_read (SCM_UNDEFINED);
 201     if (scm_is_false (scm_equal_p (res, scm_version ())))
 202       {
 203         printf ("ports didn't work\n");
 204         exit (1);
 205       }
 206   }
 207   scm_frame_end ();
 208 }
 209
 210 void
 211 check_fluid ()
 212 {
 213   SCM f = scm_make_fluid ();
 214   SCM x;
 215
 216   scm_fluid_set_x (f, scm_from_int (12));
 217
 218   scm_frame_begin (0);
 219   scm_frame_fluid (f, scm_from_int (13));
 220   x = scm_fluid_ref (f);
 221   scm_frame_end ();
 222
 223   if (!scm_is_eq (x, scm_from_int (13)))
 224     {
 225       printf ("setting fluid didn't work\n");
 226       exit (1);
 227     }
 228
 229   if (!scm_is_eq (scm_fluid_ref (f), scm_from_int (12)))
 230     {
 231       printf ("resetting fluid didn't work\n");
 232       exit (1);
 233     }
 234 }
 235
 236 static void
 237 inner_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
 247   check_ports ();
 248
 249   check_fluid ();
 250
 251   exit (0);
 252 }
 253
 254 int
 255 main (int argc, char **argv)
 256 {
 257   scm_boot_guile (argc, argv, inner_main, 0);
 258   return 0;
 259 }