gfc_try
gfc_check_random_seed (gfc_expr *size, gfc_expr *put, gfc_expr *get)
{
- unsigned int nargs = 0;
+ unsigned int nargs = 0, kiss_size;
locus *where = NULL;
+ mpz_t put_size;
+ bool have_gfc_real_16; /* Try and mimic HAVE_GFC_REAL_16 in libgfortran. */
+ have_gfc_real_16 = gfc_validate_kind (BT_REAL, 16, true) != -1;
+
+ /* Keep these values in sync with kiss_size in libgfortran/random.c. */
+ kiss_size = have_gfc_real_16 ? 12 : 8;
+
if (size != NULL)
{
if (size->expr_type != EXPR_VARIABLE
if (kind_value_check (put, 1, gfc_default_integer_kind) == FAILURE)
return FAILURE;
+
+ if (gfc_array_size (put, &put_size) == SUCCESS
+ && mpz_get_ui (put_size) < kiss_size)
+ gfc_error ("Array PUT of intrinsic %s is too small (%i/%i) at %L",
+ gfc_current_intrinsic, (int) mpz_get_ui (put_size),
+ kiss_size, where);
}
if (get != NULL)
GFC_REAL_* types in the range of [0,1). If GFC_REAL_*_RADIX are 2
or 16, respectively, we mask off the bits that don't fit into the
correct GFC_REAL_*, convert to the real type, then multiply by the
- correct offset.
-*/
+ correct offset. */
static inline void
We do this by using three generators with different seeds, the
first one always for the most significant bits, the second one
for bits 33..64 (if present in the REAL kind), and the third one
- (called twice) for REAL(16).
-*/
+ (called twice) for REAL(16). */
#define GFC_SL(k, n) ((k)^((k)<<(n)))
#define GFC_SR(k, n) ((k)^((k)>>(n)))
with 0<=x<2^32, 0<y<2^32, 0<=z<2^32, 0<=c<698769069
except that the two pairs
z=0,c=0 and z=2^32-1,c=698769068
- should be avoided.
-*/
+ should be avoided. */
+
+/* Any modifications to the seeds that change kiss_size below need to be
+ reflected in check.c (gfc_check_random_seed) to enable correct
+ compile-time checking of PUT size for the RANDOM_SEED intrinsic. */
#define KISS_DEFAULT_SEED_1 123456789, 362436069, 521288629, 316191069
#define KISS_DEFAULT_SEED_2 987654321, 458629013, 582859209, 438195021
while (dest)
{
- /* random_r4 (dest); */
+ /* random_r4 (dest); */
kiss = kiss_random_kernel (kiss_seed_1);
rnumber_4 (dest, kiss);
while (dest)
{
- /* random_r8 (dest); */
+ /* random_r8 (dest); */
kiss = ((GFC_UINTEGER_8) kiss_random_kernel (kiss_seed_1)) << 32;
kiss += kiss_random_kernel (kiss_seed_2);
rnumber_8 (dest, kiss);
while (dest)
{
- /* random_r10 (dest); */
+ /* random_r10 (dest); */
kiss = ((GFC_UINTEGER_8) kiss_random_kernel (kiss_seed_1)) << 32;
kiss += kiss_random_kernel (kiss_seed_2);
rnumber_10 (dest, kiss);
while (dest)
{
- /* random_r16 (dest); */
+ /* random_r16 (dest); */
kiss1 = ((GFC_UINTEGER_8) kiss_random_kernel (kiss_seed_1)) << 32;
kiss1 += kiss_random_kernel (kiss_seed_2);