guile18/test-suite/standalone/test-scm-with-guile.c

   1 /* Copyright (C) 2008 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
   5  * License as published by the Free Software Foundation; either
   6  * version 2.1 of the License, or (at your option) any later version.
   7  *
   8  * This library is distributed in the hope that it will be useful,
   9  * but 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 02110-1301 USA
  16  */
  17
  18
  19 /* Test whether `scm_with_guile ()' can be called several times from a given
  20    thread, but from a different stack depth.  Up to 1.8.5, `scm_with_guile
  21    ()' would not update the thread's `base' field, which would then confuse
  22    the GC.
  23
  24    See http://lists.gnu.org/archive/html/guile-devel/2008-11/msg00037.html
  25    for a detailed report.  */
  26
  27 #ifdef HAVE_CONFIG_H
  28 # include <config.h>
  29 #endif
  30
  31 #include <libguile.h>
  32
  33 static void *
  34 entry_point (void *arg)
  35 {
  36   /* Invoke the GC.  If `THREAD->base' is incorrect, then Guile will just
  37      segfault somewhere in `scm_mark_locations ()'.  */
  38   scm_gc ();
  39
  40   return NULL;
  41 }
  42
  43 static void
  44 go_deeper_into_the_stack (unsigned level)
  45 {
  46   /* The assumption is that the compiler is not smart enough to optimize this
  47      out.  */
  48   if (level > 0)
  49     go_deeper_into_the_stack (level - 1);
  50   else
  51     scm_with_guile (entry_point, NULL);
  52 }
  53
  54 \f
  55 int
  56 main (int argc, char *argv[])
  57 {
  58   /* Invoke `scm_with_guile ()' from someplace deep into the stack.  */
  59   go_deeper_into_the_stack (100);
  60
  61   /* Invoke it from much higher into the stack.  This time, Guile is expected
  62      to update the `base' field of the current thread.  */
  63   scm_with_guile (entry_point, NULL);
  64
  65   return 0;
  66 }