1
Fork 0
mirror of https://git.savannah.gnu.org/git/guile.git synced 2025-04-30 11:50:28 +02:00

Adapted to 'frame' renamings. (check_fluid): New.

This commit is contained in:
Marius Vollmer 2004-01-07 18:18:00 +00:00
parent a316356834
commit 8843e1fa41

View file

@ -16,6 +16,7 @@ SCM check_cont_body (void *data);
void close_port (SCM port); void close_port (SCM port);
void delete_file (void *data); void delete_file (void *data);
void check_ports (void); void check_ports (void);
void check_fluid (void);
int flag1, flag2, flag3; int flag1, flag2, flag3;
@ -32,10 +33,10 @@ set_flag (void *data)
void void
func1 () func1 ()
{ {
scm_begin_frame (0); scm_frame_begin (0);
flag1 = 0; flag1 = 0;
scm_on_unwind (set_flag, &flag1, 0); scm_frame_unwind (set_flag, &flag1, 0);
scm_end_frame (); scm_frame_end ();
} }
/* FUNC2 should set flag1. /* FUNC2 should set flag1.
@ -44,10 +45,10 @@ func1 ()
void void
func2 () func2 ()
{ {
scm_begin_frame (0); scm_frame_begin (0);
flag1 = 0; flag1 = 0;
scm_on_unwind (set_flag, &flag1, SCM_F_WIND_EXPLICITLY); scm_frame_unwind (set_flag, &flag1, SCM_F_WIND_EXPLICITLY);
scm_end_frame (); scm_frame_end ();
} }
/* FUNC3 should set flag1. /* FUNC3 should set flag1.
@ -56,11 +57,11 @@ func2 ()
void void
func3 () func3 ()
{ {
scm_begin_frame (0); scm_frame_begin (0);
flag1 = 0; flag1 = 0;
scm_on_unwind (set_flag, &flag1, 0); scm_frame_unwind (set_flag, &flag1, 0);
scm_misc_error ("func3", "gratuitous error", SCM_EOL); scm_misc_error ("func3", "gratuitous error", SCM_EOL);
scm_end_frame (); scm_frame_end ();
} }
/* FUNC4 should set flag1. /* FUNC4 should set flag1.
@ -69,11 +70,11 @@ func3 ()
void void
func4 () func4 ()
{ {
scm_begin_frame (0); scm_frame_begin (0);
flag1 = 0; flag1 = 0;
scm_on_unwind (set_flag, &flag1, SCM_F_WIND_EXPLICITLY); scm_frame_unwind (set_flag, &flag1, SCM_F_WIND_EXPLICITLY);
scm_misc_error ("func4", "gratuitous error", SCM_EOL); scm_misc_error ("func4", "gratuitous error", SCM_EOL);
scm_end_frame (); scm_frame_end ();
} }
SCM SCM
@ -110,10 +111,10 @@ check_cont_body (void *data)
int first; int first;
SCM val; SCM val;
scm_begin_frame (flags); scm_frame_begin (flags);
val = scm_make_continuation (&first); val = scm_make_continuation (&first);
scm_end_frame (); scm_frame_end ();
return val; return val;
} }
@ -174,26 +175,26 @@ check_ports ()
if (mktemp (filename) == NULL) if (mktemp (filename) == NULL)
exit (1); exit (1);
scm_begin_frame (0); scm_frame_begin (0);
{ {
SCM port = scm_open_file (scm_str2string (filename), SCM port = scm_open_file (scm_str2string (filename),
scm_str2string ("w")); scm_str2string ("w"));
scm_on_unwind_with_scm (close_port, port, SCM_F_WIND_EXPLICITLY); scm_frame_unwind_with_scm (close_port, port, SCM_F_WIND_EXPLICITLY);
scm_with_current_output_port (port); scm_frame_current_output_port (port);
scm_write (scm_version (), SCM_UNDEFINED); scm_write (scm_version (), SCM_UNDEFINED);
} }
scm_end_frame (); scm_frame_end ();
scm_begin_frame (0); scm_frame_begin (0);
{ {
SCM port = scm_open_file (scm_str2string (filename), SCM port = scm_open_file (scm_str2string (filename),
scm_str2string ("r")); scm_str2string ("r"));
SCM res; SCM res;
scm_on_unwind_with_scm (close_port, port, SCM_F_WIND_EXPLICITLY); scm_frame_unwind_with_scm (close_port, port, SCM_F_WIND_EXPLICITLY);
scm_on_unwind (delete_file, filename, SCM_F_WIND_EXPLICITLY); scm_frame_unwind (delete_file, filename, SCM_F_WIND_EXPLICITLY);
scm_with_current_input_port (port); scm_frame_current_input_port (port);
res = scm_read (SCM_UNDEFINED); res = scm_read (SCM_UNDEFINED);
if (SCM_FALSEP (scm_equal_p (res, scm_version ()))) if (SCM_FALSEP (scm_equal_p (res, scm_version ())))
{ {
@ -201,7 +202,33 @@ check_ports ()
exit (1); exit (1);
} }
} }
scm_end_frame (); scm_frame_end ();
}
void
check_fluid ()
{
SCM f = scm_make_fluid ();
SCM x;
scm_fluid_set_x (f, SCM_MAKINUM (12));
scm_frame_begin (0);
scm_frame_fluid (f, SCM_MAKINUM (13));
x = scm_fluid_ref (f);
scm_frame_end ();
if (!SCM_EQ_P (x, SCM_MAKINUM (13)))
{
printf ("setting fluid didn't work\n");
exit (1);
}
if (!SCM_EQ_P (scm_fluid_ref (f), SCM_MAKINUM (12)))
{
printf ("resetting fluid didn't work\n");
exit (1);
}
} }
static void static void
@ -217,6 +244,8 @@ inner_main (void *data, int argc, char **argv)
check_ports (); check_ports ();
check_fluid ();
exit (0); exit (0);
} }