summaryrefslogtreecommitdiff
diff options
context:
space:
mode:
Diffstat (limited to 'dev-scheme/gauche/files/gauche-0.9.5-main.patch')
-rw-r--r--dev-scheme/gauche/files/gauche-0.9.5-main.patch116
1 files changed, 116 insertions, 0 deletions
diff --git a/dev-scheme/gauche/files/gauche-0.9.5-main.patch b/dev-scheme/gauche/files/gauche-0.9.5-main.patch
new file mode 100644
index 000000000000..20f70703552d
--- /dev/null
+++ b/dev-scheme/gauche/files/gauche-0.9.5-main.patch
@@ -0,0 +1,116 @@
+commit 97196adb9dab30e7ab610daf4cc486bfc01ed403
+Author: Shiro Kawai <shiro@acm.org>
+Date: Mon Oct 17 11:00:44 2016 -1000
+
+ Fix main.c to call 'main' proc properly
+
+ https://github.com/shirok/Gauche/issues/244
+
+diff --git a/src/core.c b/src/core.c
+index 923d116..fc01211 100644
+--- a/src/core.c
++++ b/src/core.c
+@@ -653,9 +653,14 @@ void Scm_SimpleMain(int argc, const char *argv[],
+ ScmModule *user = Scm_UserModule();
+ ScmObj mainproc = Scm_GlobalVariableRef(user, SCM_SYMBOL(SCM_INTERN("main")), 0);
+ if (SCM_PROCEDUREP(mainproc)) {
+- ScmObj r = Scm_ApplyRec1(mainproc, args);
+- if (SCM_INTP(r)) Scm_Exit(SCM_INT_VALUE(r));
+- else Scm_Exit(70);
++ static ScmObj run_main_proc = SCM_UNDEFINED;
++ SCM_BIND_PROC(run_main_proc, "run-main", Scm_GaucheInternalModule());
++ SCM_ASSERT(SCM_PROCEDUREP(run_main_proc));
++
++ ScmEvalPacket epak;
++ int r = Scm_Apply(run_main_proc, SCM_LIST2(mainproc, args), &epak);
++ SCM_ASSERT(r == 1 && SCM_INTP(epak.results[0]));
++ Scm_Exit(SCM_INT_VALUE(epak.results[0]));
+ } else {
+ Scm_Exit(70);
+ }
+diff --git a/src/libeval.scm b/src/libeval.scm
+index 2a2c1fc..279fd7f 100644
+--- a/src/libeval.scm
++++ b/src/libeval.scm
+@@ -370,6 +370,17 @@
+ (loop1)))))
+
+ ;;;
++;;; Kick 'main' procedure
++;;; Returns an integer suitable for the exit code.
++;;; This is mainly to display proper stack trace in case 'main'
++;;; raises an error.
++(select-module gauche.internal)
++(define (run-main main args)
++ (guard (e [else (report-error e) 70])
++ (let1 r (main args)
++ (if (fixnum? r) r 70))))
++
++;;;
+ ;;; Macros
+ ;;;
+
+diff --git a/src/main.c b/src/main.c
+index 46223a6..55660c9 100644
+--- a/src/main.c
++++ b/src/main.c
+@@ -502,22 +502,14 @@ int execute_script(const char *scriptfile, ScmObj args)
+ SCM_BINDING_STAY_IN_MODULE);
+ }
+ if (SCM_PROCEDUREP(mainproc)) {
+-#if 0 /* Temporarily turned off due to the bug that loses stack traces. */
++ static ScmObj run_main_proc = SCM_UNDEFINED;
++ SCM_BIND_PROC(run_main_proc, "run-main", Scm_GaucheInternalModule());
++ SCM_ASSERT(SCM_PROCEDUREP(run_main_proc));
++
+ ScmEvalPacket epak;
+- int r = Scm_Apply(mainproc, SCM_LIST1(args), &epak);
+- if (r > 0) {
+- ScmObj res = epak.results[0];
+- if (SCM_INTP(res)) return SCM_INT_VALUE(res);
+- else return 70; /* EX_SOFTWARE, see SRFI-22. */
+- } else {
+- Scm_ReportError(epak.exception);
+- return 70; /* EX_SOFTWARE, see SRFI-22. */
+- }
+-#else
+- ScmObj r = Scm_ApplyRec1(mainproc, args);
+- if (SCM_INTP(r)) return SCM_INT_VALUE(r);
+- else return 70;
+-#endif
++ int r = Scm_Apply(run_main_proc, SCM_LIST2(mainproc, args), &epak);
++ SCM_ASSERT(r == 1 && SCM_INTP(epak.results[0]));
++ return SCM_INT_VALUE(epak.results[0]);
+ }
+ return 0;
+ }
+diff --git a/test/scripts.scm b/test/scripts.scm
+index 44bb44b..4e6777b 100644
+--- a/test/scripts.scm
++++ b/test/scripts.scm
+@@ -58,6 +58,25 @@
+ (process-output->string '("./gosh" "-ftest" "test.o")))
+ (delete-files "test.o")))
+
++;; This caused assertion failure in 0.9.5, because 'main' was called
++;; via Scm_ApplyRec without base VM running.
++;; See https://github.com/shirok/Gauche/issues/244
++(test* "proper error handling of 'main'" "ok"
++ (unwind-protect
++ (begin
++ (delete-files "test.o")
++ (with-output-to-file "test.o"
++ (^[]
++ (write
++ '(use gauche.partcont))
++ (write
++ '(define (main args)
++ (reset (shift k (call-with-input-file "gauche.h" k)))
++ (print 'ok)
++ 0))))
++ (process-output->string '("./gosh" "-ftest" "test.o")))
++ (delete-files "test.o")))
++
+ ;;=======================================================================
+ (test-section "gauche-config")
+