test-suite/standalone/test-srfi-1.c

   1 /* Copyright (C) 2010 Free Software Foundation, Inc.
   2  *
   3  * This library is free software; you can redistribute it and/or
   4  * modify it under the terms of the GNU Lesser General Public License
   5  * as published by the Free Software Foundation; either version 3 of
   6  * the License, or (at your option) any later version.
   7  *
   8  * This library is distributed in the hope that it will be useful, but
   9  * WITHOUT ANY WARRANTY; without even the implied warranty of
  10  * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
  11  * Lesser General Public License for more details.
  12  *
  13  * You should have received a copy of the GNU Lesser General Public
  14  * License along with this library; if not, write to the Free Software
  15  * Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA
  16  * 02110-1301 USA
  17  */
  18
  19 /* Exercise the compatibility layer of `libguile-srfi-srfi-1'.  */
  20
  21 #ifndef HAVE_CONFIG_H
  22 # include <config.h>
  23 #endif
  24
  25 #include <libguile.h>
  26 #include <srfi/srfi-1.h>
  27
  28 #include <stdlib.h>
  29
  30 static void
  31 failure (const char *proc, SCM result)
  32 {
  33   scm_simple_format (scm_current_error_port (),
  34                      scm_from_locale_string ("`~S' failed: ~S~%"),
  35                      scm_list_2 (scm_from_locale_symbol (proc), result));
  36 }
  37
  38 static void *
  39 tests (void *data)
  40 {
  41   SCM times, negative_p, lst, result;
  42
  43   scm_init_srfi_1 ();
  44
  45   times = SCM_VARIABLE_REF (scm_c_lookup ("*"));
  46   lst = scm_list_3 (scm_from_int (1), scm_from_int (2), scm_from_int (3));
  47
  48   /* (fold * 1 '(1 2 3) '(1 2 3)) */
  49   result = scm_srfi1_fold (times, scm_from_int (1), lst, scm_list_1 (lst));
  50
  51   if (scm_to_int (result) == 36)
  52     {
  53       negative_p = SCM_VARIABLE_REF (scm_c_lookup ("negative?"));
  54       result = scm_srfi1_break (negative_p,
  55                                 scm_list_3 (scm_from_int (1),
  56                                             scm_from_int (2),
  57                                             scm_from_int (-1)));
  58
  59       if (SCM_VALUESP (result))
  60         /* There's no API to access the values, so assume this is OK.  */
  61         * (int *) data = EXIT_SUCCESS;
  62       else
  63         {
  64           failure ("break", result);
  65           * (int *) data = EXIT_FAILURE;
  66         }
  67     }
  68   else
  69     {
  70       failure ("fold", result);
  71       * (int *) data = EXIT_FAILURE;
  72     }
  73
  74   return data;
  75 }
  76
  77 \f
  78 int
  79 main (int argc, char *argv[])
  80 {
  81   int ret;
  82
  83   scm_with_guile (tests, &ret);
  84
  85   return ret;
  86 }