common_test: Add experimental module ct_property_test

This module may change without warning...

3 files changed, 180 insertions, 0 deletions

diff --git a/lib/common_test/doc/src/Makefile b/lib/common_test/doc/src/Makefile
index 99161ce68a..57233a7f6c 100644
--- a/lib/common_test/doc/src/Makefile
+++ b/lib/common_test/doc/src/Makefile
@@ -47,6 +47,7 @@ CT_MODULES = \
 	ct_snmp \
 	unix_telnet \
 	ct_slave \
+	ct_property_test \
 	ct_netconfc
 
 CT_XML_FILES = $(CT_MODULES:=.xml)
diff --git a/lib/common_test/doc/src/ref_man.xml b/lib/common_test/doc/src/ref_man.xml
index 2f5c892e60..c266b70d00 100644
--- a/lib/common_test/doc/src/ref_man.xml
+++ b/lib/common_test/doc/src/ref_man.xml
@@ -78,6 +78,7 @@
   <xi:include href="unix_telnet.xml"/>
   <xi:include href="ct_slave.xml"/>
   <xi:include href="ct_hooks.xml"/>
+  <xi:include href="ct_property_test.xml"/>
 </application>
 
 
diff --git a/lib/common_test/src/ct_property_test.erl b/lib/common_test/src/ct_property_test.erl
new file mode 100644
index 0000000000..e401fef669
--- /dev/null
+++ b/lib/common_test/src/ct_property_test.erl
@@ -0,0 +1,178 @@
+%%
+%% %CopyrightBegin%
+%% 
+%% Copyright Ericsson AB 2003-2014. All Rights Reserved.
+%% 
+%% The contents of this file are subject to the Erlang Public License,
+%% Version 1.1, (the "License"); you may not use this file except in
+%% compliance with the License. You should have received a copy of the
+%% Erlang Public License along with this software. If not, it can be
+%% retrieved online at http://www.erlang.org/.
+%% 
+%% Software distributed under the License is distributed on an "AS IS"
+%% basis, WITHOUT WARRANTY OF ANY KIND, either express or implied. See
+%% the License for the specific language governing rights and limitations
+%% under the License.
+%% 
+%% %CopyrightEnd%
+%%
+
+%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+%%%                                                             %%%
+%%%                       WARNING                               %%%
+%%%                                                             %%%
+%%% This is experimental code which may be changed or removed   %%%
+%%%               anytime without any warning.                  %%%
+%%%                                                             %%%
+%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+
+
+%%% @doc EXPERIMENTAL support in common-test for calling property based tests.
+%%%
+%%% <p>This module is a first step towards running Property Based testing in the
+%%% Common Test framework.  A property testing tool like QuickCheck or PropEr is
+%%% assumed to be installed.</p>
+%%%
+%%% <p>The idea is to have a common_test testsuite calling a property testing
+%%% tool with special property test suites as defined by that tool. In this manual
+%%% we assume the usual Erlang Application directory structure.  The tests are
+%%% collected in the application's <c>test</c> directory. The test directory
+%%% has a sub-directory called <c>property_test</c> where everything needed for
+%%% the property tests are collected.</p>
+%%%
+%%% <p>A typical ct test suite using <c>ct_property_test</c> is organized as follows:
+%%% </p>
+%%% ```
+%%% -include_lib("common_test/include/ct.hrl").
+%%% 
+%%% all() -> [prop_ftp_case].
+%%% 
+%%% init_per_suite(Config) ->
+%%%     ct_property_test:init_per_suite(Config).
+%%% 
+%%% %%%---- test case
+%%% prop_ftp_case(Config) ->
+%%%     ct_property_test:quickcheck(
+%%%       ftp_simple_client_server:prop_ftp(Config),
+%%%       Config
+%%%      ).
+%%% '''
+%%%
+%%% <warning>
+%%% This is experimental code which may be changed or removed
+%%% anytime without any warning.  
+%%% </warning>
+%%%
+%%% @end
+
+-module(ct_property_test).
+
+%% API
+-export([init_per_suite/1,
+	 quickcheck/2]).
+
+-include_lib("common_test/include/ct.hrl").
+
+%%%-----------------------------------------------------------------
+%%% @spec init_per_suite(Config) -> Config | {skip,Reason}
+%%%
+%%% @doc Initializes Config for property testing.
+%%%
+%%% <p>The function investigates if support is available for either Quickcheck or PropEr.
+%%% The options <c>{property_dir,AbsPath}</c> and
+%%% <c>{property_test_tool,Tool}</c> is set in the Config returned.</p>
+%%% <p>The function is intended to be called in the init_per_suite in the test suite.</p>
+%%% <p>The property tests are assumed to be in the subdirectory <c>property_test</c>.</p>
+%%% @end
+
+init_per_suite(Config) ->
+    case which_module_exists([eqc,proper]) of
+	{ok,ToolModule} ->
+ 	    ct:pal("Found property tester ~p",[ToolModule]),
+	    Path = property_tests_path("property_test", Config),
+	    case compile_tests(Path,ToolModule) of
+		error -> 
+		    {fail, "Property test compilation failed in "++Path};
+		up_to_date ->
+		    add_code_pathz(Path),
+		    [{property_dir,Path},
+		     {property_test_tool,ToolModule} | Config]
+	    end;
+
+	not_found ->
+ 	    ct:pal("No property tester found",[]),
+	    {skip, "No property testing tool found"}
+    end.
+	
+%%%-----------------------------------------------------------------
+%%% @spec quickcheck(Property, Config) -> true | {fail,Reason}
+%%%
+%%% @doc Call quickcheck and return the result in a form suitable for common_test.
+%%%
+%%% <p>The function is intended to be called in the test cases in the test suite.</p>
+%%% @end
+
+quickcheck(Property, Config) ->
+    Tool = proplists:get_value(property_test_tool,Config),
+    mk_ct_return( Tool:quickcheck(Property) ).
+
+
+%%%================================================================
+%%%
+%%% Local functions
+%%% 
+
+%%% Make return values back to the calling Common Test suite
+mk_ct_return(true) ->
+    true;
+mk_ct_return(Other) -> 
+    try lists:last(hd(eqc:counterexample()))
+    of
+	{set,{var,_},{call,M,F,Args}} ->
+	    {fail, io_lib:format("~p:~p/~p returned bad result",[M,F,length(Args)])}
+    catch
+	_:_ ->
+	    {fail, Other}
+    end.
+
+%%% Check if a property testing tool is found
+which_module_exists([Module|Modules]) ->
+    case module_exists(Module) of
+	true -> {ok,Module};
+	false -> which_module_exists(Modules)
+    end;
+which_module_exists(_) ->
+    not_found.
+
+module_exists(Module) ->
+    is_list(catch Module:module_info()).
+
+%%% The path to the property tests
+property_tests_path(Dir, Config) ->
+    DataDir = proplists:get_value(data_dir, Config),
+    filename:join(lists:droplast(filename:split(DataDir))++[Dir]).
+
+%%% Extend the code path with Dir if it not already present
+add_code_pathz(Dir) ->
+    case lists:member(Dir, code:get_path()) of
+	true ->  ok;
+	false -> code:add_pathz(Dir)
+    end.
+
+compile_tests(Path, ToolModule) ->
+    MacroDefs = macro_def(ToolModule),
+    {ok,Cwd} = file:get_cwd(),
+    ok = file:set_cwd(Path),
+    {ok,FileNames} = file:list_dir("."),
+    BeamFiles = [F || F<-FileNames,
+		      filename:extension(F) == ".beam"],
+    [file:delete(F) || F<-BeamFiles],
+    ct:pal("Compiling in ~p:~n  Deleted ~p~n  MacroDefs=~p",[Path,BeamFiles,MacroDefs]),
+    Result = make:all([load|MacroDefs]),
+    file:set_cwd(Cwd),
+    Result.
+    
+
+macro_def(eqc) -> [{d, 'EQC'}];
+macro_def(proper) -> [{d, 'PROPER'}].
+