mirror of
https://git.savannah.gnu.org/git/guile.git
synced 2025-04-30 03:40:34 +02:00
Adapted to 'frame' renamings. (check_fluid): New.
This commit is contained in:
parent
a316356834
commit
8843e1fa41
1 changed files with 53 additions and 24 deletions
|
@ -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,9 +202,35 @@ 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
|
||||||
inner_main (void *data, int argc, char **argv)
|
inner_main (void *data, int argc, char **argv)
|
||||||
{
|
{
|
||||||
|
@ -217,6 +244,8 @@ inner_main (void *data, int argc, char **argv)
|
||||||
|
|
||||||
check_ports ();
|
check_ports ();
|
||||||
|
|
||||||
|
check_fluid ();
|
||||||
|
|
||||||
exit (0);
|
exit (0);
|
||||||
}
|
}
|
||||||
|
|
||||||
|
|
Loading…
Add table
Add a link
Reference in a new issue