Extend PropEr with atomlimit-safe generator variants

The atom generator of PropEr generates atoms from random strings and its use, explicitly or implicitly, is prone to exhausting the atom limit. This commit adds variants to the atom generator which pick from the existing atoms and do not generate any new ones. It also provides variants of the any, list, map, term and tuple generators which implicitly use the atom generator. This extension is intended for internal use in property-based tests in OTP. It will only be enabled when PropEr is detected as property testing tool. Co-authored-by: Jan Uhlig <[email protected]> Co-authored-by: Björn Gustavsson <[email protected]>
erlang · Jun 27, 2023 · c39caa3 · c39caa3
1 parent 9e8359d
commit c39caa3
Show file tree

Hide file tree

Showing 4 changed files with 275 additions and 13 deletions.
diff --git a/lib/common_test/Makefile b/lib/common_test/Makefile
@@ -25,15 +25,7 @@ include $(ERL_TOP)/make/$(TARGET)/otp.mk
 # Macros
 #
 
-ifeq ($(findstring linux,$(TARGET)),linux)
-SUB_DIRECTORIES = doc/src src priv
-else
-ifeq ($(findstring solaris,$(TARGET)),solaris)
-SUB_DIRECTORIES = doc/src src priv
-else
-SUB_DIRECTORIES = doc/src src priv
-endif
-endif
+SUB_DIRECTORIES = doc/src src priv proper_ext
 
 include vsn.mk
 VSN = $(COMMON_TEST_VSN)

diff --git a/lib/common_test/proper_ext/Makefile b/lib/common_test/proper_ext/Makefile
@@ -0,0 +1,84 @@
+#
+# %CopyrightBegin%
+#
+# Copyright Ericsson AB 2023. All Rights Reserved.
+#
+# 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.
+#
+# %CopyrightEnd%
+#
+
+include $(ERL_TOP)/make/target.mk
+
+# ----------------------------------------------------
+# Configuration info.
+# ----------------------------------------------------
+include $(ERL_TOP)/make/$(TARGET)/otp.mk
+
+# ----------------------------------------------------
+# Release directory specification
+# ----------------------------------------------------
+PROPEREXTDIR = $(RELEASE_PATH)/lib/common_test-$(VSN)/proper_ext
+
+# ----------------------------------------------------
+# Target Specs
+# ----------------------------------------------------
+
+EBIN=.
+
+MODULES= \
+	ct_proper_ext
+
+TARGET_MODULES= $(MODULES:%=$(EBIN)/%)
+TARGET_MODULES= $(MODULES:%=$(EBIN)/%)
+
+ERL_FILES = $(MODULES:=.erl)
+HRL_FILES =
+
+TARGET_FILES = $(MODULES:%=$(EBIN)/%.$(EMULATOR))
+
+TARGETS = $(MODULES:%=$(EBIN)/%.$(EMULATOR))
+
+# ----------------------------------------------------
+# FLAGS
+# ----------------------------------------------------
+ERL_COMPILE_FLAGS += -I../include -Werror
+
+# ----------------------------------------------------
+# Targets
+# ----------------------------------------------------
+
+tests $(TYPES): $(TARGETS)
+
+clean:
+	rm -f $(TARGET_FILES)
+	rm -f core
+
+docs:
+
+# ----------------------------------------------------
+# Special Build Targets
+# ----------------------------------------------------
+
+# ----------------------------------------------------
+# Release Target
+# ----------------------------------------------------
+include $(ERL_TOP)/make/otp_release_targets.mk
+
+release_spec: opt
+	$(INSTALL_DIR) "$(PROPEREXTDIR)"
+	$(INSTALL_DATA) $(ERL_FILES) $(HRL_FILES) \
+		$(TARGET_FILES) \
+		"$(PROPEREXTDIR)"
+
+release_docs_spec:
diff --git a/lib/common_test/proper_ext/ct_proper_ext.erl b/lib/common_test/proper_ext/ct_proper_ext.erl
@@ -0,0 +1,178 @@
+%%
+%% %CopyrightBegin%
+%%
+%% Copyright Ericsson AB 2023. All Rights Reserved.
+%%
+%% 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.
+%%
+%% %CopyrightEnd%
+%%
+
+%% For internal use only.
+%%
+%% Some generators of the PropEr framework used by OTP for property tests
+%% create atoms at random, ie from random strings, and are therefore likely
+%% to exhaust the atom table.
+%%
+%% This module provides additional variants of these generators which do
+%% not create new atoms but pick from the already existing atoms.
+%%
+%% Other than in PropEr, the respective atom generators provided by this module
+%% do not shrink.
+
+-module(ct_proper_ext).
+
+-export([existing_atom/0]).
+-export([safe_any/0]).
+-export([safe_atom/0]).
+-export([safe_list/0]).
+-export([safe_map/0]).
+-export([safe_term/0]).
+-export([safe_tuple/0]).
+
+%% Atomlimit-safe variant of `proper_types:list()'
+-spec safe_list() -> proper_types:type().
+safe_list() ->
+    proper_types:list(safe_any()).
+
+
+%% Atomlimit-safe variant of `proper_types:map()'
+-spec safe_map() -> proper_types:type().
+safe_map() ->
+    proper_types:map(safe_any(), safe_any()).
+
+
+%% Atomlimit-safe variant of `proper_types:tuple()'
+-spec safe_tuple() -> proper_types:type().
+safe_tuple() ->
+    proper_types:loose_tuple(safe_any()).
+
+
+%% Atomlimit-safe variant of `proper_types:atom()'.
+-spec existing_atom() -> proper_types:type().
+existing_atom() ->
+    proper_types:noshrink(
+        proper_types:lazy(fun() ->
+                              N = erlang:system_info(atom_count),
+                              get_existing_atom(rand_int0(N - 1), N)
+                          end)).
+
+-define(ATOM_TERM_BIN(Index), <<131, 75, Index:24>>).
+get_existing_atom(Index, Max) ->
+    Index1 = Index rem Max,
+    case binary_to_term(?ATOM_TERM_BIN(Index1)) of
+        '' ->
+            '';
+        Atom ->
+            case hd(atom_to_list(Atom)) of
+                $$ -> get_existing_atom(Index1 + 1, Max);
+                _ -> Atom
+            end
+    end.
+
+
+%% Atomlimit-safe variant of `proper_types:atom()'.
+%% Like `existing_atom()', but also emphasizes some common atoms
+%% like `undefined', `false', `ok' etc
+-spec safe_atom() -> proper_types:type().
+safe_atom() ->
+    proper_types:oneof([proper_types:oneof(['', true, false, ok,
+                                            error, undefined,
+                                            infinity, 'ätöm',
+                                            '原子', '_', '"',
+                                            '\'', '\\', '+', '-',
+                                            '*', '/', '(', ')',
+                                            '[', ']', '{', '}',
+                                            '#' | erlang:nodes(known)]),
+                        existing_atom()]).
+
+
+%% Atomlimit-safe variant of `proper_types:term()'.
+%% Alias for `safe_any/0'.
+-spec safe_term() -> proper_types:type().
+safe_term() ->
+    safe_any().
+
+
+%% Atomlimit-safe variant of `proper_types:any()'.
+-spec safe_any() -> proper_types:type().
+safe_any() ->
+    proper_types:sized(fun(Size) -> safe_any(Size) end).
+
+safe_any(0) ->
+    proper_types:oneof([safe_atom(),
+                        proper_types:integer(),
+                        proper_types:float()]);
+safe_any(Size) ->
+    case pick_type(Size) of
+        simple ->
+            safe_any(0);
+        binary ->
+            proper_types:resize(Size, proper_types:bitstring());
+        {list, 0} ->
+            [];
+        {list, 1} ->
+            [proper_types:lazy(fun() -> safe_any(Size - 1) end)];
+        {list, NumEls} ->
+            ElSizes = distribute(Size - 1, NumEls),
+            proper_types:fixed_list([proper_types:lazy(fun() ->
+                                                           safe_any(S)
+                                                       end)
+                                     || S <- ElSizes]);
+        {tuple, 0} ->
+            {};
+        {tuple, 1} ->
+            {proper_types:lazy(fun() -> safe_any(Size - 1) end)};
+        {tuple, NumEls} ->
+            ElSizes = distribute(Size - 1, NumEls),
+            proper_types:tuple([proper_types:lazy(fun() ->
+                                                      safe_any(S) end)
+                                || S <- ElSizes])
+    end.
+
+%% Randomly picks a type with the following distribution (same as in PropEr):
+%% * 25% tuples
+%% * 25% lists
+%% * 12.5% bitstrings
+%% * 37.5% simple types
+pick_type(Size) ->
+    case rand:uniform(1000) of
+        X when X =< 250 ->
+            {tuple, rand_int0(Size)};
+        X when X =< 500 ->
+            {list, rand_int0(Size)};
+        X when X =< 625 ->
+            binary;
+        _ ->
+            simple
+    end.
+
+%% Randomly distributes the given number of `Credits' over the given
+%% number of `Slots'
+distribute(Slots, Credits) ->
+    [X || {_, X} <- lists:sort(distribute_1(Slots, Credits))].
+
+distribute_1(0, 0) ->
+    [];
+distribute_1(1, Credits) ->
+    [{rand:uniform(1000), Credits}];
+distribute_1(Slots, 0) ->
+    [{rand:uniform(1000), 0} || _ <- lists:seq(1, Slots)];
+distribute_1(Slots, Credits) ->
+    N = rand_int0(Credits),
+    [{rand:uniform(1000), N}|distribute_1(Slots - 1, Credits - N)].
+
+
+%% Random non-neg integer
+rand_int0(Max) ->
+    rand:uniform(Max + 1) - 1.
diff --git a/lib/common_test/src/ct_property_test.erl b/lib/common_test/src/ct_property_test.erl
@@ -69,20 +69,28 @@ init_tool(Config) ->
 	{ok,ToolModule} ->
             case code:where_is_file(lists:concat([ToolModule,".beam"])) of
                 non_existing ->
-                    ct:log("Found ~p, but ~tp~n is not found",
+                    ct:log("Found ~p, but ~ts was not found",
                            [ToolModule, lists:concat([ToolModule,".beam"])]),
                     {skip, "Strange Property testing tool installation"};
                 ToolPath ->
-                    ct:pal("Found property tester ~p~n"
-                           "at ~tp",
+                    ct:pal("Found property tester ~p at ~ts",
                            [ToolModule, ToolPath]),
+                    init_tool_extensions(ToolModule),
                     [{property_test_tool, ToolModule} | Config]
             end;
         not_found ->
             ct:pal("No property tester found",[]),
             {skip, "No property testing tool found"}
     end.
-
+
+init_tool_extensions(proper) ->
+    ProperExtDir = code:lib_dir(common_test, proper_ext),
+    true = code:add_patha(ProperExtDir),
+    ct:pal("Added ~ts to code path~n", [ProperExtDir]),
+    ok;
+init_tool_extensions(_) ->
+    ok.
+
 %%%----------------------------------------------------------------
 %%%
 %%% Call the found property tester (if any)