From 4189a5c0bd4c235c383b043bef69dc66a7ef64d0 Mon Sep 17 00:00:00 2001
From: Andy Wingo <wingo@pobox.com>
Date: Sat, 15 Mar 2014 18:56:18 +0100
Subject: [PATCH] Add stack overflow test

* libguile/throw.c (throw_without_pre_unwind): Newline after the
  unwind-only warning.

* test-suite/standalone/Makefile.am:
* test-suite/standalone/test-stack-overflow: New test to handle
  mmap/malloc failure.
---
 libguile/throw.c                          |  2 +-
 test-suite/standalone/Makefile.am         |  5 ++-
 test-suite/standalone/test-stack-overflow | 38 +++++++++++++++++++++++
 3 files changed, 43 insertions(+), 2 deletions(-)
 create mode 100755 test-suite/standalone/test-stack-overflow

diff --git a/libguile/throw.c b/libguile/throw.c
index 98149a167..fd84f6048 100644
--- a/libguile/throw.c
+++ b/libguile/throw.c
@@ -185,7 +185,7 @@ throw_without_pre_unwind (SCM tag, SCM args)
 
       if (scm_is_true (scm_c_vector_ref (eh, 3)))
         fprintf (stderr, "\nWarning: unwind-only exception, perhaps due to "
-                 "stack overflow; not running pre-unwind handlers.");
+                 "stack overflow; not running pre-unwind handlers.\n");
 
       prompt_tag = scm_c_vector_ref (eh, 2);
       if (scm_is_true (prompt_tag))
diff --git a/test-suite/standalone/Makefile.am b/test-suite/standalone/Makefile.am
index 5c0c6a79f..6f252f4cf 100644
--- a/test-suite/standalone/Makefile.am
+++ b/test-suite/standalone/Makefile.am
@@ -1,7 +1,7 @@
 ## Process this file with automake to produce Makefile.in.
 ##
 ## Copyright 2003, 2004, 2005, 2006, 2007, 2008, 2009, 2010,
-##   2011, 2012, 2013 Free Software Foundation, Inc.
+##   2011, 2012, 2013, 2014 Free Software Foundation, Inc.
 ##
 ## This file is part of GUILE.
 ##
@@ -264,4 +264,7 @@ test_smob_mark_LDADD = $(LIBGUILE_LDADD)
 check_PROGRAMS += test-smob-mark
 TESTS += test-smob-mark
 
+check_SCRIPTS += test-stack-overflow
+TESTS += test-stack-overflow
+
 EXTRA_DIST += ${check_SCRIPTS}
diff --git a/test-suite/standalone/test-stack-overflow b/test-suite/standalone/test-stack-overflow
new file mode 100755
index 000000000..5a0b77799
--- /dev/null
+++ b/test-suite/standalone/test-stack-overflow
@@ -0,0 +1,38 @@
+#!/bin/sh
+exec guile -q -s "$0" "$@"
+!#
+
+(unless (defined? 'setrlimit)
+  ;; Without an rlimit, this test can take down your system, as it
+  ;; consumes all of your memory in stack space.  That doesn't seem like
+  ;; something we should run as part of an automated test suite.
+  (exit 0))
+
+;; 100 MB.
+(define *limit* (* 100 1024 1024))
+
+(call-with-values (lambda () (getrlimit 'as))
+  (lambda (soft hard)
+    (unless (and soft (< soft *limit*))
+      (setrlimit 'as (if hard (min *limit* hard) *limit*) hard))))
+
+(define (test)
+  (catch 'stack-overflow
+    (lambda ()
+      (let lp ()
+        (lp)
+        (error "should not be reached")))
+    (lambda _
+      #t)))
+
+;; Run the test a few times.  The stack will only be enlarged and
+;; relocated on the first one.
+(test)
+(test)
+(test)
+(test)
+(test)
+
+;; Local Variables:
+;; mode: scheme
+;; End: