Skip to content

HTTPS clone URL

Subversion checkout URL

You can clone with
or
.
Download ZIP
Browse files

major refactoring, README not yet updated

User-visible changes:
* Minor changes in return value format.
* Impemented opaque data type for counterexamples that contains
  all information necessary for rerunning counterexamples, plus
  functions that extract the interesting parts for the user.
* The most recent counterexample can now be retrieved after the
  conclusion of a test.
* Mismatch between format of variables and types in ?FORALLs now
  results in an error message instead of crashing the program.
* Counterexamples can now carry stacktraces.
* New options: to_file, on_output, long_result, start_size, noshrink,
  plus a change in the effect of 'quiet'.
* proper_types:is_instance(X,Type) is now part of the public interface.
* Implemented aggregate/2, on_output/2 test wrappers.
* Better statistics printing.
* Removed unneeded macro version of some wrappers.

Internal changes:
* Cleaned up Makefile.
* Cleaner use of 'size' parameter.
* 'crypto' module now actually used in the generation of binaries.
* Fixed a bug in the random function generator.
* AND3 and OR3 are now lazy, this fixes a bug in instance testing.
* Better growing behaviour and smarter shrinking for numbers.
* 'opts()' record no longer exported from main module.
* Cleaner use of process dictionary (mainly inside proper_gen).
* Added unit tests, contained in tests/proper_tests.erl, powered by
  EUnit - compile with 'make tests' ('eunit' application required),
  run with 'make test'.
  • Loading branch information...
commit 0c9af8ec2d1d467923abe2588c10c227e417284a 1 parent 888e261
@manopapad authored
View
43 Makefile
@@ -8,27 +8,27 @@ TST_BIN_DIR=tests
EXM_DIR=examples
TMP_PATTERN=*~ \\\#*\\\# *.dump
-APP_MODULES=proper proper_types proper_gen proper_symb proper_shrink proper_arith proper_extra
-HEADERS=proper proper_internal proper_common
-TST_MODULES=proper_tests
-EXM_MODULES=mm
TXT_FILES=COPYING Makefile README $(DOC_DIR)/overview.edoc
RELEASE_FILE=proper.tar.gz
-APP_SRC_FILES=$(addprefix $(APP_SRC_DIR)/, $(addsuffix .erl, $(APP_MODULES)))
-APP_BIN_FILES=$(addprefix $(APP_BIN_DIR)/, $(addsuffix .beam, $(APP_MODULES)))
-HDR_FILES=$(addprefix $(HDR_DIR)/, $(addsuffix .hrl, $(HEADERS)))
+APP_SRC_FILES=$(wildcard $(APP_SRC_DIR)/*.erl)
+APP_MODULES=$(APP_SRC_FILES:$(APP_SRC_DIR)/%.erl=%)
+APP_BIN_FILES=$(APP_MODULES:%=$(APP_BIN_DIR)/%.beam)
+HDR_FILES=$(wildcard $(HDR_DIR)/*.hrl)
DOC_FILES=$(addprefix $(DOC_DIR)/, $(DOC_PATTERN) $(addsuffix .html, $(APP_MODULES)))
-TST_SRC_FILES=$(addprefix $(TST_SRC_DIR)/, $(addsuffix .erl, $(TST_MODULES)))
-TST_BIN_FILES=$(addprefix $(TST_BIN_DIR)/, $(addsuffix .beam, $(TST_MODULES)))
-EXM_FILES=$(addprefix $(EXM_DIR)/, $(addsuffix .erl, $(EXM_MODULES)))
+TST_SRC_FILES=$(wildcard $(TST_SRC_DIR)/*.erl)
+TST_MODULES=$(TST_SRC_FILES:$(TST_SRC_DIR)/%.erl=%)
+TST_BIN_FILES=$(TST_MODULES:%=$(TST_BIN_DIR)/%.beam)
+EXM_FILES=$(wildcard $(EXM_DIR)/*.erl)
TMP_FILES=$(TMP_PATTERN) $(addprefix $(APP_SRC_DIR)/, $(TMP_PATTERN)) $(addprefix $(HDR_DIR)/, $(TMP_PATTERN)) $(addprefix $(DOC_DIR)/, $(TMP_PATTERN)) $(addprefix $(TST_SRC_DIR)/, $(TMP_PATTERN)) $(addprefix $(EXM_DIR)/, $(TMP_PATTERN))
-ENTER_ERL=erl -noinput -eval '
-EXIT_ERL=, halt().'
+ENTER_ERL=erl -noinput -pa $(APP_BIN_DIR) -eval '
+EXIT_ERL=' -run init stop
ERLC=erlc
-ERLC_FLAGS=-W2 -Ddebug -DTEST +debug_info +warn_missing_spec +warn_untyped_record +inline -I $(HDR_DIR)
+APP_ERLC_FLAGS=-W2 -Ddebug +debug_info +warn_missing_spec +warn_untyped_record -I $(HDR_DIR)
+TST_ERLC_FLAGS=-W2 +debug_info +nowarn_unused_function -I $(HDR_DIR)
EDOC_OPTIONS=[{dialyzer_specs,all}, {report_missing_type,true}, {report_type_mismatch,true}, {pretty_print,erl_pp}, {preprocess,true}]
+EUNIT_OPTIONS=[]
DIALYZER=dialyzer
DIALYZER_FLAGS=-Wunmatched_returns
NEEDED_APPS=compiler erts kernel stdlib crypto
@@ -40,37 +40,42 @@ TAR=tar -czf
# TODO: extra targets: test, tags, commit/update
# TODO: header and text files as dependencies: more fine-grained
-.PHONY: default all compile tests doc check clean distclean rebuild release build_plt
+.PHONY: default all compile tests doc test check clean distclean rebuild release build_plt
default: compile
-all: compile tests doc
+all: compile doc
compile: $(APP_BIN_FILES)
$(APP_BIN_FILES): $(HDR_FILES)
$(APP_BIN_DIR)/%.beam: $(APP_SRC_DIR)/%.erl
- $(ERLC) $(ERLC_FLAGS) -o $(APP_BIN_DIR) $<
+ $(ERLC) $(APP_ERLC_FLAGS) -o $(APP_BIN_DIR) $<
tests: $(TST_BIN_FILES)
$(TST_BIN_FILES): $(HDR_FILES)
$(TST_BIN_DIR)/%.beam: $(TST_SRC_DIR)/%.erl
- $(ERLC) $(ERLC_FLAGS) -o $(TST_BIN_DIR) $<
+ $(ERLC) $(TST_ERLC_FLAGS) -o $(TST_BIN_DIR) $<
doc: $(APP_SRC_FILES) $(HDR_FILES) $(TXT_FILES)
$(ENTER_ERL) edoc:application(proper, ".", $(EDOC_OPTIONS)) $(EXIT_ERL)
+test: tests
+ $(ENTER_ERL) eunit:test({dir,"$(TST_BIN_DIR)"},$(EUNIT_OPTIONS)) $(EXIT_ERL)
+
check: compile
$(DIALYZER) $(DIALYZER_FLAGS) $(APP_BIN_FILES)
clean:
- $(RM) $(TMP_FILES)
+ @echo removing temporary files...
+ @$(RM) $(TMP_FILES)
distclean: clean
- $(RM) $(APP_BIN_FILES) $(DOC_FILES) $(TST_BIN_FILES) $(RELEASE_FILE)
+ @echo removing build artifacts...
+ @$(RM) $(APP_BIN_FILES) $(DOC_FILES) $(TST_BIN_FILES) $(RELEASE_FILE)
rebuild: distclean compile
View
8 README
@@ -64,7 +64,7 @@ wrapping such a boolean expression with one or more of the following wrappers:
rejected (it doesn't count as a failing test case), and PropEr starts over
with a new random test case. Also, in verbose mode, an 'x' is printed on
screen.
-collect(<Category>, <Prop>) or ?COLLECT(<Category>, <Prop>)
+collect(<Category>, <Prop>)
The <Category> field can be an expression or statement block that evaluates
to any term - the test case produced will be categorized under this term.
All produced categories are printed at the end of testing (in case no test
@@ -96,9 +96,9 @@ equals(<A>, <B>)
Additionally, a property may be wrapped with one or more of the following
outer-level wrappers, which control the behaviour of the testing subsystem:
-numtests(<Positive_number>, <Prop>) or ?NUMTESTS(<Positive_number>, <Prop>)
+numtests(<Positive_number>, <Prop>)
Specifies the number of tests to run. Default is 100.
-fails(<Prop>) or ?FAILS(<Prop>)
+fails(<Prop>)
Specifies that we expect the property to fail for some input. The property
will be considered failing if it passes all the tests.
@@ -145,7 +145,7 @@ available options are:
Specifies the maximum number of times a failing test case should be shrunk
before returning. Note that the shrinking may stop before so many shrinks
are achieved if the shrinking subsystem deduces that it cannot shrink the
- failing test case further. Default is 300.
+ failing test case further. Default is 500.
{'constraint_tries', <Positive_number>}
Specifies the maximum number of tries before the generator subsystem gives
up on producing an instance that satisfies a ?SUCHTHAT constraint. Default
View
4 include/proper.hrl
@@ -1,4 +1,5 @@
%%% Copyright 2010 Manolis Papadakis (manopapad@gmail.com)
+%%% and Kostis Sagonas (kostis@cs.ntua.gr)
%%%
%%% This file is part of PropEr.
%%%
@@ -26,7 +27,8 @@
%% Test generation functions
%%------------------------------------------------------------------------------
--import(proper, [numtests/2, collect/2, fails/1, equals/2]).
+-import(proper, [numtests/2, collect/2, aggregate/2, fails/1, on_output/2,
+ equals/2]).
%%------------------------------------------------------------------------------
View
4 include/proper_common.hrl
@@ -1,4 +1,5 @@
%%% Copyright 2010 Manolis Papadakis (manopapad@gmail.com)
+%%% and Kostis Sagonas (kostis@cs.ntua.gr)
%%%
%%% This file is part of PropEr.
%%%
@@ -24,10 +25,7 @@
-define(FORALL(X,RawType,Prop), {'$forall',RawType,fun(X) -> Prop end}).
-define(IMPLIES(Pre,Prop), {'$implies',Pre,?DELAY(Prop)}).
--define(COLLECT(Category,Prop), {'$collect',Category,Prop}).
-define(WHENFAIL(Action,Prop), {'$whenfail',?DELAY(Action),?DELAY(Prop)}).
--define(NUMTESTS(N,Test), {'$numtests',N,Test}).
--define(FAILS(Test), {'$fails',Test}).
-define(TRAPEXIT(Prop), {'$trapexit',?DELAY(Prop)}).
-define(TIMEOUT(Limit,Prop), {'$timeout',Limit,?DELAY(Prop)}).
%% TODO: -define(ALWAYS(Tests,Prop), {'$always',Tests,?DELAY(Prop)}).
View
10 include/proper_internal.hrl
@@ -26,8 +26,6 @@
%% Constants
%%------------------------------------------------------------------------------
-%% TODO: make some of these into parameters, store them in process registry
--define(MAX_RANDOM_TRIES_WHEN_SHRINKING, 5).
-define(MAX_LIST_LEN, 200).
-define(MAX_ATOM_LEN, 255).
-define(MAX_BINARY_LEN, 300).
@@ -35,6 +33,14 @@
%%------------------------------------------------------------------------------
+%% Macros
+%%------------------------------------------------------------------------------
+
+-define(AND3(X,Y), proper_arith:and3(?DELAY(X),?DELAY(Y))).
+-define(OR3(X,Y), proper_arith:or3(?DELAY(X),?DELAY(Y))).
+
+
+%%------------------------------------------------------------------------------
%% Common type aliases
%%------------------------------------------------------------------------------
View
729 src/proper.erl
@@ -22,50 +22,56 @@
%%% @doc This is the main PropEr module.
-module(proper).
--export([set_size/1, erase_size/0, grow_size/0, get_size/1, global_state_init/0,
- global_state_erase/0]).
--export([numtests/2, collect/2, fails/1, equals/2]).
--export([check/1, check/2, still_fails/3, skip_to_next/1]).
--export([print/3]).
+-export([check/1, check/2]).
+-export([global_state_erase/0, get_counterexample/0, clean_garbage/0,
+ get_fail_reason/1, get_bound/1]).
--export_type([imm_testcase/0, test/0, forall_clause/0, fail_reason/0, opts/0]).
+-export([get_size/1, global_state_init_size/1]).
+-export([numtests/2, collect/2, aggregate/2, fails/1, on_output/2, equals/2]).
+-export([still_fails/3, skip_to_next/1]).
+
+-export_type([dependent_test/0, imm_testcase/0, test/0, fail_reason/0,
+ forall_clause/0, output_fun/0]).
-include("proper_internal.hrl").
%%------------------------------------------------------------------------------
-%% Types
+%% Test types
%%------------------------------------------------------------------------------
-type imm_testcase() :: [proper_gen:imm_instance()].
-type clean_testcase() :: [proper_gen:instance()].
--type category() :: term().
--type cat_dict() :: [{category(),frequency()}].
+-type sample() :: [term()].
-type side_effects_fun() :: fun(() -> 'ok').
-type fail_actions() :: [side_effects_fun()].
+-type output_fun() :: fun((string(), [term()]) -> 'ok').
-type time_period() :: non_neg_integer().
-type outer_test() :: test()
| numtests_clause()
- | fails_clause().
+ | fails_clause()
+ | on_output_clause().
-type test() :: boolean()
| forall_clause()
| implies_clause()
- | collect_clause()
+ | sample_clause()
| whenfail_clause()
| trapexit_clause()
| timeout_clause()
%%| always_clause()
%%| sometimes_clause()
| apply_clause().
+-type dependent_test() :: fun((proper_gen:instance()) -> test()).
-type delayed_test() :: fun(() -> test()).
-type numtests_clause() :: {'$numtests', pos_integer(), outer_test()}.
-type fails_clause() :: {'$fails', outer_test()}.
--type forall_clause() :: {'$forall', proper_types:raw_type(),
- fun((proper_gen:instance()) -> test())}.
+-type on_output_clause() :: {'$on_output', output_fun(), outer_test()}.
+
+-type forall_clause() :: {'$forall', proper_types:raw_type(), dependent_test()}.
-type implies_clause() :: {'$implies', boolean(), delayed_test()}.
--type collect_clause() :: {'$collect', category(), test()}.
+-type sample_clause() :: {'$sample', sample(), test()}.
-type whenfail_clause() :: {'$whenfail', side_effects_fun(), delayed_test()}.
-type trapexit_clause() :: {'$trapexit', delayed_test()}.
-type timeout_clause() :: {'$timeout', time_period(), delayed_test()}.
@@ -73,340 +79,418 @@
%%-type sometimes_clause() :: {'$sometimes', pos_integer(), delayed_test()}.
-type apply_clause() :: {'$apply', [term()], function()}.
--type opt() :: 'quiet'
- | 'crypto'
- | {'numtests', pos_integer()}
- | pos_integer()
- | {'max_shrinks', non_neg_integer()}
- | {'constraint_tries', pos_integer()}
- | 'fails'.
+
+%%------------------------------------------------------------------------------
+%% Options and Context types
+%%------------------------------------------------------------------------------
+
+-type user_opt() :: 'quiet'
+ | {'to_file', file:io_device()}
+ | {'on_output', output_fun()}
+ | 'long_result'
+ | 'crypto'
+ | {'numtests', pos_integer()}
+ | pos_integer()
+ | {'start_size', size()}
+ | {'max_shrinks', non_neg_integer()}
+ | 'noshrink'
+ | {'constraint_tries', pos_integer()}
+ | 'fails'.
+-record(opts, {output_fun = fun io:format/2 :: output_fun(),
+ long_result = false :: boolean(),
+ crypto = false :: boolean(),
+ numtests = 100 :: pos_integer(),
+ start_size = 1 :: size(),
+ max_shrinks = 500 :: non_neg_integer(),
+ noshrink = false :: boolean(),
+ constraint_tries = 50 :: pos_integer(),
+ expect_fail = false :: boolean()}).
+-type opts() :: #opts{}.
%% TODO: other ways for the user to define the extra exceptions to catch?
%% TODO: should they contain specific reasons (or '$any' for all reasons)?
%% TODO: allow errors to be caught?
-record(ctx, {catch_exits = false :: boolean(),
+ try_shrunk = false :: boolean(),
bound = [] :: imm_testcase(),
+ to_try = [] :: imm_testcase(),
fail_actions = [] :: fail_actions(),
- categories = [] :: [category()]}).
+ samples = [] :: [sample()]}).
-type ctx() :: #ctx{}.
--type single_run_result() :: {'passed', 'didnt_crash'}
- | {'passed', {'categories',[category()]}}
- | {'failed', fail_reason(), imm_testcase(),
- fail_actions()}
- | {'error', 'wrong_type'}
- | {'error', 'cant_generate'}
- | {'error', 'rejected'}.
--type exc_kind() :: 'throw' | 'exit'.
--type exc_reason() :: term().
--type fail_reason() :: 'false_property' | 'timeout' | {exc_kind(),exc_reason()}.
--type common_result() :: {'passed', pos_integer(), [cat_dict()]}
- | {'error', 'cant_generate'}
- | {'error', 'cant_satisfy'}
- | {'error', {'unexpected', single_run_result()}}.
--type imm_result() :: common_result()
- | {'failed', pos_integer(), fail_reason(), imm_testcase(),
- fail_actions()}.
--type final_result() :: common_result()
- | {'failed', pos_integer(), fail_reason(),
- clean_testcase()}
- | {'failed', pos_integer(), fail_reason(),
- clean_testcase(), non_neg_integer(), clean_testcase()}.
%%------------------------------------------------------------------------------
-%% Options record
+%% Result types
%%------------------------------------------------------------------------------
--record(opts, {quiet = false :: boolean(),
- crypto = false :: boolean(),
- numtests = 100 :: pos_integer(),
- max_shrinks = 300 :: non_neg_integer(),
- constraint_tries = 50 :: pos_integer(),
- expect_fail = false :: boolean(),
- try_shrunk = false :: boolean(),
- shrunk :: proper:imm_testcase()}).
--type opts() :: #opts{}.
+-type single_run_result() :: {'passed', pass_reason(), [sample()]}
+ | {'failed', counterexample(), fail_actions()}
+ | {'error', single_run_error_reason()}.
+-type pass_reason() :: 'true_prop' | 'didnt_crash'.
+-type fail_reason() :: 'false_prop' | 'timeout'
+ | {'exception',exc_kind(),exc_reason(),stacktrace()}.
+-type exc_kind() :: 'throw' | 'exit'.
+-type exc_reason() :: term().
+-type stacktrace() :: [{atom(),atom(),arity() | [term()]}].
+-type single_run_error_reason() :: 'wrong_type' | 'cant_generate' | 'rejected'
+ | 'type_mismatch' | 'need_size_info'
+ | 'too_many_instances'.
+
+-type pass_result() :: {'passed', pos_integer(), [sample()]}.
+-type error_result() :: {'error', error_reason()}.
+-type error_reason() :: 'cant_generate' | 'cant_satisfy' | 'type_mismatch'
+ | {'unexpected', single_run_result()}.
+-type common_result() :: pass_result() | error_result().
+-type imm_result() :: common_result()
+ | {'failed',pos_integer(),counterexample(),fail_actions()}.
+-type long_result() :: common_result()
+ | {'failed', pos_integer(), counterexample()}
+ | {'failed', pos_integer(), counterexample(),
+ non_neg_integer(), counterexample()}.
+-type short_result() :: boolean() | error_result().
+
+-record(cexm, {fail_reason :: fail_reason(),
+ bound :: imm_testcase(),
+ size :: size(),
+ gen_state :: proper_gen:gen_state()}).
+-type counterexample() :: #cexm{}.
%%------------------------------------------------------------------------------
-%% Utility functions
+%% State handling functions
%%------------------------------------------------------------------------------
--spec set_size(size()) -> 'ok'.
-set_size(Size) ->
- put('$size', Size),
- ok.
-
--spec erase_size() -> 'ok'.
-erase_size() ->
- erase('$size'),
- ok.
-
--spec get_size() -> size().
+-spec get_size() -> size() | 'undefined'.
get_size() ->
get('$size').
-spec grow_size() -> 'ok'.
grow_size() ->
- Size = get_size(),
- set_size(Size + 1),
+ Size = get('$size'),
+ put('$size', Size + 1),
ok.
--spec get_size(proper_types:type()) -> size().
+-spec get_size(proper_types:type()) -> size() | 'undefined'.
get_size(Type) ->
- Size1 = get_size(),
- Size2 = case proper_types:find_prop(size_transform, Type) of
- {ok, Transform} -> Transform(Size1);
- error -> Size1
- end,
- %% TODO: should the size be normalized (streched or pressed)?
- case proper_types:find_prop(size_limit, Type) of
- {ok, Limit} -> erlang:min(Size2, Limit);
- error -> Size2
- end.
-
--spec parse_opts([opt()] | opt()) -> opts().
-parse_opts(OptsList) ->
- parse_opts_tr(OptsList, #opts{}).
-
--spec parse_opts_tr([opt()] | opt(), opts()) -> opts().
-parse_opts_tr([], Opts) ->
- Opts;
-parse_opts_tr([Opt | Rest], Opts) ->
- parse_opts_tr(Rest, parse_opt(Opt,Opts));
-parse_opts_tr(Opt, Opts) ->
- parse_opt(Opt, Opts).
-
--spec parse_opt(opt(), opts()) -> opts().
-parse_opt(Opt, Opts) ->
- case Opt of
- quiet -> Opts#opts{quiet = true};
- crypto -> Opts#opts{crypto = true};
- {numtests,N} -> Opts#opts{numtests = N};
- N when is_integer(N), N > 0 -> Opts#opts{numtests = N};
- {max_shrinks,N} -> Opts#opts{max_shrinks = N};
- {constraint_tries,N} -> Opts#opts{constraint_tries = N};
- fails -> Opts#opts{expect_fail = true}
+ case get('$size') of
+ undefined ->
+ undefined;
+ Size1 ->
+ Size2 = case proper_types:find_prop(size_transform, Type) of
+ {ok, Transform} -> Transform(Size1);
+ error -> Size1
+ end,
+ %% TODO: should the size be normalized (streched or pressed)?
+ case proper_types:find_prop(size_limit, Type) of
+ {ok, Limit} -> erlang:min(Size2, Limit);
+ error -> Size2
+ end
end.
--spec global_state_init() -> 'ok'.
-global_state_init() ->
- global_state_init(#opts{}).
+-spec global_state_init_size(size()) -> 'ok'.
+global_state_init_size(Size) ->
+ global_state_init(#opts{start_size = Size}).
-spec global_state_init(opts()) -> 'ok'.
-global_state_init(#opts{constraint_tries = CTries, crypto = Crypto}) ->
+global_state_init(#opts{start_size = Size, constraint_tries = CTries,
+ crypto = Crypto}) ->
+ clean_garbage(),
+ put('$size', Size),
put('$constraint_tries', CTries),
proper_arith:rand_start(Crypto),
- set_size(0),
ok.
-spec global_state_erase() -> 'ok'.
global_state_erase() ->
proper_gen:gen_state_erase(),
- erase_size(),
proper_arith:rand_stop(),
erase('$constraint_tries'),
- _ = code:delete('$temp_mod'),
- _ = code:purge('$temp_mod'),
+ erase('$size'),
ok.
+-spec save_counterexample(counterexample()) -> 'ok'.
+save_counterexample(CExm) ->
+ put('$counterexample', CExm),
+ ok.
+
+-spec get_counterexample() -> counterexample() | 'undefined'.
+get_counterexample() ->
+ get('$counterexample').
+
+-spec clean_garbage() -> 'ok'.
+clean_garbage() ->
+ erase('$counterexample'),
+ ok.
+
+-spec get_fail_reason(counterexample()) -> fail_reason().
+get_fail_reason(#cexm{fail_reason = Reason}) ->
+ Reason.
+
+-spec get_bound(counterexample()) -> clean_testcase().
+get_bound(#cexm{bound = ImmTestCase}) ->
+ clean_testcase(ImmTestCase).
+
+
+%%------------------------------------------------------------------------------
+%% Options support
+%%------------------------------------------------------------------------------
+
+-spec parse_opts([user_opt()] | user_opt()) -> opts().
+parse_opts(OptsList) ->
+ parse_opts(OptsList, #opts{}).
+
+-spec parse_opts([user_opt()] | user_opt(), opts()) -> opts().
+parse_opts([], Opts) ->
+ Opts;
+parse_opts([UserOpt | Rest], Opts) ->
+ parse_opts(Rest, parse_opt(UserOpt,Opts));
+parse_opts(UserOpt, Opts) ->
+ parse_opt(UserOpt, Opts).
+
+-spec parse_opt(user_opt(), opts()) -> opts().
+parse_opt(UserOpt, Opts) ->
+ case UserOpt of
+ quiet -> Opts#opts{output_fun =
+ fun(_,_) -> ok end};
+ {to_file,IoDev} -> Opts#opts{output_fun =
+ fun(S,F) ->
+ io:format(IoDev, S, F)
+ end};
+ {on_output,Print} -> Opts#opts{output_fun = Print};
+ long_result -> Opts#opts{long_result = true};
+ crypto -> Opts#opts{crypto = true};
+ {numtests,N} -> Opts#opts{numtests = N};
+ N when is_integer(N), N > 0 -> Opts#opts{numtests = N};
+ {start_size,Size} -> Opts#opts{start_size = Size};
+ {max_shrinks,N} -> Opts#opts{max_shrinks = N};
+ noshrink -> Opts#opts{noshrink = true};
+ {constraint_tries,N} -> Opts#opts{constraint_tries = N};
+ fails -> Opts#opts{expect_fail = true}
+ end.
+
%%------------------------------------------------------------------------------
%% Test declaration functions
%%------------------------------------------------------------------------------
-spec numtests(pos_integer(), outer_test()) -> numtests_clause().
-numtests(N, Test) -> {'$numtests',N,Test}.
+numtests(N, Test) ->
+ {'$numtests', N, Test}.
+
+-spec collect(term(), test()) -> sample_clause().
+collect(SingleSample, Prop) ->
+ aggregate([SingleSample], Prop).
--spec collect(category(), test()) -> collect_clause().
-collect(Category, Prop) -> {'$collect',Category,Prop}.
+-spec aggregate(sample(), test()) -> sample_clause().
+aggregate(Sample, Prop) ->
+ {'$sample', Sample, Prop}.
-spec fails(outer_test()) -> fails_clause().
-fails(Test) -> {'$fails',Test}.
+fails(Test) ->
+ {'$fails', Test}.
+
+-spec on_output(output_fun(), outer_test()) -> on_output_clause().
+on_output(Print, Test) ->
+ {'$on_output', Print, Test}.
-spec equals(term(), term()) -> whenfail_clause().
equals(A, B) ->
- ?WHENFAIL(io:format("~w =/= ~w~n", [A, B]), A =:= B).
+ ?WHENFAIL(io:format("~w =/= ~w~n",[A,B]), A =:= B).
%%------------------------------------------------------------------------------
%% Main usage functions
%%------------------------------------------------------------------------------
--spec check(outer_test()) -> final_result() | boolean().
+-spec check(outer_test()) -> long_result() | short_result().
check(Test) ->
check(Test, #opts{}).
--spec check(outer_test(), opts() | [opt()] | opt()) ->
- final_result() | boolean().
-check({'$numtests',N,Test}, #opts{} = Opts) ->
- check(Test, Opts#opts{numtests = N});
%% We only allow a 'fails' to be an external wrapper, since the property
%% wrapped by a 'fails' is not delayed, and thus a failure-inducing exception
%% will cause the test to fail before the 'fails' is processed.
+-spec check(outer_test(), opts() | [user_opt()] | user_opt()) ->
+ long_result() | short_result().
+check({'$numtests',N,Test}, #opts{} = Opts) ->
+ check(Test, Opts#opts{numtests = N});
check({'$fails',Test}, #opts{} = Opts) ->
check(Test, Opts#opts{expect_fail = true});
-check(Test, #opts{numtests = NumTests, quiet = Quiet} = Opts) ->
+check({'$on_output',Print,Test}, #opts{} = Opts) ->
+ check(Test, Opts#opts{output_fun = Print});
+check(Test, #opts{numtests = NumTests, output_fun = Print,
+ long_result = ReturnLong} = Opts) ->
global_state_init(Opts),
- ImmResult = perform(0, NumTests, Test, none, Opts),
+ ImmResult = perform(NumTests, Test, Print),
report_imm_result(ImmResult, Opts),
ShortResult = get_short_result(ImmResult, Opts),
- FinalResult = get_final_result(ImmResult, Test, Opts),
+ LongResult = get_long_result(ImmResult, Test, Opts),
global_state_erase(),
- case Quiet of
- true -> FinalResult;
+ case ReturnLong of
+ true -> LongResult;
false -> ShortResult
end;
-check(Test, OptsList) ->
- check(Test, parse_opts(OptsList)).
-
--spec get_short_result(imm_result(), opts()) -> boolean().
-get_short_result({passed,_,_}, #opts{expect_fail = ExpectFail}) ->
- not ExpectFail;
-get_short_result({failed,_,_,_,_}, #opts{expect_fail = ExpectFail}) ->
- ExpectFail;
-get_short_result({error,_}, _Opts) ->
- false.
-
--spec get_final_result(imm_result(), test(), opts()) -> final_result().
-get_final_result({failed,Performed,Reason,ImmFailedTestCase,_FailActions}, Test,
- #opts{max_shrinks = Max, expect_fail = ExpectFail} = Opts) ->
- FailedTestCase = proper_gen:clean_instance(ImmFailedTestCase),
- case ExpectFail of %% TODO: no shrink option here
- false ->
- {Shrinks, ImmMinTestCase} =
- proper_shrink:shrink(ImmFailedTestCase, Test, Reason, Max, Opts),
- NewOpts = #opts{quiet = true, try_shrunk = true,
- shrunk = ImmMinTestCase},
- {failed, _Reason, _Bound, MinFailActions} = run(Test, NewOpts),
- MinTestCase = proper_gen:clean_instance(ImmMinTestCase),
- report_shrinking(Shrinks, MinTestCase, MinFailActions, Opts),
- {failed, Performed, Reason, FailedTestCase, Shrinks, MinTestCase};
- true ->
- {failed, Performed, Reason, FailedTestCase}
- end;
-get_final_result(ImmResult, _Test, _Opts) ->
+check(Test, UserOpts) ->
+ check(Test, parse_opts(UserOpts)).
+
+-spec get_short_result(imm_result(), opts()) -> short_result().
+get_short_result({passed,_Passed,_Samples}, Opts) ->
+ not Opts#opts.expect_fail;
+get_short_result({failed,_Performed,_CExm,_Actions}, Opts) ->
+ Opts#opts.expect_fail;
+get_short_result({error,_Reason} = ErrorResult, _Opts) ->
+ ErrorResult.
+
+-spec get_long_result(imm_result(), test(), opts()) -> long_result().
+get_long_result({failed,Performed,CExm,_Actions}, Test,
+ #opts{expect_fail = false, noshrink = false,
+ max_shrinks = MaxShrinks, output_fun = Print}) ->
+ Print("Shrinking", []),
+ #cexm{fail_reason = Reason, bound = ImmTestCase} = CExm,
+ {Shrinks, MinImmTestCase} =
+ proper_shrink:shrink(ImmTestCase, Test, Reason, MaxShrinks, Print),
+ Ctx = #ctx{try_shrunk = true, to_try = MinImmTestCase},
+ {failed, MinCExm, MinActions} = run(Test, Ctx),
+ report_shrinking(Shrinks, MinImmTestCase, MinActions, Print),
+ save_counterexample(MinCExm),
+ {failed, Performed, CExm, Shrinks, MinCExm};
+get_long_result({failed,Performed,CExm,_Actions}, _Test, _Opts) ->
+ save_counterexample(CExm),
+ {failed, Performed, CExm};
+get_long_result(ImmResult, _Test, _Opts) ->
ImmResult.
--spec perform(non_neg_integer(), non_neg_integer(), test(),
- [cat_dict()] | 'none', opts()) -> imm_result().
-perform(0, 0, _Test, _CatDicts, _Opts) ->
+-spec perform(non_neg_integer(), test(), output_fun()) -> imm_result().
+perform(NumTests, Test, Print) ->
+ perform(0, 0, NumTests, Test, none, Print).
+
+-spec perform(non_neg_integer(), non_neg_integer(), non_neg_integer(), test(),
+ [sample()] | 'none', output_fun()) -> imm_result().
+perform(0, _Performed, 0, _Test, _Samples, _Print) ->
{error, cant_satisfy};
-perform(Performed, 0, _Test, CatDicts, _Opts) ->
- {passed, Performed, CatDicts};
-perform(Performed, Left, Test, CatDicts, Opts) ->
+perform(Passed, _Performed, 0, _Test, Samples, _Print) ->
+ {passed, Passed, Samples};
+perform(Passed, Performed, Left, Test, Samples, Print) ->
proper_gen:gen_state_erase(),
- case run(Test, Opts) of
- {passed, {categories,Categories}} ->
- print(".", [], Opts),
- NewCatDicts = update_catdicts(Categories, CatDicts),
+ case run(Test) of
+ {passed, true_prop, MoreSamples} ->
+ Print(".", []),
+ NewSamples = add_samples(MoreSamples, Samples),
grow_size(),
- perform(Performed + 1, Left - 1, Test, NewCatDicts, Opts);
- {failed, Reason, Bound, FailActions} ->
- print("!", [], Opts),
- {failed, Performed + 1, Reason, Bound, FailActions};
+ perform(Passed+1, Performed+1, Left-1, Test, NewSamples, Print);
+ {failed, CExm, Actions} ->
+ Print("!", []),
+ {failed, Passed+1, CExm, Actions};
{error, cant_generate} = Error ->
Error;
+ {error, type_mismatch} = Error ->
+ Error;
{error, rejected} ->
- print("x", [], Opts),
+ Print("x", []),
grow_size(),
- perform(Performed, Left - 1, Test, CatDicts, Opts);
+ perform(Passed, Performed+1, Left-1, Test, Samples, Print);
Unexpected ->
- {error, {unexpected, Unexpected}}
+ {error, {unexpected,Unexpected}}
end.
--spec update_catdicts([category()], [cat_dict()] | 'none') -> [cat_dict()].
-update_catdicts(Categories, none) ->
- [orddict:from_list([{C,1}]) || C <- Categories];
-update_catdicts(Categories, CatDicts) ->
- lists:zipwith(fun(C,D) -> add_to_category(C,D) end,
- Categories, CatDicts).
-
--spec add_to_category(category(), cat_dict()) -> cat_dict().
-add_to_category(Category, CatDict) ->
- case orddict:find(Category, CatDict) of
- {ok, Count} -> orddict:store(Category, Count + 1, CatDict);
- error -> orddict:store(Category, 1, CatDict)
- end.
-
--spec run(test(), opts()) -> single_run_result().
-run(Test, Opts) ->
- run(Test, #ctx{}, Opts).
-
--spec run(test(), ctx(), opts()) -> single_run_result().
-run(true, Context, _Opts) ->
- {passed, {categories,lists:reverse(Context#ctx.categories)}};
-run(false, Context, _Opts) ->
- {failed, false_property, lists:reverse(Context#ctx.bound),
- lists:reverse(Context#ctx.fail_actions)};
-run({'$forall',RawType,Prop}, Context = #ctx{bound = Bound}, Opts) ->
- Type = proper_types:cook_outer(RawType),
- case {Opts#opts.try_shrunk, Opts#opts.shrunk} of
+-spec add_samples([sample()], [sample()] | 'none') -> [sample()].
+add_samples(MoreSamples, none) ->
+ MoreSamples;
+add_samples(MoreSamples, Samples) ->
+ lists:zipwith(fun erlang:'++'/2, MoreSamples, Samples).
+
+-spec run(test()) -> single_run_result().
+run(Test) ->
+ run(Test, #ctx{}).
+
+-spec run(test(), ctx()) -> single_run_result().
+run(true, #ctx{to_try = [], samples = Samples}) ->
+ {passed, true_prop, lists:reverse(Samples)};
+run(true, _Ctx) ->
+ {error, too_many_instances};
+run(false, #ctx{to_try = []} = Ctx) ->
+ create_failed_result(Ctx, false_prop);
+run(false, _Ctx) ->
+ {error, too_many_instances};
+run({'$forall',RawType,Prop},
+ #ctx{try_shrunk = TryShrunk, to_try = ToTry, bound = Bound} = Ctx) ->
+ case {TryShrunk, ToTry} of
{true, []} ->
- {passed, didnt_crash};
+ {passed, didnt_crash, []};
{true, [ImmInstance | Rest]} ->
case proper_arith:surely(proper_types:is_instance(ImmInstance,
- Type)) of
+ RawType)) of
true ->
Instance = proper_gen:clean_instance(ImmInstance),
- NewOpts = Opts#opts{shrunk = Rest},
- run({'$apply',[Instance],Prop}, Context, NewOpts);
+ NewCtx =
+ Ctx#ctx{to_try = Rest, bound = [ImmInstance | Bound]},
+ run({'$apply',[Instance],Prop}, NewCtx);
false ->
{error, wrong_type}
end;
- {false, _} ->
- case proper_gen:generate(Type) of
+ {false, []} ->
+ case proper_gen:generate(RawType) of
'$cant_generate' ->
{error, cant_generate};
ImmInstance ->
Instance = proper_gen:clean_instance(ImmInstance),
- NewContext = Context#ctx{bound = [ImmInstance | Bound]},
- run({'$apply',[Instance],Prop}, NewContext, Opts)
+ NewCtx = Ctx#ctx{bound = [ImmInstance | Bound]},
+ run({'$apply',[Instance],Prop}, NewCtx)
end
end;
-run({'$implies',Pre,Prop}, Context, Opts) ->
- case Pre of
- true -> run({'$apply',[],Prop}, Context, Opts);
- false -> {error, rejected}
- end;
-run({'$collect',NewCategory,Prop}, #ctx{categories = Categories} = Context,
- Opts) ->
- NewContext = Context#ctx{categories = [NewCategory | Categories]},
- run(Prop, NewContext, Opts);
-run({'$whenfail',Action,Prop}, Context = #ctx{fail_actions = FailActions},
- Opts) ->
- NewContext = Context#ctx{fail_actions = [Action | FailActions]},
- run({'$apply',[],Prop}, NewContext, Opts);
-run({'$trapexit',Prop}, Context, Opts) ->
- NewContext = Context#ctx{catch_exits = true},
- run({'$apply',[],Prop}, NewContext, Opts);
-run({'$timeout',Limit,Prop}, Context, Opts) ->
- Child = spawn_link(fun() -> child(self(), Prop, Context, Opts) end),
+run({'$implies',true,Prop}, Ctx) ->
+ run({'$apply',[],Prop}, Ctx);
+run({'$implies',false,_Prop}, _Ctx) ->
+ {error, rejected};
+run({'$sample',NewSample,Prop}, #ctx{samples = Samples} = Ctx) ->
+ NewCtx = Ctx#ctx{samples = [NewSample | Samples]},
+ run(Prop, NewCtx);
+run({'$whenfail',NewAction,Prop}, #ctx{fail_actions = Actions} = Ctx)->
+ NewCtx = Ctx#ctx{fail_actions = [NewAction | Actions]},
+ run({'$apply',[],Prop}, NewCtx);
+run({'$trapexit',Prop}, Ctx) ->
+ NewCtx = Ctx#ctx{catch_exits = true},
+ run({'$apply',[],Prop}, NewCtx);
+run({'$timeout',Limit,Prop}, Ctx) ->
+ Self = self(),
+ Child = spawn_link(fun() -> child(Self,Prop,Ctx) end),
receive
{result, Result} -> Result
after Limit ->
unlink(Child),
exit(Child, kill),
clear_mailbox(),
- setelement(2, run(false,Context,Opts), timeout)
+ create_failed_result(Ctx, timeout)
end;
-run({'$apply',Args,Prop}, Context, Opts) ->
+run({'$apply',Args,Prop}, Ctx) ->
try
- %% TODO: should we care what the code returns when trapping exits?
- %% if we are doing that, we are probably testing code that will
- %% run as a separate process against crashes
- run(apply(Prop,Args), Context, Opts)
+ %% TODO: should we care if the code returns true when trapping exits?
+ %% If we are doing that, we are probably testing code that will
+ %% run as a separate process against crashes.
+ run(apply(Prop,Args), Ctx)
catch
+ error:function_clause ->
+ {error, type_mismatch};
throw:'$cant_generate' ->
{error, cant_generate};
+ throw:'$need_size_info' ->
+ {error, need_size_info};
throw:ExcReason ->
- setelement(2, run(false,Context,Opts), {throw,ExcReason});
- exit:ExcReason when Context#ctx.catch_exits ->
- setelement(2, run(false,Context,Opts), {exit,ExcReason})
+ create_failed_result(Ctx, {exception, throw, ExcReason,
+ erlang:get_stacktrace()});
+ exit:ExcReason when Ctx#ctx.catch_exits ->
+ create_failed_result(Ctx, {exception, exit, ExcReason,
+ erlang:get_stacktrace()})
end.
--spec child(pid(), delayed_test(), ctx(), opts()) -> 'ok'.
-child(Father, Prop, Context, Opts) ->
- Result = run({'$apply',[],Prop}, Context, Opts),
+-spec create_failed_result(ctx(), fail_reason()) ->
+ {'failed', counterexample(), fail_actions()}.
+create_failed_result(#ctx{bound = Bound, fail_actions = Actions}, Reason) ->
+ CExm = #cexm{fail_reason = Reason, bound = lists:reverse(Bound),
+ size = get_size(), gen_state = proper_gen:gen_state_get()},
+ {failed, CExm, lists:reverse(Actions)}.
+
+-spec child(pid(), delayed_test(), ctx()) -> 'ok'.
+child(Father, Prop, Ctx) ->
+ Result = run({'$apply',[],Prop}, Ctx),
Father ! {result, Result},
ok.
@@ -418,16 +502,37 @@ clear_mailbox() ->
ok
end.
+-spec clean_testcase(imm_testcase()) -> clean_testcase().
+clean_testcase(ImmTestCase) ->
+ [proper_gen:clean_instance(I) || I <- ImmTestCase].
+
+
+%%------------------------------------------------------------------------------
+%% Shrinking callback functions
+%%------------------------------------------------------------------------------
+
-spec still_fails(imm_testcase(), test(), fail_reason()) -> boolean().
-still_fails(TestCase, Test, OldReason) ->
- Opts = #opts{quiet = true, try_shrunk = true, shrunk = TestCase},
- case run(Test, Opts) of
+still_fails(ImmTestCase, Test, OldReason) ->
+ Ctx = #ctx{try_shrunk = true, to_try = ImmTestCase},
+ case run(Test, Ctx) of
%% We check that it's the same fault that caused the crash.
- %% TODO: Should we check that the stacktrace is the same?
- {failed, Reason, _Bound, _FailActions} -> OldReason =:= Reason;
- _ -> false
+ {failed, #cexm{fail_reason = NewReason}, _Actions} ->
+ same_fail_reason(OldReason, NewReason);
+ _ ->
+ false
end.
+%% We don't consider two exceptions different if they have a different
+%% stacktrace.
+-spec same_fail_reason(fail_reason(), fail_reason()) -> boolean().
+same_fail_reason({exception,_SameExcKind,_SameExcReason,_StackTrace1},
+ {exception,_SameExcKind,_SameExcReason,_StackTrace2}) ->
+ true;
+same_fail_reason(_SameReason, _SameReason) ->
+ true;
+same_fail_reason(_, _) ->
+ false.
+
-spec skip_to_next(test()) -> forall_clause() | 'false' | 'error'.
%% We should never encounter false ?IMPLIES, true final results or unprecedented
%% tests.
@@ -441,20 +546,20 @@ skip_to_next({'$implies',true,Prop}) ->
skip_to_next({'$apply',[],Prop});
skip_to_next({'$implies',false,_Prop}) ->
error;
-skip_to_next({'$collect',_Category,Prop}) ->
+skip_to_next({'$sample',_Sample,Prop}) ->
skip_to_next(Prop);
skip_to_next({'$whenfail',_Action,Prop}) ->
skip_to_next({'$apply',[],Prop});
skip_to_next({'$trapexit',Prop}) ->
skip_to_next({'$apply',[],Prop});
skip_to_next({'$timeout',_Limit,_Prop}) ->
- false; % this is OK, since timeout cannot contain any ?FORALLs
+ false; % This is OK, since timeout cannot contain any ?FORALLs.
skip_to_next({'$apply',Args,Prop}) ->
try
skip_to_next(apply(Prop, Args))
catch
- %% TODO: should be OK to catch everything here, since we have
- %% already tested at this point that the test still fails
+ %% Should be OK to catch everything here, since we have already tested
+ %% at this point that the test still fails.
_ExcKind:_ExcReason -> false
end.
@@ -463,80 +568,86 @@ skip_to_next({'$apply',Args,Prop}) ->
%% Output functions
%%------------------------------------------------------------------------------
--spec print(string(), [term()], opts()) -> 'ok'.
-print(Str, Args, #opts{quiet = Quiet}) ->
- case Quiet of
- true -> ok;
- false -> io:format(Str, Args)
- end.
-
-spec report_imm_result(imm_result(), opts()) -> 'ok'.
-report_imm_result({error,{unexpected,Unexpected}}, _Opts) ->
- io:format("~nInternal error: the last run returned an unexpected result:~n"
- "~w~nPlease notify the maintainers about this error~n",
- [Unexpected]),
- ok;
-report_imm_result(_Result, #opts{quiet = true}) ->
- ok;
-report_imm_result({passed,Performed,CatDicts}, Opts) ->
- case Opts#opts.expect_fail of
- true -> io:format("~nError: no test failed~n", []);
- false -> io:format("~nOK, passed ~b tests~n", [Performed])
+report_imm_result({passed,Passed,Samples},
+ #opts{expect_fail = ExpectF, output_fun = Print}) ->
+ case ExpectF of
+ true -> Print("~nError: no test failed~n", []);
+ false -> Print("~nOK, passed ~b tests~n", [Passed])
end,
- print_categories(Performed, CatDicts),
+ lists:foreach(fun(S) -> print_percentages(S,Passed,Print) end, Samples),
ok;
-report_imm_result({failed,Performed,_Reason,ImmFailedTestCase,FailActions},
- Opts) ->
- case Opts#opts.expect_fail of
- true ->
- io:format("~nOK, failed as expected, after ~b tests.~n",
- [Performed]);
- false ->
- io:format("~nFailed, after ~b tests.~n", [Performed]),
- FailedTestCase = proper_gen:clean_instance(ImmFailedTestCase),
- print_instances(FailedTestCase),
- execute_actions(FailActions),
- io:format("Shrinking", [])
+report_imm_result({failed,Performed,_CExm,_Actions},
+ #opts{expect_fail = true, output_fun = Print}) ->
+ Print("~nOK, failed as expected, after ~b tests.~n", [Performed]);
+report_imm_result({failed,Performed,#cexm{fail_reason = Reason, bound = Bound},
+ Actions},
+ #opts{expect_fail = false, output_fun = Print}) ->
+ Print("~nFailed, after ~b tests.~n", [Performed]),
+ case Reason of
+ false_prop ->
+ ok;
+ timeout ->
+ Print("Reason: timeout.~n", []);
+ {exception,ExcKind,ExcReason,_StackTrace} ->
+ %% TODO: print stacktrace too?
+ Print("Reason: ~w:~w.~n", [ExcKind,ExcReason])
end,
+ print_bound(Bound, Print),
+ execute_actions(Actions),
ok;
-report_imm_result({error,cant_generate}, _Opts) ->
- io:format("~nError: couldn't produce an instance that satisfies all strict"
- " constraints after ~b tries~n", [get('$constraint_tries')]),
- ok;
-report_imm_result({error,cant_satisfy}, _Opts) ->
- io:format("~nError: no valid test could be generated.~n", []),
+report_imm_result({error,Reason}, #opts{output_fun = Print}) ->
+ case Reason of
+ cant_generate ->
+ Print("~nError: couldn't produce an instance that satisfies all "
+ "strict constraints after ~b tries~n",
+ [get('$constraint_tries')]);
+ cant_satisfy ->
+ Print("~nError: no valid test could be generated.~n", []);
+ type_mismatch ->
+ Print("~nError: the variables' and types' structures inside a "
+ "?FORALL don't match.~n", []);
+ {unexpected,Unexpected} ->
+ Print("~nInternal error: the last run returned an unexpected result"
+ ":~n~w~nPlease notify the maintainers about this error~n",
+ [Unexpected])
+ end,
ok.
--spec print_categories(pos_integer(), [cat_dict()]) -> 'ok'.
-print_categories(_Performed, []) ->
- ok;
-print_categories(Performed, [CatDict]) ->
- lists:foreach(fun({C,N}) ->
- io:format("~7.3f\% ~w~n", [100 * N / Performed,C])
- end,
- orddict:to_list(CatDict)),
+-spec print_percentages(sample(), pos_integer(), output_fun()) -> 'ok'.
+print_percentages([], _Passed, _Print) ->
ok;
-print_categories(Performed, [CatDict | Rest]) ->
- print_categories(Performed, [CatDict]),
- io:format("~n", []),
- print_categories(Performed, Rest).
-
--spec print_instances(clean_testcase()) -> 'ok'.
-print_instances(Instances) ->
- lists:foreach(fun(I) -> io:format("~w~n", [I]) end, Instances),
+print_percentages(Sample, Passed, Print) ->
+ FreqDict = lists:foldl(fun add_one_to_freq/2, dict:new(), Sample),
+ Freqs = dict:to_list(FreqDict),
+ SortedFreqs = lists:reverse(lists:keysort(2, Freqs)),
+ Print("~n", []),
+ lists:foreach(fun({X,F}) -> Print("~b\% ~w~n", [100 * F div Passed,X]) end,
+ SortedFreqs),
+ ok.
+
+-spec add_one_to_freq(term(), dict()) -> dict().
+add_one_to_freq(X, Dict) ->
+ case dict:find(X, Dict) of
+ {ok,Freq} -> dict:store(X, Freq + 1, Dict);
+ error -> dict:store(X, 1, Dict)
+ end.
+
+-spec print_bound(imm_testcase(), output_fun()) -> 'ok'.
+print_bound(ImmInstances, Print) ->
+ Instances = clean_testcase(ImmInstances),
+ lists:foreach(fun(I) -> Print("~w~n", [I]) end, Instances),
ok.
-spec execute_actions(fail_actions()) -> 'ok'.
-execute_actions(FailActions) ->
- lists:foreach(fun(A) -> ?FORCE(A) end, FailActions),
+execute_actions(Actions) ->
+ lists:foreach(fun(A) -> ?FORCE(A) end, Actions),
ok.
--spec report_shrinking(non_neg_integer(), clean_testcase(), fail_actions(),
- opts()) -> 'ok'.
-report_shrinking(_Shrinks, _MinTestCase, _FailActions, #opts{quiet = true}) ->
- ok;
-report_shrinking(Shrinks, MinTestCase, FailActions, _Opts) ->
- io:format("(~b times)~n", [Shrinks]),
- print_instances(MinTestCase),
- execute_actions(FailActions),
+-spec report_shrinking(non_neg_integer(), imm_testcase(), fail_actions(),
+ output_fun()) -> 'ok'.
+report_shrinking(Shrinks, MinImmTestCase, MinActions, Print) ->
+ Print("(~b times)~n", [Shrinks]),
+ print_bound(MinImmTestCase, Print),
+ execute_actions(MinActions),
ok.
View
46 src/proper_arith.erl
@@ -43,6 +43,7 @@
-type extint() :: integer() | 'inf'.
-type extnum() :: number() | 'inf'.
-type ternary() :: boolean() | 'unknown'.
+-type delayed_ternary() :: fun(() -> ternary()).
%%------------------------------------------------------------------------------
@@ -54,17 +55,29 @@ le(inf, _B) -> true;
le(_A, inf) -> true;
le(A, B) -> A =< B.
--spec and3(ternary(), ternary()) -> ternary().
-and3(true, true) -> true;
-and3(false, _) -> false;
-and3(_, false) -> false;
-and3(_, _) -> unknown.
+-spec and3(delayed_ternary(), delayed_ternary()) -> ternary().
+and3(A, B) ->
+ case ?FORCE(A) of
+ true -> ?FORCE(B);
+ false -> false;
+ unknown ->
+ case ?FORCE(B) of
+ false -> false;
+ _ -> unknown
+ end
+ end.
--spec or3(ternary(), ternary()) -> ternary().
-or3(false, false) -> false;
-or3(true, _) -> true;
-or3(_, true) -> true;
-or3(_, _) -> unknown.
+-spec or3(delayed_ternary(), delayed_ternary()) -> ternary().
+or3(A, B) ->
+ case ?FORCE(A) of
+ true -> true;
+ false -> ?FORCE(B);
+ unknown ->
+ case ?FORCE(B) of
+ true -> true;
+ _ -> unknown
+ end
+ end.
-spec any3([ternary()]) -> ternary().
any3(TernList) ->
@@ -150,10 +163,10 @@ cut_improper_tail_tr(ImproperTail, AccList) ->
%% @doc Seeds the random number generator. This function should be run before
%% calling any random function from this module.
-spec rand_start(boolean()) -> 'ok'.
-rand_start(CryptoExists) ->
+rand_start(Crypto) ->
_ = random:seed(now()),
%% TODO: read option for RNG bijections here
- case CryptoExists of
+ case Crypto of
true ->
case crypto:start() of
ok ->
@@ -220,11 +233,14 @@ rand_float(Low, High) when is_float(Low), is_float(High), Low =< High ->
%% may be undefined at 1.0.
%% TODO: read global options and decide here which bijection to use
zero_one_to_zero_inf(X) ->
- 10 * X / math:sqrt(1 - X*X).
+ X / math:sqrt(1 - X*X).
--spec rand_bytes(length()) -> binary().
+-spec rand_bytes(length()) -> binary() | '$cant_generate'.
rand_bytes(Len) ->
- crypto:rand_bytes(Len).
+ case get('$crypto') of
+ true -> crypto:rand_bytes(Len);
+ _ -> '$cant_generate'
+ end.
-spec jumble([T]) -> [T].
%% @doc Produces a random permutation of a list.
View
3  src/proper_extra.erl
@@ -1,4 +1,5 @@
%%% Copyright 2010 Manolis Papadakis (manopapad@gmail.com)
+%%% and Kostis Sagonas (kostis@cs.ntua.gr)
%%%
%%% This file is part of PropEr.
%%%
@@ -16,7 +17,7 @@
%%% along with PropEr. If not, see <http://www.gnu.org/licenses/>.
%%% @author Manolis Papadakis <manopapad@gmail.com>
-%%% @copyright 2010 Manolis Papadakis
+%%% @copyright 2010 Manolis Papadakis and Kostis Sagonas
%%% @version {@version}
%%% @doc Some additional types from the standard library are declared here.
View
201 src/proper_gen.erl
@@ -23,10 +23,12 @@
%%% this module.
-module(proper_gen).
+-export([pick/1, pick/2]).
--export([generate/1, generate/2, pick/1, pick/2]).
+-export([gen_state_get/0, gen_state_set/1, gen_state_erase/0]).
+-export([generate/1]).
-export([normal_gen/1, alt_gens/1, clean_instance/1, get_ret_type/2,
- function_body/3, gen_state_erase/0]).
+ function_body/3]).
-export([integer_gen/3, float_gen/3, atom_gen/1, atom_rev/1, binary_gen/1,
binary_str_gen/1, binary_rev/1, binary_len_gen/1, binary_len_str_gen/1,
bitstring_gen/0, bitstring_rev/1, bitstring_len_gen/1, list_gen/2,
@@ -35,7 +37,7 @@
-export_type([instance/0, imm_instance/0, sized_generator/0, nosize_generator/0,
generator/0, straight_gen/0, reverse_gen/0, combine_fun/0,
- alt_gens/0]).
+ alt_gens/0, gen_state/0]).
-include("proper_internal.hrl").
@@ -47,36 +49,89 @@
-type instance() :: term().
%% TODO: update imm_instance() when adding more types: be careful when reading
%% anything that returns it
--type imm_instance() :: proper_types:raw_type() % TODO: is this correct?
+-type imm_instance() :: proper_types:raw_type()
| instance()
- | {'$used', _, _}.
+ | {'$used', imm_instance(), imm_instance()}.
-type sized_generator() :: fun((size()) -> imm_instance()).
-type nosize_generator() :: fun(() -> imm_instance()).
-type generator() :: sized_generator() | nosize_generator().
--type sized_straight_gen() :: fun((size()) -> instance()).
--type nosize_straight_gen() :: fun(() -> instance()).
+-type sized_straight_gen() :: fun((size()) -> instance() | '$cant_generate').
+-type nosize_straight_gen() :: fun(() -> instance() | '$cant_generate').
-type straight_gen() :: sized_straight_gen() | nosize_straight_gen().
-type reverse_gen() :: fun((instance()) -> imm_instance()).
-type combine_fun() :: fun((instance()) -> imm_instance()).
-type alt_gens() :: fun(() -> [imm_instance()]).
-type fun_num() :: pos_integer().
+%% TODO: fill in the type of abstract format clauses
+-opaque gen_state() :: {fun_num(), _}.
+
+
+%%------------------------------------------------------------------------------
+%% State handling functions
+%%------------------------------------------------------------------------------
+
+%% TODO: fill in the type of abstract format clauses
+-spec get_forms() -> _.
+get_forms() ->
+ get('$forms').
+
+%% TODO: fill in the type of abstract format clauses
+-spec set_forms(_) -> 'ok'.
+set_forms(Forms) ->
+ put('$forms', Forms),
+ ok.
+
+-spec get_next_fun_num() -> fun_num().
+get_next_fun_num() ->
+ FunNum = case get('$next_fun_num') of
+ undefined -> 1;
+ N -> N
+ end,
+ put('$next_fun_num', FunNum + 1),
+ FunNum.
+
+-spec gen_state_get() -> gen_state().
+gen_state_get() ->
+ {get('$forms'), get('$next_fun_num')}.
+
+-spec gen_state_set(gen_state()) -> 'ok'.
+gen_state_set({Forms, NextFunNum}) ->
+ put('$forms', Forms),
+ put('$next_fun_num', NextFunNum),
+ case Forms of
+ undefined ->
+ ok;
+ _ ->
+ load_forms()
+ end.
+
+-spec gen_state_erase() -> 'ok'.
+gen_state_erase() ->
+ erase('$forms'),
+ erase('$next_fun_num'),
+ _ = code:purge('$temp_mod'),
+ _ = code:delete('$temp_mod'),
+ _ = code:purge('$temp_mod'),
+ ok.
+
+-spec load_forms() -> 'ok'.
+load_forms() ->
+ %% TODO: verbose and report options?
+ {ok,'$temp_mod',Code} = compile:forms(get('$forms'), [export_all]),
+ {module,_Mod} = code:load_binary('$temp_mod', "no_file", Code),
+ ok.
+
%%------------------------------------------------------------------------------
%% Instance generation functions
%%------------------------------------------------------------------------------
-spec generate(proper_types:raw_type()) -> imm_instance() | '$cant_generate'.
-generate(Type = {'$type',_Props}) ->
- generate(Type, get('$constraint_tries'), '$cant_generate');
generate(RawType) ->
- generate(proper_types:cook_outer(RawType)).
-
--spec generate(proper_types:type(), non_neg_integer()) ->
- imm_instance() | '$cant_generate'.
-generate(Type, MaxTries) ->
- generate(Type, MaxTries, '$cant_generate').
+ Type = proper_types:cook_outer(RawType),
+ generate(Type, get('$constraint_tries'), '$cant_generate').
-spec generate(proper_types:type(), non_neg_integer(), term()) -> term().
generate(_Type, 0, Fallback) ->
@@ -98,14 +153,10 @@ generate(Type, TriesLeft, Fallback) ->
{clean_instance(ImmInstance2),{'$used',ImmParts,ImmInstance2}};
Kind ->
ImmInstance1 =
- case {Kind, proper_types:find_prop(straight_gen,Type)} of
- {wrapper, {ok,StraightGen}} ->
- %% TODO: should we have an option to enable this?
- ReverseGen =
- proper_types:get_prop(reverse_gen, Type),
- ReverseGen(call_gen(StraightGen, Type));
- _ ->
- normal_gen(Type)
+ case Kind of
+ %% TODO: should we have an option to enable this?
+ wrapper -> normal_or_str_gen(Type);
+ _ -> normal_gen(Type)
end,
ImmInstance2 =
case proper_types:is_raw_type(ImmInstance1) of
@@ -123,49 +174,69 @@ generate(Type, TriesLeft, Fallback) ->
case proper_types:satisfies_all(Instance, Type) of
{_,true} -> Result;
{true,false} -> generate(Type, TriesLeft - 1, Result);
- {false,false} -> % TODO: is it okay to grow the size here?
- proper:grow_size(),
- generate(Type, TriesLeft - 1, Fallback)
+ {false,false} -> generate(Type, TriesLeft - 1, Fallback)
end.
--spec pick(proper_types:raw_type()) -> instance().
+-spec pick(proper_types:raw_type()) -> 'error' | {'ok',instance()}.
pick(RawType) ->
pick(RawType, 10).
--spec pick(proper_types:raw_type(), size()) -> instance().
+-spec pick(proper_types:raw_type(), size()) -> 'error' | {'ok',instance()}.
pick(RawType, Size) ->
- proper:global_state_init(),
- proper:set_size(Size),
- ImmInstance = generate(RawType),
- %% io:format("~p~n~n", [ImmInstance]),
- Instance = clean_instance(ImmInstance),
- if
- is_function(Instance) ->
+ proper:global_state_init_size(Size),
+ case clean_instance(generate(RawType)) of
+ '$cant_generate' ->
+ io:format("Error: couldn't produce an instance that satisfies all "
+ "strict constraints after ~b tries~n",
+ [get('$constraint_tries')]),
+ proper:global_state_erase(),
+ error;
+ FunInstance when is_function(FunInstance) ->
io:format("WARNING: Some garbage has been left in the process "
"registry and the code server to allow for the returned "
"function to run normally.~nPlease run "
- "proper:global_state_erase() when done.~n", []);
- true ->
- proper:global_state_erase()
- end,
- Instance.
+ "proper:global_state_erase() when done.~n", []),
+ {ok,FunInstance};
+ Instance ->
+ proper:global_state_erase(),
+ {ok,Instance}
+ end.
%%------------------------------------------------------------------------------
%% Utility functions
%%------------------------------------------------------------------------------
+-spec normal_or_str_gen(proper_types:type()) -> imm_instance().
+normal_or_str_gen(Type) ->
+ case proper_types:find_prop(straight_gen,Type) of
+ {ok, StraightGen} ->
+ case call_gen(StraightGen, Type) of
+ '$cant_generate' ->
+ normal_gen(Type);
+ Instance ->
+ ReverseGen = proper_types:get_prop(reverse_gen, Type),
+ ReverseGen(Instance)
+ end;
+ error ->
+ normal_gen(Type)
+ end.
+
-spec normal_gen(proper_types:type()) -> imm_instance().
normal_gen(Type) ->
call_gen(proper_types:get_prop(generator,Type), Type).
-spec call_gen(generator() | straight_gen(), proper_types:type()) ->
- imm_instance() | instance().
+ imm_instance() | instance() | '$cant_generate'.
call_gen(Gen, Type) ->
if
- is_function(Gen, 0) -> Gen();
- is_function(Gen, 1) -> Size = proper:get_size(Type),
- Gen(Size)
+ is_function(Gen, 0) ->
+ Gen();
+ is_function(Gen, 1) ->
+ case proper:get_size(Type) of
+ undefined -> throw('$need_size_info');
+ Size -> Gen(Size)
+ end
end.
-spec alt_gens(proper_types:type()) -> [imm_instance()].
@@ -189,15 +260,6 @@ clean_instance(ImmInstance) ->
ImmInstance
end.
--spec get_next_fun_num() -> fun_num().
-get_next_fun_num() ->
- FunNum = case get('$next_fun_num') of
- undefined -> 1;
- N -> N
- end,
- put('$next_fun_num', FunNum + 1),
- FunNum.
-
-spec get_ret_type(function(), arity()) -> proper_types:type().
get_ret_type(Fun, Arity) ->
put('$get_ret_type', true),
@@ -228,13 +290,6 @@ function_body(Args, ImmRetType, {Seed1,Seed2}) ->
end
end.
--spec gen_state_erase() -> 'ok'.
-gen_state_erase() ->
- erase('$next_fun_num'),
- erase('$forms'),
- ok.
-
-
%%------------------------------------------------------------------------------
%% Basic type generators
%%------------------------------------------------------------------------------
@@ -283,7 +338,7 @@ binary_gen(Size) ->
proper_types:list(proper_types:byte())),
list_to_binary(Bytes)).
--spec binary_str_gen(size()) -> binary().
+-spec binary_str_gen(size()) -> binary() | '$cant_generate'.
binary_str_gen(Size) ->
Len = proper_arith:rand_int(0, Size),
binary_len_str_gen(Len).
@@ -298,7 +353,7 @@ binary_len_gen(Len) ->
proper_types:vector(Len, proper_types:byte()),
list_to_binary(Bytes)).
--spec binary_len_str_gen(length()) -> binary().
+-spec binary_len_str_gen(length()) -> binary() | '$cant_generate'.
binary_len_str_gen(Len) ->
proper_arith:rand_bytes(Len).
@@ -373,30 +428,30 @@ function_gen(Arity, RetType) ->
proper_arith:rand_int(0,?SEED_RANGE - 1)},
case Arity of
0 ->
- fun() -> function_body([], RetType, FunSeed) end;
+ fun() -> ?MODULE:function_body([], RetType, FunSeed) end;
1 ->
- fun(A) -> function_body([A], RetType, FunSeed) end;
+ fun(A) -> ?MODULE:function_body([A], RetType, FunSeed) end;
2 ->
- fun(A,B) -> function_body([A,B], RetType, FunSeed) end;
+ fun(A,B) -> ?MODULE:function_body([A,B], RetType, FunSeed) end;
3 ->
- fun(A,B,C) -> function_body([A,B,C], RetType, FunSeed) end;
+ fun(A,B,C) -> ?MODULE:function_body([A,B,C], RetType, FunSeed) end;
4 ->
- fun(A,B,C,D) -> function_body([A,B,C,D], RetType, FunSeed) end;
+ fun(A,B,C,D) ->
+ ?MODULE:function_body([A,B,C,D], RetType, FunSeed)
+ end;
_ ->
- OldForms = case get('$forms') of
+ OldForms = case get_forms() of
undefined -> [{attribute,0,module,'$temp_mod'}];
F -> F
end,
{FunName,FunForm} = new_function(Arity, RetType, FunSeed),
Forms = OldForms ++ [FunForm],
- put('$forms', Forms),
- %% TODO: verbose and report options?
- {ok,'$temp_mod',Code} = compile:forms(Forms, [export_all]),
- {module,_Mod} = code:load_binary('$temp_mod', "no_file", Code),
+ set_forms(Forms),
+ load_forms(),
erlang:make_fun('$temp_mod', FunName, Arity)
end.
-%% TODO: what is the type for abstract format clauses?
+%% TODO: fill in the type of abstract format clauses
-spec new_function(arity(), proper_types:type(), {integer(),integer()}) ->
{atom(), _}.
new_function(Arity, RetType, FunSeed) ->
View
175 src/proper_shrink.erl
@@ -25,8 +25,7 @@
-module(proper_shrink).
-export([shrink/5]).
-
--export([integer_shrinker/4, float_shrinker/4, union_first_choice_shrinker/3,
+-export([number_shrinker/4, union_first_choice_shrinker/3,
union_recursive_shrinker/3]).
-export_type([shrinker/0]).
@@ -39,9 +38,9 @@
%%------------------------------------------------------------------------------
-type forall2_clause() :: {'$forall2', proper_types:type(),
- fun((proper_gen:instance()) -> proper:test())}.
+ proper:dependent_test()}.
%% TODO: rename to 'shrinker_state()'?
--type state() :: 'init' | 'done' | {'shrunk',position(),_} | term().
+-type state() :: 'init' | 'done' | {'shrunk',position(),state()} | term().
-type shrinker() :: fun((proper_gen:imm_instance(), proper_types:type(),
state()) -> {[proper_gen:imm_instance()],state()}).
@@ -50,15 +49,16 @@
%% Main shrinking functions
%%------------------------------------------------------------------------------
+
-spec shrink(proper:imm_testcase(), proper:test(), proper:fail_reason(),
- non_neg_integer(), proper:opts()) ->
+ non_neg_integer(), proper:output_fun()) ->
{non_neg_integer(),proper:imm_testcase()}.
-shrink(ImmFailedTestCase, Test, Reason, Shrinks, Opts) ->
- shrink_to_fixpoint(ImmFailedTestCase, Test, Reason, 0, Shrinks, Opts).
+shrink(ImmTestCase, Test, Reason, Shrinks, Print) ->
+ shrink_to_fixpoint(ImmTestCase, Test, Reason, 0, Shrinks, Print).
-spec shrink_to_fixpoint(proper:imm_testcase(), proper:test(),
proper:fail_reason(), non_neg_integer(),
- non_neg_integer(), proper:opts()) ->
+ non_neg_integer(), proper:output_fun()) ->
{non_neg_integer(),proper:imm_testcase()}.
%% TODO: is it too much if we try to reach an equilibrium by repeaing all the
%% shrinkers?
@@ -66,46 +66,47 @@ shrink(ImmFailedTestCase, Test, Reason, Shrinks, Opts) ->
%% dangerous)? should we check if the returned values have been
%% encountered before?
shrink_to_fixpoint(ImmFailedTestCase, _Test, _Reason,
- TotalShrinks, 0, _Opts) ->
+ TotalShrinks, 0, _Print) ->
{TotalShrinks, ImmFailedTestCase};
shrink_to_fixpoint(ImmFailedTestCase, Test, Reason,
- TotalShrinks, ShrinksLeft, Opts) ->
+ TotalShrinks, ShrinksLeft, Print) ->
{Shrinks, ImmMinTestCase} =
shrink_tr([], ImmFailedTestCase, proper:skip_to_next(Test), Reason,
- 0, ShrinksLeft, init, Opts),
+ 0, ShrinksLeft, init, Print),
case Shrinks of
0 -> {TotalShrinks, ImmMinTestCase};
N -> shrink_to_fixpoint(ImmMinTestCase, Test, Reason,
- TotalShrinks + N, ShrinksLeft - N, Opts)
+ TotalShrinks + N, ShrinksLeft - N, Print)
end.
-spec shrink_tr(proper:imm_testcase(), proper:imm_testcase(),
proper:forall_clause() | forall2_clause(), proper:fail_reason(),
- non_neg_integer(), non_neg_integer(), state(), proper:opts()) ->
+ non_neg_integer(), non_neg_integer(), state(),
+ proper:output_fun()) ->
{non_neg_integer(),proper:imm_testcase()}.
%% TODO: 'tries_left' instead of 'shrinks_left'?
shrink_tr(Shrunk, TestTail, error, _Reason,
- Shrinks, _ShrinksLeft, _State, _Opts) ->
+ Shrinks, _ShrinksLeft, _State, _Print) ->
io:format("~nInternal Error: skip_to_next returned error~n", []),
{Shrinks, lists:reverse(Shrunk) ++ TestTail};
-shrink_tr(Shrunk, TestTail, _Test, _Reason, Shrinks, 0, _State, _Opts) ->
+shrink_tr(Shrunk, TestTail, _Test, _Reason, Shrinks, 0, _State, _Print) ->
{Shrinks, lists:reverse(Shrunk) ++ TestTail};
-shrink_tr(Shrunk, [], false, _Reason, Shrinks, _ShrinksLeft, init, _Opts) ->
+shrink_tr(Shrunk, [], false, _Reason, Shrinks, _ShrinksLeft, init, _Print) ->
{Shrinks, lists:reverse(Shrunk)};
shrink_tr(Shrunk, TestTail, {'$forall',RawType,Prop}, Reason,
- Shrinks, ShrinksLeft, init, Opts) ->
+ Shrinks, ShrinksLeft, init, Print) ->
Type = proper_types:cook_outer(RawType),
shrink_tr(Shrunk, TestTail, {'$forall2',Type,Prop}, Reason,
- Shrinks, ShrinksLeft, init, Opts);
+ Shrinks, ShrinksLeft, init, Print);
shrink_tr(Shrunk, [ImmInstance | Rest], {'$forall2',_Type,Prop}, Reason,
- Shrinks, ShrinksLeft, done, Opts) ->
+ Shrinks, ShrinksLeft, done, Print) ->
Instance = proper_gen:clean_instance(ImmInstance),
NewTest = proper:skip_to_next({'$apply',[Instance],Prop}),
shrink_tr([ImmInstance | Shrunk], Rest, NewTest, Reason,
- Shrinks, ShrinksLeft, init, Opts);
+ Shrinks, ShrinksLeft, init, Print);
shrink_tr(Shrunk, TestTail = [ImmInstance | Rest],
Test = {'$forall2',Type,Prop}, Reason,
- Shrinks, ShrinksLeft, State, Opts) ->
+ Shrinks, ShrinksLeft, State, Print) ->
{NewImmInstances,NewState} = shrink_one(ImmInstance, Type, State),
%% we also test if the recently returned instance is a valid instance
%% for its type, since we don't check constraints while shrinking
@@ -120,11 +121,11 @@ shrink_tr(Shrunk, TestTail = [ImmInstance | Rest],
case find_first(IsValid, NewImmInstances) of
none ->
shrink_tr(Shrunk, TestTail, Test, Reason,
- Shrinks, ShrinksLeft, NewState, Opts);
+ Shrinks, ShrinksLeft, NewState, Print);
{Pos, ShrunkImmInstance} ->
- proper:print(".", [], Opts),
+ Print(".", []),
shrink_tr(Shrunk, [ShrunkImmInstance | Rest], Test, Reason,
- Shrinks + 1, ShrinksLeft - 1, {shrunk,Pos,NewState}, Opts)
+ Shrinks+1, ShrinksLeft-1, {shrunk,Pos,NewState}, Print)
end.
-spec find_first(fun((T) -> boolean()), [T]) -> {position(),T} | 'none'.
@@ -178,10 +179,10 @@ get_shrinkers(Type) ->
[fun parts_shrinker/3, fun recursive_shrinker/3];
semi_opaque ->
[fun split_shrinker/3, fun remove_shrinker/3,
- fun elements_shrinker/3];
+ fun elements_shrinker/3];
opaque ->
[fun split_shrinker/3, fun remove_shrinker/3,
- fun elements_shrinker/3]
+ fun elements_shrinker/3]
end,
CustomShrinkers ++ StandardShrinkers
end.
@@ -274,8 +275,7 @@ try_combine(ImmParts, OldImmInstance, PartsType, Combine) ->
{'$used',ImmParts,OldImmInstance};
false ->
%% TODO: return more than one? then we must flatten
- NewImmInstance = proper_gen:generate(InnerType,
- ?MAX_RANDOM_TRIES_WHEN_SHRINKING),
+ NewImmInstance = proper_gen:generate(InnerType),
{'$used',ImmParts,NewImmInstance}
end;
false ->
@@ -467,74 +467,66 @@ elements_shrinker(Instance, Type,
%% Custom shrinkers
%%------------------------------------------------------------------------------
--spec integer_shrinker(integer(), proper_arith:extint(), proper_arith:extint(),
- state()) -> {[integer()],state()}.
-integer_shrinker(X, Low, High, init) ->
- Operators = [fun(Y) -> Y div 10 end,
- fun(Y) -> Y - sign(Y) end,
- fun(Y) -> abs(Y) end],
- number_shrinker(X, 0, Low, High, {operators,Operators});
-integer_shrinker(X, Low, High, State) ->
- number_shrinker(X, 0, Low, High, State).
-
--spec float_shrinker(float(), proper_arith:extnum(), proper_arith:extnum(),
- state()) -> {[float()],state()}.
-float_shrinker(X, Low, High, init) ->
- Operators = [fun(Y) -> Y / 10.0 end,
- fun(Y) -> Y - sign(Y) end,
- fun(Y) -> abs(Y) end],
- number_shrinker(X, 0.0, Low, High, {operators,Operators});
-float_shrinker(X, Low, High, State) ->
- number_shrinker(X, 0.0, Low, High, State).
-
--spec number_shrinker(T, T, T | 'inf', T | 'inf', state()) -> {[T],state()}.
-%% TODO: produce a few (random) values per operator
-number_shrinker(_X, _Target, _Low, _High, {operators,[]}) ->
- {[], done};
-number_shrinker(X, Target, Low, High, {operators,[Op | Rest]}) ->
- {op_to_target(X,Target,Low,High,Op), {just_used,Op,Rest}};
-number_shrinker(X, Target, Low, High, {just_used,_Op,Rest}) ->
- number_shrinker(X, Target, Low, High, {operators,Rest});
-number_shrinker(X, Target, Low, High, {shrunk,_Pos,{just_used,Op,Rest}}) ->
- number_shrinker(X, Target, Low, High, {operators,[Op | Rest]}).
-
--spec op_to_target(T, T, T | 'inf', T | 'inf', fun((T) -> T)) -> [T].
-%% Op should be a function that approaces Target,
-%% X should be between Low and High
-op_to_target(_Target, _Target, _Low, _High, _Op) ->
- [];
-op_to_target(X, Target, Low, High, Op) ->
- NewX = Op(X),
- case NewX =:= X of
- true ->
- [];
- false ->
- case proper_arith:le(Low, Target) of
- false ->
- case proper_arith:le(Low, NewX) of
- false -> [];
- true -> [NewX]
- end;
- true ->
- case proper_arith:le(Target, High) of
- false ->
- case proper_arith:le(NewX, High) of
- false -> [];
- true -> [NewX]
- end;
- true ->
- [NewX]
- end
- end
+-spec number_shrinker(number(), proper_arith:extnum(), proper_arith:extnum(),
+ state()) -> {[number()],state()}.
+number_shrinker(X, Low, High, init) ->
+ {Target,Inc,OverLimit} = find_target(X, Low, High),
+ case X =:= Target of
+ true -> {[], done};
+ false -> {[Target], {inc,Target,Inc,OverLimit}}
+ end;
+number_shrinker(_X, _Low, _High, {inc,Last,Inc,OverLimit}) ->
+ NewLast = Inc(Last),
+ case OverLimit(NewLast) of
+ true -> {[], done};
+ false -> {[NewLast], {inc,NewLast,Inc,OverLimit}}
+ end;
+number_shrinker(_X, _Low, _High, {shrunk,_Pos,_State}) ->
+ {[], done}.
+
+-spec find_target(number(), number(), number()) ->
+ {number(),fun((number()) -> number()),fun((number()) -> boolean())}.
+find_target(X, Low, High) ->
+ case {proper_arith:le(Low,0), proper_arith:le(0,High)} of
+ {false, _} ->
+ Limit = find_limit(X, Low, High, High),
+ {Low, fun(Y) -> Y + 1 end, fun(Y) -> Y > Limit end};
+ {true,false} ->
+ Limit = find_limit(X, Low, High, Low),
+ {High, fun(Y) -> Y - 1 end, fun(Y) -> Y < Limit end};
+ {true,true} ->
+ Sign = sign(X),
+ OverLimit =
+ case X >= 0 of
+ true ->
+ Limit = find_limit(X, Low, High, High),
+ fun(Y) -> Y > Limit end;
+ false ->
+ Limit = find_limit(X, Low, High, Low),
+ fun(Y) -> Y < Limit end
+ end,
+ {zero(X), fun(Y) -> Y + Sign end, OverLimit}
+ end.
+
+-spec find_limit(number(), number(), number(), number()) -> number().
+find_limit(X, Low, High, FallBack) ->
+ case proper_arith:le(Low, X) andalso proper_arith:le(X, High) of
+ true -> X;
+ false -> FallBack
end.
--spec sign(number()) -> -1 | 1.
+-spec sign(number()) -> number().
sign(X) ->
if
- X >= 0 -> 1;
- X < 0 -> -1
+ X > 0 -> 1;
+ X < 0 -> -1;
+ true -> zero(X)
end.
+-spec zero(number()) -> number().
+zero(X) when is_integer(X) -> 0;
+zero(X) when is_float(X) -> 0.0.
+
-spec union_first_choice_shrinker(proper_gen:instance(), [proper_types:type()],
state()) -> {[proper_gen:instance()],state()}.
%% TODO: just try first choice?
@@ -545,8 +537,7 @@ union_first_choice_shrinker(Instance, Choices, init) ->
{[],done};
{N,_Type} ->
%% TODO: some kind of constraints test here?
- {[X || X <- [proper_gen:generate(T,
- ?MAX_RANDOM_TRIES_WHEN_SHRINKING)
+ {[X || X <- [proper_gen:generate(T)
|| T <- lists:sublist(Choices, N - 1)],
X =/= '$cant_generate'],
done}
View
8 src/proper_symb.erl
@@ -23,6 +23,7 @@
%%% datatypes.
-module(proper_symb).
+
-export([eval/1, eval/2, defined/1, well_defined/1, pretty_print/1,
pretty_print/2]).
@@ -83,11 +84,12 @@ pretty_print(VarValues, SymbTerm) ->
symb_walk(VarValues, SymbTerm, fun parse_fun/3, fun parse_term/1),
lists:flatten(erl_pp:expr(ExprTree)).
-%% TODO: what is the type for abstract format expressions?
+%% TODO: fill in the type of abstract format expressions
-spec parse_fun(module_name(), function_name(), [_]) -> _.
parse_fun(Module, Function, ArgTreeList) ->
{call,0,{remote,0,{atom,0,Module},{atom,0,Function}},ArgTreeList}.
+%% TODO: fill in the type of abstract format expressions
-spec parse_term(term()) -> _.
parse_term(TreeList) when is_list(TreeList) ->
{RestOfList, Acc0} =
@@ -113,7 +115,9 @@ symb_walk(VarValues, {var,VarId}, HandleCall, HandleTerm) ->
SymbWalk = fun(X) -> symb_walk(VarValues, X, HandleCall, HandleTerm) end,
case lists:keyfind(VarId, 1, VarValues) of
{VarId,VarValue} ->
- %% TODO: this allows symbolic calls and vars inside var values
+ %% TODO: this allows symbolic calls and vars inside var values,
+ %% which may result in an infinite loop, as in:
+ %% [{aZz,{call,m,f,[{var,a}]}}], {var,a}
SymbWalk(VarValue);
false ->
HandleTerm({HandleTerm(var),SymbWalk(VarId)})
View
85 src/proper_types.erl
@@ -1,4 +1,5 @@
%%% Copyright 2010 Manolis Papadakis (manopapad@gmail.com)
+%%% and Kostis Sagonas (kostis@cs.ntua.gr)
%%%
%%% This file is part of PropEr.
%%%
@@ -16,14 +17,16 @@
%%% along with PropEr. If not, see <http://www.gnu.org/licenses/>.
%%% @author Manolis Papadakis <manopapad@gmail.com>
-%%% @copyright 2010 Manolis Papadakis
+%%% @copyright 2010 Manolis Papadakis and Kostis Sagonas
%%% @version {@version}
%%% @doc Type manipulation functions and predefined types are contained in this
%%% module.
-module(proper_types).
--export([cook_outer/1, is_raw_type/1, get_prop/2, find_prop/2, new_type/2,
- subtype/2, is_instance/2, unwrap/1, weakly/1, strongly/1,
+-export([is_instance/2]).
+
+-export([cook_outer/1, is_type/1, is_raw_type/1, get_prop/2, find_prop/2,
+ new_type/2, subtype/2, unwrap/1, weakly/1, strongly/1,
satisfies_all/2]).
-export([lazy/1, sized/1, bind/2, shrinkwith/2, add_constraint/3]).
-export([integer/2, float/2, atom/0, binary/0, binary/1, bitstring/0,
@@ -57,7 +60,7 @@
-type type() :: {'$type', [type_prop()]}.
%% TODO: update raw_type() when adding more standard types
-type raw_type() :: type() | integer() | float() | atom() | tuple()
- | maybe_improper_list(_,_) | <<_:_ * 1>>.
+ | maybe_improper_list(_,_) | <<_:_ * 1>>.
-type type_prop_name() :: 'kind' | 'generator' | 'straight_gen' | 'reverse_gen'
| 'size_limit' | 'size_transform' | 'is_instance'
| 'shrinkers' | 'noshrink' | 'internal_type'
@@ -124,6 +127,12 @@ cook_outer(RawType) ->
true -> exactly(RawType)
end.
+-spec is_type(term()) -> boolean().
+is_type({'$type',_Props}) ->
+ true;
+is_type(_) ->
+ false.
+
-spec is_raw_type(term()) -> boolean().
is_raw_type({'$type',_TypeProps}) ->
true;
@@ -178,31 +187,40 @@ new_type(PropList, Kind) ->
subtype(PropList, Type) ->
add_props(PropList, Type).
--spec is_instance(proper_gen:imm_instance(), type()) -> proper_arith:ternary().
+-spec is_instance(proper_gen:imm_instance(), raw_type()) ->
+ proper_arith:ternary().
%% TODO: if the second argument is not a type, let it pass (don't even check for
%% term equality?) - if it's a raw type, don't cook it, instead recurse
%% into it.
-is_instance(ImmInstance, Type) ->
+is_instance(ImmInstance, RawType) ->
CleanInstance = proper_gen:clean_instance(ImmInstance),
- proper_arith:and3(
- weakly(satisfies_all(CleanInstance, Type)),
- proper_arith:or3(
- case find_prop(is_instance, Type) of
- {ok, IsInstance} -> IsInstance(ImmInstance);
- error -> unknown
- end,
+ Type = cook_outer(RawType),
+ ?AND3(
+ ?OR3(
case get_prop(kind, Type) of
wrapper -> wrapper_test(ImmInstance, Type);
constructed -> constructed_test(ImmInstance, Type);
- _ -> unknown
+ _ -> false
+ end,
+ case find_prop(is_instance, Type) of
+ {ok, IsInstance} -> IsInstance(ImmInstance);
+ error -> false
end
- )
+ ),
+ weakly(satisfies_all(CleanInstance, Type))
).
-spec wrapper_test(proper_gen:imm_instance(), type()) -> proper_arith:ternary().
wrapper_test(ImmInstance, Type) ->
%% TODO: check if it's actually a raw type that's returned?
- proper_arith:any3([is_instance(ImmInstance, T) || T <- unwrap(Type)]).
+ try
+ proper_arith:any3([is_instance(ImmInstance, T) || T <- unwrap(Type)])
+ catch
+ throw:'$need_size_info' ->
+ %% TODO: print some more info?
+ %% TODO: alt_gens can still give a result?
+ unknown
+ end.
-spec unwrap(type()) -> [type()].
%% TODO: check if it's actually a raw type that's returned?
@@ -221,8 +239,7 @@ constructed_test({'$used',ImmParts,ImmInstance}, Type) ->
%% TODO: move construction code to proper_gen
%% TODO: non-type => should we check for strict term equality?
RawInnerType = Combine(proper_gen:clean_instance(ImmParts)),
- InnerType = cook_outer(RawInnerType),
- is_instance(ImmInstance, InnerType);
+ is_instance(ImmInstance, RawInnerType);
Other ->