diff --git a/lib/crypto/src/crypto.erl b/lib/crypto/src/crypto.erl index de1f20c0fb93..1bdf6239222a 100644 --- a/lib/crypto/src/crypto.erl +++ b/lib/crypto/src/crypto.erl @@ -158,7 +158,7 @@ end -export([sign/4, sign/5, verify/5, verify/6]). -export([generate_key/2, generate_key/3, compute_key/4]). -export([encapsulate_key/2, decapsulate_key/3]). --export([exor/2, strong_rand_bytes/1, mod_pow/3]). +-export([exor/2, strong_rand_bytes/1, strong_rand_range/1, mod_pow/3]). -export([rand_seed/0, rand_seed_alg/1, rand_seed_alg/2]). -export([rand_seed_s/0, rand_seed_alg_s/1, rand_seed_alg_s/2]). -export([rand_plugin_next/1]). @@ -330,12 +330,13 @@ end get_test_engine/0]). -export([rand_plugin_aes_jump_2pow20/1]). --deprecated({rand_uniform, 2, "use rand:uniform/1 instead"}). +-deprecated( + {rand_uniform, 2, "use strong_rand_range/1 instead"}). %% This should correspond to the similar macro in crypto.c -define(MAX_BYTES_TO_NIF, 20000). %% Current value is: erlang:system_info(context_reductions) * 10 -%% Used by strong_rand_float/0 +%% Used by rand_plugin_uniform/1 -define(HALF_DBL_EPSILON, 1.1102230246251565e-16). % math:pow(2, -53) @@ -1994,11 +1995,9 @@ alias1_rev(C) -> C. %%%================================================================ %%% -%%% RAND - pseudo random numbers using RN_ and BN_ functions in crypto lib +%%% RANDOM - pseudo random numbers using RN_ and BN_ functions in crypto lib %%% %%%================================================================ --type rand_cache_seed() :: - nonempty_improper_list(non_neg_integer(), binary()). -doc """ Generate bytes with randomly uniform values 0..255. @@ -2020,131 +2019,284 @@ strong_rand_bytes(Bytes) -> false -> erlang:error(low_entropy); Bin -> Bin end. + strong_rand_bytes_nif(_Bytes) -> ?nif_stub. +-doc(#{group => <<"Random API">>}). +-doc """ +Generate a random integer number. + +The interval is `From =< N < To`. Uses the `crypto` library +pseudo-random number generator. `To` must be larger than `From`. + +> #### Note {: .info } +> +> This function is deprecated because it originally used +> the OpenSSL method BN_pseudo_rand_range that was not +> cryptographically strong and could not run out of entropy. +> That behaviour changed in OpenSSL and this function +> cannot be fixed without making it raise `error:low_entropy`, +> which is not backwards compatible. +> +> Instead, use `strong_rand_range(To - From) + From` +> +> Be aware of the possible `error:low_entropy` exception. +""". +-spec rand_uniform(crypto_integer(), crypto_integer()) -> + crypto_integer(). +rand_uniform(From, To) when is_binary(From), is_binary(To) -> + case rand_uniform_nif(From,To) of + <> when MSB > 127 -> + <<(Len + 1):32/integer, 0, MSB, Rest/binary>>; + Whatever -> + Whatever + end; +rand_uniform(From,To) when is_integer(From),is_integer(To) -> + if From < 0 -> + rand_uniform_pos(0, To - From) + From; + true -> + rand_uniform_pos(From, To) + end. + +rand_uniform_pos(From,To) when From < To -> + BinFrom = mpint(From), + BinTo = mpint(To), + case rand_uniform(BinFrom, BinTo) of + Result when is_binary(Result) -> + erlint(Result); + Other -> + Other + end; +rand_uniform_pos(_,_) -> + error(badarg). + +rand_uniform_nif(_From,_To) -> ?nif_stub. + + +-doc """ +Mixes in the bytes of the given binary into the internal state +of OpenSSL's random number generator. + +This calls the RAND_seed function from OpenSSL. Only use this if +the system you are running on does not have enough "randomness" built in. +Normally this is when `strong_rand_bytes/1` or a generator +from `rand_seed_alg_s/1` raises `error:low_entropy`. +""". +-doc(#{group => <<"Random API">>, + since => <<"OTP 17.0">>}). +-spec rand_seed(binary()) -> ok. +rand_seed(Seed) when is_binary(Seed) -> + rand_seed_nif(Seed). + +rand_seed_nif(_Seed) -> ?nif_stub. + + +-doc(#{group => <<"Random API">>, + since => <<"OTP @OTP-19841@">>}). -doc """ -Create a state object for [random number generation](`m:rand`), in order to -generate cryptographically strong random numbers (based on OpenSSL's -`BN_rand_range`). +Generate a random integer in a specified range. + +The returned random integer is in the interval is `0` =< `N` < `Range`. + +Uses the `crypto` library random number generator BN_rand_range. -Saves the state in the process dictionary before returning it as -well. See also `rand:seed/1` and `rand_seed_s/0`. +If the `Range` argument is a `pos_integer/0` the return value +is a `non_neg_integer/0`. If the `Range` argument is a positive integer +in a `binary/0`, the return value is a non-negative integer in a `binary/0`. -When using the state object from this function the `m:rand` functions using it -may raise exception `error:low_entropy` in case the random generator failed due +May raise exception `error:low_entropy` in case the random generator failed due to lack of secure "randomness". +""". +-spec strong_rand_range(Range :: pos_integer()) -> N :: non_neg_integer(); + (Range :: binary()) -> N :: binary(). +%% BN_rand_range +strong_rand_range(Range) when is_integer(Range), Range > 0 -> + bin_to_int(strong_rand_range(int_to_bin(Range))); +strong_rand_range(BinRange) when is_binary(BinRange) -> + case strong_rand_range_nif(BinRange) of + false -> + V = bin_to_int(BinRange), + if + 0 < V -> + erlang:error(low_entropy); + true -> + error(badarg, [BinRange]) + end; + <> -> + BinResult + end; +strong_rand_range(Range) -> + error(badarg, [Range]). + +strong_rand_range_nif(_BinRange) -> ?nif_stub. + +%%%================================================================ +%%% +%%% RAND - Plug-In Generators for the `rand` module +%%% +%%%================================================================ + +-type rand_cache_seed() :: + nonempty_improper_list(non_neg_integer(), binary()). + +-doc """ +Create a generator for `m:rand` and save it in the process dictionary. -_Example_ +Equivalent to `rand_seed_s/0` but also saves the returned +state object (generator) in the process dictionary. That is, +it is equivalent to `rand:seed(rand_seed_s())`. + +See `rand:seed/1` and `rand_seed_s/0`. + +#### _Example_ ```erlang _ = crypto:rand_seed(), -_IntegerValue = rand:uniform(42), % [1; 42] -_FloatValue = rand:uniform(). % [0.0; 1.0[ +IntegerValue = rand:uniform(42), % 1 .. 42 +FloatValue = rand:uniform(). % [0.0; 1.0) ``` + +> ### Note {: .info } +> +> Note that when using the process dictionary for cryptographically +> secure random numbers one has to ensure that no code called +> between initializing the generator and between generating numbers +> accidentally alters the generator state in the process dictionary. +> +> The safe approach is to use the `m:rand` functions that +> do not use the process dictionary but take an explicit state argument: +> the ones suffixed `_s`. Thereby it is rather `rand_seed_s/0` +> that should be used instead of this function. """. --doc(#{group => <<"Random API">>, + +-doc(#{group => <<"Plug-In Generators">>, since => <<"OTP 20.0">>}). -spec rand_seed() -> rand:state(). rand_seed() -> rand:seed(rand_seed_s()). -doc """ -Create a state object for [random number generation](`m:rand`), in order to -generate cryptographically strongly random numbers (based on OpenSSL's -`BN_rand_range`). See also `rand:seed_s/1`. +Create a generator for `m:rand`. -When using the state object from this function the `m:rand` functions using it -may raise exception `error:low_entropy` in case the random generator failed due -to lack of secure "randomness". +Create a state object (generator) for [random number generation](`m:rand`), +which when used by the `m:rand` functions produce +**cryptographically strong** random numbers (based on OpenSSL's +`BN_rand_range` function). See also `rand:seed_s/1`, and for example +`rand:uniform_s/2`. + +#### _Example_ + +``` erlang +S0 = crypto:rand_seed_s(), +{RandomInteger, S1} = rand:uniform_s(1000, S0). +``` + +May cause the `m:rand` functions using this state object +to raise the exception `error:low_entropy` in case +the random generator failed due to lack of secure "randomness". > #### Note {: .info } > > The state returned from this function cannot be used to get a reproducible -> random sequence as from the other `m:rand` functions, since reproducibility -> does not match cryptographically safe. +> random sequence as from the other `m:rand` functions, since that would +> not be cryptographically safe. > -> The only supported usage is to generate one distinct random sequence from this -> start state. +> The only supported usage is to generate one distinct random sequence. """. --doc(#{group => <<"Random API">>, +-doc(#{group => <<"Plug-In Generators">>, since => <<"OTP 20.0">>}). -spec rand_seed_s() -> rand:state(). rand_seed_s() -> rand_seed_alg_s(?MODULE). -doc """ -Create a state object for [random number generation](`m:rand`), in order to -generate cryptographically strong random numbers. +Create a generator for `m:rand` with specified algorithm, +and save it in the process dictionary. -Saves the state in the process dictionary before returning it as well. See also -`rand:seed/1` and `rand_seed_alg_s/1`. +Equivalent `rand_seed_alg_s/1` but also saves the returned +state object (generator) in the process dictionary. That is, +it is equivalent to `rand:seed(rand_seed_alg_s(Alg))`. -When using the state object from this function the `m:rand` functions using it -may raise exception `error:low_entropy` in case the random generator failed due -to lack of secure "randomness". +See `rand:seed/1` and `rand_seed_alg_s/1`. +Note the warning about the usage of the process dictionary in `rand_seed/0`. -_Example_ +#### _Example_ ```erlang _ = crypto:rand_seed_alg(crypto_cache), -_IntegerValue = rand:uniform(42), % [1; 42] -_FloatValue = rand:uniform(). % [0.0; 1.0[ +IntegerValue = rand:uniform(42), % 1 .. 42 +FloatValue = rand:uniform(). % [0.0; 1.0) ``` """. --doc(#{group => <<"Random API">>, +-doc(#{group => <<"Plug-In Generators">>, since => <<"OTP 21.0">>}). --spec rand_seed_alg(Alg :: atom()) -> - {rand:alg_handler(), - atom() | rand_cache_seed()}. +-spec rand_seed_alg(Alg :: 'crypto' | 'crypto_cache') -> + {rand:alg_handler(), + atom() | rand_cache_seed()}. rand_seed_alg(Alg) -> rand:seed(rand_seed_alg_s(Alg)). -doc """ -Creates a state object for [random number generation](`m:rand`), in order to -generate cryptographically unpredictable random numbers. +Create and seed a generator for `m:rand` with specified algorithm, +and save it in the process dictionary. + +Equivalent to `rand_seed_alg_s/2` but also saves the returned +state object (generator) in the process dictionary. That is, +it is equivalent to `rand:seed(rand_seed_alg_s(Alg, Seed))`. -Saves the state in the process dictionary before returning it as well. See also -`rand_seed_alg_s/2`. +See `rand:seed/1` and `rand_seed_alg_s/2`. +Note the warning about the usage of the process dictionary in `rand_seed/0`. -_Example_ +#### _Example_ ```erlang _ = crypto:rand_seed_alg(crypto_aes, "my seed"), -IntegerValue = rand:uniform(42), % [1; 42] -FloatValue = rand:uniform(), % [0.0; 1.0[ +IntegerValue = rand:uniform(42), % 1 .. 42 +FloatValue = rand:uniform(), % [0.0; 1.0) _ = crypto:rand_seed_alg(crypto_aes, "my seed"), IntegerValue = rand:uniform(42), % Same values FloatValue = rand:uniform(). % again ``` """. --doc(#{group => <<"Random API">>, +-doc(#{group => <<"Plug-In Generators">>, since => <<"OTP-22.0">>}). --spec rand_seed_alg(Alg :: atom(), Seed :: term()) -> - {rand:alg_handler(), - atom() | rand_cache_seed()}. +-spec rand_seed_alg(Alg :: 'crypto_aes', Seed :: term()) -> + {rand:alg_handler(), + atom() | rand_cache_seed()}. rand_seed_alg(Alg, Seed) -> rand:seed(rand_seed_alg_s(Alg, Seed)). -define(CRYPTO_CACHE_BITS, 56). -define(CRYPTO_AES_BITS, 58). --doc(#{group => <<"Random API">>}). +-doc(#{group => <<"Plug-In Generators">>}). -doc """ -Create a state object for [random number generation](`m:rand`), in order to -generate cryptographically strongly random numbers. +Create a generator for `m:rand` with specified algorithm. -See also `rand:seed_s/1`. +Create a state object (generator) for [random number generation](`m:rand`), +which when used by the `m:rand` functions produce +**cryptographically strong** random number. -If `Alg` is `crypto` this function behaves exactly like `rand_seed_s/0`. +See also `rand:seed_s/1` and for example `rand:uniform_s/2`. -If `Alg` is `crypto_cache` this function fetches random data with OpenSSL's -`RAND_bytes` and caches it for speed using an internal word size of 56 bits that -makes calculations fast on 64 bit machines. +If `Alg` is `crypto` this function is equivalent to `rand_seed_s/0`. -When using the state object from this function the `m:rand` functions using it -may raise exception `error:low_entropy` in case the random generator failed due -to lack of secure "randomness". +If `Alg` is `crypto_cache` the returned generator fetches random data + with OpenSSL's `RAND_bytes` and caches it as 56 bit numbers +which makes calculations fast on 64 bit machines. + +#### _Example_ + +```erlang +S0 = crypto:rand_seed_alg_s(crypto_cache), +{IntegerValue, S1} = rand:uniform(42, S0), % 1 .. 42 +{FloatValue, S2} = rand:uniform(S1). % [0.0; 1.0) +``` + +May cause the `m:rand` functions using this state object +to raise the exception `error:low_entropy` in case +the random generator failed due to lack of secure "randomness". The cache size can be changed from its default value using the [crypto app's ](crypto_app.md)configuration parameter `rand_cache_size`. @@ -2152,31 +2304,34 @@ The cache size can be changed from its default value using the > #### Note {: .info } > > The state returned from this function cannot be used to get a reproducible -> random sequence as from the other `m:rand` functions, since reproducibility -> does not match cryptographically safe. +> random sequence as from the other `m:rand` functions, since that would +> not be cryptographically safe. > -> In fact since random data is cached some numbers may get reproduced if you -> try, but this is unpredictable. +> In fact when random data is cached some numbers may get reproduced +> occasionally, but this is unpredictable. > -> The only supported usage is to generate one distinct random sequence from this -> start state. +> The only supported usage is to generate one distinct random sequence. """. -doc(#{since => <<"OTP 21.0">>}). --spec rand_seed_alg_s(Alg :: atom()) -> - {rand:alg_handler(), - atom() | rand_cache_seed()}. +-spec rand_seed_alg_s(Alg :: 'crypto' | 'crypto_cache') -> + {rand:alg_handler(), + atom() | rand_cache_seed()}. rand_seed_alg_s({AlgHandler, _AlgState} = State) when is_map(AlgHandler) -> State; rand_seed_alg_s({Alg, AlgState}) when is_atom(Alg) -> {mk_alg_handler(Alg),AlgState}; - rand_seed_alg_s(Alg) when is_atom(Alg) -> +rand_seed_alg_s(Alg) when is_atom(Alg) -> {mk_alg_handler(Alg),mk_alg_state(Alg)}. -%% + -doc """ -Create a state object for [random number generation](`m:rand`), in order to -generate cryptographically unpredictable random numbers. +Create and seed a generator for `m:rand` with specified algorithm. + +Create a state object (generator) for [random number generation](`m:rand`), +which when used by the `m:rand` functions produce +**cryptographically unpredictable** random numbers -See also `rand_seed_alg/1`. +See also `rand:seed_s/1`, and for example `rand:uniform_s/2`. +Compare to `rand_seed_alg/1`. To get a long period the Xoroshiro928 generator from the `m:rand` module is used as a counter (with period 2^928 - 1) and the generator states are scrambled @@ -2185,14 +2340,27 @@ through AES to create 58-bit pseudo random values. The result should be statistically completely unpredictable random values, since the scrambling is cryptographically strong and the period is ridiculously long. But the generated numbers are not to be regarded as cryptographically strong -since there is no re-keying schedule. +since there is no re-keying schedule, and since the sequence is repeated +for the same seed. - If you need cryptographically strong random numbers use `rand_seed_alg_s/1` with `Alg =:= crypto` or `Alg =:= crypto_cache`. -- If you need to be able to repeat the sequence use this function. +- If you need to be able to repeat the sequence use this function + with `Alg =:= crypto_aes`. - If you do not need the statistical quality of this function, there are faster algorithms in the `m:rand` module. +#### _Example_ + +```erlang +S0 = crypto:rand_seed_alg_s(crypto_aes, "my seed"), +{IntegerValue, S1} = rand:uniform(42, S0), % 1 .. 42 +{FloatValue, S2 = rand:uniform(S1), % [0.0; 1.0) +S3 = crypto:rand_seed_alg_s(crypto_aes, "my seed"), +{IntegerValue, S4} = rand:uniform(42, S3), % Same values +{FloatValue, S5} = rand:uniform(S4). % again +``` + Thanks to the used generator the state object supports the [`rand:jump/0,1`](`rand:jump/0`) function with distance 2^512. @@ -2200,11 +2368,11 @@ Numbers are generated in batches and cached for speed reasons. The cache size can be changed from its default value using the [crypto app's ](crypto_app.md)configuration parameter `rand_cache_size`. """. --doc(#{group => <<"Random API">>, +-doc(#{group => <<"Plug-In Generators">>, since => <<"OTP 22.0">>}). --spec rand_seed_alg_s(Alg :: atom(), Seed :: term()) -> - {rand:alg_handler(), - atom() | rand_cache_seed()}. +-spec rand_seed_alg_s(Alg :: 'crypto_aes', Seed :: term()) -> + {rand:alg_handler(), + atom() | rand_cache_seed()}. rand_seed_alg_s(Alg, Seed) when is_atom(Alg) -> {mk_alg_handler(Alg),mk_alg_state({Alg,Seed})}. @@ -2253,15 +2421,16 @@ rand_cache_size() -> -doc false. rand_plugin_next(Seed) -> - {bytes_to_integer(strong_rand_range(1 bsl 64)), Seed}. + {strong_rand_range(1 bsl 64), Seed}. -doc false. rand_plugin_uniform(State) -> - {strong_rand_float(), State}. + Value = ?HALF_DBL_EPSILON * strong_rand_range(1 bsl 53), + {Value, State}. -doc false. rand_plugin_uniform(Max, State) -> - {bytes_to_integer(strong_rand_range(Max)) + 1, State}. + {strong_rand_range(Max) + 1, State}. -doc false. @@ -2302,7 +2471,7 @@ block_encrypt(Key, Data) -> 32 -> aes_256_ecb; _ -> error(badarg) end, - try + try crypto_one_time(Cipher, Key, Data, true) catch error:{error, {_File,_Line}, _Reason} -> @@ -2376,75 +2545,6 @@ aes_cache( [V|aes_cache(Encrypted, Cache)]. -strong_rand_range(Range) when is_integer(Range), Range > 0 -> - BinRange = int_to_bin(Range), - strong_rand_range(BinRange); -strong_rand_range(BinRange) when is_binary(BinRange) -> - case strong_rand_range_nif(BinRange) of - false -> - erlang:error(low_entropy); - <> -> - BinResult - end. -strong_rand_range_nif(_BinRange) -> ?nif_stub. - -strong_rand_float() -> - WholeRange = strong_rand_range(1 bsl 53), - ?HALF_DBL_EPSILON * bytes_to_integer(WholeRange). - --doc(#{group => <<"Random API">>}). --doc """ -Generate a random integer number. - -The interval is `From =< N < To`. Uses the `crypto` library -pseudo-random number generator. `To` must be larger than `From`. -""". --spec rand_uniform(crypto_integer(), crypto_integer()) -> - crypto_integer(). -rand_uniform(From, To) when is_binary(From), is_binary(To) -> - case rand_uniform_nif(From,To) of - <> when MSB > 127 -> - <<(Len + 1):32/integer, 0, MSB, Rest/binary>>; - Whatever -> - Whatever - end; -rand_uniform(From,To) when is_integer(From),is_integer(To) -> - if From < 0 -> - rand_uniform_pos(0, To - From) + From; - true -> - rand_uniform_pos(From, To) - end. - -rand_uniform_pos(From,To) when From < To -> - BinFrom = mpint(From), - BinTo = mpint(To), - case rand_uniform(BinFrom, BinTo) of - Result when is_binary(Result) -> - erlint(Result); - Other -> - Other - end; -rand_uniform_pos(_,_) -> - error(badarg). - -rand_uniform_nif(_From,_To) -> ?nif_stub. - - --doc """ -Set the seed for PRNG to the given binary. - -This calls the RAND_seed function from openssl. Only use this if the system you -are running on does not have enough "randomness" built in. Normally this is when -`strong_rand_bytes/1` raises `error:low_entropy`. -""". --doc(#{group => <<"Random API">>, - since => <<"OTP 17.0">>}). --spec rand_seed(binary()) -> ok. -rand_seed(Seed) when is_binary(Seed) -> - rand_seed_nif(Seed). - -rand_seed_nif(_Seed) -> ?nif_stub. - %%%================================================================ %%% %%% Sign/verify @@ -3147,8 +3247,8 @@ engine_get_all_methods() -> Load an OpenSSL engine. Loads the OpenSSL engine given by `EngineId` if it is available and intialize -it. Returns `ok` and an engine handle, or if the engine can't be loaded an error -tuple is returned. +it. Returns `ok` and an engine handle, or if the engine cannot be loaded +an error tuple is returned. The function raises a `error:badarg` if the parameters are in wrong format. It may also raise the exception `error:notsup` in case there is no engine support @@ -3226,7 +3326,7 @@ engine_load_2(Engine, PostCmds) -> Unload an OpenSSL engine. Unloads the OpenSSL engine given by `Engine`. An error tuple is returned if the -engine can't be unloaded. +engine cannot be unloaded. The function raises a `error:badarg` if the parameter is in wrong format. It may also raise the exception `error:notsup` in case there is no engine support in @@ -3259,7 +3359,7 @@ engine_unload(Engine, _EngineMethods) -> %%---------------------------------------------------------------------- -doc """ Get a reference to an already loaded engine with `EngineId`. An error tuple is -returned if the engine can't be unloaded. +returned if the engine cannot be unloaded. The function raises a `error:badarg` if the parameter is in wrong format. It may also raise the exception `error:notsup` in case there is no engine support in @@ -3339,7 +3439,7 @@ engine_register(Engine, EngineMethods) when is_list(EngineMethods) -> %% Function: engine_unregister/2 %%---------------------------------------------------------------------- -doc """ -Unregister engine so it don't handle some type of methods. +Unregister engine so it does not handle some type of methods. The function raises a `error:badarg` if the parameters are in wrong format. It may also raise the exception `error:notsup` in case there is no engine support @@ -3465,7 +3565,7 @@ Send ctrl commands to an OpenSSL engine. `Optional` is a boolean argument that can relax the semantics of the function. If set to `true` it will only return failure if the ENGINE supported the given command name but -failed while executing it, if the ENGINE doesn't support the command name it +failed while executing it, if the ENGINE does not support the command name it will simply return success without doing anything. In this case we assume the user is only supplying commands specific to the given ENGINE so we set this to `false`. @@ -3499,8 +3599,8 @@ engine_ctrl_cmd_string(Engine, CmdName, CmdArg, Optional) -> Load a dynamic engine if not already done. Loada the engine given by `EngineId` and the path to the dynamic library -implementing the engine. An error tuple is returned if the engine can't be -loaded. +implementing the engine. An error tuple is returned if the engine cannot +be loaded. This function differs from the normal engine_load in the sense that it also add the engine id to OpenSSL's internal engine list. The difference between the diff --git a/lib/crypto/test/crypto_SUITE.erl b/lib/crypto/test/crypto_SUITE.erl index 6f780d467fad..29f206675399 100644 --- a/lib/crypto/test/crypto_SUITE.erl +++ b/lib/crypto/test/crypto_SUITE.erl @@ -2155,19 +2155,24 @@ rand_uniform_aux_test(0) -> rand_uniform_aux_test(N) -> L = N*1000, H = N*100000+1, - crypto_rand_uniform(L, H), - crypto_rand_uniform(-L, L), - crypto_rand_uniform(-H, -L), - crypto_rand_uniform(-H, L), + crypto_rand_range(L, H), + crypto_rand_range(-L, L), + crypto_rand_range(-H, -L), + crypto_rand_range(-H, L), rand_uniform_aux_test(N-1). -crypto_rand_uniform(L,H) -> - R1 = (L-1) + rand:uniform(H-L), - case (R1 >= L) and (R1 < H) of - true -> - ok; - false -> - ct:fail({"Not in interval", R1, L, H}) +crypto_rand_range(L,H) -> + Range = H-L, + R1 = crypto:strong_rand_range(Range), + case crypto:strong_rand_range(<>) of + Bin when is_binary(Bin) -> + <> = Bin, + if + is_integer(R1), 0 =< R1, R1 < Range, 0 =< R2, R2 < Range -> + ok; + true -> + ct:fail({"Not in range", R1, R2, Range}) + end end. foldallmap(_Fun, AccN, []) -> diff --git a/lib/stdlib/src/rand.erl b/lib/stdlib/src/rand.erl index 415807ae27b8..a5e4642fa657 100644 --- a/lib/stdlib/src/rand.erl +++ b/lib/stdlib/src/rand.erl @@ -31,46 +31,205 @@ -moduledoc """ Pseudo random number generation -This module provides pseudo random number generation and implements -a number of base generator algorithms. Most are provided through -a [plug-in framework](#plug-in-framework) that adds -features to the base generators. +This module provides Pseudo Random Number Generation and implements +a number of [base generator algorithms](#algorithms). Most are provided +through a [plug-in framework](#plug-in-framework) +that adds essential features to the base generators. + +PRNGs in general, and so the algorithms in this module, are mostly used +for test and simulation. They are designed for good statistical +quality and high generation speed. + +A generator algorithm, for each iteration, takes a state as input +and produces a raw pseudo random number and a new state to be used +for the next iteration. + +A particular state always produces the same number and new state. +The initial state is produced from a [seed](`seed/1`). +This makes it possible to repeat for example a simulation with the same +random number sequence, by re-using the same seed. +There are also the functions `export_seed/0` and `export_seed_s/1` +that capture the PRNG state in an `t:export_state/0`, +that can be used to start from a known state. + +This property, and others, make the algorithms in this module +unsuitable for cryptographical applications, but in the `m:crypto` module +there are suitable generators, for this module's +[plug-in framework](#plug-in-framework). +See `crypto:rand_seed_s/0` and `crypto:rand_seed_alg_s/1`. At the end of this module documentation there are some -[niche algorithms](#niche-algorithms) that don't use +[niche algorithms](#niche-algorithms) that do not use this module's normal [plug-in framework](#plug-in-framework). -They may be useful for special purposes like short generation time +They are useful for special purposes like fast generation when quality is not essential, for seeding other generators, and such. [](){: #plug-in-framework } Plug-in framework --------------------------------------------- -The [plug-in framework](#plug-in-framework-api) implements -a common [API](#plug-in-framework-api) to, and enhancements -of the base generators: - -* Operating on a generator state in the - [process dictionary](#generator-state). -* [Automatic](#generator-state) [seeding](`seed/1`). -* Manual [seeding support](`seed/2`) to avoid common pitfalls. -* Generating [integers](`t:integer/0`) in any range, with - [uniform distribution](`uniform/1`), without noticable bias. -* Generating [integers](`t:integer/0`) in any range, larger than - the base generator's, with [uniform distribution](`uniform/1`). +The raw pseudo random numbers produced by the base generators +are only appropriate in some cases such as power of two ranges +less than the generator size, and some have quirks, +for example weak low bits. Therefore, the Plug-in Framework +implements a common [API](#plug-in-framework-api) for all base generators, +that add essential or useful funcionality: + +* Keeping the generator [state](`seed/1`) in the process dictionary. +* Automatic [seeding](`seed/1`). +* Seeding support for [manual seeding](`seed/2`) to avoid common pitfalls. +* Generating [integers](`t:integer/0`) with + [uniform distribution](`uniform/1`), in *any* range, without bias. + The range is not limited; it may be larger than + the base generator's size (but that costs some performance). * Generating [floating-point numbers](`t:float/0`) with [uniform distribution](`uniform/0`). * Generating [floating-point numbers](`t:float/0`) with - [normal distribution](`normal/0`). + [normal distribution](`normal/0`), standard normal distribution + or [specified mean and variance](`normal/2`). * Generating any number of [bytes](`bytes/1`). +* [Jumping](`jump/1`) the generator ahead, in algorithms that support that. -The base generator algorithms implements the -[Xoroshiro and Xorshift algorithms](http://xorshift.di.unimi.it) -by Sebastiano Vigna. During an iteration they generate a large integer -(at least 58-bit) and operate on a state of several large integers. +[](){: #usage } +#### Usage and examples -To create numbers with normal distribution the -[Ziggurat Method by Marsaglia and Tsang](http://www.jstatsoft.org/v05/i08) -is used on the output from a base generator. +A generator has to be initialized. This is done by one of the +`seed/1` or `seed_s/1` functions, which also select which +[algorithm](#algorithms) to use. The `seed/1` functions +store the generator and state in the process dictionary, +while the `seed_s/1` functions only return the state, which requires +the calling code to handle the state and updates to it. + +The seed functions that do not have a `Seed` value as an argument +create an automatic seed that should be unique to the created +generator instance; see `seed_s/1`. + +If an automatic seed is not desired, the seed functions that have a +[`Seed`](`t:seed/0`) argument can be used. The argument has +3 possible formats; see the `t:seed/0` type description. + +[Plug-in framework API](#plug-in-framework-api) functions +named with the suffix `_s` take an explicit state as the last argument +and return the new state as the last element in the returned tuple. +The process dictionary is not used. + +Sibling functions without that suffix take an implicit state from +and store the new state in the process dictionary, and only return +their "interesting " output value. If the process dictionary +does not contain a state, [`seed(default)`](`seed/1`) +is implicitly called to create an automatic seed for the +[_default algorithm_](#default-algorithm) as initial state. + +#### _Usage_ + +First initialize a generator by calling one of the [seed](`seed/1`) +functions, which also selects a PRNG algorithm. + +Then call a [Plug-in framework API](#plug-in-framework-api) function +either with an explicit state from the seed function +and use the returned new state in the next call, +or call an API function without an explicit state argument +to operate on the state in the process dictionary. + +#### _Examples_ + +```erlang +%% Generate two uniformly distibuted floating point numbers. +%% +%% By not calling a [seed](`seed/1`) function, this uses +%% the generator state and algorithm in the process dictionary. +%% If there is no state there, [`seed(default)`](`seed/1`) +%% is implicitly called first: +%% +1> R0 = rand:uniform(), + is_float(R0) andalso 0.0 =< R0 andalso R0 < 1.0. +true +2> R1 = rand:uniform(), + is_float(R1) andalso 0.0 =< R1 andalso R1 < 1.0. +true + +%% Generate a uniformly distributed integer in the range 1..4711: +%% +3> K0 = rand:uniform(4711), + is_integer(K0) andalso 1 =< K0 andalso K0 =< 4711. +true + +%% Generate a binary with 16 bytes, uniformly distributed: +%% +4> B0 = rand:bytes(16), + byte_size(B0) == 16. +true + +%% Select and initialize a specified algorithm, +%% with an automatic default seed, then generate +%% a floating point number: +%% +5> rand:seed(exro928ss). +6> R2 = rand:uniform(), + is_float(R2) andalso 0.0 =< R2 andalso R2 < 1.0. +true + +%% Select and initialize a specified algorithm +%% with a specified seed, then generate +%% a floating point number: +%% +7> rand:seed(exro928ss, 123456789). +8> R3 = rand:uniform(). +0.48303622772415256 + +%% Select and initialize a specific algorithm, +%% with an automatic default seed, using the functional API +%% with explicit generator state, then generate +%% two floating point numbers. +%% +9> S0 = rand:seed_s(exsss). +10> {R4, S1} = rand:uniform_s(S0), + is_float(R4) andalso 0.0 =< R4 andalso R4 < 1.0. +true +11> {R5, S2} = rand:uniform_s(S1), + is_float(R5) andalso 0.0 =< R5 andalso R5 < 1.0. +true +%% Repeat the first after seed +12> {R4, _} = rand:uniform_s(S0). + +%% Generate a standard normal distribution number +%% using the built-in fast Ziggurat Method: +%% +13> {SND0, S3} = rand:normal_s(S2), + is_float(SND0). +true + +%% Generate a normal distribution number +%% with mean -3 and variance 0.5: +%% +14> {ND0, S4} = rand:normal_s(-3, 0.5, S3), + is_float(ND0). +true + +%% Generate a textbook basic form Box-Muller +%% standard normal distribution number, which has the same +%% distribution as the built-in Ziggurat method above, +%% but is much slower: +%% +15> R6 = rand:uniform_real(), + is_float(R6) andalso 0.0 < R6 andalso R6 < 1.0. +true +16> R7 = rand:uniform(), + is_float(R7) andalso 0.0 =< R7 andalso R7 < 1.0. +true +%% R6 cannot be equal to 0.0 so math:log/1 will never fail +17> SND1 = math:sqrt(-2 * math:log(R6)) * math:cos(math:pi() * R7). +``` + +[](){: #algorithms } Algorithms +------------------------------- + +The base generator algorithms implement the +[Xoroshiro and Xorshift algorithms](http://xorshift.di.unimi.it) +by Sebastiano Vigna. During an iteration they generate an integer +(at least 58-bit) and operate on a state of several integers. +The size of these integers is chosen to not require bignum arithmetic +on 64-bit platforms, which facilitates fast integer operations, +in particular when handled by the JIT VM. For most algorithms, jump functions are provided for generating non-overlapping sequences. A jump function perform a calculation @@ -78,30 +237,41 @@ equivalent to a large number of repeated state iterations, but execute in a time roughly equivalent to one regular iteration per generator bit. -[](){: #algorithms } The following algorithms are provided: +By using a jump function instead of starting several generators +from different seeds it is assured that the generated sequences +do not overlap. The alternative of using different seeds +may accidentally start the generators in sequence positions +that are close to each other, but a jump function jumps +to a sequence position very far ahead. + +To create numbers with normal distribution the +[Ziggurat Method by Marsaglia and Tsang](http://www.jstatsoft.org/v05/i08) +is used on the output from a base generator. + +The following algorithms are provided: - **`exsss`**, the [_default algorithm_](#default-algorithm) *(Since OTP 22.0)* - Xorshift116\*\*, 58 bits precision and period of 2^116-1 + Xorshift116\*\*, 58 bits precision and period of 2^116-1. - Jump function: equivalent to 2^64 calls + Jump function: equivalent to 2^64 calls. This is the Xorshift116 generator combined with the StarStar scrambler from the 2018 paper by David Blackman and Sebastiano Vigna: [Scrambled Linear Pseudorandom Number Generators](http://vigna.di.unimi.it/ftp/papers/ScrambledLinear.pdf) - The generator doesn't use 58-bit rotates so it is faster than the + The generator does not use 58-bit rotates so it is faster than the Xoroshiro116 generator, and when combined with the StarStar scrambler - it doesn't have any weak low bits like `exrop` (Xoroshiro116+). + it does not have any weak low bits like `exrop` (Xoroshiro116+). Alas, this combination is about 10% slower than `exrop`, but despite that it is the [_default algorithm_](#default-algorithm) thanks to its statistical qualities. - **`exro928ss`** *(Since OTP 22.0)* - Xoroshiro928\*\*, 58 bits precision and a period of 2^928-1 + Xoroshiro928\*\*, 58 bits precision and a period of 2^928-1. - Jump function: equivalent to 2^512 calls + Jump function: equivalent to 2^512 calls. This is a 58 bit version of Xoroshiro1024\*\*, from the 2018 paper by David Blackman and Sebastiano Vigna: @@ -114,25 +284,29 @@ per generator bit. Many thanks to Sebastiano Vigna for his help with the 58 bit adaption. - **`exrop`** *(Since OTP 20.0)* - Xoroshiro116+, 58 bits precision and period of 2^116-1 + Xoroshiro116+, 58 bits precision and period of 2^116-1. - Jump function: equivalent to 2^64 calls + Jump function: equivalent to 2^64 calls. - **`exs1024s`** *(Since OTP 20.0)* Xorshift1024\*, 64 bits precision and a period of 2^1024-1 - Jump function: equivalent to 2^512 calls + Jump function: equivalent to 2^512 calls. + + Since this generator operates on 64-bit integers that are bignums + on 64 bit platforms, it is much slower than `exro928ss` above. - **`exsp`** *(Since OTP 20.0)* Xorshift116+, 58 bits precision and period of 2^116-1 - Jump function: equivalent to 2^64 calls + Jump function: equivalent to 2^64 calls. This is a corrected version of a previous [_default algorithm_](#default-algorithm) (`exsplus`, _deprecated_), that was superseded by Xoroshiro116+ (`exrop`). Since this algorithm - doesn't use rotate it executes a little (say < 15%) faster than `exrop` - (that has to do a 58 bit rotate, for which there is no native instruction). + does not use rotate operations it executes a little (say < 15%) faster + than `exrop` (that has to do a 58 bit rotate, + for which there is no native instruction). See the [algorithms' homepage](http://xorshift.di.unimi.it). [](){: #default-algorithm } @@ -144,7 +318,9 @@ required, ensure to always use `seed/1` to initialize the state. Which algorithm that is the default may change between Erlang/OTP releases, and is selected to be one with high speed, small state and "good enough" -statistical properties. +statistical properties. So to ensure that the same sequence is reproduced +on a later Erlang/OTP release, use a `seed/2` or `seed_s/2` to select +both a specific algorithm and the seed value. #### Old Algorithms @@ -165,7 +341,7 @@ relying on them will produce the same pseudo random sequences as before. > Uniform integer ranges larger than or equal to the generator's precision > used a floating point fallback that only calculated with 52 bits > which is smaller than the requested range and therefore all numbers -> in the requested range weren't even possible to produce. +> in the requested range were not even possible to produce. > > Uniform floats had a non-uniform density so small values for example > less than 0.5 had got smaller intervals decreasing as the generated value @@ -173,81 +349,13 @@ relying on them will produce the same pseudo random sequences as before. > subranges. The new algorithms produces uniformly distributed floats > of the form `N * 2.0^(-53)` hence they are equally spaced. -[](){: #generator-state } -#### Generator State - -Every time a random number is generated, a state is used to calculate it, -producing a new state. The state can either be implicit -or be an explicit argument and return value. - -The functions with implicit state operates on a state stored -in the process dictionary under the key `rand_seed`. If that key -doesn't exist when the function is called, `seed/1` is called automatically -with the [_default algorithm_](#default-algorithm) and creates -a reasonably unpredictable seed. - -The functions with explicit state don't use the process dictionary. - -#### _Examples_ - -Simple use; create and seed the -[_default algorithm_](#default-algorithm) with a non-fixed seed, -if not already done, and generate two uniformly distibuted -floating point numbers. - -```erlang -R0 = rand:uniform(), -R1 = rand:uniform(), -``` - -Use a specified algorithm: - -```erlang -_ = rand:seed(exro928ss), -R2 = rand:uniform(), -``` - -Use a specified algorithm with a fixed seed: - -```erlang -_ = rand:seed(exro928ss, {123, 123534, 345345}), -R3 = rand:uniform(), -``` - -Use the functional API with a non-fixed seed: - -```erlang -S0 = rand:seed_s(exsss), -{R4, S1} = rand:uniform_s(S0), -``` - -Generate a textbook basic form Box-Muller standard normal distribution number: - -```erlang -R5 = rand:uniform_real(), -R6 = rand:uniform(), -SND0 = math:sqrt(-2 * math:log(R5)) * math:cos(math:pi() * R6) -``` - -Generate a standard normal distribution number: - -```erlang -{SND1, S2} = rand:normal_s(S1), -``` - -Generate a normal distribution number with with mean -3 and variance 0.5: - -```erlang -{ND0, S3} = rand:normal_s(-3, 0.5, S2), -``` - #### Quality of the Generated Numbers > #### Note {: .info } > > The builtin random number generator algorithms are not cryptographically > strong. If a cryptographically strong random number generator is needed, -> use something like `crypto:rand_seed/0`. +> use for example `crypto:rand_seed_s/0` or `crypto:rand_seed_alg_s/1`. For all these generators except `exro928ss` and `exsss` the lowest bit(s) have got a slightly less random behaviour than all other bits. @@ -286,7 +394,7 @@ when converting from an integer so they avoid this snag. ------------------------------------------- The [niche algorithms API](#niche-algorithms-api) contains -special purpose algorithms that don't use the +special purpose algorithms that do not use the [plug-in framework](#plug-in-framework), mainly for performance reasons. Since these algorithms lack the plug-in framework support, generating numbers @@ -520,18 +628,22 @@ the generator's range: -doc """ Generator seed value. +A single integer is the easiest to use. It is set as the initial state +of a [SplitMix64](`splitmix64_next/1`) generator. The sequential +output values of that generator are then used for setting the actual +generator's internal state, after masking to the proper word size +and avoiding zero values, if necessary. + A list of integers sets the generator's internal state directly, after algorithm-dependent checks of the value and masking to the proper word size. The number of integers must be equal to the number of state words -in the generator. +in the generator. This format would only be needed in special cases. -A single integer is used as the initial state for a SplitMix64 generator. -The sequential output values of that is then used for setting -the generator's internal state after masking to the proper word size -and if needed avoiding zero values. - -A traditional 3-tuple of integers seed is passed through algorithm-dependent -hashing functions to create the generator's initial state. +A traditional 3-tuple of integers is passed through algorithm-dependent +hashing functions to create the generator's initial state. This format is +inherited from this module's predecessor, the `m:random` module, +where the 3-tuple from `erlang:now/0` (also now deprectated) was often used +for seeding to get some uniqueness. """. -type seed() :: [integer()] | integer() | {integer(), integer(), integer()}. -export_type( @@ -673,7 +785,9 @@ The argument `default` is an alias for the that has been implemented *(Since OTP 24.0)*. """. -doc(#{group => <<"Plug-in framework API">>,since => <<"OTP 18.0">>}). --spec seed(Alg_or_State :: term()) -> state(). +-spec seed(Alg | State) -> state() when + Alg :: builtin_alg() | 'default', + State :: state() | export_state(). seed(Alg_or_State) -> seed_put(seed_s(Alg_or_State)). @@ -681,7 +795,11 @@ seed(Alg_or_State) -> Seed the random number generator and select algorithm. With the argument `Alg`, select that algorithm and seed random number -generation with reasonably unpredictable time dependent data. +generation with reasonably unpredictable time dependent data +that should be unique to the created generator instance. +It is (for now) based on the node name, the calling `t:pid/0`, +the system time, and a system unique integer. This set of +fairly unique items may change in the future, if necessary. `Alg = default` is an alias for the [_default algorithm_](#default-algorithm) @@ -694,13 +812,16 @@ See also `export_seed/0`. -spec seed_s(Alg | State) -> state() when Alg :: builtin_alg() | 'default', State :: state() | export_state(). -seed_s({AlgHandler, _AlgState} = State) when is_map(AlgHandler) -> - State; -seed_s({Alg, AlgState}) when is_atom(Alg) -> - {AlgHandler,_SeedFun} = mk_alg(Alg), - {AlgHandler,AlgState}; -seed_s(Alg) -> - seed_s(Alg, default_seed()). +seed_s(Alg_or_State) -> + case Alg_or_State of + {AlgHandler, _AlgState} = State when is_map(AlgHandler) -> + State; + {Alg, AlgState} when is_atom(Alg) -> + {AlgHandler,_SeedFun} = mk_alg(Alg), + {AlgHandler,AlgState}; + Alg -> + seed_s(Alg, default_seed()) + end. default_seed() -> {erlang:phash2([{node(),self()}]), @@ -721,7 +842,9 @@ but also stores the generated state in the process dictionary. that has been implemented *(Since OTP 24.0)*. """. -doc(#{group => <<"Plug-in framework API">>,since => <<"OTP 18.0">>}). --spec seed(Alg :: term(), Seed :: term()) -> state(). +-spec seed(Alg, Seed) -> state() when + Alg :: builtin_alg() | 'default', + Seed :: seed(). seed(Alg, Seed) -> seed_put(seed_s(Alg, Seed)). @@ -885,10 +1008,10 @@ uniform_real() -> %% returns a random float X where 0.0 < X =< 1.0, %% and a new state. %% -%% This function doesn't use the same form of uniformity +%% This function does not use the same form of uniformity %% as the uniform_s/1 function. %% -%% Instead, this function doesn't generate numbers with equal +%% Instead, this function does not generate numbers with equal %% distance in the interval, but rather tries to keep all mantissa %% bits random also for small numbers, meaning that the distance %% between possible numbers decreases when the numbers @@ -906,7 +1029,7 @@ uniform_real() -> %% This concept of uniformity should work better for applications %% where you need to calculate 1.0/X or math:log(X) since those %% operations benefits from larger precision approaching 0.0, -%% and that this function doesn't return 0.0 nor denormalized +%% and that this function does not return 0.0 nor denormalized %% numbers very close to 0.0. The log() operation in The Box-Muller %% transformation for normal distribution is an example of this. %% @@ -935,18 +1058,22 @@ normalized number in the IEEE 754 Double Precision Format is returned. The concept implicates that the probability to get exactly zero is extremely low; so low that this function in fact never returns `0.0`. -The smallest number that it might return is `DBL_MIN`, -which is `2.0^(-1022)`. +The smallest number that it *might* return is `DBL_MIN`, +which is `2.0^(-1022)`. However, the generators in this module +have technical limitations on how many zero words in a row they +*can* return, which limits the number of leading zeros +that *can* be generated, which sets an upper limit for the smallest +generated number, that is still extremely small. The value range stated at the top of this function description is technically correct, but `0.0 =< X < 1.0` is a better description -of the generated numbers' statistical distribution, and that -this function never returns exactly `0.0` is impossible to observe. +of the generated numbers' statistical distribution. That this function +never returns exactly `0.0` is impossible to observe. For all sub ranges `N*2.0^(-53) =< X < (N+1)*2.0^(-53)` where `0 =< integer(N) < 2.0^53`, the probability to generate a number -in the range is the same. Compare with the numbers -generated by `uniform_s/1`. +in a sub range is the same, very much like the numbers generated by +`uniform_s/1`. Having to generate extra random bits for occasional small numbers costs a little performance. This function is about 20% slower @@ -1129,6 +1256,27 @@ with that number of random bytes. The selected algorithm is used to generate as many random numbers as required to compose the `t:binary/0`. Returns the generated [`Bytes`](`t:binary/0`) and a [`NewState`](`t:state/0`). + +> ### Note {: .info } +> +> The `m:crypto` module contains a function `crypto:strong_rand_bytes/1` +> that does the same thing, but cryptographically secure. +> It is pretty fast and efficient on modern systems. +> +> This function, however, offers the possibility to reproduce +> a byte sequence by re-using seed, which a cryptographically secure +> function cannot do. +> +> Alas, because this function is based on a PRNG that produces +> random integers, thus has to create bytes from integers, +> it becomes rather slow. +> +> Particularly inefficient and slow is to use +> a [`rand` plug-in generator](#plug-in-framework) from `m:crypto` +> such as `crypto:rand_seed_s/0` to call this function for generating +> bytes. Since in that case it is not possible to reproduce +> the byte sequence anyway; it is better to use +> `crypto:strong_rand_bytes/1` directly. """. -doc(#{group => <<"Plug-in framework API">>,since => <<"OTP 24.0">>}). -spec bytes_s(N :: non_neg_integer(), State :: state()) -> @@ -1204,7 +1352,9 @@ See this module's [algorithms list](#algorithms). Returns the [`NewState`](`t:state/0`). This feature can be used to create many non-overlapping -random number sequences from one start state. +random number sequences from one start state; +see the start of section [Algorithms](#algorithms) +describing jump functions. This function raises a `not_implemented` error exception if there is no jump function implemented for the [`State`](`t:state/0`)'s algorithm. @@ -2322,9 +2472,14 @@ adding up to 59 bits, which is not a bignum (on a 64-bit VM ): """. -doc(#{group => <<"Niche algorithms API">>,since => <<"OTP 25.0">>}). -spec mwc59_value(CX :: mwc59_state()) -> V :: 0..?MASK(59). -mwc59_value(CX) when is_integer(CX), 1 =< CX, CX < ?MWC59_P -> - CX2 = CX bxor ?BSL(59, CX, ?MWC59_XS1), - CX2 bxor ?BSL(59, CX2, ?MWC59_XS2). +-define( + mwc59_value(CX0, CX1), + begin + CX1 = (CX0) bxor ?BSL(59, (CX0), ?MWC59_XS1), + CX1 bxor ?BSL(59, CX1, ?MWC59_XS2) + end). +mwc59_value(CX0) when is_integer(CX0), 1 =< CX0, CX0 < ?MWC59_P -> + ?mwc59_value(CX0, CX1). -doc """ Calculate a scrambled `t:float/0` from a [MWC59 state](`t:mwc59_state/0`). @@ -2337,11 +2492,8 @@ The generator state is scrambled as with """. -doc(#{group => <<"Niche algorithms API">>,since => <<"OTP 25.0">>}). -spec mwc59_float(CX :: mwc59_state()) -> V :: float(). -mwc59_float(CX1) when is_integer(CX1), 1 =< CX1, CX1 < ?MWC59_P -> - CX = ?MASK(53, CX1), - CX2 = CX bxor ?BSL(53, CX, ?MWC59_XS1), - CX3 = CX2 bxor ?BSL(53, CX2, ?MWC59_XS2), - CX3 * ?TWO_POW_MINUS53. +mwc59_float(CX0) when is_integer(CX0), 1 =< CX0, CX0 < ?MWC59_P -> + ?MASK(53, ?mwc59_value(CX0, CX1)) * ?TWO_POW_MINUS53. -doc """ Create a [MWC59 generator state](`t:mwc59_state/0`). diff --git a/lib/stdlib/src/shell_docs_test.erl b/lib/stdlib/src/shell_docs_test.erl index c24bf1f8b768..02552972c3e1 100644 --- a/lib/stdlib/src/shell_docs_test.erl +++ b/lib/stdlib/src/shell_docs_test.erl @@ -169,12 +169,15 @@ should not be tested """. -spec module(#docs_v1{}, erl_eval:binding_struct()) -> _. module(#docs_v1{ docs = Docs, module_doc = MD }, Bindings) -> - MDRes = [parse_and_run(module_doc, MD, Bindings)], - Res0 = [parse_and_run(KFA, EntryDocs, Bindings) || - {KFA, _Anno, _Sig, EntryDocs, _Meta} <- Docs, - is_map(EntryDocs)] ++ MDRes, - Res = lists:append(Res0), - Errors = [{{F,A},E} || {{function,F,A},[{error,E}]} <- Res], + MDRes = lists:append([parse_and_run(module_doc, MD, Bindings)]), + Res = + lists:append( + [parse_and_run(KFA, EntryDocs, Bindings) || + {KFA, _Anno, _Sig, EntryDocs, _Meta} <- Docs, + is_map(EntryDocs)]), + Errors = + [{{F,A},E} || {{function,F,A},[{error,E}]} <- Res] + ++ [{module_doc,E} || {module_doc,[{error,E}]} <- MDRes], _ = [print_error(E) || E <- Errors], case length(Errors) of 0 -> @@ -193,6 +196,8 @@ module(#docs_v1{ docs = Docs, module_doc = MD }, Bindings) -> error({N,errors}) end. +print_error({module_doc,{Message,Context}}) -> + io:format("Module Doc: ~ts~n~ts~n", [Context,Message]); print_error({{Name,Arity},{Message,Context}}) -> io:format("~p/~p: ~ts~n~ts~n", [Name,Arity,Context,Message]). diff --git a/lib/stdlib/test/rand_SUITE.erl b/lib/stdlib/test/rand_SUITE.erl index c81ec771bb75..cf0fea048630 100644 --- a/lib/stdlib/test/rand_SUITE.erl +++ b/lib/stdlib/test/rand_SUITE.erl @@ -46,7 +46,8 @@ all() -> uniform_real_conv, plugin, measure, {group, reference_jump}, - short_jump + short_jump, + doctests ]. groups() -> @@ -2051,6 +2052,11 @@ check(N, Range, StateA, StateB) -> ct:fail({Wrong,neq,V,for,N}) end. +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% + +doctests(Config) when is_list(Config) -> + shell_docs:test(rand, []). + %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% %%% Data reference_val(exs64) ->