+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
## 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"
## 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"
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
access_func (char *name, char *mode, gfc_charlen_type name_len,
gfc_charlen_type mode_len)
{
- char * file;
gfc_charlen_type i;
int m;
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
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;
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;
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];
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;
}
+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);
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);
}
}
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
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();
}
}
+ free (cmd);
+
/* Now copy back to the Fortran string if needed. */
if (cmdstat && *cmdstat > EXEC_NOERROR)
{
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
#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
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)
{
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);
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);
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
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
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);
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);
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,
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
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);
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);
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
#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 */
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);
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);
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,
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);
}
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
#endif
val = stat(str, &sb);
+ free (str);
+
if (val == 0)
{
index_type stride = GFC_DESCRIPTOR_STRIDE(sarray,0);
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
#endif
val = stat(str, &sb);
+ free (str);
+
if (val == 0)
{
index_type stride = GFC_DESCRIPTOR_STRIDE(sarray,0);
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
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);
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);
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);
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,
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
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;
}
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
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;
}
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)
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);
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;
exponent_sign = 1;
exponent = 0;
w = f->u.w;
+ buffer = tmp;
/* Read in the next block. */
p = read_block_form (dtp, &w);
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 */
goto bad_float;
convert_infnan (dtp, dest, buffer, length);
+ if (buf_size > READF_TMP)
+ free (buffer);
return;
}
/* Do the actual conversion. */
convert_real (dtp, dest, buffer, length);
-
+ if (buf_size > READF_TMP)
+ free (buffer);
return;
/* The value read is 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);
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;
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;
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)
{
default:
internal_error (NULL, "bad real kind");
}
+ if (size > BUF_STACK_SZ)
+ free (buffer);
}
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.
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);
}
+/* 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. */
projects / gcc.git / commitdiff