make scm_make_continuation internal

[bpt/guile.git] / test-suite / standalone / test-unwind.c

/* Copyright (C) 2004, 2005, 2008, 2009, 2010 Free Software Foundation, Inc.
 *
 * This library is free software; you can redistribute it and/or
 * modify it under the terms of the GNU Lesser General Public License
 * as published by the Free Software Foundation; either version 3 of
 * the License, or (at your option) any later version.
 *
 * This library is distributed in the hope that it will be useful, but
 * WITHOUT ANY WARRANTY; without even the implied warranty of
 * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
 * Lesser General Public License for more details.
 *
 * You should have received a copy of the GNU Lesser General Public
 * License along with this library; if not, write to the Free Software
 * Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA
 * 02110-1301 USA
 */

#if HAVE_CONFIG_H
# include <config.h>
#endif

#include <alloca.h>

#include <libguile.h>
#include <stdlib.h>
#include <stdio.h>
#include <unistd.h>

#ifdef HAVE_STRING_H
# include <string.h>
#endif


void set_flag (void *data);
void func1 (void);
void func2 (void);
void func3 (void);
void func4 (void);
void check_flag1 (const char *msg, void (*func)(void), int val);
SCM check_flag1_body (void *data);
SCM return_tag (void *data, SCM tag, SCM args);
void check_cont (int rewindable);
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;

void
set_flag (void *data)
{
  int *f = (int *)data;
  *f = 1;
}

/* FUNC1 should leave flag1 zero.
 */

void
func1 ()
{
  scm_dynwind_begin (0);
  flag1 = 0;
  scm_dynwind_unwind_handler (set_flag, &flag1, 0);
  scm_dynwind_end ();
}

/* FUNC2 should set flag1.
 */

void
func2 ()
{
  scm_dynwind_begin (0);
  flag1 = 0;
  scm_dynwind_unwind_handler (set_flag, &flag1, SCM_F_WIND_EXPLICITLY);
  scm_dynwind_end ();
}

/* FUNC3 should set flag1.
 */

void
func3 ()
{
  scm_dynwind_begin (0);
  flag1 = 0;
  scm_dynwind_unwind_handler (set_flag, &flag1, 0);
  scm_misc_error ("func3", "gratuitous error", SCM_EOL);
  scm_dynwind_end ();
}

/* FUNC4 should set flag1.
 */

void
func4 ()
{
  scm_dynwind_begin (0);
  flag1 = 0;
  scm_dynwind_unwind_handler (set_flag, &flag1, SCM_F_WIND_EXPLICITLY);
  scm_misc_error ("func4", "gratuitous error", SCM_EOL);
  scm_dynwind_end ();
}

SCM
check_flag1_body (void *data)
{
  void (*f)(void) = (void (*)(void))data;
  f ();
  return SCM_UNSPECIFIED;
}

SCM
return_tag (void *data, SCM tag, SCM args)
{
  return tag;
}

void
check_flag1 (const char *tag, void (*func)(void), int val)
{
  scm_internal_catch (SCM_BOOL_T,
		      check_flag1_body, func,
		      return_tag, NULL);
  if (flag1 != val)
    {
      printf ("%s failed\n", tag);
      exit (1);
    }
}

SCM
check_cont_body (void *data)
{
  scm_t_dynwind_flags flags = (data? SCM_F_DYNWIND_REWINDABLE : 0);
  SCM val;

  scm_dynwind_begin (flags);
  val = scm_c_eval_string ("(call/cc (lambda (k) k))");
  scm_dynwind_end ();
  return val;
}

void
check_cont (int rewindable)
{
  SCM res;
  
  res = scm_internal_catch (SCM_BOOL_T,
			    check_cont_body, (void *)(long)rewindable,
			    return_tag, NULL);

  /* RES is now either the created continuation, the value passed to
     the continuation, or a catch-tag, such as 'misc-error.
   */

  if (scm_is_true (scm_procedure_p (res)))
    {
      /* a continuation, invoke it */
      scm_call_1 (res, SCM_BOOL_F);
    }
  else if (scm_is_false (res))
    {
      /* the result of invoking the continuation, dynwind must be
	 rewindable */
      if (rewindable)
	return;
      printf ("continuation not blocked\n");
      exit (1);
    }
  else
    {
      /* the catch tag, dynwind must not have been rewindable. */
      if (!rewindable)
	return;
      printf ("continuation didn't work\n");
      exit (1);
    }
}

void
close_port (SCM port)
{
  scm_close_port (port);
}

void
delete_file (void *data)
{
  unlink ((char *)data);
}

void
check_ports ()
{
#define FILENAME_TEMPLATE "/check-ports.XXXXXX"
  char *filename;
  const char *tmpdir = getenv ("TMPDIR");

  if (tmpdir == NULL)
    tmpdir = "/tmp";

  filename = alloca (strlen (tmpdir) + sizeof (FILENAME_TEMPLATE) + 1);
  strcpy (filename, tmpdir);
  strcat (filename, FILENAME_TEMPLATE);

  /* Sanity check: Make sure that `filename' is actually writeable.
     We used to use mktemp(3), but that is now considered a security risk.  */
  if (0 > mkstemp (filename))
    exit (1);

  scm_dynwind_begin (0);
  {
    SCM port = scm_open_file (scm_from_locale_string (filename),
			      scm_from_locale_string ("w"));
    scm_dynwind_unwind_handler_with_scm (close_port, port,
				       SCM_F_WIND_EXPLICITLY);

    scm_dynwind_current_output_port (port);
    scm_write (scm_version (), SCM_UNDEFINED);
  }
  scm_dynwind_end ();

  scm_dynwind_begin (0);
  {
    SCM port = scm_open_file (scm_from_locale_string (filename),
			      scm_from_locale_string ("r"));
    SCM res;
    scm_dynwind_unwind_handler_with_scm (close_port, port,
				       SCM_F_WIND_EXPLICITLY);
    scm_dynwind_unwind_handler (delete_file, filename, SCM_F_WIND_EXPLICITLY);

    scm_dynwind_current_input_port (port);
    res = scm_read (SCM_UNDEFINED);
    if (scm_is_false (scm_equal_p (res, scm_version ())))
      {
	printf ("ports didn't work\n");
	exit (1);
      }
  }
  scm_dynwind_end ();
#undef FILENAME_TEMPLATE
}

void
check_fluid ()
{
  SCM f = scm_make_fluid ();
  SCM x;

  scm_fluid_set_x (f, scm_from_int (12));

  scm_dynwind_begin (0);
  scm_dynwind_fluid (f, scm_from_int (13));
  x = scm_fluid_ref (f);
  scm_dynwind_end ();

  if (!scm_is_eq (x, scm_from_int (13)))
    {
      printf ("setting fluid didn't work\n");
      exit (1);
    }

  if (!scm_is_eq (scm_fluid_ref (f), scm_from_int (12)))
    {
      printf ("resetting fluid didn't work\n");
      exit (1);
    }
}

static void
inner_main (void *data, int argc, char **argv)
{
  check_flag1 ("func1", func1, 0);
  check_flag1 ("func2", func2, 1);
  check_flag1 ("func3", func3, 1);
  check_flag1 ("func4", func4, 1);

  check_cont (0);
  check_cont (1);

  check_ports ();

  check_fluid ();

  exit (0);
}

int
main (int argc, char **argv)
{
  scm_boot_guile (argc, argv, inner_main, 0);
  return 0;
}