From a72e66d2ae5cd6cce5810a0e65a736b7e3a49483 Mon Sep 17 00:00:00 2001 From: Vitor Santos Costa Date: Mon, 16 May 2016 09:22:03 +0100 Subject: [PATCH] protect against files that consult themselves --- pl/boot.yap | 1 + pl/consult.yap | 14 ++++++++++++-- 2 files changed, 13 insertions(+), 2 deletions(-) diff --git a/pl/boot.yap b/pl/boot.yap index ea6bb78c9..062cc1c7f 100644 --- a/pl/boot.yap +++ b/pl/boot.yap @@ -471,6 +471,7 @@ true :- true. nb_setval('$endif',off), nb_setval('$initialization_goals',off), nb_setval('$included_file',[]), + nb_setval('$loop_streams',[]), \+ '$undefined'('$init_preds',prolog), '$init_preds', fail. diff --git a/pl/consult.yap b/pl/consult.yap index ed8daf1f1..e1426df26 100644 --- a/pl/consult.yap +++ b/pl/consult.yap @@ -652,11 +652,19 @@ db_files(Fs) :- '$extract_minus'([-F|Fs], [F|MFs]) :- '$extract_minus'(Fs, MFs). +'$do_lf'(_ContextModule, Stream, _UserFile, _File, _TOpts) :- + stream_property(Stream, file_name(Y)), + b_getval('$loop_streams',Sts0), + lists:member(Stream0, Sts0), + stream_property(Stream0, file_name(Y)), + !. '$do_lf'(ContextModule, Stream, UserFile, File, TOpts) :- - prompt1(': '), prompt(_,' '), + prompt1(': '), prompt(_,' '), stream_property(OldStream, alias(loop_stream) ), '$lf_opt'(encoding, TOpts, Encoding), - set_stream( Stream, [alias(loop_stream), encoding(Encoding)] ), + set_stream( Stream, [alias(loop_stream), encoding(Encoding)] ), + '$nb_getval'('$loop_streams',Sts0, Sts0=[]), + nb_setval('$loop_streams',[Stream|Sts0]), '$lf_opt'('$context_module', TOpts, ContextModule), '$lf_opt'(reexport, TOpts, Reexport), '$lf_opt'(qcompile, TOpts, QCompiling), @@ -704,6 +712,7 @@ db_files(Fs) :- H is heapused-H0, '$cputime'(TF,_), T is TF-T0, '$early_print'(informational, loaded(EndMsg, File, Mod, T, H)), '$end_consult', + nb_setval('$loop_streams',Sts0), '$q_do_save_file'(File, UserFile, TOpts ), ( Reconsult = reconsult -> @@ -728,6 +737,7 @@ db_files(Fs) :- % format( 'O=~w~n', [Mod=UserFile] ), !. + '$q_do_save_file'(File, UserF, TOpts ) :- '$lf_opt'(qcompile, TOpts, QComp), '$lf_opt'('$source_pos', TOpts, Pos),