OpenE2K/gcc
2
0
Fork 0
Code Issues Pull Requests Projects Releases Wiki Activity

PR 60324 Unbounded stack allocations in libgfortran.

Browse Source 
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
This commit is contained in:
Janne Blomqvist 2014-11-13 14:05:01 +02:00
parent 95cc11e163
commit 581d232670
24 changed files with 271 additions and 295 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

62
libgfortran/ChangeLog
View File

@ -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

2
libgfortran/configure vendored
View File

@ -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"

2
libgfortran/configure.ac
View File

@ -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"

17
libgfortran/intrinsics/access.c
View File

@ -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

24
libgfortran/intrinsics/chdir.c
View File

@ -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;

31
libgfortran/intrinsics/chmod.c
View File

@ -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);

30
libgfortran/intrinsics/env.c
View File

@ -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

6
libgfortran/intrinsics/execute_command_line.c
View File

@ -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)
{

56
libgfortran/intrinsics/hostnm.c
View File

@ -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

75
libgfortran/intrinsics/link.c
View File

@ -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,27 @@ see the files COPYING3 and COPYING.RUNTIME respectively. If not, see
INTEGER, INTENT(OUT), OPTIONAL :: STATUS */
#ifdef HAVE_LINK
static int
link_internal (char *path1, char *path2, gfc_charlen_type path1_len,
gfc_charlen_type path2_len)
{
int val;
char *str1, *str2;
/* Make a null terminated copy of the strings. */
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);
@ -45,28 +66,10 @@ void
link_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 = 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_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

13
libgfortran/intrinsics/perror.c
View File

@ -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);

6
libgfortran/intrinsics/random.c
View File

@ -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);

70
libgfortran/intrinsics/rename.c
View File

@ -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);
}

20
libgfortran/intrinsics/stat.c
View File

@ -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);

68
libgfortran/intrinsics/symlnk.c
View File

@ -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

6
libgfortran/intrinsics/system.c
View File

@ -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;
}

12
libgfortran/intrinsics/unlink.c
View File

@ -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;
}

2
libgfortran/io/file_pos.c
View File

@ -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)

13
libgfortran/io/list_read.c
View File

@ -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);

16
libgfortran/io/read.c
View File

@ -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);

4
libgfortran/io/transfer.c
View File

@ -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;

10
libgfortran/io/write_float.def
View File

@ -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);
}

7
libgfortran/libgfortran.h
View File

@ -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);

14
libgfortran/runtime/string.c
View File

@ -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. */