diff --git a/lib/error.g b/lib/error.g index 34addd9eb20..43f1c6bbc52 100644 --- a/lib/error.g +++ b/lib/error.g @@ -50,17 +50,17 @@ BIND_GLOBAL("WHERE", function( context, depth, outercontext) bottom := GetBottomLVars(); lastcontext := outercontext; while depth > 0 and context <> bottom do - PRINT_CURRENT_STATEMENT(context); - Print(" called from\n"); + PRINT_CURRENT_STATEMENT("*errout*", context); + PrintTo("*errout*", " called from\n"); lastcontext := context; context := ParentLVars(context); depth := depth-1; od; if depth = 0 then - Print("... "); + PrintTo("*errout*", "... "); else f := ContentsLVars(lastcontext).func; - Print("( )\n called from read-eval loop "); fi; end); @@ -75,11 +75,11 @@ BIND_GLOBAL("Where", function(arg) fi; if ErrorLVars = fail or ErrorLVars = GetBottomLVars() then - Print("not in any function "); + PrintTo("*errout*", "not in any function "); else WHERE(ParentLVars(ErrorLVars),depth, ErrorLVars); fi; - Print("at ",INPUT_FILENAME(),":",INPUT_LINENUMBER(),"\n"); + PrintTo("*errout*", "at ",INPUT_FILENAME(),":",INPUT_LINENUMBER(),"\n"); end); OnBreak := Where; @@ -204,7 +204,7 @@ BIND_GLOBAL("ErrorInner", if printThisStatement then if context <> GetBottomLVars() then PrintTo("*errout*"," in\n \c"); - PRINT_CURRENT_STATEMENT(context); + PRINT_CURRENT_STATEMENT("*errout*", context); Print("\c"); PrintTo("*errout*"," called from \n"); else diff --git a/src/error.c b/src/error.c index 443072d9875..85c56a03059 100644 --- a/src/error.c +++ b/src/error.c @@ -152,8 +152,16 @@ Obj FuncCURRENT_STATEMENT_LOCATION(Obj self, Obj context) return retlist; } -Obj FuncPRINT_CURRENT_STATEMENT(Obj self, Obj context) +Obj FuncPRINT_CURRENT_STATEMENT(Obj self, Obj stream, Obj context) { + /* HACK: we want to redirect output */ + int openedOutput = 1; + if ((IsStringConv(stream) && !OpenOutput(CSTR_STRING(stream))) || + (!IS_STRING(stream) && !OpenOutputStream(stream))) { + Pr("Can't open output stream\n", 0L, 0L); + openedOutput = 0; + } + if (context == STATE(BottomLVars)) return 0; @@ -186,6 +194,10 @@ Obj FuncPRINT_CURRENT_STATEMENT(Obj self, Obj context) Pr(" at %g:%d", (Int)filename, LINE_STAT(call)); } SWITCH_TO_OLD_LVARS(currLVars); + /* HACK: close the output again */ + if (openedOutput) { + CloseOutput(); + } return 0; } @@ -578,7 +590,7 @@ static StructGVarFunc GVarFuncs[] = { GVAR_FUNC(CALL_WITH_CATCH, 2, "func, args"), GVAR_FUNC(JUMP_TO_CATCH, 1, "payload"), - GVAR_FUNC(PRINT_CURRENT_STATEMENT, 1, "context"), + GVAR_FUNC(PRINT_CURRENT_STATEMENT, 2, "stream, context"), GVAR_FUNC(CURRENT_STATEMENT_LOCATION, 1, "context"), GVAR_FUNC(SetUserHasQuit, 1, "value"), diff --git a/tst/testinstall/kernel/gap.tst b/tst/testinstall/kernel/gap.tst index 8fbf66f3e6a..7e7dcabee32 100644 --- a/tst/testinstall/kernel/gap.tst +++ b/tst/testinstall/kernel/gap.tst @@ -92,9 +92,9 @@ Error, usage: UpEnv( [ ] ) # gap> CURRENT_STATEMENT_LOCATION(GetCurrentLVars()); fail -gap> PRINT_CURRENT_STATEMENT(GetCurrentLVars()); -gap> f:=function() PRINT_CURRENT_STATEMENT(GetCurrentLVars()); Print("\n"); end;; f(); -PRINT_CURRENT_STATEMENT( GetCurrentLVars( ) ); at stream:1 +gap> PRINT_CURRENT_STATEMENT("*errout*", GetCurrentLVars()); +gap> f:=function() PRINT_CURRENT_STATEMENT("*errout*", GetCurrentLVars()); Print("\n"); end;; f(); +PRINT_CURRENT_STATEMENT( "*errout*", GetCurrentLVars( ) ); at *stdin*:1 # gap> CALL_WITH_CATCH(fail,fail);