test-scm-with-guile.c 1.9 KB

123456789101112131415161718192021222324252627282930313233343536373839404142434445464748495051525354555657585960616263646566676869
  1. /* Copyright 2008,2018
  2. Free Software Foundation, Inc.
  3. This file is part of Guile.
  4. Guile is free software: you can redistribute it and/or modify it
  5. under the terms of the GNU Lesser General Public License as published
  6. by the Free Software Foundation, either version 3 of the License, or
  7. (at your option) any later version.
  8. Guile is distributed in the hope that it will be useful, but WITHOUT
  9. ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or
  10. FITNESS FOR A PARTICULAR PURPOSE. See the GNU Lesser General Public
  11. License for more details.
  12. You should have received a copy of the GNU Lesser General Public
  13. License along with Guile. If not, see
  14. <https://www.gnu.org/licenses/>. */
  15. /* Test whether `scm_with_guile ()' can be called several times from a given
  16. thread, but from a different stack depth. Up to 1.8.5, `scm_with_guile
  17. ()' would not update the thread's `base' field, which would then confuse
  18. the GC.
  19. See http://lists.gnu.org/archive/html/guile-devel/2008-11/msg00037.html
  20. for a detailed report. */
  21. #ifdef HAVE_CONFIG_H
  22. # include <config.h>
  23. #endif
  24. #include <libguile.h>
  25. static void *
  26. entry_point (void *arg)
  27. {
  28. /* Invoke the GC. If `THREAD->base' is incorrect, then Guile will just
  29. segfault somewhere in `scm_mark_locations ()'. */
  30. scm_gc ();
  31. return NULL;
  32. }
  33. static void
  34. go_deeper_into_the_stack (unsigned level)
  35. {
  36. /* The assumption is that the compiler is not smart enough to optimize this
  37. out. */
  38. if (level > 0)
  39. go_deeper_into_the_stack (level - 1);
  40. else
  41. scm_with_guile (entry_point, NULL);
  42. }
  43. int
  44. main (int argc, char *argv[])
  45. {
  46. /* Invoke `scm_with_guile ()' from someplace deep into the stack. */
  47. go_deeper_into_the_stack (100);
  48. /* Invoke it from much higher into the stack. This time, Guile is expected
  49. to update the `base' field of the current thread. */
  50. scm_with_guile (entry_point, NULL);
  51. return 0;
  52. }