Merge pull request #7364 from Maria-12648430/proptest_safe_proper

Extend `common_test` PropEr with atomlimit-safe generator variants

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)

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:

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.

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)