diff --git a/M2/Macaulay2/d/actors5.d b/M2/Macaulay2/d/actors5.d index d0f92d1221..0a462661d4 100644 --- a/M2/Macaulay2/d/actors5.d +++ b/M2/Macaulay2/d/actors5.d @@ -1813,6 +1813,9 @@ export StandardE := Expr(StandardS); export topLevelMode := Expr(StandardS); topLevelModeS := dummySymbol; +threadLocal lastError := nullE; +lastErrorS := dummySymbol; + initialRandomSeed := zeroZZ; initialRandomHeight := toInteger(10); @@ -1847,7 +1850,8 @@ syms := SymbolSequence( ( handleInterruptsS = setupvar("handleInterrupts",toExpr(handleInterrupts)); handleInterruptsS ), ( printWidthS = setupvar("printWidth",toExpr(printWidth)); printWidthS ), ( notifyS = setupvar("notify",toExpr(notify)); notifyS ), - ( topLevelModeS = setupvar("topLevelMode",topLevelMode); topLevelModeS ) + ( topLevelModeS = setupvar("topLevelMode",topLevelMode); topLevelModeS ), + ( lastErrorS = setupvarThread("lastError", lastError); lastErrorS ) ); export setDebuggingMode(b:bool):void := ( @@ -1886,6 +1890,17 @@ export sethandleInterrupts(b:bool):void := ( handleInterruptsSetup(b); setGlobalVariable(handleInterruptsS,toExpr(b)); ); +setLastError(position:Position, message:string):void := ( + if !( + message == returnMessage || + message == continueMessage || message == continueMessageWithArg || + message == stepMessage || message == stepMessageWithArg || + message == breakMessage) + then ( + lastError = seq(locate(position), toExpr(message)); + setGlobalVariable(lastErrorS, lastError))); +setLastErrorpointer = setLastError; + threadLocal resetvars := ( -- These are the thread local variables that got re-initialized in tokens.d: -- Actually, this is no good! If the user assigns to one of these variables, the "top level" version @@ -1909,6 +1924,21 @@ store(e:Expr):Expr := ( -- called with (symbol,newvalue) else when s.1 is Nothing do ( if sym === debuggerHookS then (debuggerHook = s.1; e) + else if sym === lastErrorS then (lastError = s.1; e) + else buildErrorPacket(msg)) + is a:Sequence do ( + if sym === lastErrorS then ( + if length(a) == 2 then ( + when a.0 + is p:List + do ( + if p.Class == filePositionClass then ( + when a.1 + is msg:stringCell do (lastError = s.1; e) + else WrongArgString(2)) + else WrongArg(1, "a file position")) + else WrongArg(1, "a file position")) + else WrongNumArgs(2)) else buildErrorPacket(msg)) is b:Boolean do ( n := b.v; diff --git a/M2/Macaulay2/d/binding.d b/M2/Macaulay2/d/binding.d index 4b8d5aaa04..08c4561c90 100644 --- a/M2/Macaulay2/d/binding.d +++ b/M2/Macaulay2/d/binding.d @@ -415,10 +415,12 @@ export makeSymbol(t:Token):Symbol := ( export makeErrorTree(e:ParseTree,message:string):void := ( HadError = true; printErrorMessage(treePosition(e),message); + setLastErrorpointer(treePosition(e), message); ); export makeErrorTree(e:Token,message:string):void := ( HadError = true; printErrorMessage(e,message); + setLastErrorpointer(e.position, message); ); makeSymbol(e:ParseTree,dictionary:Dictionary):void := ( when e @@ -472,14 +474,8 @@ lookup(t:Token,forcedef:bool,thread:bool):void := ( is entry:Symbol do ( t.entry = entry; if entry.position == tempPosition then entry.position = t.position; - if entry.flagLookup then ( - printErrorMessage(t,"flagged symbol encountered"); - HadError=true; - ); - if thread && !entry.thread then ( - printErrorMessage(t,"symbol already present, but not thread local"); - HadError=true; - ); + if entry.flagLookup then makeErrorTree(t,"flagged symbol encountered"); + if thread && !entry.thread then makeErrorTree(t,"symbol already present, but not thread local"); ) else ( if forcedef @@ -495,9 +491,7 @@ lookup(t:Token,forcedef:bool,thread:bool):void := ( t.dictionary = globalDictionary; -- undefined variables are defined as global t.entry = makeSymbol(t.word,t.position,globalDictionary,thread,locallyCreated); ) - else ( - printErrorMessage(t,"undefined symbol " + t.word.name); - HadError=true;)))); + else makeErrorTree(t,"undefined symbol " + t.word.name)))); lookup(t:Token):void := lookup(t,true,false); lookuponly(t:Token):void := lookup(t,false,false); ----------------------------------------------------------------------------- diff --git a/M2/Macaulay2/d/evaluate.d b/M2/Macaulay2/d/evaluate.d index 756a8aa60b..dd607ba045 100644 --- a/M2/Macaulay2/d/evaluate.d +++ b/M2/Macaulay2/d/evaluate.d @@ -1343,8 +1343,9 @@ steppingFurther(c:Code):bool := steppingFlag && ( handleError(c:Code,e:Expr):Expr := ( when e is err:Error do ( - if SuppressErrors then return e; - if err.message == returnMessage + p := codePosition(c); + if SuppressErrors + || err.message == returnMessage || err.message == continueMessage || err.message == continueMessageWithArg || err.message == stepMessage || err.message == stepMessageWithArg || err.message == breakMessage @@ -1353,10 +1354,9 @@ handleError(c:Code,e:Expr):Expr := ( then ( -- an error message that is really being used to transfer control must be passed up the line -- the position is plugged in just in case it's unhandled - if err.position == dummyPosition then err.position = codePosition(c); + if err.position == dummyPosition then err.position = p; return e; ); - p := codePosition(c); clearAllFlags(); clearAlarm(); if p.loadDepth >= errorDepth && !err.position === p then ( @@ -1585,7 +1585,14 @@ export evalraw(c:Code):Expr := ( tmp) else AngleBarList(r) )); - when e is Error do handleError(c,e) else e); + when e is Error + do ( + f := handleError(c,e); + when f is err:Error + do setLastErrorpointer(err.position, err.message) + else nothing; + f) + else e); export evalexcept(c:Code):Expr := ( -- printErrorMessage(codePosition(c),"--evaluating: "+present(tostring(c))); diff --git a/M2/Macaulay2/d/lex.d b/M2/Macaulay2/d/lex.d index 9548e3d5b0..28f7215a28 100644 --- a/M2/Macaulay2/d/lex.d +++ b/M2/Macaulay2/d/lex.d @@ -82,6 +82,20 @@ export install(name:string,word:Word):Word := ( foreach ch in name do node = install(node,int(ch)); node.word = word; word); + +-- setLastError defined in actors5.d +dummysetLastError(position:Position, message:string):void := nothing; +export setLastErrorpointer := dummysetLastError; + +makeLexError(position:Position, message:string):void := ( + printErrorMessage(position, message); + setLastErrorpointer(position, message); + empty(tokenbuf)); + +newPosition(file:PosFile, line:ushort, column:ushort):Position := Position( + -- [ beginning ] [ endpoint ] [ focus ] + file.filename, line, column, file.line, file.column, line, column, loadDepth); + recognize(file:PosFile):(null or Word) := ( i := 0; state := baseLexNode; @@ -98,7 +112,7 @@ recognize(file:PosFile):(null or Word) := ( is null do ( p := position(file); getc(file); - printErrorMessage(p,"invalid character" ); + makeLexError(p, "invalid character"); (null or Word)(NULL)) is word:Word do ( for length(word.name) do getc(file); @@ -117,13 +131,14 @@ getstringslashes(o:PosFile):(null or Word) := ( -- /// ... /// ch := getc(o); if ch == ERROR then ( if !test(interruptedFlag) - then printErrorMessage(o.filename,line,column,"ERROR in string /// ... /// beginning here: " + o.file.errorMessage); - empty(tokenbuf); + then makeLexError(newPosition(o, line, column), + "ERROR in string /// ... /// beginning here: " + + o.file.errorMessage); return NULL; ); if ch == EOF then ( - printErrorMessage(o.filename,line,column,"EOF in string /// ... /// beginning here"); - empty(tokenbuf); + makeLexError(newPosition(o, line, column), + "EOF in string /// ... /// beginning here"); return NULL; ); -- this allows us to get 3,4,5,... slashes within the string by typing 4,6,8,... slashes @@ -168,17 +183,16 @@ getstring(o:PosFile):(null or Word) := ( ch := getc(o); if ch == ERROR then ( if !test(interruptedFlag) - then printErrorMessage(o.filename,line,column, - (if o.file.eof - then "reading beyond EOF in string beginning here: " - else "ERROR in string beginning here: ") - + o.file.errorMessage); - empty(tokenbuf); + then makeLexError(newPosition(o, line, column), + (if o.file.eof + then "reading beyond EOF in string beginning here: " + else "ERROR in string beginning here: ") + + o.file.errorMessage); return NULL; ); if ch == EOF then ( - printErrorMessage(o.filename,line,column,"EOF in string beginning here"); - empty(tokenbuf); + makeLexError(newPosition(o, line, column), + "EOF in string beginning here"); return NULL; ); tokenbuf << char(ch); @@ -187,9 +201,9 @@ getstring(o:PosFile):(null or Word) := ( hexcoming = hexcoming - 1; ) else ( - printErrorMessage(o.filename,line,column,"expected " + - tostring(hexcoming) + " more hex digit(s)"); - empty(tokenbuf); + makeLexError(newPosition(o, line, column), + "expected " + tostring(hexcoming) + + " more hex digit(s)"); while true do (ch2 := getc(o); if ch2 == EOF || ch2 == ERROR || ch2 == int('\n') then return NULL;); ) ) @@ -211,8 +225,8 @@ getstring(o:PosFile):(null or Word) := ( || int('0') <= ch && ch < int('8') then escaped = false else ( - empty(tokenbuf); - printErrorMessage(o.filename,line,column,"unknown escape sequence: \\" + char(ch)); + makeLexError(newPosition(o, line, column), + "unknown escape sequence: \\" + char(ch)); while true do (ch2 := getc(o); if ch2 == EOF || ch2 == ERROR || ch2 == int('\n') then return NULL;); ); ) @@ -285,23 +299,20 @@ export errorToken := Token(Word("-*error token*-",TCnone,hash_t(0),newParseinfo( globalDictionary, -- should replace this by dummyDictionary, I think dummySymbol,false); -newPosition(file:PosFile, line:ushort, column:ushort):Position := Position( - -- [ beginning ] [ endpoint ] [ focus ] - file.filename, line, column, file.line, file.column, line, column, loadDepth); - gettoken1(file:PosFile,sawNewline:bool):Token := ( -- warning : tokenbuf is static while true do ( rc := skipwhite(file); if rc == ERROR then return errorToken; if rc == EOF then ( - printErrorMessage(file.filename,swline,swcolumn,"EOF in block comment -* ... *- beginning here"); - -- empty(tokenbuf); + makeLexError(newPosition(file, swline, swcolumn), + "EOF in block comment -* ... *- beginning here"); -- while true do (ch2 := getc(file); if ch2 == EOF || ch2 == ERROR || ch2 == int('\n') then break;); return errorToken; ); if rc == DEPRECATED then ( - printErrorMessage(file.filename,swline,swcolumn,"encountered disabled block comment syntax {* ... *} beginning here"); + makeLexError(newPosition(file, swline, swcolumn), + "encountered disabled block comment syntax {* ... *} beginning here"); return errorToken; ); line := file.line; @@ -371,8 +382,8 @@ gettoken1(file:PosFile,sawNewline:bool):Token := ( tokenbuf << char(getc(file)); while isdigit(peek(file)) do tokenbuf << char(getc(file))) else ( - printErrorMessage(position(file),"precision missing in floating point constant"); - empty(tokenbuf); + makeLexError(position(file), + "precision missing in floating point constant"); return errorToken; ) ); @@ -387,8 +398,8 @@ gettoken1(file:PosFile,sawNewline:bool):Token := ( while isdigit(peek(file)) do tokenbuf << char(getc(file)); ) else ( - printErrorMessage(position(file),"exponent missing in floating point constant"); - empty(tokenbuf); + makeLexError(position(file), + "exponent missing in floating point constant"); return errorToken; ) ); @@ -419,10 +430,7 @@ gettoken1(file:PosFile,sawNewline:bool):Token := ( newPosition(file, line, column), globalDictionary, dummySymbol, sawNewline)) else ( when recognize(file) - is null do ( - empty(tokenbuf); - return errorToken - ) + is null do return errorToken is word:Word do return Token(word, newPosition(file, line, column), globalDictionary, dummySymbol, sawNewline)) ) diff --git a/M2/Macaulay2/d/parser.d b/M2/Macaulay2/d/parser.d index 98ca764320..39b5600f8f 100644 --- a/M2/Macaulay2/d/parser.d +++ b/M2/Macaulay2/d/parser.d @@ -182,14 +182,14 @@ accumulate(e:ParseTree,file:TokenFile,prec:int,obeylines:bool):ParseTree := ( ); ret ); +makeParseError(token:Token, message:string):ParseTree := ( + printErrorMessage(token, message); + setLastErrorpointer(token.position, message); + errorTree); export errorunary(token1:Token,file:TokenFile,prec:int,obeylines:bool):ParseTree := ( - printErrorMessage(token1,"syntax error at '" + token1.word.name + "'"); - errorTree - ); + makeParseError(token1,"syntax error at '" + token1.word.name + "'")); export errorbinary(lhs:ParseTree, token2:Token, file:TokenFile, prec:int,obeylines:bool):ParseTree := ( - printErrorMessage(token2,"syntax error at '" + token2.word.name + "'"); - errorTree - ); + makeParseError(token2,"syntax error at '" + token2.word.name + "'")); export defaultunary(token1:Token,file:TokenFile,prec:int,obeylines:bool):ParseTree := ( accumulate(ParseTree(token1),file,prec,obeylines) ); @@ -213,8 +213,7 @@ export nnunaryop(token1:Token,file:TokenFile,prec:int,obeylines:bool):ParseTree else accumulate(ParseTree(Unary(token1,ret)),file,prec,obeylines))); export defaultbinary(lhs:ParseTree, token2:Token, file:TokenFile, prec:int, obeylines:bool):ParseTree := ( if token2.followsNewline then ( - printErrorMessage(token2,"missing semicolon or comma on previous line?"); - errorTree) + makeParseError(token2,"missing semicolon or comma on previous line?")) else ( ret := token2.word.parse.funs.unary(token2,file,precSpace-1,obeylines); if ret == errorTree then ret else ParseTree(Adjacent(lhs,ret)))); @@ -284,9 +283,8 @@ export unaryparen(left:Token,file:TokenFile,prec:int,obeylines:bool):ParseTree : if rightparen == right.word.name then accumulate(ParseTree(Parentheses(left,e,right)),file,prec,obeylines) else ( - printErrorMessage(right, "expected \"" + rightparen + "\""); - printErrorMessage(left," ... to match this"); - errorTree))); + makeParseError(right, "expected \"" + rightparen + "\""); + makeParseError(left," ... to match this")))); export unarywhile(whileToken:Token,file:TokenFile,prec:int,obeylines:bool):ParseTree := ( predicate := parse(file,whileToken.word.parse.unaryStrength,false); if predicate == errorTree then return errorTree; @@ -311,9 +309,8 @@ export unarywhile(whileToken:Token,file:TokenFile,prec:int,obeylines:bool):Parse ret := ParseTree(WhileList(whileToken,predicate,token2,listClause)); accumulate(ret,file,prec,obeylines))) else ( - printErrorMessage(token2,"syntax error : expected 'do' or 'list'"); - printErrorMessage(whileToken," ... to match this 'while'"); - errorTree)); + makeParseError(token2,"syntax error : expected 'do' or 'list'"); + makeParseError(whileToken," ... to match this 'while'"))); --Handle parsing a file following a for token export unaryfor(forToken:Token,file:TokenFile,prec:int,obeylines:bool):ParseTree := ( @@ -375,9 +372,8 @@ export unaryfor(forToken:Token,file:TokenFile,prec:int,obeylines:bool):ParseTree accumulate(r,file,prec,obeylines)) --if there is no do clause then it is an error else ( - printErrorMessage(token2,"syntax error : expected 'do' or 'list'"); - printErrorMessage(forToken," ... to match this 'for'"); - errorTree)); + makeParseError(token2,"syntax error : expected 'do' or 'list'"); + makeParseError(forToken," ... to match this 'for'"))); -- unstringToken(q:Token):Token := ( -- if q.word.typecode == TCstring @@ -396,25 +392,25 @@ export unaryfor(forToken:Token,file:TokenFile,prec:int,obeylines:bool):ParseTree export unarysymbol(quotetoken:Token,file:TokenFile,prec:int,obeylines:bool):ParseTree := ( arg := gettoken(file,false); if arg == errorToken then return errorTree; - if arg.word.typecode != TCid then ( printErrorMessage(arg, "syntax error: " + arg.word.name); return errorTree; ); + if arg.word.typecode != TCid then return makeParseError(arg, "syntax error: " + arg.word.name); r := ParseTree(Quote(quotetoken,arg)); accumulate(r,file,prec,obeylines)); export unaryglobal(quotetoken:Token,file:TokenFile,prec:int,obeylines:bool):ParseTree := ( arg := gettoken(file,false); if arg == errorToken then return errorTree; - if arg.word.typecode != TCid then ( printErrorMessage(arg, "syntax error: " + arg.word.name); return errorTree; ); + if arg.word.typecode != TCid then return makeParseError(arg, "syntax error: " + arg.word.name); r := ParseTree(GlobalQuote(quotetoken,arg)); accumulate(r,file,prec,obeylines)); export unarythread(quotetoken:Token,file:TokenFile,prec:int,obeylines:bool):ParseTree := ( arg := gettoken(file,false); if arg == errorToken then return errorTree; - if arg.word.typecode != TCid then ( printErrorMessage(arg, "syntax error: " + arg.word.name); return errorTree; ); + if arg.word.typecode != TCid then makeParseError(arg, "syntax error: " + arg.word.name); r := ParseTree(ThreadQuote(quotetoken,arg)); accumulate(r,file,prec,obeylines)); export unarylocal(quotetoken:Token,file:TokenFile,prec:int,obeylines:bool):ParseTree := ( arg := gettoken(file,false); if arg == errorToken then return errorTree; - if arg.word.typecode != TCid then ( printErrorMessage(arg, "syntax error: " + arg.word.name); return errorTree; ); + if arg.word.typecode != TCid then makeParseError(arg, "syntax error: " + arg.word.name); r := ParseTree(LocalQuote(quotetoken,arg)); accumulate(r,file,prec,obeylines)); export unaryif(ifToken:Token,file:TokenFile,prec:int,obeylines:bool):ParseTree := ( @@ -423,9 +419,8 @@ export unaryif(ifToken:Token,file:TokenFile,prec:int,obeylines:bool):ParseTree : thenToken := gettoken(file,false); if thenToken == errorToken then return errorTree; if thenToken.word != thenW then ( - printErrorMessage(thenToken,"syntax error : expected 'then'"); - printErrorMessage(ifToken," ... to match this 'if'"); - return errorTree); + makeParseError(thenToken,"syntax error : expected 'then'"); + return makeParseError(ifToken," ... to match this 'if'")); thenClause := parse(file,thenW.parse.unaryStrength,obeylines); if thenClause == errorTree then return errorTree; if peektoken(file,obeylines).word == elseW then ( @@ -446,9 +441,8 @@ export unarytry(tryToken:Token,file:TokenFile,prec:int,obeylines:bool):ParseTree elseToken := gettoken(file,false); if elseToken == errorToken then return errorTree; if elseToken.word != elseW then ( - printErrorMessage(elseToken,"syntax error : expected 'else'"); - printErrorMessage(tryToken," ... to match this 'try'"); - return errorTree); + makeParseError(elseToken,"syntax error : expected 'else'"); + return makeParseError(tryToken," ... to match this 'try'")); elseClause := parse(file,elseW.parse.unaryStrength,obeylines); if elseClause == errorTree then return errorTree; accumulate(ParseTree(TryElse(tryToken,primary,elseToken,elseClause)),file,prec,obeylines)) diff --git a/M2/Macaulay2/m2/exports.m2 b/M2/Macaulay2/m2/exports.m2 index 354035d0a7..e6f5ebd9de 100644 --- a/M2/Macaulay2/m2/exports.m2 +++ b/M2/Macaulay2/m2/exports.m2 @@ -1340,6 +1340,7 @@ exportMutable { "handleInterrupts", "homeDirectory", "interpreterDepth", + "lastError", "lastMatch", "lineNumber", "loadDepth", diff --git a/M2/Macaulay2/packages/Macaulay2Doc/ov_debugging.m2 b/M2/Macaulay2/packages/Macaulay2Doc/ov_debugging.m2 index be5b4dac4e..e0f00f1f42 100644 --- a/M2/Macaulay2/packages/Macaulay2Doc/ov_debugging.m2 +++ b/M2/Macaulay2/packages/Macaulay2Doc/ov_debugging.m2 @@ -327,6 +327,32 @@ document { } } +doc /// + Key + symbol lastError + Headline + information about the last error + Usage + lastError + Outputs + :Sequence + of two elements, the @TO FilePosition@ of the code that generated + the last error and a string containing the error message + Description + Example + try 1/0 + lastError + Text + The last error is local to each thread. + Example + taskResult schedule(() -> try error "foo" else lastError) + lastError + Text + Clear the value by assigning null. + Example + lastError = null +/// + document { Key => "recursionLimit", diff --git a/M2/Macaulay2/packages/Macaulay2Doc/ov_language.m2 b/M2/Macaulay2/packages/Macaulay2Doc/ov_language.m2 index 96e5daeada..4fdc15ae3a 100644 --- a/M2/Macaulay2/packages/Macaulay2Doc/ov_language.m2 +++ b/M2/Macaulay2/packages/Macaulay2Doc/ov_language.m2 @@ -699,6 +699,7 @@ document { TO "error", TO "try", TO "throw", + TO "Macaulay2Doc::lastError" -- TODO: why do we need to specify pkg? } } diff --git a/M2/Macaulay2/tests/normal/error-messages.m2 b/M2/Macaulay2/tests/normal/error-messages.m2 index 2d175e2372..30b62f2c58 100644 --- a/M2/Macaulay2/tests/normal/error-messages.m2 +++ b/M2/Macaulay2/tests/normal/error-messages.m2 @@ -1,3 +1,7 @@ +assert(try 1/0 else lastError#1 == "division by zero") +lastError = null +assert(lastError === null) + stderr << "--testing the error messages must be done manually" << endl end