procyberian/gcc
1
0
Fork 0
Code Issues Pull requests Projects Releases Packages Wiki Activity Actions

Fortran: fix front-end GMP memleaks

Browse source 
gcc/fortran/ChangeLog:

	* check.cc (gfc_check_random_seed): Clear gmp variables returned by
	gfc_array_size.
	* expr.cc (gfc_check_pointer_assign): Likewise.
This commit is contained in:
Harald Anlauf 2024-12-22 21:34:19 +01:00
parent 9e1063ca1c
commit 2a474c28e5
2 changed files with 31 additions and 15 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

32
gcc/fortran/check.cc
View file

@ -7155,12 +7155,16 @@ gfc_check_random_seed (gfc_expr *size, gfc_expr *put, gfc_expr *get)
if (!kind_value_check (put, 1, gfc_default_integer_kind))
return false;
if (gfc_array_size (put, &put_size)
&& mpz_get_ui (put_size) < seed_size)
gfc_error ("Size of %qs argument of %qs intrinsic at %L "
"too small (%i/%i)",
gfc_current_intrinsic_arg[1]->name, gfc_current_intrinsic,
&put->where, (int) mpz_get_ui (put_size), seed_size);
if (gfc_array_size (put, &put_size))
{
if (mpz_get_ui (put_size) < seed_size)
gfc_error ("Size of %qs argument of %qs intrinsic at %L "
"too small (%i/%i)",
gfc_current_intrinsic_arg[1]->name,
gfc_current_intrinsic,
&put->where, (int) mpz_get_ui (put_size), seed_size);
mpz_clear (put_size);
}
}
if (get != NULL)
@ -7187,12 +7191,16 @@ gfc_check_random_seed (gfc_expr *size, gfc_expr *put, gfc_expr *get)
if (!kind_value_check (get, 2, gfc_default_integer_kind))
return false;
if (gfc_array_size (get, &get_size)
&& mpz_get_ui (get_size) < seed_size)
gfc_error ("Size of %qs argument of %qs intrinsic at %L "
"too small (%i/%i)",
gfc_current_intrinsic_arg[2]->name, gfc_current_intrinsic,
&get->where, (int) mpz_get_ui (get_size), seed_size);
if (gfc_array_size (get, &get_size))
{
if (mpz_get_ui (get_size) < seed_size)
gfc_error ("Size of %qs argument of %qs intrinsic at %L "
"too small (%i/%i)",
gfc_current_intrinsic_arg[2]->name,
gfc_current_intrinsic,
&get->where, (int) mpz_get_ui (get_size), seed_size);
mpz_clear (get_size);
}
}
/* RANDOM_SEED may not have more than one non-optional argument. */

14
gcc/fortran/expr.cc
View file

@ -4364,16 +4364,24 @@ gfc_check_pointer_assign (gfc_expr *lvalue, gfc_expr *rvalue,
/* If this can be determined, check that the target must be at least as
large as the pointer assigned to it is. */
if (gfc_array_size (lvalue, &lsize)
&& gfc_array_size (rvalue, &rsize)
&& mpz_cmp (rsize, lsize) < 0)
bool got_lsize = gfc_array_size (lvalue, &lsize);
bool got_rsize = got_lsize && gfc_array_size (rvalue, &rsize);
bool too_small = got_rsize && mpz_cmp (rsize, lsize) < 0;
if (too_small)
{
gfc_error ("Rank remapping target is smaller than size of the"
" pointer (%ld < %ld) at %L",
mpz_get_si (rsize), mpz_get_si (lsize),
&lvalue->where);
mpz_clear (lsize);
mpz_clear (rsize);
return false;
}
if (got_lsize)
mpz_clear (lsize);
if (got_rsize)
mpz_clear (rsize);
/* An assumed rank target is an experimental F202y feature. */
if (rvalue->rank == -1 && !(gfc_option.allow_std & GFC_STD_F202Y))