Make error output use "*errout*" consistently

- ErrorInner, Where, and WHERE consistently print their output to
"*errout*"
- Get rid of now unnecessary flush character \c in ErrorInner
- PRINT_CURRENT_STATEMENT now takes a stream as additional input.
- Adjust its tests accordingly.

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("<function \"",NAME_FUNC(f)
+        PrintTo("*errout*", "<function \"",NAME_FUNC(f)
               ,"\">( <arguments> )\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;
@@ -177,7 +177,7 @@ BIND_GLOBAL("ErrorInner",
 
     earlyMessage := arg[2];
     if Length(arg) <> 2 then
-        PrintTo("*errout*","ErrorInner: new format takes exactly two arguments\n");
+        PrintTo("*errout*", "ErrorInner: new format takes exactly two arguments\n");
         LEAVE_ALL_NAMESPACES();
         JUMP_TO_CATCH(1);
     fi;
@@ -186,35 +186,35 @@ BIND_GLOBAL("ErrorInner",
     ERROR_COUNT := ERROR_COUNT+1;
     errorLVars := ErrorLVars;
     ErrorLVars := context;
+    # BreakOnError is defined by the `-T` command line flag in init.g
     if QUITTING or not BreakOnError then
-        PrintTo("*errout*","Error, ");
+        PrintTo("*errout*", "Error, ");
         for x in earlyMessage do
-            PrintTo("*errout*",x);
+            PrintTo("*errout*", x);
         od;
-        PrintTo("*errout*","\n");
+        PrintTo("*errout*", "\n");
         ErrorLevel := ErrorLevel-1;
         ErrorLVars := errorLVars;
         if ErrorLevel = 0 then LEAVE_ALL_NAMESPACES(); fi;
         JUMP_TO_CATCH(0);
     fi;
-    PrintTo("*errout*","Error, ");
+    PrintTo("*errout*", "Error, ");
     for x in earlyMessage do
-        PrintTo("*errout*",x);
+        PrintTo("*errout*", x);
     od;
     if printThisStatement then 
         if context <> GetBottomLVars() then
-            PrintTo("*errout*"," in\n  \c");
-            PRINT_CURRENT_STATEMENT(context);
-            Print("\c");
-            PrintTo("*errout*"," called from \n");
+            PrintTo("*errout*", " in\n  ");
+            PRINT_CURRENT_STATEMENT("*errout*", context);
+            PrintTo("*errout*", " called from \n");
         else
-            PrintTo("*errout*","\c\n");
+            PrintTo("*errout*", "\n");
         fi;
     else
         location := CURRENT_STATEMENT_LOCATION(context);
         if location <> fail then          PrintTo("*errout*", " at ", location[1], ":", location[2]);
         fi;
-        PrintTo("*errout*"," called from\c\n");
+        PrintTo("*errout*", " called from\n");
     fi;
 
     if SHOULD_QUIT_ON_BREAK() then
@@ -225,7 +225,7 @@ BIND_GLOBAL("ErrorInner",
         OnBreak();
     fi;
     if IsString(lateMessage) then
-        PrintTo("*errout*",lateMessage,"\n");
+        PrintTo("*errout*", lateMessage,"\n");
     elif lateMessage then
         if IsBound(OnBreakMessage) and IsFunction(OnBreakMessage) then
             OnBreakMessage();

src/error.c

@@ -152,22 +152,38 @@ 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)
 {
     if (context == STATE(BottomLVars))
         return 0;
 
+    /* HACK: we want to redirect output */
+    /* Try to print the output to stream. Use *errout* as a fallback. */
+    if ((IsStringConv(stream) && !OpenOutput(CSTR_STRING(stream))) ||
+        (!IS_STRING(stream) && !OpenOutputStream(stream))) {
+        if (OpenOutput("*errout*")) {
+            Pr("PRINT_CURRENT_STATEMENT: failed to open error stream\n", 0, 0);
+        }
+        else {
+            Panic("gap: failed to open *errout*!\n");
+        }
+    }
+
     Obj func = FUNC_LVARS(context);
     GAP_ASSERT(func);
     Stat call = STAT_LVARS(context);
     if (IsKernelFunction(func)) {
         Pr("<compiled statement> ", 0L, 0L);
+        /* HACK: close the output again */
+        CloseOutput();
         return 0;
     }
     Obj body = BODY_FUNC(func);
     if (call < OFFSET_FIRST_STAT ||
         call > SIZE_BAG(body) - sizeof(StatHeader)) {
         Pr("<corrupted statement> ", 0L, 0L);
+        /* HACK: close the output again */
+        CloseOutput();
         return 0;
     }
 
@@ -186,6 +202,8 @@ 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 */
+    CloseOutput();
     return 0;
 }
 
@@ -576,7 +594,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"),

tst/testinstall/kernel/gap.tst

@@ -92,9 +92,9 @@ Error, usage: UpEnv( [ <depth> ] )
 #
 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 stream:1
 
 #
 gap> CALL_WITH_CATCH(fail,fail);