This commit is contained in:
Vitor Santos Costa 2018-10-31 00:35:49 +00:00
parent a491f71cb0
commit 004bbef62b
7 changed files with 61 additions and 46 deletions

View File

@ -1266,7 +1266,7 @@ static Int is_predicate_indicator(USES_REGS1) {
void Yap_InitErrorPreds(void) { void Yap_InitErrorPreds(void) {
CACHE_REGS CACHE_REGS
Yap_InitCPred("$print_exception<", 1, print_exception, 0); Yap_InitCPred("$print_exception", 1, print_exception, 0);
Yap_InitCPred("$reset_exception", 1, reset_exception, 0); Yap_InitCPred("$reset_exception", 1, reset_exception, 0);
Yap_InitCPred("$new_exception", 1, new_exception, 0); Yap_InitCPred("$new_exception", 1, new_exception, 0);
Yap_InitCPred("$get_exception", 1, get_exception, 0); Yap_InitCPred("$get_exception", 1, get_exception, 0);

View File

@ -392,25 +392,25 @@ static Term syntax_error(TokEntry *errtok, int sno, Term cmod, Int newpos, bool
if (GLOBAL_Stream[sno].status & Seekable_Stream_f) if (GLOBAL_Stream[sno].status & Seekable_Stream_f)
{ {
char *o, *o2; char *o, *o2;
if (startpos)
startpos--;
#if HAVE_FTELLO #if HAVE_FTELLO
fseeko(GLOBAL_Stream[sno].file, startpos, SEEK_SET); fseeko(GLOBAL_Stream[sno].file, startpos, SEEK_SET);
#else #else
fseek(GLOBAL_Stream[sno].file, startpos, SEEK_SET); fseek(GLOBAL_Stream[sno].file, startpos, SEEK_SET);
#endif #endif
int lvl = push_text_stack();
if (GLOBAL_Stream[sno].status & Seekable_Stream_f) if (GLOBAL_Stream[sno].status & Seekable_Stream_f)
{ {
char *o, *o2;
while (tok) while (tok)
{ {
if (tok->Tok != Error_tok) if (tok->Tok != Error_tok)
{ {
tok = tok->TokNext; tok = tok->TokNext;
} }
} break;
}
err_line = tok->TokLine; err_line = tok->TokLine;
errpos = tok->TokPos; errpos = tok->TokPos -1;
if (errpos <= startpos) if (errpos <= startpos)
{ {
o = malloc(1); o = malloc(1);
@ -421,24 +421,12 @@ static Term syntax_error(TokEntry *errtok, int sno, Term cmod, Int newpos, bool
Int sza = (errpos - startpos) + 1, tot = sza; Int sza = (errpos - startpos) + 1, tot = sza;
o = malloc(sza); o = malloc(sza);
char *p = o; char *p = o;
while (true)
{ {
size_t siz = fread(p, tot - 1, 1, GLOBAL_Stream[sno].file); size_t siz = fread(p, tot - 1, 1, GLOBAL_Stream[sno].file);
if (siz < 0) if (siz < 0)
Yap_Error(EVALUATION_ERROR_READ_STREAM, GLOBAL_Stream[sno].user_name, "%s", strerror(errno)); Yap_Error(EVALUATION_ERROR_READ_STREAM, GLOBAL_Stream[sno].user_name, "%s", strerror(errno));
if (siz < tot - 1)
{
p += siz;
tot -= siz;
}
else
{
break;
}
}
o[sza - 1] = '\0'; o[sza - 1] = '\0';
} }
}
Yap_local.ActiveError->parserTextA = o; Yap_local.ActiveError->parserTextA = o;
if (endpos <= errpos) if (endpos <= errpos)
{ {
@ -450,25 +438,17 @@ static Term syntax_error(TokEntry *errtok, int sno, Term cmod, Int newpos, bool
Int sza = (endpos - errpos) + 1, tot = sza; Int sza = (endpos - errpos) + 1, tot = sza;
o2 = malloc(sza); o2 = malloc(sza);
char *p = o2; char *p = o2;
while (true)
{ {
size_t siz = fread(p, tot - 1, 1, GLOBAL_Stream[sno].file); size_t siz = fread(p, tot - 1, 1, GLOBAL_Stream[sno].file);
if (siz < 0) if (siz < 0)
Yap_Error(EVALUATION_ERROR_READ_STREAM, GLOBAL_Stream[sno].user_name, "%s", strerror(errno)); Yap_Error(EVALUATION_ERROR_READ_STREAM, GLOBAL_Stream[sno].user_name, "%s", strerror(errno));
if (siz < tot - 1)
{
p += siz;
tot -= siz;
}
else
{
break;
}
}
o2[sza - 1] = '\0'; o2[sza - 1] = '\0';
} }
Yap_local.ActiveError->parserTextB = o2; Yap_local.ActiveError->parserTextB = o2;
} }
}
}
else else
{ {
size_t sz = 1024, e; size_t sz = 1024, e;
@ -506,7 +486,8 @@ static Term syntax_error(TokEntry *errtok, int sno, Term cmod, Int newpos, bool
o = realloc(o, strlen(o) + 1); o = realloc(o, strlen(o) + 1);
Yap_local.ActiveError->parserTextB = o; Yap_local.ActiveError->parserTextB = o;
} }
Yap_local.ActiveError->parserPos = errpos; }
Yap_local.ActiveError->parserPos = errpos;
Yap_local.ActiveError->parserLine = err_line; Yap_local.ActiveError->parserLine = err_line;
/* 0: strat, error, end line */ /* 0: strat, error, end line */
/*2 msg */ /*2 msg */
@ -1182,7 +1163,7 @@ static Term syntax_error(TokEntry *errtok, int sno, Term cmod, Int newpos, bool
LOCAL_Error_TYPE = WARNING_SYNTAX_ERROR; LOCAL_Error_TYPE = WARNING_SYNTAX_ERROR;
t = Yap_MkFullError(); t = Yap_MkFullError();
Yap_PrintWarning(t); Yap_PrintWarning(t);
LOCAL_Error_TYPE = YAPC_NO_ERROR; LOCAL_Error_TYPE = YAP_NO_ERROR;
if (ParserErrorStyle == TermDec10) if (ParserErrorStyle == TermDec10)
{ {
return YAP_SCANNING; return YAP_SCANNING;

View File

@ -94,7 +94,7 @@ error_handler(Error, Level) :-
'$LoopError'(Error, Level). '$LoopError'(Error, Level).
'$LoopError'(_, _) :- '$LoopError'(_, _) :-
stop_low_level_trace, %stop_low_level_trace,
flush_output(user_output), flush_output(user_output),
flush_output(user_error), flush_output(user_error),
fail. fail.

View File

@ -203,15 +203,15 @@ compose_message(error(warning(syntax_error,Info), Exc), Level) -->
compose_message(error(syntax_error(Info), Exc), Level). compose_message(error(syntax_error(Info), Exc), Level).
compose_message(error(E, Exc), Level) --> compose_message(error(E, Exc), Level) -->
{ {
% start_low_level_trace, '$show_consult_level'(LC)
'$show_consult_level'(LC)
}, },
location(error(E, Exc), Level, LC), location(error(E, Exc), Level, LC),
main_message(error(E,Exc) , Level, LC ), main_message(error(E,Exc) , Level, LC ),
c_goal( error(E, Exc), Level ), c_goal( error(E, Exc), Level ),
caller( error(E, Exc), Level ), caller( error(E, Exc), Level ),
extra_info( error(E, Exc), Level ), extra_info( error(E, Exc), Level ),
% { stop_low_level_trace }, stack_info( error(E, Exc), Level ),
% { stop_low_level_trace },
!, !,
[nl], [nl],
[nl]. [nl].
@ -278,14 +278,13 @@ location( error(_,Info), Level, LC ) -->
query_exception(prologPredLine, Desc, FilePos), query_exception(prologPredLine, Desc, FilePos),
query_exception(prologPredModule, Desc, M), query_exception(prologPredModule, Desc, M),
query_exception(prologPredName, Desc, Na), query_exception(prologPredName, Desc, Na),
query_exception(prologPredArity, Desc, Ar), query_exception(prologPredArity, Desc, Ar)
query_exception(prologStack, Desc, Stack)
}, },
!, !,
display_consulting( File, Level, Info, LC ), display_consulting( File, Level, Info, LC ),
{simplify_pred(M:Na/Ar,FF)}, {simplify_pred(M:Na/Ar,FF)},
[ '~a:~d:0 ~a while executing ~q:'-[File, FilePos,Level,FF] ], [ '~a:~d:0 ~a while executing ~q:'-[File, FilePos,Level,FF] ].
( { Stack == [] } -> [] ; [ nl, Stack- [] ]).
location( error(_,Info), Level, LC ) --> location( error(_,Info), Level, LC ) -->
{ '$error_descriptor'(Info, Desc) }, { '$error_descriptor'(Info, Desc) },
{ {
@ -433,6 +432,21 @@ extra_info( error(_,Info), _ ) -->
extra_info( _, _ ) --> extra_info( _, _ ) -->
[]. [].
stack_info( error(_,Info), _ ) -->
{ '$error_descriptor'(Info, Desc) },
{
query_exception(prologStack, Desc, Stack),
Stack \= []
},
!,
['~*|Prolog execution stack is:' - [10]],
[nl],
[Stack - []].
stack_info( _, _ ) -->
[].
prolog_message(X) --> prolog_message(X) -->
system_message(X). system_message(X).
@ -1028,7 +1042,8 @@ prolog:print_message(Severity, Msg) :-
!. !.
prolog:print_message(Level, _Msg) :- prolog:print_message(Level, _Msg) :-
current_prolog_flag(verbose_load, false), current_prolog_flag(verbose_load, false),
stream_property(_Stream, alias(loop_stream) ), '$show_consult_level'(LC),
LC > 0,
Level = informational, Level = informational,
!. !.
prolog:print_message(Level, _Msg) :- prolog:print_message(Level, _Msg) :-
@ -1070,6 +1085,7 @@ prolog:print_message(Severity, Term) :-
prolog:print_message(_Severity, _Term) :- prolog:print_message(_Severity, _Term) :-
format(user_error,'failed to print ~w: ~w~n' ,[ _Severity, _Term]). format(user_error,'failed to print ~w: ~w~n' ,[ _Severity, _Term]).
'$error_descriptor'( V, Info ) :- var(V), !, Info = [].
'$error_descriptor'( exception(Info), Info ). '$error_descriptor'( exception(Info), Info ).
query_exception(K0,[H|L],V) :- query_exception(K0,[H|L],V) :-

View File

@ -23,6 +23,7 @@
% start a Prolog engine. % start a Prolog engine.
live :- live :-
repeat, repeat,
yap_flag(verbose,normal),
'$current_module'(Module), '$current_module'(Module),
( Module==user -> ( Module==user ->
true % '$compile_mode'(_,0) true % '$compile_mode'(_,0)
@ -582,6 +583,15 @@ write_query_answer( Bindings ) :-
'$current_choice_point'(CP), '$current_choice_point'(CP),
'$call'(G, CP, G, M). '$call'(G, CP, G, M).
'$user_call'(G, CP, G0, M) :-
gated_call(
'$enable_debugging',
'$call'(G, CP, G0, M),
Port,
'$disable_debugging_on_port'(Port)
).
'$user_call'(G, M) :- '$user_call'(G, M) :-
gated_call( gated_call(
'$enable_debugging', '$enable_debugging',

View File

@ -107,6 +107,10 @@ option(Opt, _, Default) :-
% %
% @param Option Term of the form Name(?Value). % @param Option Term of the form Name(?Value).
option(Opt, Options) :- % make option processing stead-fast
atom(Opt),
!,
get_option(Opt, Options).
option(Opt, Options) :- % make option processing stead-fast option(Opt, Options) :- % make option processing stead-fast
arg(1, Opt, OptVal), arg(1, Opt, OptVal),
nonvar(OptVal), !, nonvar(OptVal), !,
@ -132,6 +136,10 @@ get_option(Opt, Options) :-
% the matching option from Options and unifying the remaining % the matching option from Options and unifying the remaining
% options with RestOptions. % options with RestOptions.
select_option(Opt, Options0, Options) :- % stead-fast
atom(Opt),
!,
select_option(Opt, Options0, Options).
select_option(Opt, Options0, Options) :- % stead-fast select_option(Opt, Options0, Options) :- % stead-fast
arg(1, Opt, OptVal), arg(1, Opt, OptVal),
nonvar(OptVal), !, nonvar(OptVal), !,

View File

@ -422,7 +422,7 @@ valid_test_mode(Options0, Options) :-
test_mode(true(_)). test_mode(true(_)).
test_mode(all(_)). test_mode(all(_)).
test_mode(set(_)). test_mode(set(_)).
test_mode(fail(_)). test_mode(fail).
test_mode(throws(_)). test_mode(throws(_)).
@ -509,7 +509,7 @@ verify_options([H|T], Pred) :-
test_option(Option) :- test_option(Option) :-
test_set_option(Option), !. test_set_option(Option), !.
test_option(true(_)). test_option(true(_)).
test_option(fail(_)). test_option(fail).
test_option(throws(_)). test_option(throws(_)).
test_option(all(_)). test_option(all(_)).
test_option(set(_)). test_option(set(_)).
@ -889,7 +889,7 @@ run_test_6(Unit, Name, Line, Options, Body, Result) :-
option(set(Answer), Options), !, % set(Bindings) option(set(Answer), Options), !, % set(Bindings)
nondet_test(set(Answer), Unit, Name, Line, Options, Body, Result). nondet_test(set(Answer), Unit, Name, Line, Options, Body, Result).
run_test_6(Unit, Name, Line, Options, Body, Result) :- run_test_6(Unit, Name, Line, Options, Body, Result) :-
option(fail(true), Options), !, % fail option(fail, Options), !, % fail
unit_module(Unit, Module), unit_module(Unit, Module),
( setup(Module, test(Unit,Name,Line), Options) ( setup(Module, test(Unit,Name,Line), Options)
-> statistics(runtime, [T0,_]), -> statistics(runtime, [T0,_]),
@ -1095,8 +1095,8 @@ setup(_,_,_).
% Call Goal in Module after applying goal expansion. % Call Goal in Module after applying goal expansion.
call_ex(Module, Goal) :- call_ex(Module, Goal) :-
(expand_goal(Goal,Module: GoalEx), expand_goal(Module:Goal, GoalEx),
Module:GoalEx). call(GoalEx).
%% cleanup(+Module, +Options) is det. %% cleanup(+Module, +Options) is det.
% %