diff options
| author | Mark Eggleston <markeggleston@gcc.gnu.org> | 2020-08-10 08:07:39 +0100 |
|---|---|---|
| committer | Mark Eggleston <markeggleston@gcc.gnu.org> | 2020-08-24 11:13:11 +0100 |
| commit | de09e7ebc9d5555653745a103eef2b20c7f1dd76 (patch) | |
| tree | bbf7e02b3cd07e5352e74e4fd97f3d2e69178fa9 | |
| parent | 259d072067997ab8f55afcf735c91b6740fd0425 (diff) | |
| download | gcc-de09e7ebc9d5555653745a103eef2b20c7f1dd76.zip gcc-de09e7ebc9d5555653745a103eef2b20c7f1dd76.tar.gz gcc-de09e7ebc9d5555653745a103eef2b20c7f1dd76.tar.bz2 | |
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 <markeggleston@gcc.gnu.org>
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 <markeggleston@gcc.gnu.org>
gcc/testsuite/
PR fortran/96486
* gfortran.dg/pr96486.f90: New test.
| -rw-r--r-- | gcc/testsuite/gfortran.dg/pr96486.f90 | 9 | ||||
| -rw-r--r-- | libgfortran/intrinsics/env.c | 7 |
2 files changed, 11 insertions, 5 deletions
diff --git a/gcc/testsuite/gfortran.dg/pr96486.f90 b/gcc/testsuite/gfortran.dg/pr96486.f90 new file mode 100644 index 0000000..fdc7025 --- /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 b7837b3..7ab0b44 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); } } |