<commit_before>%%
%% This file is part of Triq - Trifork QuickCheck
%%
%% Copyright (c) 2010 by Trifork
%%
%% Licensed under the Apache License, Version 2.0 (the "License");
%% you may not use this file except in compliance with the License.
%% You may obtain a copy of the License at
%%  
%%     http://www.apache.org/licenses/LICENSE-2.0
%%
%% Unless required by applicable law or agreed to in writing, software
%% distributed under the License is distributed on an "AS IS" BASIS,
%% WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied.
%% See the License for the specific language governing permissions and
%% limitations under the License.
%%

-module(triq).

-export([check/1,fails/1,module/1, sample/1, 
	 counterexample/0, counterexample/1]).

-import(triq_domain, [generate/2]).

-record(triq, {count=0,
	      context=[],
	      size=100,
	      report= fun(pass,_)->ok;
			 (fail,_)->ok;
			 (skip,_)->ok end,
	      shrinking= false,
	      result=undefined,
	      body}).


report(pass,_) ->
    io:format(".");
report(skip,_) ->
    io:format("x");
report(fail,false) ->
    io:format("Failed!~n");
report(fail,Value) ->
    io:format("Failed with: ~p~n", [Value]).

check(Fun,Input,IDom,#triq{count=Count,report=DoReport}=QCT) ->

    try Fun(Input) of	
	true -> 
	    DoReport(pass,true),
	    {success, Count+1};
	
	{success, NewCount} -> 
	    {success, NewCount};
	
	{failure, _, _, _, _}=Fail -> 
	    Fail;

	{'prop:timeout', Limit, Fun2, Body2} ->
	    Yield = check_timeout(Fun,Input,IDom,Limit,Fun2,QCT#triq{body=Body2}),
	    Yield;
	
	{'prop:fails', Property} ->
	    case check(fun(none)->Property end,none,none,QCT#triq{}) of
		{success, _} ->
		    {failure, Fun, Input, IDom, QCT#triq{result=unexpected_success,
							 context=[{"?",Fun,Input,IDom}
								  |QCT#triq.context]}};
		_ -> {success, Count+1}
	    end;
	
	{'prop:implies', false, _, _, _} ->
	    DoReport(skip,true),
	    {success, Count};
	
	{'prop:implies', true, _Syntax, Fun2, Body2} ->
	    check(fun(none)->Fun2()end,none,none,QCT#triq{body=Body2});
	
	{'prop:whenfail', Action, Fun2, Body2} ->
	    case check(fun(none)->Fun2()end,none,none,QCT#triq{body=Body2}) of
		{success, _}=Success ->
		    Success;
		Any when not QCT#triq.shrinking ->
		    Action(),
		    Any;
		Any ->
		    Any
	    end;
	
	{'prop:trapexit', Fun2, Body2} ->
	    WasTrap = process_flag(trap_exit, true),
	    Main = self(),
	    PID = spawn_link
		    (fun() ->
			     Result = check(fun(none)->Fun2()end,none,none,
					    QCT#triq{body=Body2}),
			     Main ! {self(), Result}
		     end),
	    receive 
		{PID, Result} -> 

		    %% unlink and flush any EXITs
		    unlink(PID),
		    process_flag(trap_exit, WasTrap),
		    receive {'EXIT', PID, _} -> true
		    after 0 -> true end,

		    Result;

		{'EXIT', PID, Reason} ->
		    process_flag(trap_exit, WasTrap),
		    DoReport(fail, Reason),
		    {failure, Fun, Input, IDom, 
		     QCT#triq{count=Count+1,result={'EXIT', Reason}}}
		    
	    end;
	
	{'prop:forall', Dom2, Syntax2, Fun2, Body2} ->
	    check_forall(0, 100, Dom2, Fun2, Syntax2, QCT#triq{body=Body2}, gb_sets:new());

	Any ->
	    DoReport(fail,Any),
	    {failure, Fun, Input, IDom, QCT#triq{count=Count+1,result=Any}}

    catch
	Class : Exception ->
	    DoReport(fail, {Class, Exception, erlang:get_stacktrace()}),
	    {failure, Fun, Input, IDom, QCT#triq{count=Count+1,result={'EXIT',Exception}}}
	
    end.
    

check_timeout(Fun,Input,IDom,Limit,Fun2,#triq{count=Count,report=DoReport}=QCT) ->
    Main = self(),
    Controller = 
	spawn
	  (fun() -> 
		   process_flag(trap_exit, true),
		   Controller = self(),
		   
		   Slave = spawn_link
			     (fun() ->
				      Slave = self(),
				      Result = check(fun(none)->Fun2()end,
						     none,
						     none,
						     QCT),
				      Controller ! {Slave, Result}
			      end),
		   
		   receive 
		       {Slave, Result} ->
			   %% from Slave
			   Main ! {Controller, Result };
		       
		       {'EXIT', Slave, Reason} ->
			   %% from Slave
			   DoReport(fail, Reason),
			   Main ! {Controller, {failure, Fun, Input, IDom, 
						QCT#triq{count=Count+1,
							 result={'EXIT', Reason}}}};
		       
		       {'EXIT', _, timeout} ->
			   %% from Main
			   erlang:exit(Slave,kill)			     
		   end
	   end),

    Yield = receive 
		{Controller, Result} ->
		    Result
		
	    after Limit ->
		    
		    %% Yank the controller (and the slave)
		    erlang:exit(Controller, timeout),
		    
		    %% flush any reply from our queue
		    receive {Controller, _} -> ignore
		    after 5 -> ignore end,
		    
		    Reason = {timeout, Limit},
		    DoReport(fail, Reason),
		    {failure, Fun, Input, IDom, 
		     QCT#triq{count=Count+1,result={'EXIT', Reason}}}
    end,

    Yield.

check_forall(N,N,_,_,_,#triq{count=Count}, _) ->
    {success, Count};

check_forall(N,NMax,XDom,Fun,Syntax,#triq{context=Context}=QCT, Tested) ->

    GenSize = 2 + 2*N,

    %% if input domain is one of LET or SIZED, then it
    %% needs to be resolved here before we continue.
    Dom = triq_domain:bind(XDom,GenSize),

    Input = generate(Dom, GenSize),

    IsTested = gb_sets:is_member(Input,Tested),
    if 
	IsTested ->
	    check_forall(N+1,NMax,Dom,Fun,Syntax,QCT,Tested);

	true ->
	    case check(Fun,Input,Dom,QCT#triq{size=GenSize, 
					      context=[{Syntax,Fun,Input,Dom}|Context]}) of

		%% it did not fail, try again with N := N+1
		{success,NewCount} -> 
		    NewTested = gb_sets:add(Input,Tested),
		    check_forall(N+1, NMax,Dom, Fun, Syntax, QCT#triq{count=NewCount}, NewTested);

		%% it failed, report it!
		{failure, _, _, _, Ctx} ->
		    {failure, Fun, Input, Dom, Ctx};
		
		true ->
		    io:format("huh?"),
		    {success, 1000}

	    end
    end.


all(_Fun,[]) ->
    true;<commit_msg>check_forall has a gb_sets with all previous tests.  When skipping a test because a (randomly generated) test has already been run, also report that with an "x" and increment test count; even though no actual test is there.  This works well when the value domain is so small that it is not possible to generate 100 (or more) different values in the domain.<commit_after>%%
%% This file is part of Triq - Trifork QuickCheck
%%
%% Copyright (c) 2010 by Trifork
%%
%% Licensed under the Apache License, Version 2.0 (the "License");
%% you may not use this file except in compliance with the License.
%% You may obtain a copy of the License at
%%  
%%     http://www.apache.org/licenses/LICENSE-2.0
%%
%% Unless required by applicable law or agreed to in writing, software
%% distributed under the License is distributed on an "AS IS" BASIS,
%% WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied.
%% See the License for the specific language governing permissions and
%% limitations under the License.
%%

-module(triq).

-export([check/1,fails/1,module/1, sample/1, 
	 counterexample/0, counterexample/1]).

-import(triq_domain, [generate/2]).

-record(triq, {count=0,
	      context=[],
	      size=100,
	      report= fun(pass,_)->ok;
			 (fail,_)->ok;
			 (skip,_)->ok end,
	      shrinking= false,
	      result=undefined,
	      body}).


report(pass,_) ->
    io:format(".");
report(skip,_) ->
    io:format("x");
report(fail,false) ->
    io:format("Failed!~n");
report(fail,Value) ->
    io:format("Failed with: ~p~n", [Value]).

check(Fun,Input,IDom,#triq{count=Count,report=DoReport}=QCT) ->

    try Fun(Input) of	
	true -> 
	    DoReport(pass,true),
	    {success, Count+1};
	
	{success, NewCount} -> 
	    {success, NewCount};
	
	{failure, _, _, _, _}=Fail -> 
	    Fail;

	{'prop:timeout', Limit, Fun2, Body2} ->
	    Yield = check_timeout(Fun,Input,IDom,Limit,Fun2,QCT#triq{body=Body2}),
	    Yield;
	
	{'prop:fails', Property} ->
	    case check(fun(none)->Property end,none,none,QCT#triq{}) of
		{success, _} ->
		    {failure, Fun, Input, IDom, QCT#triq{result=unexpected_success,
							 context=[{"?",Fun,Input,IDom}
								  |QCT#triq.context]}};
		_ -> {success, Count+1}
	    end;
	
	{'prop:implies', false, _, _, _} ->
	    DoReport(skip,true),
	    {success, Count};
	
	{'prop:implies', true, _Syntax, Fun2, Body2} ->
	    check(fun(none)->Fun2()end,none,none,QCT#triq{body=Body2});
	
	{'prop:whenfail', Action, Fun2, Body2} ->
	    case check(fun(none)->Fun2()end,none,none,QCT#triq{body=Body2}) of
		{success, _}=Success ->
		    Success;
		Any when not QCT#triq.shrinking ->
		    Action(),
		    Any;
		Any ->
		    Any
	    end;
	
	{'prop:trapexit', Fun2, Body2} ->
	    WasTrap = process_flag(trap_exit, true),
	    Main = self(),
	    PID = spawn_link
		    (fun() ->
			     Result = check(fun(none)->Fun2()end,none,none,
					    QCT#triq{body=Body2}),
			     Main ! {self(), Result}
		     end),
	    receive 
		{PID, Result} -> 

		    %% unlink and flush any EXITs
		    unlink(PID),
		    process_flag(trap_exit, WasTrap),
		    receive {'EXIT', PID, _} -> true
		    after 0 -> true end,

		    Result;

		{'EXIT', PID, Reason} ->
		    process_flag(trap_exit, WasTrap),
		    DoReport(fail, Reason),
		    {failure, Fun, Input, IDom, 
		     QCT#triq{count=Count+1,result={'EXIT', Reason}}}
		    
	    end;
	
	{'prop:forall', Dom2, Syntax2, Fun2, Body2} ->
	    check_forall(0, 100, Dom2, Fun2, Syntax2, QCT#triq{body=Body2}, gb_sets:new());

	Any ->
	    DoReport(fail,Any),
	    {failure, Fun, Input, IDom, QCT#triq{count=Count+1,result=Any}}

    catch
	Class : Exception ->
	    DoReport(fail, {Class, Exception, erlang:get_stacktrace()}),
	    {failure, Fun, Input, IDom, QCT#triq{count=Count+1,result={'EXIT',Exception}}}
	
    end.
    

check_timeout(Fun,Input,IDom,Limit,Fun2,#triq{count=Count,report=DoReport}=QCT) ->
    Main = self(),
    Controller = 
	spawn
	  (fun() -> 
		   process_flag(trap_exit, true),
		   Controller = self(),
		   
		   Slave = spawn_link
			     (fun() ->
				      Slave = self(),
				      Result = check(fun(none)->Fun2()end,
						     none,
						     none,
						     QCT),
				      Controller ! {Slave, Result}
			      end),
		   
		   receive 
		       {Slave, Result} ->
			   %% from Slave
			   Main ! {Controller, Result };
		       
		       {'EXIT', Slave, Reason} ->
			   %% from Slave
			   DoReport(fail, Reason),
			   Main ! {Controller, {failure, Fun, Input, IDom, 
						QCT#triq{count=Count+1,
							 result={'EXIT', Reason}}}};
		       
		       {'EXIT', _, timeout} ->
			   %% from Main
			   erlang:exit(Slave,kill)			     
		   end
	   end),

    Yield = receive 
		{Controller, Result} ->
		    Result
		
	    after Limit ->
		    
		    %% Yank the controller (and the slave)
		    erlang:exit(Controller, timeout),
		    
		    %% flush any reply from our queue
		    receive {Controller, _} -> ignore
		    after 5 -> ignore end,
		    
		    Reason = {timeout, Limit},
		    DoReport(fail, Reason),
		    {failure, Fun, Input, IDom, 
		     QCT#triq{count=Count+1,result={'EXIT', Reason}}}
    end,

    Yield.

check_forall(N,N,_,_,_,#triq{count=Count}, _) ->
    {success, Count};

check_forall(N,NMax,XDom,Fun,Syntax,#triq{context=Context,report=DoReport,count=Count}=QCT, Tested) ->

    GenSize = 2 + 2*N,

    %% if input domain is one of LET or SIZED, then it
    %% needs to be resolved here before we continue.
    Dom = triq_domain:bind(XDom,GenSize),

    Input = generate(Dom, GenSize),

    IsTested = gb_sets:is_member(Input,Tested),
    if 
	IsTested ->
	    DoReport(skip,true),
	    check_forall(N+1,NMax,Dom,Fun,Syntax,QCT#triq{count=Count+1},Tested);

	true ->
	    case check(Fun,Input,Dom,QCT#triq{size=GenSize, 
					      context=[{Syntax,Fun,Input,Dom}|Context]}) of

		%% it did not fail, try again with N := N+1
		{success,NewCount} -> 
		    NewTested = gb_sets:add(Input,Tested),
		    check_forall(N+1, NMax,Dom, Fun, Syntax, QCT#triq{count=NewCount}, NewTested);

		%% it failed, report it!
		{failure, _, _, _, Ctx} ->
		    {failure, Fun, Input, Dom, Ctx};
		
		true ->
		    io:format("huh?"),
		    {success, 1000}

	    end
    end.


all(_Fun,[]) ->
    true;
{'fraction_non_alphanumeric': 0.15768943480786787, 'fraction_numerical': 0.011453232633413562, 'mean_word_length': 2.770337922403004, 'pattern_counts': {'":': 0, '<': 3, '<?xml version=': 0, '>': 109, 'https://': 0, 'lorem ipsum': 0, 'www.': 2, 'xml': 0}, 'pii_count': 0, 'substrings_counts': 0, 'word_list_counts': {'cursed_substrings.json': 0, 'profanity_word_list.json': 0, 'sexual_word_list.json': 0, 'zh_pornsignals.json': 0}}
{'dir': 'git-commits-cleaned', 'id': '6665379', 'n_tokens_mistral': 4803, 'n_tokens_neox': 4124, 'n_words': 964}