From 477f490820a28e479527e93d420f26ea23fdf3e3 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Bj=C3=B6rn=20Gustavsson?= Date: Wed, 2 Mar 2016 06:33:45 +0100 Subject: Replace "%" with "%%" at the beginning of a line We want to re-ident the source files after having taken out all ?line macros. When re-indenting using Emacs, it's important that comments that should be at the beginning of a line (or follow the indentation of statements around it) must start with "%%". --- lib/stdlib/test/run_pcre_tests.erl | 37 +++++++------------------------------ 1 file changed, 7 insertions(+), 30 deletions(-) (limited to 'lib/stdlib/test/run_pcre_tests.erl') diff --git a/lib/stdlib/test/run_pcre_tests.erl b/lib/stdlib/test/run_pcre_tests.erl index b7d1df39b8..8b0373d062 100644 --- a/lib/stdlib/test/run_pcre_tests.erl +++ b/lib/stdlib/test/run_pcre_tests.erl @@ -69,8 +69,6 @@ pick_exec_options([]) -> test([],_,_,_) -> 0; test([{RE0,Line,Options0,Tests}|T],PreCompile,XMode,REAsList) -> - %io:format("."), - %case RE of <<>> -> io:format("Empty re:~w~n",[Line]); _ -> ok end, Unicode = lists:member(unicode,Options0), RE = case REAsList of true -> @@ -90,7 +88,6 @@ test([{RE0,Line,Options0,Tests}|T],PreCompile,XMode,REAsList) -> end, case Cres of {ok,P} -> - %erlang:display({testrun,RE,P,Tests,ExecOptions,Xopt,XMode}), case (catch testrun(RE,P,Tests,ExecOptions,Xopt,XMode)) of N when is_integer(N) -> N + test(T,PreCompile,XMode,REAsList); @@ -125,16 +122,10 @@ test([{RE0,Line,Options0,Tests}|T],PreCompile,XMode,REAsList) -> loopexec(_,_,X,Y,_,_) when X > Y -> {match,[]}; loopexec(P,Chal,X,Y,Unicode,Xopt) -> - %io:format("~p~n",[X]), case re:run(Chal,P,[{offset,X}]++Xopt) of nomatch -> - %io:format(" re:exec(~p,~p,[{offset,~p}]) -> ~p~n", - % [P,Chal,X,no]), {match,[]}; - %loopexec(P,Chal,X+1,Y); {match,[{A,B}|More]} -> - %io:format(" re:exec(~p,~p,[{offset,~p}]) -> ~p~n", - % [P,Chal,X,{match,[{A,B}|More]}]), {match,Rest} = case B>0 of true -> @@ -169,7 +160,6 @@ forward(Chal,A,N,true) -> _ -> 1 end, - %io:format("Forward ~p~n",[Forw]), forward(Chal,A+Forw,N-1,true). contains_eightbit(<<>>) -> @@ -334,8 +324,6 @@ testrun(RE,P,[{Chal,Line,ExecOpt,Responses}|T],EO,Xopt0,XMode) -> nomatch -> nomatch; {match, Reslist} -> - %io:format("re:run(~w,~w,~w) -> ~w~n",[Chal,P,ExecOpt++Xopt++ - % [{capture,all,list}],Reslist]), UFix = lists:member(unicode,EO), {match,bfix([if UFix =:= true -> list_to_utf8(L); @@ -425,7 +413,6 @@ pickline(Start,Stop,Bin) when Stop >= size(Bin) -> {Res,Stop}; pickline(Start,Stop,Bin) -> - %erlang:display({Start,Stop,size(Bin)}), <<_:Stop/binary,Ch,_/binary>> = Bin, case Ch of $\n -> @@ -465,15 +452,13 @@ stru([{_,<<>>}|T]) -> stru(T); stru([{Line,<>}|T0]) -> {T,Re} = find_rest_re(Ch,[{Line,Re0}|T0]), - %io:format("DBG: ~p~n",[Re]), {NewRe,<< Ch, Options/binary >>} = end_of_re(Ch,Re), case interpret_options_x(backstrip(frontstrip(Options)),NewRe) of {Olist,<<>>} -> U = lists:member(unicode,Olist), case T of [{_,<<$-,_/binary>>}|Con] -> - %Debug output, we skip those - %io:format("Skipping debug (~w)~n",[Line]), + %%Debug output, we skip those TmpT = skip_debug(Con), {NewT,Matches} = stru2(TmpT,U), [{NewRe,Line,Olist,Matches}|stru(NewT)]; @@ -482,12 +467,10 @@ stru([{Line,<>}|T0]) -> {NewT,Matches} = stru2(NewT0,U), [{NewRe,Line,Olist,Matches}|stru(NewT)]; [{_,<>}|_] when Bla =/= $ -> - %io:format("Skipping blabla (~w)~n",[Line]), NewT = skip_until_empty(T), stru(NewT); _ -> {NewT,Matches} = stru2(T,U), - %erlang:display({NewRe,Line,Olist,Matches}), Matches1 = case U of true -> Matches ++ @@ -496,7 +479,6 @@ stru([{Line,<>}|T0]) -> false -> Matches end, - %erlang:display({NewRe,Line,Olist,Matches1}), [{NewRe,Line,Olist,Matches1}|stru(NewT)] end; {_,Rest} -> @@ -605,7 +587,7 @@ backslash_end(<<_,R/binary>>) -> backslash_end(R). stru2([{Line,<<$ ,Rest/binary>>} | T],U) -> - % A challenge + %% A challenge case (catch responses(T,U)) of {NewT,Rlist} -> {NewNewT,StrList} = stru2(NewT,U), @@ -765,17 +747,17 @@ pick_offset(Rest) -> escape(<<>>,_) -> {[],<<>>}; escape(<<$\\, Ch, Rest/binary>>,U) when Ch >= $A, Ch =< $Z; Ch =:= $? -> - %Options in the string... + %%Options in the string... NewOpts = eopt(Ch), {MoreOpts,Tail} = escape(Rest,U), {NewOpts ++ MoreOpts,Tail}; escape(<<$\\, $>, Rest/binary>>,U) -> - %Offset Options in the string... + %%Offset Options in the string... {NewOpt,NewRest} = pick_offset(Rest), {MoreOpts,Tail} = escape(NewRest,U), {[NewOpt|MoreOpts],Tail}; escape(<<$\\, $<, Rest/binary>>,U) -> - %CR Options in the string... + %%CR Options in the string... {NewOpt,NewRest} = pinch_cr(Rest), {MoreOpts,Tail} = escape(NewRest,U), {[NewOpt|MoreOpts],Tail}; @@ -789,7 +771,6 @@ escape(<<$\\, Ch, Rest/binary>>,U) -> {<<$\\>>,<>} end; CCC -> - %erlang:display({escape,CCC}), {<>,Rest} end, {MoreOpts,Tail} = escape(NR,U), @@ -877,7 +858,6 @@ multi_esc(<<$x,${,N,O,$},Rest/binary>>,Unicode) ((N >= $a) and (N =< $f))) and (((O >= $0) and (O =< $9)) or ((O >= $A) and (O =< $F)) or ((O >= $a) and (O =< $f)))) -> - %io:format("~p(~p)~n",[<<$x,${,N,O,$}>>,get(unicode)]), Cha = (trx(N) bsl 4) bor trx(O), case Unicode of false -> @@ -974,8 +954,8 @@ single_esc($\\) -> $\\; single_esc($a) -> 7; -%single_esc(Ch) when Ch >= $A, Ch =< $Z -> % eh? -% Ch; +%%single_esc(Ch) when Ch >= $A, Ch =< $Z -> % eh? +%% Ch; single_esc(_) -> no. @@ -1003,8 +983,6 @@ gen_split_test(OneFile) -> io:format(F,"-module(~s).~n",[ErlModule]), io:format(F,"-compile(export_all).~n",[]), io:format(F,"-compile(no_native).~n",[]), - %io:format(F,"-include(\"test_server.hrl\").~n",[]), - %io:format(F,"-define(line,erlang:display(?LINE),).~n",[]), io:format(F,"%% This file is generated by running ~w:gen_split_test(~p)~n", [?MODULE,OneFile]), io:format(F,"join([]) -> [];~n",[]), @@ -1095,7 +1073,6 @@ gen_repl_test(OneFile) -> io:format(F,"-module(~s).~n",[ErlModule]), io:format(F,"-compile(export_all).~n",[]), io:format(F,"-compile(no_native).~n",[]), - %io:format(F,"-include(\"test_server.hrl\").~n",[]), io:format(F,"%% This file is generated by running ~w:gen_repl_test(~p)~n", [?MODULE,OneFile]), io:format(F,"run() ->~n",[]), -- cgit v1.2.3