Refactor source-file-errors a little bit to remove some code duplication, and so that clicking 'Edit' in error list tool works for parse errors in unit tests
parent
c3d60e5899
commit
3b2fd98e7c
|
@ -47,43 +47,12 @@ M: cannot-find-source error.
|
|||
: edit-vocab ( name -- )
|
||||
>vocab-link edit ;
|
||||
|
||||
GENERIC: error-file ( error -- file )
|
||||
|
||||
GENERIC: error-line ( error -- line )
|
||||
|
||||
M: lexer-error error-file
|
||||
error>> error-file ;
|
||||
|
||||
M: lexer-error error-line
|
||||
[ error>> error-line ] [ line>> ] bi or ;
|
||||
|
||||
M: source-file-error error-file
|
||||
[ error>> error-file ] [ file>> ] bi or ;
|
||||
|
||||
M: source-file-error error-line
|
||||
error>> error-line ;
|
||||
|
||||
M: condition error-file
|
||||
error>> error-file ;
|
||||
|
||||
M: condition error-line
|
||||
error>> error-line ;
|
||||
|
||||
M: object error-file
|
||||
drop f ;
|
||||
|
||||
M: object error-line
|
||||
drop f ;
|
||||
|
||||
: (:edit) ( error -- )
|
||||
: edit-error ( error -- )
|
||||
[ error-file ] [ error-line ] bi
|
||||
2dup and [ edit-location ] [ 2drop ] if ;
|
||||
|
||||
: :edit ( -- )
|
||||
error get (:edit) ;
|
||||
|
||||
: edit-error ( error -- )
|
||||
[ file>> ] [ line#>> ] bi 2dup and [ edit-location ] [ 2drop ] if ;
|
||||
error get edit-error ;
|
||||
|
||||
: edit-each ( seq -- )
|
||||
[
|
||||
|
|
|
@ -14,14 +14,16 @@ M: source-file-error error-help error>> error-help ;
|
|||
|
||||
CONSTANT: +listener-input+ "<Listener input>"
|
||||
|
||||
M: source-file-error summary
|
||||
: error-location ( error -- string )
|
||||
[
|
||||
[ file>> [ % ": " % ] [ +listener-input+ % ] if* ]
|
||||
[ line#>> [ # ] when* ] bi
|
||||
[ file>> [ % ] [ +listener-input+ % ] if* ]
|
||||
[ line#>> [ ": " % # ] when* ] bi
|
||||
] "" make ;
|
||||
|
||||
M: source-file-error summary error>> summary ;
|
||||
|
||||
M: source-file-error error.
|
||||
[ summary print nl ]
|
||||
[ error-location print nl ]
|
||||
[ asset>> [ "Asset: " write short. nl ] when* ]
|
||||
[ error>> error. ]
|
||||
tri ;
|
||||
|
|
|
@ -130,7 +130,7 @@ TEST: must-fail
|
|||
|
||||
M: test-failure error. ( error -- )
|
||||
{
|
||||
[ summary print nl ]
|
||||
[ error-location print nl ]
|
||||
[ asset>> [ experiment. nl ] when* ]
|
||||
[ error>> error. ]
|
||||
[ traceback-button. ]
|
||||
|
|
|
@ -1,7 +1,8 @@
|
|||
! Copyright (C) 2008, 2009 Slava Pestov.
|
||||
! See http://factorcode.org/license.txt for BSD license.
|
||||
USING: kernel sequences accessors namespaces math words strings
|
||||
io vectors arrays math.parser combinators continuations ;
|
||||
io vectors arrays math.parser combinators continuations
|
||||
source-files.errors ;
|
||||
IN: lexer
|
||||
|
||||
TUPLE: lexer text line line-text line-length column ;
|
||||
|
@ -24,11 +25,8 @@ TUPLE: lexer text line line-text line-length column ;
|
|||
|
||||
ERROR: unexpected want got ;
|
||||
|
||||
PREDICATE: unexpected-tab < unexpected
|
||||
got>> CHAR: \t = ;
|
||||
|
||||
: forbid-tab ( c -- c )
|
||||
[ CHAR: \t eq? [ "[space]" "[tab]" unexpected ] when ] keep ;
|
||||
[ CHAR: \t eq? [ "[space]" "[tab]" unexpected ] when ] keep ; inline
|
||||
|
||||
: skip ( i seq ? -- n )
|
||||
over length
|
||||
|
@ -96,6 +94,9 @@ PREDICATE: unexpected-eof < unexpected
|
|||
|
||||
TUPLE: lexer-error line column line-text error ;
|
||||
|
||||
M: lexer-error error-file error>> error-file ;
|
||||
M: lexer-error error-line [ error>> error-line ] [ line>> ] bi or ;
|
||||
|
||||
: <lexer-error> ( msg -- error )
|
||||
\ lexer-error new
|
||||
lexer get
|
||||
|
|
|
@ -1,11 +1,23 @@
|
|||
! Copyright (C) 2009 Slava Pestov.
|
||||
! See http://factorcode.org/license.txt for BSD license.
|
||||
USING: accessors assocs kernel math.order sorting sequences definitions
|
||||
namespaces arrays splitting io math.parser math init ;
|
||||
namespaces arrays splitting io math.parser math init continuations ;
|
||||
IN: source-files.errors
|
||||
|
||||
GENERIC: error-file ( error -- file )
|
||||
GENERIC: error-line ( error -- line )
|
||||
|
||||
M: object error-file drop f ;
|
||||
M: object error-line drop f ;
|
||||
|
||||
M: condition error-file error>> error-file ;
|
||||
M: condition error-line error>> error-line ;
|
||||
|
||||
TUPLE: source-file-error error asset file line# ;
|
||||
|
||||
M: source-file-error error-file [ error>> error-file ] [ file>> ] bi or ;
|
||||
M: source-file-error error-line [ error>> error-line ] [ line#>> ] bi or ;
|
||||
|
||||
: sort-errors ( errors -- alist )
|
||||
[ [ line#>> ] sort-with ] { } assoc-map-as sort-keys ;
|
||||
|
||||
|
|
Loading…
Reference in New Issue