From 581d232670be67eb51d3839c43f1113507a89185 Mon Sep 17 00:00:00 2001
From: Janne Blomqvist <jb@gcc.gnu.org>
Date: Thu, 13 Nov 2014 14:05:01 +0200
Subject: [PATCH] PR 60324 Unbounded stack allocations in libgfortran.
2014-11-13 Janne Blomqvist <jb@gcc.gnu.org>
PR libfortran/60324
* configure: Regenerated.
* configure.ac (AM_CFLAGS): Add Werror=vla.
* libgfortran.h (gfc_alloca): Remove macro.
(fc_strdup_notrim): New prototype.
* intrinsics/access.c (access_func): Use fc_strdup rather than
stack allocation.
* intrinsics/chdir.c (chdir_i4_sub): Likewise.
(chdir_i8_sub): Likewise.
* intrinsics/chmod.c (chmod_internal): New function, move logic
here.
(chmod_func): Call chmod_internal.
* intrinsics/env.c (getenv): Use fc_strdup rather than stack
allocation.
(get_environment_variable_i4): Likewise.
* intrinsics/execute_command_line.c (execute_command_line):
Likewise.
* intrinsics/hostnm.c (hostnm_0): New function, use static buffer
rather than VLA.
(hostnm_i4_sub): Call hostnm_0.
(hostnm_i8_sub): Likewise.
(hostnm): Likewise.
* intrinsics/link.c (link_internal): New function, use fc_strdup
rather than stack allocation.
(link_i4_sub): Call link_internal.
(link_i8_sub): Likewise.
(link_i4): Likewise.
(link_i8): Likewise.
* intrinsics/perror.c (perror_sub): Use fc_strdup rather than
stack allocation.
* intrinsics/random.c (random_seed_i4): Use static buffer rather
than VLA, use _Static_assert to make sure it's big enough.
* intrinsics/rename.c (rename_internal): New function, use
fc_strdup rather than stack allocation.
(rename_i4_sub): Call rename_internal.
(rename_i8_sub): Likewise.
(rename_i4): Likewise.
(rename_i8): Likewise.
* intrinsics/stat.c (stat_i4_sub_0): Use fc_strdup rather than
stack allocation.
(stat_i8_sub_0): Likewise.
* intrinsics/symlink.c (symlnk_internal): New function, use
fc_strdup rather than stack allocation.
(symlnk_i4_sub): Call symlnk_internal.
(symlnk_i8_sub): Likewise.
(symlnk_i4): Likewise.
(symlnk_i8): Likewise.
* intrinsics/system.c (system_sub): Use fc_strdup rather than
stack allocation.
* intrinsics/unlink.c (unlink_i4_sub): Likewise.
* io/file_pos.c (READ_CHUNK): Make it a macro rather than variable.
* io/list_read.c (nml_get_obj_data): Use fixed stack buffer, fall
back to xmalloc/free for large sizes.
* io/read.c (read_f): Likewise.
* io/transfer.c (MAX_READ): Make it a macro rather than variable.
(WRITE_CHUNK): Likewise.
* io/write_float.def (write_float): Use fixed stack buffer, fall
back to xmalloc/free for large sizes.
* runtime/string.c (fc_strdup_notrim): New function.
From-SVN: r217480
---
libgfortran/ChangeLog | 62 +++++++++++++++
libgfortran/configure | 2 +-
libgfortran/configure.ac | 2 +-
libgfortran/intrinsics/access.c | 17 ++---
libgfortran/intrinsics/chdir.c | 24 +-----
libgfortran/intrinsics/chmod.c | 31 ++++----
libgfortran/intrinsics/env.c | 30 +++-----
libgfortran/intrinsics/execute_command_line.c | 6 +-
libgfortran/intrinsics/hostnm.c | 56 +++++++-------
libgfortran/intrinsics/link.c | 75 +++++++------------
libgfortran/intrinsics/perror.c | 13 +---
libgfortran/intrinsics/random.c | 6 +-
libgfortran/intrinsics/rename.c | 70 ++++++-----------
libgfortran/intrinsics/stat.c | 20 ++---
libgfortran/intrinsics/symlnk.c | 68 +++++------------
libgfortran/intrinsics/system.c | 6 +-
libgfortran/intrinsics/unlink.c | 12 +--
libgfortran/io/file_pos.c | 2 +-
libgfortran/io/list_read.c | 13 +++-
libgfortran/io/read.c | 16 +++-
libgfortran/io/transfer.c | 4 +-
libgfortran/io/write_float.def | 10 ++-
libgfortran/libgfortran.h | 7 +-
libgfortran/runtime/string.c | 14 ++++
24 files changed, 271 insertions(+), 295 deletions(-)
diff --git a/libgfortran/ChangeLog b/libgfortran/ChangeLog
index 2d600d1947e0..119e1aef402a 100644
--- a/libgfortran/ChangeLog
+++ b/libgfortran/ChangeLog
@@ -1,3 +1,65 @@
+2014-11-13 Janne Blomqvist <jb@gcc.gnu.org>
+
+ PR libfortran/60324
+ * configure: Regenerated.
+ * configure.ac (AM_CFLAGS): Add Werror=vla.
+ * libgfortran.h (gfc_alloca): Remove macro.
+ (fc_strdup_notrim): New prototype.
+ * intrinsics/access.c (access_func): Use fc_strdup rather than
+ stack allocation.
+ * intrinsics/chdir.c (chdir_i4_sub): Likewise.
+ (chdir_i8_sub): Likewise.
+ * intrinsics/chmod.c (chmod_internal): New function, move logic
+ here.
+ (chmod_func): Call chmod_internal.
+ * intrinsics/env.c (getenv): Use fc_strdup rather than stack
+ allocation.
+ (get_environment_variable_i4): Likewise.
+ * intrinsics/execute_command_line.c (execute_command_line):
+ Likewise.
+ * intrinsics/hostnm.c (hostnm_0): New function, use static buffer
+ rather than VLA.
+ (hostnm_i4_sub): Call hostnm_0.
+ (hostnm_i8_sub): Likewise.
+ (hostnm): Likewise.
+ * intrinsics/link.c (link_internal): New function, use fc_strdup
+ rather than stack allocation.
+ (link_i4_sub): Call link_internal.
+ (link_i8_sub): Likewise.
+ (link_i4): Likewise.
+ (link_i8): Likewise.
+ * intrinsics/perror.c (perror_sub): Use fc_strdup rather than
+ stack allocation.
+ * intrinsics/random.c (random_seed_i4): Use static buffer rather
+ than VLA, use _Static_assert to make sure it's big enough.
+ * intrinsics/rename.c (rename_internal): New function, use
+ fc_strdup rather than stack allocation.
+ (rename_i4_sub): Call rename_internal.
+ (rename_i8_sub): Likewise.
+ (rename_i4): Likewise.
+ (rename_i8): Likewise.
+ * intrinsics/stat.c (stat_i4_sub_0): Use fc_strdup rather than
+ stack allocation.
+ (stat_i8_sub_0): Likewise.
+ * intrinsics/symlink.c (symlnk_internal): New function, use
+ fc_strdup rather than stack allocation.
+ (symlnk_i4_sub): Call symlnk_internal.
+ (symlnk_i8_sub): Likewise.
+ (symlnk_i4): Likewise.
+ (symlnk_i8): Likewise.
+ * intrinsics/system.c (system_sub): Use fc_strdup rather than
+ stack allocation.
+ * intrinsics/unlink.c (unlink_i4_sub): Likewise.
+ * io/file_pos.c (READ_CHUNK): Make it a macro rather than variable.
+ * io/list_read.c (nml_get_obj_data): Use fixed stack buffer, fall
+ back to xmalloc/free for large sizes.
+ * io/read.c (read_f): Likewise.
+ * io/transfer.c (MAX_READ): Make it a macro rather than variable.
+ (WRITE_CHUNK): Likewise.
+ * io/write_float.def (write_float): Use fixed stack buffer, fall
+ back to xmalloc/free for large sizes.
+ * runtime/string.c (fc_strdup_notrim): New function.
+
2014-11-11 Francois-Xavier Coudert <fxcoudert@gcc.gnu.org>
PR target/63610
diff --git a/libgfortran/configure b/libgfortran/configure
index e02ef1a7281e..17d7570e26c8 100755
--- a/libgfortran/configure
+++ b/libgfortran/configure
@@ -5783,7 +5783,7 @@ if test "x$GCC" = "xyes"; then
## We like to use C11 and C99 routines when available. This makes
## sure that
## __STDC_VERSION__ is set such that libc includes make them available.
- AM_CFLAGS="-std=gnu11 -Wall -Wstrict-prototypes -Wmissing-prototypes -Wold-style-definition -Wextra -Wwrite-strings -Werror=implicit-function-declaration"
+ AM_CFLAGS="-std=gnu11 -Wall -Wstrict-prototypes -Wmissing-prototypes -Wold-style-definition -Wextra -Wwrite-strings -Werror=implicit-function-declaration -Werror=vla"
## Compile the following tests with the same system header contents
## that we'll encounter when compiling our own source files.
CFLAGS="-std=gnu11 $CFLAGS"
diff --git a/libgfortran/configure.ac b/libgfortran/configure.ac
index f54104bb4602..ada74e3318ab 100644
--- a/libgfortran/configure.ac
+++ b/libgfortran/configure.ac
@@ -142,7 +142,7 @@ if test "x$GCC" = "xyes"; then
## We like to use C11 and C99 routines when available. This makes
## sure that
## __STDC_VERSION__ is set such that libc includes make them available.
- AM_CFLAGS="-std=gnu11 -Wall -Wstrict-prototypes -Wmissing-prototypes -Wold-style-definition -Wextra -Wwrite-strings -Werror=implicit-function-declaration"
+ AM_CFLAGS="-std=gnu11 -Wall -Wstrict-prototypes -Wmissing-prototypes -Wold-style-definition -Wextra -Wwrite-strings -Werror=implicit-function-declaration -Werror=vla"
## Compile the following tests with the same system header contents
## that we'll encounter when compiling our own source files.
CFLAGS="-std=gnu11 $CFLAGS"
diff --git a/libgfortran/intrinsics/access.c b/libgfortran/intrinsics/access.c
index a418d6703c5b..65a0a103e251 100644
--- a/libgfortran/intrinsics/access.c
+++ b/libgfortran/intrinsics/access.c
@@ -2,7 +2,7 @@
Copyright (C) 2006-2014 Free Software Foundation, Inc.
Contributed by François-Xavier Coudert <coudert@clipper.ens.fr>
-This file is part of the GNU Fortran 95 runtime library (libgfortran).
+This file is part of the GNU Fortran runtime library (libgfortran).
Libgfortran is free software; you can redistribute it and/or
modify it under the terms of the GNU General Public
@@ -43,7 +43,6 @@ int
access_func (char *name, char *mode, gfc_charlen_type name_len,
gfc_charlen_type mode_len)
{
- char * file;
gfc_charlen_type i;
int m;
@@ -75,16 +74,12 @@ access_func (char *name, char *mode, gfc_charlen_type name_len,
break;
}
- /* Trim trailing spaces from NAME argument. */
- while (name_len > 0 && name[name_len - 1] == ' ')
- name_len--;
-
- /* Make a null terminated copy of the string. */
- file = gfc_alloca (name_len + 1);
- memcpy (file, name, name_len);
- file[name_len] = '\0';
+ char *path = fc_strdup (name, name_len);
/* And make the call to access(). */
- return (access (file, m) == 0 ? 0 : errno);
+ int res = (access (path, m) == 0 ? 0 : errno);
+
+ free (path);
+ return res;
}
#endif
diff --git a/libgfortran/intrinsics/chdir.c b/libgfortran/intrinsics/chdir.c
index c4933a3d5f33..87419a82e3c8 100644
--- a/libgfortran/intrinsics/chdir.c
+++ b/libgfortran/intrinsics/chdir.c
@@ -44,18 +44,10 @@ void
chdir_i4_sub (char *dir, GFC_INTEGER_4 *status, gfc_charlen_type dir_len)
{
int val;
- char *str;
-
- /* Trim trailing spaces from paths. */
- while (dir_len > 0 && dir[dir_len - 1] == ' ')
- dir_len--;
-
- /* Make a null terminated copy of the strings. */
- str = gfc_alloca (dir_len + 1);
- memcpy (str, dir, dir_len);
- str[dir_len] = '\0';
+ char *str = fc_strdup (dir, dir_len);
val = chdir (str);
+ free (str);
if (status != NULL)
*status = (val == 0) ? 0 : errno;
@@ -69,18 +61,10 @@ void
chdir_i8_sub (char *dir, GFC_INTEGER_8 *status, gfc_charlen_type dir_len)
{
int val;
- char *str;
-
- /* Trim trailing spaces from paths. */
- while (dir_len > 0 && dir[dir_len - 1] == ' ')
- dir_len--;
-
- /* Make a null terminated copy of the strings. */
- str = gfc_alloca (dir_len + 1);
- memcpy (str, dir, dir_len);
- str[dir_len] = '\0';
+ char *str = fc_strdup (dir, dir_len);
val = chdir (str);
+ free (str);
if (status != NULL)
*status = (val == 0) ? 0 : errno;
diff --git a/libgfortran/intrinsics/chmod.c b/libgfortran/intrinsics/chmod.c
index acef433d92e3..c42fa8c28fa3 100644
--- a/libgfortran/intrinsics/chmod.c
+++ b/libgfortran/intrinsics/chmod.c
@@ -61,14 +61,10 @@ see the files COPYING3 and COPYING.RUNTIME respectively. If not, see
A return value of 0 indicates success, -1 an error of chmod() while 1
indicates a mode parsing error. */
-extern int chmod_func (char *, char *, gfc_charlen_type, gfc_charlen_type);
-export_proto(chmod_func);
-int
-chmod_func (char *name, char *mode, gfc_charlen_type name_len,
- gfc_charlen_type mode_len)
+static int
+chmod_internal (char *file, char *mode, gfc_charlen_type mode_len)
{
- char * file;
int i;
bool ugo[3];
bool rwxXstugo[9];
@@ -80,15 +76,6 @@ chmod_func (char *name, char *mode, gfc_charlen_type name_len,
mode_t mode_mask, file_mode, new_mode;
struct stat stat_buf;
- /* Trim trailing spaces of the file name. */
- while (name_len > 0 && name[name_len - 1] == ' ')
- name_len--;
-
- /* Make a null terminated copy of the file name. */
- file = gfc_alloca (name_len + 1);
- memcpy (file, name, name_len);
- file[name_len] = '\0';
-
if (mode_len == 0)
return 1;
@@ -496,6 +483,20 @@ clause_done:
}
+extern int chmod_func (char *, char *, gfc_charlen_type, gfc_charlen_type);
+export_proto(chmod_func);
+
+int
+chmod_func (char *name, char *mode, gfc_charlen_type name_len,
+ gfc_charlen_type mode_len)
+{
+ char *cname = fc_strdup (name, name_len);
+ int ret = chmod_internal (cname, mode, mode_len);
+ free (cname);
+ return ret;
+}
+
+
extern void chmod_i4_sub (char *, char *, GFC_INTEGER_4 *,
gfc_charlen_type, gfc_charlen_type);
export_proto(chmod_i4_sub);
diff --git a/libgfortran/intrinsics/env.c b/libgfortran/intrinsics/env.c
index 9f4507305cd6..ffdc54ac42f7 100644
--- a/libgfortran/intrinsics/env.c
+++ b/libgfortran/intrinsics/env.c
@@ -52,27 +52,19 @@ PREFIX(getenv) (char * name, char * value, gfc_charlen_type name_len,
else
memset (value, ' ', value_len); /* Blank the string. */
- /* Trim trailing spaces from name. */
- while (name_len > 0 && name[name_len - 1] == ' ')
- name_len--;
-
/* Make a null terminated copy of the string. */
- name_nt = gfc_alloca (name_len + 1);
- memcpy (name_nt, name, name_len);
- name_nt[name_len] = '\0';
+ name_nt = fc_strdup (name, name_len);
res = getenv(name_nt);
+ free (name_nt);
+
/* If res is NULL, it means that the environment variable didn't
exist, so just return. */
if (res == NULL)
return;
- res_len = strlen(res);
- if (value_len < res_len)
- memcpy (value, res, value_len);
- else
- memcpy (value, res, res_len);
+ cf_strcpy (value, value_len, res);
}
@@ -127,18 +119,14 @@ get_environment_variable_i4 (char *name, char *value, GFC_INTEGER_4 *length,
}
if ((!trim_name) || *trim_name)
- {
- /* Trim trailing spaces from name. */
- while (name_len > 0 && name[name_len - 1] == ' ')
- name_len--;
- }
- /* Make a null terminated copy of the name. */
- name_nt = gfc_alloca (name_len + 1);
- memcpy (name_nt, name, name_len);
- name_nt[name_len] = '\0';
+ name_nt = fc_strdup (name, name_len);
+ else
+ name_nt = fc_strdup_notrim (name, name_len);
res = getenv(name_nt);
+ free (name_nt);
+
if (res == NULL)
stat = GFC_NAME_DOES_NOT_EXIST;
else
diff --git a/libgfortran/intrinsics/execute_command_line.c b/libgfortran/intrinsics/execute_command_line.c
index 19cc29b3c42c..578b4e92658d 100644
--- a/libgfortran/intrinsics/execute_command_line.c
+++ b/libgfortran/intrinsics/execute_command_line.c
@@ -61,9 +61,7 @@ execute_command_line (const char *command, bool wait, int *exitstat,
gfc_charlen_type cmdmsg_len)
{
/* Transform the Fortran string to a C string. */
- char cmd[command_len + 1];
- memcpy (cmd, command, command_len);
- cmd[command_len] = '\0';
+ char *cmd = fc_strdup (command, command_len);
/* Flush all I/O units before executing the command. */
flush_all_units();
@@ -110,6 +108,8 @@ execute_command_line (const char *command, bool wait, int *exitstat,
}
}
+ free (cmd);
+
/* Now copy back to the Fortran string if needed. */
if (cmdstat && *cmdstat > EXEC_NOERROR)
{
diff --git a/libgfortran/intrinsics/hostnm.c b/libgfortran/intrinsics/hostnm.c
index 856625826e5d..c94dd7753297 100644
--- a/libgfortran/intrinsics/hostnm.c
+++ b/libgfortran/intrinsics/hostnm.c
@@ -2,7 +2,7 @@
Copyright (C) 2005-2014 Free Software Foundation, Inc.
Contributed by François-Xavier Coudert <coudert@clipper.ens.fr>
-This file is part of the GNU Fortran 95 runtime library (libgfortran).
+This file is part of the GNU Fortran runtime library (libgfortran).
Libgfortran is free software; you can redistribute it and/or
modify it under the terms of the GNU General Public
@@ -32,6 +32,12 @@ see the files COPYING3 and COPYING.RUNTIME respectively. If not, see
#include <unistd.h>
#endif
+#include <limits.h>
+
+#ifndef HOST_NAME_MAX
+#define HOST_NAME_MAX 255
+#endif
+
/* Windows32 version */
#if defined __MINGW32__ && !defined HAVE_GETHOSTNAME
@@ -79,19 +85,17 @@ w32_gethostname (char *name, size_t len)
INTEGER, INTENT(OUT), OPTIONAL :: STATUS */
#ifdef HAVE_GETHOSTNAME
-extern void hostnm_i4_sub (char *, GFC_INTEGER_4 *, gfc_charlen_type);
-iexport_proto(hostnm_i4_sub);
-
-void
-hostnm_i4_sub (char *name, GFC_INTEGER_4 *status, gfc_charlen_type name_len)
+static int
+hostnm_0 (char *name, gfc_charlen_type name_len)
{
int val, i;
- char *p;
+ char p[HOST_NAME_MAX + 1];
memset (name, ' ', name_len);
- p = gfc_alloca (name_len + 1);
- val = gethostname (p, name_len);
+ size_t reqlen = sizeof (p) > (size_t) name_len + 1
+ ? (size_t) name_len + 1: sizeof (p);
+ val = gethostname (p, reqlen);
if (val == 0)
{
@@ -100,8 +104,18 @@ hostnm_i4_sub (char *name, GFC_INTEGER_4 *status, gfc_charlen_type name_len)
name[i] = p[i];
}
+ return ((val == 0) ? 0 : errno);
+}
+
+extern void hostnm_i4_sub (char *, GFC_INTEGER_4 *, gfc_charlen_type);
+iexport_proto(hostnm_i4_sub);
+
+void
+hostnm_i4_sub (char *name, GFC_INTEGER_4 *status, gfc_charlen_type name_len)
+{
+ int val = hostnm_0 (name, name_len);
if (status != NULL)
- *status = (val == 0) ? 0 : errno;
+ *status = val;
}
iexport(hostnm_i4_sub);
@@ -111,23 +125,9 @@ iexport_proto(hostnm_i8_sub);
void
hostnm_i8_sub (char *name, GFC_INTEGER_8 *status, gfc_charlen_type name_len)
{
- int val, i;
- char *p;
-
- memset (name, ' ', name_len);
- p = gfc_alloca (name_len + 1);
-
- val = gethostname (p, name_len);
-
- if (val == 0)
- {
- i = -1;
- while (i < name_len && p[++i] != '\0')
- name[i] = p[i];
- }
-
+ int val = hostnm_0 (name, name_len);
if (status != NULL)
- *status = (val == 0) ? 0 : errno;
+ *status = val;
}
iexport(hostnm_i8_sub);
@@ -137,8 +137,6 @@ export_proto(hostnm);
GFC_INTEGER_4
hostnm (char *name, gfc_charlen_type name_len)
{
- GFC_INTEGER_4 val;
- hostnm_i4_sub (name, &val, name_len);
- return val;
+ return hostnm_0 (name, name_len);
}
#endif
diff --git a/libgfortran/intrinsics/link.c b/libgfortran/intrinsics/link.c
index 2018c628a00f..c6084a1cc668 100644
--- a/libgfortran/intrinsics/link.c
+++ b/libgfortran/intrinsics/link.c
@@ -2,7 +2,7 @@
Copyright (C) 2005-2014 Free Software Foundation, Inc.
Contributed by François-Xavier Coudert <coudert@clipper.ens.fr>
-This file is part of the GNU Fortran 95 runtime library (libgfortran).
+This file is part of the GNU Fortran runtime library (libgfortran).
Libgfortran is free software; you can redistribute it and/or
modify it under the terms of the GNU General Public
@@ -37,36 +37,39 @@ see the files COPYING3 and COPYING.RUNTIME respectively. If not, see
INTEGER, INTENT(OUT), OPTIONAL :: STATUS */
#ifdef HAVE_LINK
-extern void link_i4_sub (char *, char *, GFC_INTEGER_4 *, gfc_charlen_type,
- gfc_charlen_type);
-iexport_proto(link_i4_sub);
-void
-link_i4_sub (char *path1, char *path2, GFC_INTEGER_4 *status,
- gfc_charlen_type path1_len, gfc_charlen_type path2_len)
+static int
+link_internal (char *path1, char *path2, gfc_charlen_type path1_len,
+ gfc_charlen_type path2_len)
{
int val;
char *str1, *str2;
- /* Trim trailing spaces from paths. */
- while (path1_len > 0 && path1[path1_len - 1] == ' ')
- path1_len--;
- while (path2_len > 0 && path2[path2_len - 1] == ' ')
- path2_len--;
-
/* Make a null terminated copy of the strings. */
- str1 = gfc_alloca (path1_len + 1);
- memcpy (str1, path1, path1_len);
- str1[path1_len] = '\0';
-
- str2 = gfc_alloca (path2_len + 1);
- memcpy (str2, path2, path2_len);
- str2[path2_len] = '\0';
+ str1 = fc_strdup (path1, path1_len);
+ str2 = fc_strdup (path2, path2_len);
val = link (str1, str2);
+ free (str1);
+ free (str2);
+
+ return ((val == 0) ? 0 : errno);
+}
+
+
+extern void link_i4_sub (char *, char *, GFC_INTEGER_4 *, gfc_charlen_type,
+ gfc_charlen_type);
+iexport_proto(link_i4_sub);
+
+void
+link_i4_sub (char *path1, char *path2, GFC_INTEGER_4 *status,
+ gfc_charlen_type path1_len, gfc_charlen_type path2_len)
+{
+ int val = link_internal (path1, path2, path1_len, path2_len);
+
if (status != NULL)
- *status = (val == 0) ? 0 : errno;
+ *status = val;
}
iexport(link_i4_sub);
@@ -78,28 +81,10 @@ void
link_i8_sub (char *path1, char *path2, GFC_INTEGER_8 *status,
gfc_charlen_type path1_len, gfc_charlen_type path2_len)
{
- int val;
- char *str1, *str2;
-
- /* Trim trailing spaces from paths. */
- while (path1_len > 0 && path1[path1_len - 1] == ' ')
- path1_len--;
- while (path2_len > 0 && path2[path2_len - 1] == ' ')
- path2_len--;
-
- /* Make a null terminated copy of the strings. */
- str1 = gfc_alloca (path1_len + 1);
- memcpy (str1, path1, path1_len);
- str1[path1_len] = '\0';
-
- str2 = gfc_alloca (path2_len + 1);
- memcpy (str2, path2, path2_len);
- str2[path2_len] = '\0';
-
- val = link (str1, str2);
+ int val = link_internal (path1, path2, path1_len, path2_len);
if (status != NULL)
- *status = (val == 0) ? 0 : errno;
+ *status = val;
}
iexport(link_i8_sub);
@@ -111,9 +96,7 @@ GFC_INTEGER_4
link_i4 (char *path1, char *path2, gfc_charlen_type path1_len,
gfc_charlen_type path2_len)
{
- GFC_INTEGER_4 val;
- link_i4_sub (path1, path2, &val, path1_len, path2_len);
- return val;
+ return link_internal (path1, path2, path1_len, path2_len);
}
extern GFC_INTEGER_8 link_i8 (char *, char *, gfc_charlen_type,
@@ -124,8 +107,6 @@ GFC_INTEGER_8
link_i8 (char *path1, char *path2, gfc_charlen_type path1_len,
gfc_charlen_type path2_len)
{
- GFC_INTEGER_8 val;
- link_i8_sub (path1, path2, &val, path1_len, path2_len);
- return val;
+ return link_internal (path1, path2, path1_len, path2_len);
}
#endif
diff --git a/libgfortran/intrinsics/perror.c b/libgfortran/intrinsics/perror.c
index 9a2851f5507a..a8f09728706e 100644
--- a/libgfortran/intrinsics/perror.c
+++ b/libgfortran/intrinsics/perror.c
@@ -37,17 +37,8 @@ iexport_proto(perror_sub);
void
perror_sub (char *string, gfc_charlen_type string_len)
{
- char * str;
-
- /* Trim trailing spaces from paths. */
- while (string_len > 0 && string[string_len - 1] == ' ')
- string_len--;
-
- /* Make a null terminated copy of the strings. */
- str = gfc_alloca (string_len + 1);
- memcpy (str, string, string_len);
- str[string_len] = '\0';
-
+ char *str = fc_strdup (string, string_len);
perror (str);
+ free (str);
}
iexport(perror_sub);
diff --git a/libgfortran/intrinsics/random.c b/libgfortran/intrinsics/random.c
index 593a6518cae3..5e919292aabc 100644
--- a/libgfortran/intrinsics/random.c
+++ b/libgfortran/intrinsics/random.c
@@ -666,7 +666,11 @@ void
random_seed_i4 (GFC_INTEGER_4 *size, gfc_array_i4 *put, gfc_array_i4 *get)
{
int i;
- unsigned char seed[4*kiss_size];
+
+#define KISS_MAX_SIZE 12
+ unsigned char seed[4 * KISS_MAX_SIZE];
+ _Static_assert (kiss_size <= KISS_MAX_SIZE,
+ "kiss_size must <= KISS_MAX_SIZE");
__gthread_mutex_lock (&random_lock);
diff --git a/libgfortran/intrinsics/rename.c b/libgfortran/intrinsics/rename.c
index 63901df43986..aabf8211c70b 100644
--- a/libgfortran/intrinsics/rename.c
+++ b/libgfortran/intrinsics/rename.c
@@ -2,7 +2,7 @@
Copyright (C) 2005-2014 Free Software Foundation, Inc.
Contributed by François-Xavier Coudert <coudert@clipper.ens.fr>
-This file is part of the GNU Fortran 95 runtime library (libgfortran).
+This file is part of the GNU Fortran runtime library (libgfortran).
Libgfortran is free software; you can redistribute it and/or
modify it under the terms of the GNU General Public
@@ -28,6 +28,20 @@ see the files COPYING3 and COPYING.RUNTIME respectively. If not, see
#include <errno.h>
#include <string.h>
+
+static int
+rename_internal (char *path1, char *path2, gfc_charlen_type path1_len,
+ gfc_charlen_type path2_len)
+{
+ char *str1 = fc_strdup (path1, path1_len);
+ char *str2 = fc_strdup (path2, path2_len);
+ int val = rename (str1, str2);
+ free (str1);
+ free (str2);
+ return ((val == 0) ? 0 : errno);
+}
+
+
/* SUBROUTINE RENAME(PATH1, PATH2, STATUS)
CHARACTER(len=*), INTENT(IN) :: PATH1, PATH2
INTEGER, INTENT(OUT), OPTIONAL :: STATUS */
@@ -40,28 +54,9 @@ void
rename_i4_sub (char *path1, char *path2, GFC_INTEGER_4 *status,
gfc_charlen_type path1_len, gfc_charlen_type path2_len)
{
- int val;
- char *str1, *str2;
-
- /* Trim trailing spaces from paths. */
- while (path1_len > 0 && path1[path1_len - 1] == ' ')
- path1_len--;
- while (path2_len > 0 && path2[path2_len - 1] == ' ')
- path2_len--;
-
- /* Make a null terminated copy of the strings. */
- str1 = gfc_alloca (path1_len + 1);
- memcpy (str1, path1, path1_len);
- str1[path1_len] = '\0';
-
- str2 = gfc_alloca (path2_len + 1);
- memcpy (str2, path2, path2_len);
- str2[path2_len] = '\0';
-
- val = rename (str1, str2);
-
+ int val = rename_internal (path1, path2, path1_len, path2_len);
if (status != NULL)
- *status = (val == 0) ? 0 : errno;
+ *status = val;
}
iexport(rename_i4_sub);
@@ -73,28 +68,9 @@ void
rename_i8_sub (char *path1, char *path2, GFC_INTEGER_8 *status,
gfc_charlen_type path1_len, gfc_charlen_type path2_len)
{
- int val;
- char *str1, *str2;
-
- /* Trim trailing spaces from paths. */
- while (path1_len > 0 && path1[path1_len - 1] == ' ')
- path1_len--;
- while (path2_len > 0 && path2[path2_len - 1] == ' ')
- path2_len--;
-
- /* Make a null terminated copy of the strings. */
- str1 = gfc_alloca (path1_len + 1);
- memcpy (str1, path1, path1_len);
- str1[path1_len] = '\0';
-
- str2 = gfc_alloca (path2_len + 1);
- memcpy (str2, path2, path2_len);
- str2[path2_len] = '\0';
-
- val = rename (str1, str2);
-
+ int val = rename_internal (path1, path2, path1_len, path2_len);
if (status != NULL)
- *status = (val == 0) ? 0 : errno;
+ *status = val;
}
iexport(rename_i8_sub);
@@ -106,9 +82,7 @@ GFC_INTEGER_4
rename_i4 (char *path1, char *path2, gfc_charlen_type path1_len,
gfc_charlen_type path2_len)
{
- GFC_INTEGER_4 val;
- rename_i4_sub (path1, path2, &val, path1_len, path2_len);
- return val;
+ return rename_internal (path1, path2, path1_len, path2_len);
}
extern GFC_INTEGER_8 rename_i8 (char *, char *, gfc_charlen_type,
@@ -119,7 +93,5 @@ GFC_INTEGER_8
rename_i8 (char *path1, char *path2, gfc_charlen_type path1_len,
gfc_charlen_type path2_len)
{
- GFC_INTEGER_8 val;
- rename_i8_sub (path1, path2, &val, path1_len, path2_len);
- return val;
+ return rename_internal (path1, path2, path1_len, path2_len);
}
diff --git a/libgfortran/intrinsics/stat.c b/libgfortran/intrinsics/stat.c
index 1bd8b4b5a71c..a60664210ec5 100644
--- a/libgfortran/intrinsics/stat.c
+++ b/libgfortran/intrinsics/stat.c
@@ -67,14 +67,8 @@ stat_i4_sub_0 (char *name, gfc_array_i4 *sarray, GFC_INTEGER_4 *status,
if (GFC_DESCRIPTOR_EXTENT(sarray,0) < 13)
runtime_error ("Array size of SARRAY is too small.");
- /* Trim trailing spaces from name. */
- while (name_len > 0 && name[name_len - 1] == ' ')
- name_len--;
-
/* Make a null terminated copy of the string. */
- str = gfc_alloca (name_len + 1);
- memcpy (str, name, name_len);
- str[name_len] = '\0';
+ str = fc_strdup (name, name_len);
/* On platforms that don't provide lstat(), we use stat() instead. */
#ifdef HAVE_LSTAT
@@ -84,6 +78,8 @@ stat_i4_sub_0 (char *name, gfc_array_i4 *sarray, GFC_INTEGER_4 *status,
#endif
val = stat(str, &sb);
+ free (str);
+
if (val == 0)
{
index_type stride = GFC_DESCRIPTOR_STRIDE(sarray,0);
@@ -188,14 +184,8 @@ stat_i8_sub_0 (char *name, gfc_array_i8 *sarray, GFC_INTEGER_8 *status,
if (GFC_DESCRIPTOR_EXTENT(sarray,0) < 13)
runtime_error ("Array size of SARRAY is too small.");
- /* Trim trailing spaces from name. */
- while (name_len > 0 && name[name_len - 1] == ' ')
- name_len--;
-
/* Make a null terminated copy of the string. */
- str = gfc_alloca (name_len + 1);
- memcpy (str, name, name_len);
- str[name_len] = '\0';
+ str = fc_strdup (name, name_len);
/* On platforms that don't provide lstat(), we use stat() instead. */
#ifdef HAVE_LSTAT
@@ -205,6 +195,8 @@ stat_i8_sub_0 (char *name, gfc_array_i8 *sarray, GFC_INTEGER_8 *status,
#endif
val = stat(str, &sb);
+ free (str);
+
if (val == 0)
{
index_type stride = GFC_DESCRIPTOR_STRIDE(sarray,0);
diff --git a/libgfortran/intrinsics/symlnk.c b/libgfortran/intrinsics/symlnk.c
index 3c3d2fbba790..5c53cb75378b 100644
--- a/libgfortran/intrinsics/symlnk.c
+++ b/libgfortran/intrinsics/symlnk.c
@@ -2,7 +2,7 @@
Copyright (C) 2005-2014 Free Software Foundation, Inc.
Contributed by François-Xavier Coudert <coudert@clipper.ens.fr>
-This file is part of the GNU Fortran 95 runtime library (libgfortran).
+This file is part of the GNU Fortran runtime library (libgfortran).
Libgfortran is free software; you can redistribute it and/or
modify it under the terms of the GNU General Public
@@ -37,6 +37,18 @@ see the files COPYING3 and COPYING.RUNTIME respectively. If not, see
INTEGER, INTENT(OUT), OPTIONAL :: STATUS */
#ifdef HAVE_SYMLINK
+static int
+symlnk_internal (char *path1, char *path2, gfc_charlen_type path1_len,
+ gfc_charlen_type path2_len)
+{
+ char *str1 = fc_strdup (path1, path1_len);
+ char *str2 = fc_strdup (path2, path2_len);
+ int val = symlink (str1, str2);
+ free (str1);
+ free (str2);
+ return ((val == 0) ? 0 : errno);
+}
+
extern void symlnk_i4_sub (char *, char *, GFC_INTEGER_4 *, gfc_charlen_type,
gfc_charlen_type);
iexport_proto(symlnk_i4_sub);
@@ -45,28 +57,9 @@ void
symlnk_i4_sub (char *path1, char *path2, GFC_INTEGER_4 *status,
gfc_charlen_type path1_len, gfc_charlen_type path2_len)
{
- int val;
- char *str1, *str2;
-
- /* Trim trailing spaces from paths. */
- while (path1_len > 0 && path1[path1_len - 1] == ' ')
- path1_len--;
- while (path2_len > 0 && path2[path2_len - 1] == ' ')
- path2_len--;
-
- /* Make a null terminated copy of the strings. */
- str1 = gfc_alloca (path1_len + 1);
- memcpy (str1, path1, path1_len);
- str1[path1_len] = '\0';
-
- str2 = gfc_alloca (path2_len + 1);
- memcpy (str2, path2, path2_len);
- str2[path2_len] = '\0';
-
- val = symlink (str1, str2);
-
+ int val = symlnk_internal (path1, path2, path1_len, path2_len);
if (status != NULL)
- *status = (val == 0) ? 0 : errno;
+ *status = val;
}
iexport(symlnk_i4_sub);
@@ -78,28 +71,9 @@ void
symlnk_i8_sub (char *path1, char *path2, GFC_INTEGER_8 *status,
gfc_charlen_type path1_len, gfc_charlen_type path2_len)
{
- int val;
- char *str1, *str2;
-
- /* Trim trailing spaces from paths. */
- while (path1_len > 0 && path1[path1_len - 1] == ' ')
- path1_len--;
- while (path2_len > 0 && path2[path2_len - 1] == ' ')
- path2_len--;
-
- /* Make a null terminated copy of the strings. */
- str1 = gfc_alloca (path1_len + 1);
- memcpy (str1, path1, path1_len);
- str1[path1_len] = '\0';
-
- str2 = gfc_alloca (path2_len + 1);
- memcpy (str2, path2, path2_len);
- str2[path2_len] = '\0';
-
- val = symlink (str1, str2);
-
+ int val = symlnk_internal (path1, path2, path1_len, path2_len);
if (status != NULL)
- *status = (val == 0) ? 0 : errno;
+ *status = val;
}
iexport(symlnk_i8_sub);
@@ -111,9 +85,7 @@ GFC_INTEGER_4
symlnk_i4 (char *path1, char *path2, gfc_charlen_type path1_len,
gfc_charlen_type path2_len)
{
- GFC_INTEGER_4 val;
- symlnk_i4_sub (path1, path2, &val, path1_len, path2_len);
- return val;
+ return symlnk_internal (path1, path2, path1_len, path2_len);
}
extern GFC_INTEGER_8 symlnk_i8 (char *, char *, gfc_charlen_type,
@@ -124,8 +96,6 @@ GFC_INTEGER_8
symlnk_i8 (char *path1, char *path2, gfc_charlen_type path1_len,
gfc_charlen_type path2_len)
{
- GFC_INTEGER_8 val;
- symlnk_i8_sub (path1, path2, &val, path1_len, path2_len);
- return val;
+ return symlnk_internal (path1, path2, path1_len, path2_len);
}
#endif
diff --git a/libgfortran/intrinsics/system.c b/libgfortran/intrinsics/system.c
index d0a131d60e17..add6f4ff2183 100644
--- a/libgfortran/intrinsics/system.c
+++ b/libgfortran/intrinsics/system.c
@@ -34,16 +34,14 @@ iexport_proto(system_sub);
void
system_sub (const char *fcmd, GFC_INTEGER_4 *status, gfc_charlen_type cmd_len)
{
- char cmd[cmd_len + 1];
+ char *cmd = fc_strdup (fcmd, cmd_len);
int stat;
/* Flush all I/O units before executing the command. */
flush_all_units();
- memcpy (cmd, fcmd, cmd_len);
- cmd[cmd_len] = '\0';
-
stat = system (cmd);
+ free (cmd);
if (status)
*status = stat;
}
diff --git a/libgfortran/intrinsics/unlink.c b/libgfortran/intrinsics/unlink.c
index b4de6e65cbef..2971a62e7e07 100644
--- a/libgfortran/intrinsics/unlink.c
+++ b/libgfortran/intrinsics/unlink.c
@@ -2,7 +2,7 @@
Copyright (C) 2004-2014 Free Software Foundation, Inc.
Contributed by Steven G. Kargl <kargls@comcast.net>.
-This file is part of the GNU Fortran 95 runtime library (libgfortran).
+This file is part of the GNU Fortran runtime library (libgfortran).
Libgfortran is free software; you can redistribute it and/or
modify it under the terms of the GNU General Public
@@ -46,17 +46,13 @@ unlink_i4_sub (char *name, GFC_INTEGER_4 *status, gfc_charlen_type name_len)
char *str;
GFC_INTEGER_4 stat;
- /* Trim trailing spaces from name. */
- while (name_len > 0 && name[name_len - 1] == ' ')
- name_len--;
-
/* Make a null terminated copy of the string. */
- str = gfc_alloca (name_len + 1);
- memcpy (str, name, name_len);
- str[name_len] = '\0';
+ str = fc_strdup (name, name_len);
stat = unlink (str);
+ free (str);
+
if (status != NULL)
*status = (stat == 0) ? stat : errno;
}
diff --git a/libgfortran/io/file_pos.c b/libgfortran/io/file_pos.c
index 85183a6632d8..061f42ea9be4 100644
--- a/libgfortran/io/file_pos.c
+++ b/libgfortran/io/file_pos.c
@@ -36,7 +36,7 @@ see the files COPYING3 and COPYING.RUNTIME respectively. If not, see
record, and we have to sift backwards to find the newline before
that or the start of the file, whichever comes first. */
-static const int READ_CHUNK = 4096;
+#define READ_CHUNK 4096
static void
formatted_backspace (st_parameter_filepos *fpp, gfc_unit *u)
diff --git a/libgfortran/io/list_read.c b/libgfortran/io/list_read.c
index 1cb329f7df41..20b2b83a5e69 100644
--- a/libgfortran/io/list_read.c
+++ b/libgfortran/io/list_read.c
@@ -3132,16 +3132,27 @@ get_name:
if (component_flag)
{
+#define EXT_STACK_SZ 100
+ char ext_stack[EXT_STACK_SZ];
+ char *ext_name;
size_t var_len = strlen (root_nl->var_name);
size_t saved_len
= dtp->u.p.saved_string ? strlen (dtp->u.p.saved_string) : 0;
- char ext_name[var_len + saved_len + 1];
+ size_t ext_size = var_len + saved_len + 1;
+
+ if (ext_size > EXT_STACK_SZ)
+ ext_name = xmalloc (ext_size);
+ else
+ ext_name = ext_stack;
memcpy (ext_name, root_nl->var_name, var_len);
if (dtp->u.p.saved_string)
memcpy (ext_name + var_len, dtp->u.p.saved_string, saved_len);
ext_name[var_len + saved_len] = '\0';
nl = find_nml_node (dtp, ext_name);
+
+ if (ext_size > EXT_STACK_SZ)
+ free (ext_name);
}
else
nl = find_nml_node (dtp, dtp->u.p.saved_string);
diff --git a/libgfortran/io/read.c b/libgfortran/io/read.c
index 64f2ddf49a19..5c56dc26e42f 100644
--- a/libgfortran/io/read.c
+++ b/libgfortran/io/read.c
@@ -881,6 +881,9 @@ read_radix (st_parameter_dt *dtp, const fnode *f, char *dest, int length,
void
read_f (st_parameter_dt *dtp, const fnode *f, char *dest, int length)
{
+#define READF_TMP 50
+ char tmp[READF_TMP];
+ size_t buf_size = 0;
int w, seen_dp, exponent;
int exponent_sign;
const char *p;
@@ -895,6 +898,7 @@ read_f (st_parameter_dt *dtp, const fnode *f, char *dest, int length)
exponent_sign = 1;
exponent = 0;
w = f->u.w;
+ buffer = tmp;
/* Read in the next block. */
p = read_block_form (dtp, &w);
@@ -911,7 +915,10 @@ read_f (st_parameter_dt *dtp, const fnode *f, char *dest, int length)
exponent because of an implicit decimal point or the like. Thus allocating
strlen ("+0.0e-1000") == 10 characters plus one for NUL more than the
original buffer had should be enough. */
- buffer = gfc_alloca (w + 11);
+ buf_size = w + 11;
+ if (buf_size > READF_TMP)
+ buffer = xmalloc (buf_size);
+
out = buffer;
/* Optional sign */
@@ -984,6 +991,8 @@ read_f (st_parameter_dt *dtp, const fnode *f, char *dest, int length)
goto bad_float;
convert_infnan (dtp, dest, buffer, length);
+ if (buf_size > READF_TMP)
+ free (buffer);
return;
}
@@ -1170,7 +1179,8 @@ done:
/* Do the actual conversion. */
convert_real (dtp, dest, buffer, length);
-
+ if (buf_size > READF_TMP)
+ free (buffer);
return;
/* The value read is zero. */
@@ -1203,6 +1213,8 @@ zero:
return;
bad_float:
+ if (buf_size > READF_TMP)
+ free (buffer);
generate_error (&dtp->common, LIBERROR_READ_VALUE,
"Bad value during floating point read");
next_record (dtp, 1);
diff --git a/libgfortran/io/transfer.c b/libgfortran/io/transfer.c
index 87b8c05c1a4a..71c60b6f4122 100644
--- a/libgfortran/io/transfer.c
+++ b/libgfortran/io/transfer.c
@@ -2982,7 +2982,7 @@ static void
skip_record (st_parameter_dt *dtp, ssize_t bytes)
{
ssize_t rlength, readb;
- static const ssize_t MAX_READ = 4096;
+#define MAX_READ 4096
char p[MAX_READ];
dtp->u.p.current_unit->bytes_left_subrecord += bytes;
@@ -3282,7 +3282,7 @@ next_record_w_unf (st_parameter_dt *dtp, int next_subrecord)
static ssize_t
sset (stream * s, int c, ssize_t nbyte)
{
- static const int WRITE_CHUNK = 256;
+#define WRITE_CHUNK 256
char p[WRITE_CHUNK];
ssize_t bytes_left, trans;
diff --git a/libgfortran/io/write_float.def b/libgfortran/io/write_float.def
index 99f6ff8e83f8..1b345f8fc4b0 100644
--- a/libgfortran/io/write_float.def
+++ b/libgfortran/io/write_float.def
@@ -1277,7 +1277,13 @@ write_float (st_parameter_dt *dtp, const fnode *f, const char *source, \
trailing null, and finally some extra digits depending on the
requested precision. */
const size_t size = 4932 + 3 + precision;
- char buffer[size];
+#define BUF_STACK_SZ 5000
+ char buf_stack[BUF_STACK_SZ];
+ char *buffer;
+ if (size > BUF_STACK_SZ)
+ buffer = xmalloc (size);
+ else
+ buffer = buf_stack;
switch (len)
{
@@ -1306,4 +1312,6 @@ write_float (st_parameter_dt *dtp, const fnode *f, const char *source, \
default:
internal_error (NULL, "bad real kind");
}
+ if (size > BUF_STACK_SZ)
+ free (buffer);
}
diff --git a/libgfortran/libgfortran.h b/libgfortran/libgfortran.h
index d2de76fcb927..bf7442c405a7 100644
--- a/libgfortran/libgfortran.h
+++ b/libgfortran/libgfortran.h
@@ -573,10 +573,6 @@ iexport_data_proto(line);
extern char *filename;
iexport_data_proto(filename);
-/* Avoid conflicting prototypes of alloca() in system headers by using
- GCC's builtin alloca(). */
-#define gfc_alloca(x) __builtin_alloca(x)
-
/* The default value of record length for preconnected units is defined
here. This value can be overriden by an environment variable.
@@ -851,6 +847,9 @@ export_proto(string_len_trim_char4);
extern char *fc_strdup(const char *, gfc_charlen_type);
internal_proto(fc_strdup);
+extern char *fc_strdup_notrim(const char *, gfc_charlen_type);
+internal_proto(fc_strdup_notrim);
+
/* io/intrinsics.c */
extern void flush_all_units (void);
diff --git a/libgfortran/runtime/string.c b/libgfortran/runtime/string.c
index b95d1997a5c8..79f75b444585 100644
--- a/libgfortran/runtime/string.c
+++ b/libgfortran/runtime/string.c
@@ -134,6 +134,20 @@ fc_strdup (const char *src, gfc_charlen_type src_len)
}
+/* Duplicate a non-null-terminated Fortran string to a malloced
+ null-terminated C string, without getting rid of trailing
+ blanks. */
+
+char *
+fc_strdup_notrim (const char *src, gfc_charlen_type src_len)
+{
+ char *p = strndup (src, src_len);
+ if (!p)
+ os_error ("Memory allocation failed in fc_strdup");
+ return p;
+}
+
+
/* Given a fortran string and an array of st_option structures, search through
the array to find a match. If the option is not found, we generate an error
if no default is provided. */
--
GitLab