File 1001-Extend-PropEr-with-atomlimit-safe-generator-variants.patch of Package erlang

From c39caa328f63497ec45be42dd8112b117bc40f5e Mon Sep 17 00:00:00 2001
From: Maria Scott <maria-12648430@hnc-agency.org>
Date: Tue, 6 Jun 2023 10:12:15 +0200
Subject: [PATCH] Extend PropEr with atomlimit-safe generator variants
MIME-Version: 1.0
Content-Type: text/plain; charset=UTF-8
Content-Transfer-Encoding: 8bit

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 <juhlig@hnc-agency.org>
Co-authored-by: Björn Gustavsson <bjorn@erlang.org>
---
 lib/common_test/Makefile                     |  10 +-
 lib/common_test/proper_ext/Makefile          |  84 +++++++++
 lib/common_test/proper_ext/ct_proper_ext.erl | 178 +++++++++++++++++++
 lib/common_test/src/ct_property_test.erl     |  16 +-
 4 files changed, 275 insertions(+), 13 deletions(-)
 create mode 100644 lib/common_test/proper_ext/Makefile
 create mode 100644 lib/common_test/proper_ext/ct_proper_ext.erl

diff --git a/lib/common_test/Makefile b/lib/common_test/Makefile
index ca7baaa959..5357e78dc2 100644
--- 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
new file mode 100644
index 0000000000..ffb4bdea3f
--- /dev/null
+++ 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
new file mode 100644
index 0000000000..8187e0f26d
--- /dev/null
+++ 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
index 12644dca49..f42eb635dd 100644
--- 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)
-- 
2.35.3

openSUSE Build Service is sponsored by