From de09e7ebc9d5555653745a103eef2b20c7f1dd76 Mon Sep 17 00:00:00 2001 From: Mark Eggleston Date: Mon, 10 Aug 2020 08:07:39 +0100 Subject: [PATCH] Fortran : get_environment_variable runtime error PR96486 Runtime error occurs when the type of the value argument is character(0): "Zero-length string passed as value...". The status argument, intent(out), will contain -1 if the value of the environment is too large to fit in the value argument, this is the case if the type is character(0) so there is no reason to produce a runtime error if the value argument is zero length. 2020-08-24 Mark Eggleston libgfortran/ PR fortran/96486 * intrinsics/env.c: If value_len is > 0 blank the string. Copy the result only if its length is > 0. 2020-08-24 Mark Eggleston gcc/testsuite/ PR fortran/96486 * gfortran.dg/pr96486.f90: New test. --- gcc/testsuite/gfortran.dg/pr96486.f90 | 9 +++++++++ libgfortran/intrinsics/env.c | 7 ++----- 2 files changed, 11 insertions(+), 5 deletions(-) create mode 100644 gcc/testsuite/gfortran.dg/pr96486.f90 diff --git a/gcc/testsuite/gfortran.dg/pr96486.f90 b/gcc/testsuite/gfortran.dg/pr96486.f90 new file mode 100644 index 00000000000..fdc7025d61c --- /dev/null +++ b/gcc/testsuite/gfortran.dg/pr96486.f90 @@ -0,0 +1,9 @@ +! { dg-do run } + +program test + implicit none + character(0) :: value + integer :: l, stat + call get_environment_variable("HOME",value,length=l,status=stat) + if (stat.ne.-1) stop 1 +end program test diff --git a/libgfortran/intrinsics/env.c b/libgfortran/intrinsics/env.c index b7837b30873..7ab0b443897 100644 --- a/libgfortran/intrinsics/env.c +++ b/libgfortran/intrinsics/env.c @@ -110,10 +110,7 @@ get_environment_variable_i4 (char *name, char *value, GFC_INTEGER_4 *length, if (value != NULL) { - if (value_len < 1) - runtime_error ("Zero-length string passed as value to " - "get_environment_variable."); - else + if (value_len > 0) memset (value, ' ', value_len); /* Blank the string. */ } @@ -138,7 +135,7 @@ get_environment_variable_i4 (char *name, char *value, GFC_INTEGER_4 *length, memcpy (value, res, value_len); stat = GFC_VALUE_TOO_SHORT; } - else + else if (res_len > 0) memcpy (value, res, res_len); } } -- 2.30.2