PR 60324 Handle long path names, don't use PATH_MAX.

git-svn-id: svn+ssh://gcc.gnu.org/svn/gcc/trunk@210738 138bc75d-0d04-0410-961f-82ee72b054a4

12 files changed, 238 insertions, 135 deletions

diff --git a/libgfortran/ChangeLog b/libgfortran/ChangeLog
index 94789e8f3a1..9f5a39bfcd6 100644
--- a/libgfortran/ChangeLog
+++ b/libgfortran/ChangeLog
@@ -1,3 +1,35 @@
+2014-05-22  Janne Blomqvist  <jb@gcc.gnu.org>
+
+	PR libfortran/60324
+	* config.h.in: Regenerated.
+	* configure: Regenerated.
+	* configure.ac (AC_CHECK_FUNCS_ONCE): Check for strnlen and
+	strndup.
+	* libgfortran.h (fc_strdup): New prototype.
+	* runtime/string.c (strnlen): New fallback function.
+	(strndup): New fallback function.
+	(fc_strdup): New function.
+	* io/close.c (st_close): Use fc_strdup.
+	* io/open.c (new_unit): Likewise.
+	(already_open): Likewise.
+	* io/unit.c (filename_from_unit): Likewise.
+	* io/unix.c (unpack_filename): Remove function.
+	(regular_file): Rename to regular_file2, add path argument.
+	(regular_file): New function calling regular_file2.
+	(compare_file_filename): Use fc_strdup.
+	(find_file): Likewise.
+	(delete_file): Likewise.
+	(file_exists): Likewise.
+	(file_size): Likewise.
+	(inquire_sequential): Likewise.
+	(inquire_direct): Likewise.
+	(inquire_formatted): Likewise.
+	(inquire_access): Likewise.
+	* io/unix.h (unpack_filename): Remove prototype.
+	* runtime/main.c (please_free_exe_path_when_done): Change type to
+	bool.
+	(store_exe_path): Use malloced buffer, grow as needed.
+
 2014-05-17  Jerry DeLisle  <jvdelisle@gcc.gnu>
 
 	PR libfortran/52539
diff --git a/libgfortran/config.h.in b/libgfortran/config.h.in
index 8298f8d7812..110fb6d5b9a 100644
--- a/libgfortran/config.h.in
+++ b/libgfortran/config.h.in
@@ -729,6 +729,12 @@
 /* Define to 1 if you have the <string.h> header file. */
 #undef HAVE_STRING_H
 
+/* Define to 1 if you have the `strndup' function. */
+#undef HAVE_STRNDUP
+
+/* Define to 1 if you have the `strnlen' function. */
+#undef HAVE_STRNLEN
+
 /* Define to 1 if you have the `strtof' function. */
 #undef HAVE_STRTOF
 
diff --git a/libgfortran/configure b/libgfortran/configure
index 8e5db19c8a9..d46a6e2d796 100755
--- a/libgfortran/configure
+++ b/libgfortran/configure
@@ -2599,6 +2599,8 @@ as_fn_append ac_func_list " getegid"
 as_fn_append ac_func_list " secure_getenv"
 as_fn_append ac_func_list " __secure_getenv"
 as_fn_append ac_func_list " mkostemp"
+as_fn_append ac_func_list " strnlen"
+as_fn_append ac_func_list " strndup"
 as_fn_append ac_header_list " math.h"
 # Check that the precious variables saved in the cache have kept the same
 # value.
@@ -12344,7 +12346,7 @@ else
   lt_dlunknown=0; lt_dlno_uscore=1; lt_dlneed_uscore=2
   lt_status=$lt_dlunknown
   cat > conftest.$ac_ext <<_LT_EOF
-#line 12347 "configure"
+#line 12349 "configure"
 #include "confdefs.h"
 
 #if HAVE_DLFCN_H
@@ -12450,7 +12452,7 @@ else
   lt_dlunknown=0; lt_dlno_uscore=1; lt_dlneed_uscore=2
   lt_status=$lt_dlunknown
   cat > conftest.$ac_ext <<_LT_EOF
-#line 12453 "configure"
+#line 12455 "configure"
 #include "confdefs.h"
 
 #if HAVE_DLFCN_H
@@ -16606,6 +16608,10 @@ done
 
 
 
+
+
+
+
 fi
 
 # Check strerror_r, cannot be above as versions with two and three arguments exist
diff --git a/libgfortran/configure.ac b/libgfortran/configure.ac
index 212628540a2..fb29c147666 100644
--- a/libgfortran/configure.ac
+++ b/libgfortran/configure.ac
@@ -287,7 +287,7 @@ else
    strcasestr getrlimit gettimeofday stat fstat lstat getpwuid vsnprintf dup \
    getcwd localtime_r gmtime_r getpwuid_r ttyname_r clock_gettime \
    readlink getgid getpid getppid getuid geteuid umask getegid \
-   secure_getenv __secure_getenv mkostemp)
+   secure_getenv __secure_getenv mkostemp strnlen strndup)
 fi
 
 # Check strerror_r, cannot be above as versions with two and three arguments exist
diff --git a/libgfortran/io/close.c b/libgfortran/io/close.c
index 63da0c420cd..55f49da831e 100644
--- a/libgfortran/io/close.c
+++ b/libgfortran/io/close.c
@@ -72,8 +72,7 @@ st_close (st_parameter_close *clp)
 	    generate_error (&clp->common, LIBERROR_BAD_OPTION,
 			    "Can't KEEP a scratch file on CLOSE");
 #if !HAVE_UNLINK_OPEN_FILE
-	  path = (char *) gfc_alloca (u->file_len + 1);
-          unpack_filename (path, u->file, u->file_len);
+	  path = fc_strdup (u->file, u->file_len);
 #endif
 	}
       else
@@ -83,8 +82,7 @@ st_close (st_parameter_close *clp)
 #if HAVE_UNLINK_OPEN_FILE
 	      delete_file (u);
 #else
-	      path = (char *) gfc_alloca (u->file_len + 1);
-              unpack_filename (path, u->file, u->file_len);
+	      path = fc_strdup (u->file, u->file_len);
 #endif
             }
 	}
@@ -93,7 +91,10 @@ st_close (st_parameter_close *clp)
 
 #if !HAVE_UNLINK_OPEN_FILE
       if (path != NULL)
-        unlink (path);
+	{
+	  unlink (path);
+	  free (path);
+	}
 #endif
     }
 
diff --git a/libgfortran/io/open.c b/libgfortran/io/open.c
index 06fd59415fe..b803859ac3d 100644
--- a/libgfortran/io/open.c
+++ b/libgfortran/io/open.c
@@ -502,12 +502,9 @@ new_unit (st_parameter_open *opp, gfc_unit *u, unit_flags * flags)
   s = open_external (opp, flags);
   if (s == NULL)
     {
-      char *path, *msg;
-      size_t msglen;
-      path = (char *) gfc_alloca (opp->file_len + 1);
-      msglen = opp->file_len + 51;
-      msg = (char *) gfc_alloca (msglen);
-      unpack_filename (path, opp->file, opp->file_len);
+      char *path = fc_strdup (opp->file, opp->file_len);
+      size_t msglen = opp->file_len + 51;
+      char *msg = xmalloc (msglen);
 
       switch (errno)
 	{
@@ -529,10 +526,13 @@ new_unit (st_parameter_open *opp, gfc_unit *u, unit_flags * flags)
 	  break;
 
 	default:
+	  free (msg);
 	  msg = NULL;
 	}
 
       generate_error (&opp->common, LIBERROR_OS, msg);
+      free (msg);
+      free (path);
       goto cleanup;
     }
 
@@ -676,15 +676,6 @@ already_open (st_parameter_open *opp, gfc_unit * u, unit_flags * flags)
 
   if (!compare_file_filename (u, opp->file, opp->file_len))
     {
-#if !HAVE_UNLINK_OPEN_FILE
-      char *path = NULL;
-      if (u->file && u->flags.status == STATUS_SCRATCH)
-	{
-	  path = (char *) gfc_alloca (u->file_len + 1);
-	  unpack_filename (path, u->file, u->file_len);
-	}
-#endif
-
       if (sclose (u->s) == -1)
 	{
 	  unlock_unit (u);
@@ -699,8 +690,14 @@ already_open (st_parameter_open *opp, gfc_unit * u, unit_flags * flags)
       u->file_len = 0;
 
 #if !HAVE_UNLINK_OPEN_FILE
+      char *path = NULL;
+      if (u->file && u->flags.status == STATUS_SCRATCH)
+	path = fc_strdup (u->file, u->file_len);
       if (path != NULL)
-	unlink (path);
+	{
+	  unlink (path);
+	  free (path);
+	}
 #endif
 
       u = new_unit (opp, u, flags);
diff --git a/libgfortran/io/unit.c b/libgfortran/io/unit.c
index 385818adc1f..a406c9e8be9 100644
--- a/libgfortran/io/unit.c
+++ b/libgfortran/io/unit.c
@@ -786,7 +786,6 @@ unit_truncate (gfc_unit * u, gfc_offset pos, st_parameter_common * common)
 char *
 filename_from_unit (int n)
 {
-  char *filename;
   gfc_unit *u;
   int c;
 
@@ -805,11 +804,7 @@ filename_from_unit (int n)
 
   /* Get the filename.  */
   if (u != NULL)
-    {
-      filename = (char *) xmalloc (u->file_len + 1);
-      unpack_filename (filename, u->file, u->file_len);
-      return filename;
-    }
+    return fc_strdup (u->file, u->file_len);
   else
     return (char *) NULL;
 }
diff --git a/libgfortran/io/unix.c b/libgfortran/io/unix.c
index 76ed84effbf..3721b71f994 100644
--- a/libgfortran/io/unix.c
+++ b/libgfortran/io/unix.c
@@ -114,9 +114,6 @@ id_from_fd (const int fd)
     typeof (b) _b = (b);	\
     _a < _b ? _a : _b; })
 
-#ifndef PATH_MAX
-#define PATH_MAX 1024
-#endif
 
 /* These flags aren't defined on all targets (mingw32), so provide them
    here.  */
@@ -1060,26 +1057,6 @@ unit_to_fd (int unit)
 }
 
 
-/* unpack_filename()-- Given a fortran string and a pointer to a
- * buffer that is PATH_MAX characters, convert the fortran string to a
- * C string in the buffer.  Returns nonzero if this is not possible.  */
-
-int
-unpack_filename (char *cstring, const char *fstring, int len)
-{
-  if (fstring == NULL)
-    return EFAULT;
-  len = fstrlen (fstring, len);
-  if (len >= PATH_MAX)
-    return ENAMETOOLONG;
-
-  memmove (cstring, fstring, len);
-  cstring[len] = '\0';
-
-  return 0;
-}
-
-
 /* Set the close-on-exec flag for an existing fd, if the system
    supports such.  */
 
@@ -1244,27 +1221,18 @@ tempfile (st_parameter_open *opp)
 }
 
 
-/* regular_file()-- Open a regular file.
+/* regular_file2()-- Open a regular file.
  * Change flags->action if it is ACTION_UNSPECIFIED on entry,
  * unless an error occurs.
  * Returns the descriptor, which is less than zero on error. */
 
 static int
-regular_file (st_parameter_open *opp, unit_flags *flags)
+regular_file2 (const char *path, st_parameter_open *opp, unit_flags *flags)
 {
-  char path[min(PATH_MAX, opp->file_len + 1)];
   int mode;
   int rwflag;
   int crflag, crflag2;
   int fd;
-  int err;
-
-  err = unpack_filename (path, opp->file, opp->file_len);
-  if (err)
-    {
-      errno = err;		/* Fake an OS error */
-      return -1;
-    }
 
 #ifdef __CYGWIN__
   if (opp->file_len == 7)
@@ -1404,6 +1372,18 @@ regular_file (st_parameter_open *opp, unit_flags *flags)
 }
 
 
+/* Wrapper around regular_file2, to make sure we free the path after
+   we're done.  */
+
+static int
+regular_file (st_parameter_open *opp, unit_flags *flags)
+{
+  char *path = fc_strdup (opp->file, opp->file_len);
+  int fd = regular_file2 (path, opp, flags);
+  free (path);
+  return fd;
+}
+
 /* open_external()-- Open an external file, unix specific version.
  * Change flags->action if it is ACTION_UNSPECIFIED on entry.
  * Returns NULL on operating system error. */
@@ -1494,8 +1474,8 @@ error_stream (void)
 int
 compare_file_filename (gfc_unit *u, const char *name, int len)
 {
-  char path[min(PATH_MAX, len + 1)];
   struct stat st;
+  int ret;
 #ifdef HAVE_WORKING_STAT
   unix_stream *s;
 #else
@@ -1504,18 +1484,21 @@ compare_file_filename (gfc_unit *u, const char *name, int len)
 # endif
 #endif
 
-  if (unpack_filename (path, name, len))
-    return 0;			/* Can't be the same */
+  char *path = fc_strdup (name, len);
 
   /* If the filename doesn't exist, then there is no match with the
    * existing file. */
 
   if (stat (path, &st) < 0)
-    return 0;
+    {
+      ret = 0;
+      goto done;
+    }
 
 #ifdef HAVE_WORKING_STAT
   s = (unix_stream *) (u->s);
-  return (st.st_dev == s->st_dev) && (st.st_ino == s->st_ino);
+  ret = (st.st_dev == s->st_dev) && (st.st_ino == s->st_ino);
+  goto done;
 #else
 
 # ifdef __MINGW32__
@@ -1525,13 +1508,20 @@ compare_file_filename (gfc_unit *u, const char *name, int len)
   id1 = id_from_path (path);
   id2 = id_from_fd (((unix_stream *) (u->s))->fd);
   if (id1 || id2)
-    return (id1 == id2);
+    {
+      ret = (id1 == id2);
+      goto done;
+    }
 # endif
 
   if (len != u->file_len)
-    return 0;
-  return (memcmp(path, u->file, len) == 0);
+    ret = 0;
+  else
+    ret = (memcmp(path, u->file, len) == 0);
 #endif
+ done:
+  free (path);
+  return ret;
 }
 
 
@@ -1594,18 +1584,19 @@ find_file0 (gfc_unit *u, FIND_FILE0_DECL)
 gfc_unit *
 find_file (const char *file, gfc_charlen_type file_len)
 {
-  char path[min(PATH_MAX, file_len + 1)];
   struct stat st[1];
   gfc_unit *u;
 #if defined(__MINGW32__) && !HAVE_WORKING_STAT
   uint64_t id = 0ULL;
 #endif
 
-  if (unpack_filename (path, file, file_len))
-    return NULL;
+  char *path = fc_strdup (file, file_len);
 
   if (stat (path, &st[0]) < 0)
-    return NULL;
+    {
+      u = NULL;
+      goto done;
+    }
 
 #if defined(__MINGW32__) && !HAVE_WORKING_STAT
   id = id_from_path (path);
@@ -1621,7 +1612,7 @@ retry:
 	{
 	  /* assert (u->closed == 0); */
 	  __gthread_mutex_unlock (&unit_lock);
-	  return u;
+	  goto done;
 	}
 
       inc_waiting_locked (u);
@@ -1641,6 +1632,8 @@ retry:
 
       dec_waiting_unlocked (u);
     }
+ done:
+  free (path);
   return u;
 }
 
@@ -1713,16 +1706,10 @@ flush_all_units (void)
 int
 delete_file (gfc_unit * u)
 {
-  char path[min(PATH_MAX, u->file_len + 1)];
-  int err = unpack_filename (path, u->file, u->file_len);
-
-  if (err)
-    {				/* Shouldn't be possible */
-      errno = err;
-      return 1;
-    }
-
-  return unlink (path);
+  char *path = fc_strdup (u->file, u->file_len);
+  int err = unlink (path);
+  free (path);
+  return err;
 }
 
 
@@ -1732,12 +1719,10 @@ delete_file (gfc_unit * u)
 int
 file_exists (const char *file, gfc_charlen_type file_len)
 {
-  char path[min(PATH_MAX, file_len + 1)];
-
-  if (unpack_filename (path, file, file_len))
-    return 0;
-
-  return !(access (path, F_OK));
+  char *path = fc_strdup (file, file_len);
+  int res = !(access (path, F_OK));
+  free (path);
+  return res;
 }
 
 
@@ -1746,15 +1731,12 @@ file_exists (const char *file, gfc_charlen_type file_len)
 GFC_IO_INT
 file_size (const char *file, gfc_charlen_type file_len)
 {
-  char path[min(PATH_MAX, file_len + 1)];
+  char *path = fc_strdup (file, file_len);
   struct stat statbuf;
-
-  if (unpack_filename (path, file, file_len))
-    return -1;
-
-  if (stat (path, &statbuf) < 0)
+  int err = stat (path, &statbuf);
+  free (path);
+  if (err == -1)
     return -1;
-
   return (GFC_IO_INT) statbuf.st_size;
 }
 
@@ -1767,11 +1749,15 @@ static const char yes[] = "YES", no[] = "NO", unknown[] = "UNKNOWN";
 const char *
 inquire_sequential (const char *string, int len)
 {
-  char path[min(PATH_MAX, len + 1)];
   struct stat statbuf;
 
-  if (string == NULL ||
-      unpack_filename (path, string, len) || stat (path, &statbuf) < 0)
+  if (string == NULL)
+    return unknown;
+
+  char *path = fc_strdup (string, len);
+  int err = stat (path, &statbuf);
+  free (path);
+  if (err == -1)
     return unknown;
 
   if (S_ISREG (statbuf.st_mode) ||
@@ -1791,11 +1777,15 @@ inquire_sequential (const char *string, int len)
 const char *
 inquire_direct (const char *string, int len)
 {
-  char path[min(PATH_MAX, len + 1)];
   struct stat statbuf;
 
-  if (string == NULL ||
-      unpack_filename (path, string, len) || stat (path, &statbuf) < 0)
+  if (string == NULL)
+    return unknown;
+
+  char *path = fc_strdup (string, len);
+  int err = stat (path, &statbuf);
+  free (path);
+  if (err == -1)
     return unknown;
 
   if (S_ISREG (statbuf.st_mode) || S_ISBLK (statbuf.st_mode))
@@ -1815,11 +1805,15 @@ inquire_direct (const char *string, int len)
 const char *
 inquire_formatted (const char *string, int len)
 {
-  char path[min(PATH_MAX, len + 1)];
   struct stat statbuf;
 
-  if (string == NULL ||
-      unpack_filename (path, string, len) || stat (path, &statbuf) < 0)
+  if (string == NULL)
+    return unknown;
+
+  char *path = fc_strdup (string, len);
+  int err = stat (path, &statbuf);
+  free (path);
+  if (err == -1)
     return unknown;
 
   if (S_ISREG (statbuf.st_mode) ||
@@ -1850,10 +1844,12 @@ inquire_unformatted (const char *string, int len)
 static const char *
 inquire_access (const char *string, int len, int mode)
 {
-  char path[min(PATH_MAX, len + 1)];
-
-  if (string == NULL || unpack_filename (path, string, len) ||
-      access (path, mode) < 0)
+  if (string == NULL)
+    return no;
+  char *path = fc_strdup (string, len);
+  int res = access (path, mode);
+  free (path);
+  if (res == -1)
     return no;
 
   return yes;
diff --git a/libgfortran/io/unix.h b/libgfortran/io/unix.h
index 37561108c80..910f2c2e650 100644
--- a/libgfortran/io/unix.h
+++ b/libgfortran/io/unix.h
@@ -185,8 +185,4 @@ internal_proto(stream_isatty);
 extern int stream_ttyname (stream *, char *, size_t);
 internal_proto(stream_ttyname);
 
-extern int unpack_filename (char *, const char *, int);
-internal_proto(unpack_filename);
-
-
 #endif
diff --git a/libgfortran/libgfortran.h b/libgfortran/libgfortran.h
index 0d6f432a24b..ba6c1e91893 100644
--- a/libgfortran/libgfortran.h
+++ b/libgfortran/libgfortran.h
@@ -822,6 +822,9 @@ extern gfc_charlen_type string_len_trim_char4 (gfc_charlen_type,
 					       const gfc_char4_t *);
 export_proto(string_len_trim_char4);
 
+extern char *fc_strdup(const char *, gfc_charlen_type);
+internal_proto(fc_strdup);
+
 /* io/intrinsics.c */
 
 extern void flush_all_units (void);
diff --git a/libgfortran/runtime/main.c b/libgfortran/runtime/main.c
index 58ec6cc4961..8a572ecd5ef 100644
--- a/libgfortran/runtime/main.c
+++ b/libgfortran/runtime/main.c
@@ -26,6 +26,7 @@ see the files COPYING3 and COPYING.RUNTIME respectively.  If not, see
 #include <stdlib.h>
 #include <string.h>
 #include <limits.h>
+#include <errno.h>
 
 
 #ifdef HAVE_UNISTD_H
@@ -70,23 +71,18 @@ static int argc_save;
 static char **argv_save;
 
 static const char *exe_path;
-static int please_free_exe_path_when_done;
+static bool please_free_exe_path_when_done;
 
 /* Save the path under which the program was called, for use in the
    backtrace routines.  */
 void
 store_exe_path (const char * argv0)
 {
-#ifndef PATH_MAX
-#define PATH_MAX 1024
-#endif
-
 #ifndef DIR_SEPARATOR   
 #define DIR_SEPARATOR '/'
 #endif
 
-  char buf[PATH_MAX], *path;
-  const char *cwd;
+  char *cwd, *path;
 
   /* This can only happen if store_exe_path is called multiple times.  */
   if (please_free_exe_path_when_done)
@@ -95,13 +91,27 @@ store_exe_path (const char * argv0)
   /* Reading the /proc/self/exe symlink is Linux-specific(?), but if
      it works it gives the correct answer.  */
 #ifdef HAVE_READLINK
-  int len;
-  if ((len = readlink ("/proc/self/exe", buf, sizeof (buf) - 1)) != -1)
+  ssize_t len, psize = 256;
+  while (1)
     {
-      buf[len] = '\0';
-      exe_path = strdup (buf);
-      please_free_exe_path_when_done = 1;
-      return;
+      path = xmalloc (psize);
+      len = readlink ("/proc/self/exe", path, psize);
+      if (len < 0)
+	{
+	  free (path);
+	  break;
+	}
+      else if (len < psize)
+	{
+	  path[len] = '\0';
+	  exe_path = strdup (path);
+	  free (path);
+	  please_free_exe_path_when_done = true;
+	  return;
+	}
+      /* The remaining option is len == psize.  */
+      free (path);
+      psize *= 4;
     }
 #endif
 
@@ -117,12 +127,29 @@ store_exe_path (const char * argv0)
 #endif
     {
       exe_path = argv0;
-      please_free_exe_path_when_done = 0;
+      please_free_exe_path_when_done = false;
       return;
     }
 
 #ifdef HAVE_GETCWD
-  cwd = getcwd (buf, sizeof (buf));
+  size_t cwdsize = 256;
+  while (1)
+    {
+      cwd = xmalloc (cwdsize);
+      if (getcwd (cwd, cwdsize))
+	break;
+      else if (errno == ERANGE)
+	{
+	  free (cwd);
+	  cwdsize *= 4;
+	}
+      else
+	{
+	  free (cwd);
+	  cwd = NULL;
+	  break;
+	}
+    }
 #else
   cwd = NULL;
 #endif
@@ -130,7 +157,7 @@ store_exe_path (const char * argv0)
   if (!cwd)
     {
       exe_path = argv0;
-      please_free_exe_path_when_done = 0;
+      please_free_exe_path_when_done = false;
       return;
     }
 
@@ -138,10 +165,11 @@ store_exe_path (const char * argv0)
      if the executable is not in the cwd, but at this point we're out
      of better ideas.  */
   size_t pathlen = strlen (cwd) + 1 + strlen (argv0) + 1;
-  path = malloc (pathlen);
+  path = xmalloc (pathlen);
   snprintf (path, pathlen, "%s%c%s", cwd, DIR_SEPARATOR, argv0);
+  free (cwd);
   exe_path = path;
-  please_free_exe_path_when_done = 1;
+  please_free_exe_path_when_done = true;
 }
 
 
diff --git a/libgfortran/runtime/string.c b/libgfortran/runtime/string.c
index a7f68bf5aa1..5beb0fbd971 100644
--- a/libgfortran/runtime/string.c
+++ b/libgfortran/runtime/string.c
@@ -90,6 +90,49 @@ cf_strcpy (char *dest, gfc_charlen_type dest_len, const char *src)
 }
 
 
+#ifndef HAVE_STRNLEN
+static size_t
+strnlen (const char *s, size_t maxlen)
+{
+  for (size_t ii = 0; ii < maxlen; ii++)
+    {
+      if (s[ii] == '\0')
+	return ii;
+    }
+  return maxlen;
+}
+#endif
+
+
+#ifndef HAVE_STRNDUP
+static char *
+strndup (const char *s, size_t n)
+{
+  size_t len = strnlen (s, n);
+  char *p = malloc (len + 1);
+  if (!p)
+    return NULL;
+  memcpy (p, s, len);
+  p[len] = '\0';
+  return p;
+}
+#endif
+
+
+/* Duplicate a non-null-terminated Fortran string to a malloced
+   null-terminated C string.  */
+
+char *
+fc_strdup (const char *src, gfc_charlen_type src_len)
+{
+  gfc_charlen_type n = fstrlen (src, src_len);
+  char *p = strndup (src, n);
+  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.  */