From 4644e8f15f835a9934a8d289ee08ba4cb46cbfac Mon Sep 17 00:00:00 2001 From: Thomas Koenig Date: Sun, 14 Jun 2020 14:39:03 +0200 Subject: [PATCH] Always use locations from get and put arguments for error messages. A simple and obvios patch - the error location was taken from a variable that was not initialized for optional variables. gcc/fortran/ChangeLog: * check.c (gfc_check_random_seed): Always use locations from get and put arguments for error messages. gcc/testsuite/ChangeLog: * gfortran.dg/random_seed_4.f90: New test. --- gcc/fortran/check.c | 4 ++-- gcc/testsuite/gfortran.dg/random_seed_4.f90 | 14 ++++++++++++++ 2 files changed, 16 insertions(+), 2 deletions(-) create mode 100644 gcc/testsuite/gfortran.dg/random_seed_4.f90 diff --git a/gcc/fortran/check.c b/gcc/fortran/check.c index 148a3269815..9c9552404f3 100644 --- a/gcc/fortran/check.c +++ b/gcc/fortran/check.c @@ -6643,7 +6643,7 @@ gfc_check_random_seed (gfc_expr *size, gfc_expr *put, gfc_expr *get) gfc_error ("Size of %qs argument of %qs intrinsic at %L " "too small (%i/%i)", gfc_current_intrinsic_arg[1]->name, gfc_current_intrinsic, - where, (int) mpz_get_ui (put_size), seed_size); + &put->where, (int) mpz_get_ui (put_size), seed_size); } if (get != NULL) @@ -6675,7 +6675,7 @@ gfc_check_random_seed (gfc_expr *size, gfc_expr *put, gfc_expr *get) gfc_error ("Size of %qs argument of %qs intrinsic at %L " "too small (%i/%i)", gfc_current_intrinsic_arg[2]->name, gfc_current_intrinsic, - where, (int) mpz_get_ui (get_size), seed_size); + &get->where, (int) mpz_get_ui (get_size), seed_size); } /* RANDOM_SEED may not have more than one non-optional argument. */ diff --git a/gcc/testsuite/gfortran.dg/random_seed_4.f90 b/gcc/testsuite/gfortran.dg/random_seed_4.f90 new file mode 100644 index 00000000000..4c3afe5f928 --- /dev/null +++ b/gcc/testsuite/gfortran.dg/random_seed_4.f90 @@ -0,0 +1,14 @@ +! { dg-do compile } +! PR fortran/95037 +! This led to a segfault or a confusing error message. Original +! test case by Bill Long. + +subroutine my_random_seed_v (size, put, get) +integer, optional :: size +integer, optional :: put(1) +integer, optional :: get(1) +call random_seed (size, get=get) ! { dg-error "too small" } +call random_seed (size, put=put) ! { dg-error "too small" } +call random_seed (size, get=get, put=put) ! { dg-error "too small" } +end subroutine my_random_seed_v + -- 2.30.2