Dear all,
please find attached fixes for GMP memleaks in the gfortran frontend
found when running f951 under valgrind. One of them surfaced when
looking at a testcases that invoved pointer rank remapping. After a
successful gfc_array_size we need to clear the size returned as a
gmp variable. Further scanning revealed two places in RANDOM_SEED
when checking the GET= and PUT= array argument sizes.
Regtested on x86_64-pc-linux-gnu.
I intend to commit to mainline as obvious within 24h unless there
are objections.
Thanks,
Harald
From 2a474c28e573b8604b5fa2584f276d7b7b584cde Mon Sep 17 00:00:00 2001
From: Harald Anlauf <anl...@gmx.de>
Date: Sun, 22 Dec 2024 21:34:19 +0100
Subject: [PATCH] Fortran: fix front-end GMP memleaks
gcc/fortran/ChangeLog:
* check.cc (gfc_check_random_seed): Clear gmp variables returned by
gfc_array_size.
* expr.cc (gfc_check_pointer_assign): Likewise.
---
gcc/fortran/check.cc | 32 ++++++++++++++++++++------------
gcc/fortran/expr.cc | 14 +++++++++++---
2 files changed, 31 insertions(+), 15 deletions(-)
diff --git a/gcc/fortran/check.cc b/gcc/fortran/check.cc
index f10e665088d..f4fde83e8ab 100644
--- a/gcc/fortran/check.cc
+++ b/gcc/fortran/check.cc
@@ -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. */
diff --git a/gcc/fortran/expr.cc b/gcc/fortran/expr.cc
index a349d989d6c..dad383a1aa2 100644
--- a/gcc/fortran/expr.cc
+++ b/gcc/fortran/expr.cc
@@ -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))
--
2.35.3
