Add generator for existing atoms

Co-authored-by: Jan Uhlig <juhlig@hnc-agency.org>

Author: Maria-12648430

src/proper.erl

@@ -297,6 +297,10 @@
 %%% <dt>`{stop_nodes, boolean()}'</dt>
 %%% <dd> Specifies whether parallel PropEr should stop the nodes after running a property
 %%% or not. Defaults to true.</dd>
+%%% <dt>`{default_atom_generator, atom | existing_atom}'</dt>
+%%% <dd> Declares the type of atom generator to use in the {@link proper_types:any/0. `any()'}
+%%% to be either {@link proper_types:atom/0. `atom()'} or
+%%% {@link proper_types:existing_atom/0. `existing_atom()'}.</dd>
 %%% </dl>
 %%%
 %%% == Spec testing ==
@@ -539,6 +543,7 @@
 		  | 'quiet'
 		  | 'verbose'
 		  | pos_integer()
+		  | {'default_atom_generator', 'atom' | 'existing_atom'}
 		  | {'constraint_tries',pos_integer()}
 		  | {'false_positive_mfas',false_positive_mfas()}
 		  | {'max_shrinks',non_neg_integer()}
@@ -556,29 +561,30 @@
 		  | {'to_file',io:device()}.
 
 -type user_opts() :: [user_opt()] | user_opt().
--record(opts, {output_fun       = fun io:format/2 :: output_fun(),
-	       long_result      = false           :: boolean(),
-	       numtests         = 100             :: pos_integer(),
-	       search_steps     = 1000            :: pos_integer(),
-	       search_strategy  = proper_sa       :: proper_target:strategy(),
-	       start_size       = 1               :: proper_gen:size(),
-	       seed             = os:timestamp()  :: proper_gen:seed(),
-	       max_size         = 42              :: proper_gen:size(),
-	       max_shrinks      = 500             :: non_neg_integer(),
-	       noshrink         = false           :: boolean(),
-	       constraint_tries = 50              :: pos_integer(),
-	       expect_fail      = false           :: boolean(),
-	       any_type	        :: {'type', proper_types:type()} | 'undefined',
-	       spec_timeout     = infinity        :: timeout(),
-	       skip_mfas        = []              :: [mfa()],
-	       false_positive_mfas                :: false_positive_mfas(),
-	       setup_funs       = []              :: [setup_fun()],
-	       numworkers       = 0               :: non_neg_integer(),
-	       property_type    = pure            :: purity(),
-	       strategy_fun     = default_strategy_fun() :: strategy_fun(),
-	       stop_nodes       = true            :: boolean(),
-	       parent           = self()          :: pid(),
-	       nocolors         = false           :: boolean()}).
+-record(opts, {output_fun             = fun io:format/2        :: output_fun(),
+	       long_result            = false                  :: boolean(),
+	       numtests               = 100                    :: pos_integer(),
+	       search_steps           = 1000                   :: pos_integer(),
+	       search_strategy        = proper_sa              :: proper_target:strategy(),
+	       start_size             = 1                      :: proper_gen:size(),
+	       seed                   = os:timestamp()         :: proper_gen:seed(),
+	       max_size               = 42                     :: proper_gen:size(),
+	       max_shrinks            = 500                    :: non_neg_integer(),
+	       noshrink               = false                  :: boolean(),
+	       constraint_tries       = 50                     :: pos_integer(),
+	       expect_fail            = false                  :: boolean(),
+	       any_type                                        :: {'type', proper_types:type()} | 'undefined',
+	       default_atom_generator = atom                   :: 'atom' | 'existing_atom',
+	       spec_timeout           = infinity               :: timeout(),
+	       skip_mfas              = []                     :: [mfa()],
+	       false_positive_mfas                             :: false_positive_mfas(),
+	       setup_funs             = []                     :: [setup_fun()],
+	       numworkers             = 0                      :: non_neg_integer(),
+	       property_type          = pure                   :: purity(),
+	       strategy_fun           = default_strategy_fun() :: strategy_fun(),
+	       stop_nodes             = true                   :: boolean(),
+	       parent                 = self()                 :: pid(),
+	       nocolors               = false                  :: boolean()}).
 -type opts() :: #opts{}.
 -record(ctx, {mode     = new :: 'new' | 'try_shrunk' | 'try_cexm',
 	      bound    = []  :: imm_testcase() | counterexample(),
@@ -744,8 +750,10 @@ global_state_init_size_seed(Size, Seed) ->
 -spec global_state_init(opts()) -> 'ok'.
 global_state_init(#opts{start_size = StartSize, constraint_tries = CTries,
 			search_strategy = Strategy, search_steps = SearchSteps,
-			any_type = AnyType, seed = Seed, numworkers = NumWorkers} = Opts) ->
+			any_type = AnyType, seed = Seed, numworkers = NumWorkers,
+			default_atom_generator = DefaultAtomGen} = Opts) ->
     clean_garbage(),
+    put('$default_atom_generator', DefaultAtomGen),
     put('$size', StartSize - 1),
     put('$left', 0),
     put('$search_strategy', Strategy),
@@ -772,6 +780,8 @@ global_state_reset(#opts{start_size = StartSize} = Opts) ->
 global_state_erase() ->
     proper_typeserver:stop(),
     proper_arith:rand_stop(),
+    erase('$default_atom_generator'),
+    erase('$existing_atoms'),
     erase('$any_type'),
     erase('$constraint_tries'),
     erase('$left'),
@@ -1039,6 +1049,8 @@ parse_opt(UserOpt, Opts) ->
 	N when is_integer(N) ->
 	    ?VALIDATE_OPT(?POS_INTEGER(N), Opts#opts{numtests = N});
 	%% tuple options, sorted on tag
+	{default_atom_generator,G} ->
+	    ?VALIDATE_OPT(G =:= atom orelse G =:= existing_atom, Opts#opts{default_atom_generator = G});
 	{constraint_tries,N} ->
 	    ?VALIDATE_OPT(?POS_INTEGER(N), Opts#opts{constraint_tries = N});
 	{false_positive_mfas,F} ->

src/proper_gen.erl

@@ -46,6 +46,8 @@
 	 any_gen/1, native_type_gen/2, safe_weighted_union_gen/1,
 	 safe_union_gen/1]).
 
+-export([existing_atom_gen/1]).
+
 %% Public API types
 -export_type([instance/0, seed/0, size/0]).
 %% Internal types
@@ -418,6 +420,53 @@ atom_gen(Size) ->
 atom_rev(Atom) ->
     {'$used', atom_to_list(Atom), Atom}.
 
+%% @private
+-spec existing_atom_gen(size()) -> atom().
+%% We make sure we never clash with internal atoms by ignoring atoms starting with
+%% the character '$'.
+existing_atom_gen(_Size) ->
+    case get('$existing_atoms') of
+        undefined ->
+            {NextIndex, Atoms} = get_existing_atoms(0, #{}),
+            Range = maps:size(Atoms),
+	    put('$existing_atoms', {NextIndex, Range, Atoms}),
+	    X = proper_arith:rand_int(1, Range),
+	    maps:get(X, Atoms);
+        {NextIndex, Range, Atoms} ->
+            case get_existing_atoms(NextIndex, Atoms) of
+                {NextIndex, _} ->
+		    X = proper_arith:rand_int(1, Range),
+		    maps:get(X, Atoms);
+                {NextIndex1, Atoms1} ->
+		    Range1 = maps:size(Atoms1),
+		    put('$existing_atoms', {NextIndex1, Range1, Atoms1}),
+		    X = proper_arith:rand_int(1, Range1),
+		    maps:get(X, Atoms1)
+            end
+    end.
+
+-spec get_existing_atoms(non_neg_integer(), #{pos_integer() => atom()}) -> {non_neg_integer(), #{pos_integer() => atom()}}.
+get_existing_atoms(StartIndex, AtomMap) ->
+    get_existing_atoms(StartIndex, maps:size(AtomMap) + 1, AtomMap).
+
+get_existing_atoms(Index, Key, AtomMap) ->
+    try
+        binary_to_term(<<131, 75, Index:24>>)
+    of
+        '' ->
+            get_existing_atoms(Index + 1, Key + 1, AtomMap#{Key => ''});
+        Atom ->
+            case hd(atom_to_list(Atom)) of
+                $$ ->
+                    get_existing_atoms(Index + 1, Key, AtomMap);
+                _ ->
+                    get_existing_atoms(Index + 1, Key + 1, AtomMap#{Key => Atom})
+            end
+    catch
+        error:badarg ->
+            {Index, AtomMap}
+    end.
+
 %% @private
 -spec binary_gen(size()) -> proper_types:type().
 binary_gen(Size) ->
@@ -594,7 +643,7 @@ any_gen(Size) ->
 -spec real_any_gen(size()) -> imm_instance().
 real_any_gen(0) ->
     SimpleTypes = [proper_types:integer(), proper_types:float(),
-		   proper_types:atom()],
+		   proper_types:default_atom()],
     union_gen(SimpleTypes);
 real_any_gen(Size) ->
     FreqChoices = [{?ANY_SIMPLE_PROB,simple}, {?ANY_BINARY_PROB,binary},

src/proper_gen_next.erl

@@ -315,7 +315,7 @@ float_gen_sa({'$type', TypeProps}) ->
 
 %% List
 is_list_type(Type) ->
-  has_same_generator(Type, proper_types:list(proper_types:atom())).
+  has_same_generator(Type, proper_types:list(proper_types:default_atom())).
 
 list_choice(empty, Temp) ->
   C = ?RANDOM_MOD:uniform(),
@@ -426,7 +426,7 @@ vector_gen_sa(Type) ->
 
 %% atom
 is_atom_type(Type) ->
-  has_same_generator(Type, proper_types:atom()).
+  has_same_generator(Type, proper_types:default_atom()).
 
 atom_gen_sa(_AtomType) ->
   StringType = proper_types:list(proper_types:integer(0, 255)),

src/proper_types.erl

@@ -139,7 +139,7 @@
 -module(proper_types).
 -export([is_inst/2, is_inst/3]).
 
--export([integer/2, float/2, atom/0, binary/0, binary/1, bitstring/0,
+-export([integer/2, float/2, atom/0, existing_atom/0, binary/0, binary/1, bitstring/0,
 	 bitstring/1, list/1, vector/2, union/1, weighted_union/1, tuple/1,
 	 loose_tuple/1, exactly/1, fixed_list/1, function/2, map/0, map/2,
 	 any/0, shrink_list/1, safe_union/1, safe_weighted_union/1]).
@@ -160,6 +160,7 @@
 	 native_type/2, distlist/3, with_parameter/3, with_parameters/2,
 	 parameter/1, parameter/2]).
 -export([le/2]).
+-export([default_atom/0]).
 
 %% Public API types
 -export_type([type/0, raw_type/0]).
@@ -674,6 +675,28 @@ atom() ->
 	{is_instance, fun atom_is_instance/1}
     ]).
 
+%% @doc All existing atoms. All atoms used internally by PropEr start with a
+%% '`$'', so such atoms will never be produced as instances of this type. You
+%% should also refrain from using such atoms in your code, to avoid a potential
+%% clash.
+%% Instances do not shrink.
+-spec existing_atom() -> proper_types:type().
+existing_atom() ->
+    ?BASIC([
+        {generator, fun proper_gen:existing_atom_gen/1},
+	{reverse_gen, fun proper_gen:atom_rev/1},
+	{is_instance, fun atom_is_instance/1},
+	{noshrink, true}
+    ]).
+
+%% @private
+-spec default_atom() -> proper_types:type().
+default_atom() ->
+    case get('$default_atom_generator') of
+	existing_atom -> existing_atom();
+	_ -> atom()
+    end.
+
 atom_is_instance(X) ->
     is_atom(X)
     %% We return false for atoms starting with '$', since these are
@@ -1127,7 +1150,7 @@ map(K, V) ->
 %% type if you are certain that you need it.
 -spec any() -> proper_types:type().
 any() ->
-    AllTypes = [integer(),float(),atom(),bitstring(),?LAZY(loose_tuple(any())),
+    AllTypes = [integer(),float(),default_atom(),bitstring(),?LAZY(loose_tuple(any())),
 		?LAZY(list(any())), ?LAZY(map(any(), any()))],
     subtype([{generator, fun proper_gen:any_gen/1}], union(AllTypes)).