mirror/guile
mirror/guile
1
Fork 0
mirror of https://git.savannah.gnu.org/git/guile.git synced 2025-04-30 03:40:34 +02:00
Code Activity

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

Browse source
This commit is contained in:
Marius Vollmer 2004-01-07 18:18:00 +00:00
parent a316356834
commit 8843e1fa41
1 changed files with 53 additions and 24 deletions
Download patch file Download diff file Expand all files Collapse all files

75
test-suite/standalone/test-unwind.c
View file

@ -16,6 +16,7 @@ SCM check_cont_body (void *data);
void close_port (SCM port);
void delete_file (void *data);
void check_ports (void);
void check_fluid (void);
int flag1, flag2, flag3;
@ -32,10 +33,10 @@ set_flag (void *data)
void
func1 ()
{
scm_begin_frame (0);
scm_frame_begin (0);
flag1 = 0;
scm_on_unwind (set_flag, &flag1, 0);
scm_end_frame ();
scm_frame_unwind (set_flag, &flag1, 0);
scm_frame_end ();
}
/* FUNC2 should set flag1.
@ -44,10 +45,10 @@ func1 ()
void
func2 ()
{
scm_begin_frame (0);
scm_frame_begin (0);
flag1 = 0;
scm_on_unwind (set_flag, &flag1, SCM_F_WIND_EXPLICITLY);
scm_end_frame ();
scm_frame_unwind (set_flag, &flag1, SCM_F_WIND_EXPLICITLY);
scm_frame_end ();
}
/* FUNC3 should set flag1.
@ -56,11 +57,11 @@ func2 ()
void
func3 ()
{
scm_begin_frame (0);
scm_frame_begin (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_end_frame ();
scm_frame_end ();
}
/* FUNC4 should set flag1.
@ -69,11 +70,11 @@ func3 ()
void
func4 ()
{
scm_begin_frame (0);
scm_frame_begin (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_end_frame ();
scm_frame_end ();
}
SCM
@ -110,10 +111,10 @@ check_cont_body (void *data)
int first;
SCM val;
scm_begin_frame (flags);
scm_frame_begin (flags);
val = scm_make_continuation (&first);
scm_end_frame ();
scm_frame_end ();
return val;
}
@ -174,26 +175,26 @@ check_ports ()
if (mktemp (filename) == NULL)
exit (1);
scm_begin_frame (0);
scm_frame_begin (0);
{
SCM port = scm_open_file (scm_str2string (filename),
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_end_frame ();
scm_frame_end ();
scm_begin_frame (0);
scm_frame_begin (0);
{
SCM port = scm_open_file (scm_str2string (filename),
scm_str2string ("r"));
SCM res;
scm_on_unwind_with_scm (close_port, port, SCM_F_WIND_EXPLICITLY);
scm_on_unwind (delete_file, filename, SCM_F_WIND_EXPLICITLY);
scm_frame_unwind_with_scm (close_port, port, 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);
if (SCM_FALSEP (scm_equal_p (res, scm_version ())))
{
@ -201,7 +202,33 @@ check_ports ()
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
@ -217,6 +244,8 @@ inner_main (void *data, int argc, char **argv)
check_ports ();
check_fluid ();
exit (0);
}