guile/src/errors.c

   1 /* GnuTLS --- Guile bindings for GnuTLS.
   2    Copyright (C) 2007-2012 Free Software Foundation, Inc.
   3
   4    GnuTLS is free software; you can redistribute it and/or
   5    modify it under the terms of the GNU Lesser General Public
   6    License as published by the Free Software Foundation; either
   7    version 2.1 of the License, or (at your option) any later version.
   8
   9    GnuTLS is distributed in the hope that it will be useful,
  10    but WITHOUT ANY WARRANTY; without even the implied warranty of
  11    MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
  12    Lesser General Public License for more details.
  13
  14    You should have received a copy of the GNU Lesser General Public
  15    License along with GnuTLS; if not, write to the Free Software
  16    Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA  02110-1301  USA  */
  17
  18 /* Written by Ludovic Courtès <ludo@chbouib.org>.  */
  19
  20 #ifdef HAVE_CONFIG_H
  21 #include <config.h>
  22 #endif
  23
  24 #include <libguile.h>
  25 #include <gnutls/gnutls.h>
  26
  27 #include "errors.h"
  28 #include "enums.h"
  29
  30 SCM_SYMBOL (gnutls_error_key, "gnutls-error");
  31
  32 void
  33 scm_gnutls_error_with_args (int c_err, const char *c_func, SCM args)
  34 {
  35   SCM err, func;
  36
  37   /* Note: If error code C_ERR is unknown, then ERR will be `#f'.  */
  38   err = scm_from_gnutls_error (c_err);
  39   func = scm_from_locale_symbol (c_func);
  40
  41   (void) scm_throw (gnutls_error_key, scm_cons2 (err, func, args));
  42
  43   /* XXX: This is actually never reached, but since the Guile headers don't
  44      declare `scm_throw ()' as `noreturn', we must add this to avoid GCC's
  45      complaints.  */
  46   abort ();
  47 }
  48
  49 void
  50 scm_gnutls_error (int c_err, const char *c_func)
  51 {
  52   scm_gnutls_error_with_args (c_err, c_func, SCM_EOL);
  53 }
  54
  55 \f
  56
  57 void
  58 scm_init_gnutls_error (void)
  59 {
  60 #include "errors.x"
  61 }
  62
  63 /* arch-tag: 48f07ecf-65c4-480c-b043-a51eab592d6b
  64  */