* intrinsics/args.c: Implement GETARG and IARGC.

	* Makefile.am: Add it.
	* Makefile.in: Regenerate.
testsuite/
	* gfortran.fortran-torture/execute/getarg_1.f90: New test.

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

diff --git a/gcc/testsuite/ChangeLog b/gcc/testsuite/ChangeLog
index ec49a66..8b00960 100644 (file)
--- a/gcc/testsuite/ChangeLog
+++ b/gcc/testsuite/ChangeLog
@@ -1,5 +1,9 @@
 2004-06-12  Bud Davis  <bdavis9659@comcast.net>
 
+       * gfortran.fortran-torture/execute/getarg_1.f90: New test.
+
+2004-06-12  Bud Davis  <bdavis9659@comcast.net>
+
        PR gfortran/12839
        * gfortran.fortran-torture/execute/nan_inf_fmt.f90: New test.
 

diff --git a/gcc/testsuite/gfortran.fortran-torture/execute/getarg_1.f90 b/gcc/testsuite/gfortran.fortran-torture/execute/getarg_1.f90
new file mode 100644 (file)
index 0000000..2d56686
--- /dev/null
+++ b/gcc/testsuite/gfortran.fortran-torture/execute/getarg_1.f90
@@ -0,0 +1,24 @@
+! Check that getarg does somethig sensible.
+program getarg_1
+  CHARACTER*10 ARGS
+  INTEGER*4 I
+  I = 0
+  CALL GETARG(I,ARGS)
+  ! This should return the invoking command.  The actual value depends 
+  ! on the OS, but a blank string is wrong no matter what.
+  ! ??? What about deep embedded systems?
+  if (args.eq.'') call abort
+  I = 1
+  CALL GETARG(I,ARGS)
+  if (args.ne.'') call abort
+  I = -1
+  CALL GETARG(I,ARGS)
+  if (args.ne.'') call abort
+  ! Assume we won't have been called with more that 4 args.
+  I = 4
+  CALL GETARG(I,ARGS)
+  if (args.ne.'') call abort
+  I = 1000
+  CALL GETARG(I,ARGS)
+  if (args.ne.'') call abort
+end

diff --git a/libgfortran/ChangeLog b/libgfortran/ChangeLog
index a00f03f..6b3b430 100644 (file)
--- a/libgfortran/ChangeLog
+++ b/libgfortran/ChangeLog
@@ -1,14 +1,20 @@
 2004-06-12  Bud Davis  <bdavis9659@comcast.net>
 
+       * intrinsics/args.c: Implement GETARG and IARGC.
+       * Makefile.am: Add it.
+       * Makefile.in: Regenerate.
+
+2004-06-12  Bud Davis  <bdavis9659@comcast.net>
+
        PR gfortran/12839
-       * io/write.c(write_float): format inf and nan IAW F2003.
+       * io/write.c(write_float): Format inf and nan IAW F2003.
 
 2004-06-09  Bud Davis  <bdavis9659@comcaste.net>
 
        PR gfortran/14897
        * io/transfer.c (formatted_transfer): position is unique
          for T and TL edit descriptors.
-       (data_transfer_init): set record length to size of internal
+       (data_transfer_init): set record length to size of internal
          file.
 
 2004-06-09  Bud Davis  <bdavis9659@comcast.net>

diff --git a/libgfortran/Makefile.am b/libgfortran/Makefile.am
index 24a39e1..f77335d 100644 (file)
--- a/libgfortran/Makefile.am
+++ b/libgfortran/Makefile.am
@@ -36,6 +36,7 @@ io/io.h
 gfor_helper_src= \
 intrinsics/associated.c \
 intrinsics/abort.c \
+intrinsics/args.c \
 intrinsics/cpu_time.c \
 intrinsics/cshift0.c \
 intrinsics/eoshift0.c \

diff --git a/libgfortran/Makefile.in b/libgfortran/Makefile.in
index afd486a..9401231 100644 (file)
--- a/libgfortran/Makefile.in
+++ b/libgfortran/Makefile.in
@@ -118,7 +118,7 @@ am__objects_31 = $(am__objects_2) $(am__objects_3) $(am__objects_4) \
 am__objects_32 = backspace.lo close.lo endfile.lo format.lo inquire.lo \
        list_read.lo lock.lo open.lo read.lo rewind.lo transfer.lo \
        unit.lo unix.lo write.lo
-am__objects_33 = associated.lo abort.lo cpu_time.lo cshift0.lo \
+am__objects_33 = associated.lo abort.lo args.lo cpu_time.lo cshift0.lo \
        eoshift0.lo eoshift2.lo ishftc.lo pack_generic.lo size.lo \
        spread_generic.lo string_intrinsics.lo random.lo \
        reshape_generic.lo reshape_packed.lo selected_kind.lo \
@@ -308,6 +308,7 @@ io/io.h
 gfor_helper_src = \
 intrinsics/associated.c \
 intrinsics/abort.c \
+intrinsics/args.c \
 intrinsics/cpu_time.c \
 intrinsics/cshift0.c \
 intrinsics/eoshift0.c \
@@ -1973,6 +1974,15 @@ abort.obj: intrinsics/abort.c
 abort.lo: intrinsics/abort.c
        $(LIBTOOL) --mode=compile $(CC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(AM_CFLAGS) $(CFLAGS) -c -o abort.lo `test -f 'intrinsics/abort.c' || echo '$(srcdir)/'`intrinsics/abort.c
 
+args.o: intrinsics/args.c
+       $(CC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(AM_CFLAGS) $(CFLAGS) -c -o args.o `test -f 'intrinsics/args.c' || echo '$(srcdir)/'`intrinsics/args.c
+
+args.obj: intrinsics/args.c
+       $(CC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(AM_CFLAGS) $(CFLAGS) -c -o args.obj `if test -f 'intrinsics/args.c'; then $(CYGPATH_W) 'intrinsics/args.c'; else $(CYGPATH_W) '$(srcdir)/intrinsics/args.c'; fi`
+
+args.lo: intrinsics/args.c
+       $(LIBTOOL) --mode=compile $(CC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(AM_CFLAGS) $(CFLAGS) -c -o args.lo `test -f 'intrinsics/args.c' || echo '$(srcdir)/'`intrinsics/args.c
+
 cpu_time.o: intrinsics/cpu_time.c
        $(CC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(AM_CFLAGS) $(CFLAGS) -c -o cpu_time.o `test -f 'intrinsics/cpu_time.c' || echo '$(srcdir)/'`intrinsics/cpu_time.c
 

diff --git a/libgfortran/intrinsics/args.c b/libgfortran/intrinsics/args.c
new file mode 100644 (file)
index 0000000..da684fd
--- /dev/null
+++ b/libgfortran/intrinsics/args.c
@@ -0,0 +1,58 @@
+/* Implementation of the IARG/ARGC intrinsic(s).
+   Copyright (C) 2004 Free Software Foundation, Inc.
+
+This file is part of the GNU Fortran 95 runtime library (libgfortran).
+
+Libgfortran is free software; you can redistribute it and/or
+modify it under the terms of the GNU Lesser General Public
+License as published by the Free Software Foundation; either
+version 2.1 of the License, or (at your option) any later version.
+
+Libgfortran is distributed in the hope that it will be useful,
+but WITHOUT ANY WARRANTY; without even the implied warranty of
+MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+GNU Lesser General Public License for more details.
+
+You should have received a copy of the GNU Lesser General Public
+License along with libgfor; see the file COPYING.LIB.  If not,
+write to the Free Software Foundation, Inc., 59 Temple Place - Suite 330,
+Boston, MA 02111-1307, USA.  */
+
+#include "config.h"
+#include <sys/types.h>
+#include <string.h>
+#include "libgfortran.h"
+
+void 
+prefix(getarg) (GFC_INTEGER_4 *pos, char  *val, GFC_INTEGER_4 val_len)
+{
+  int argc;
+  int arglen;
+  char **argv;
+
+  get_args (&argc, &argv);
+
+  if (val_len < 1 || !val )
+    return;   /* something is wrong , leave immediately */
+  
+  memset( val, ' ', val_len);
+
+  if ((*pos) + 1 <= argc  && *pos >=0 )
+    {
+      arglen = strlen (argv[*pos]);
+      if (arglen > val_len)
+       arglen = val_len;
+      memcpy (val, argv[*pos], arglen);
+    }
+}
+
+GFC_INTEGER_4
+prefix(iargc) ()
+{
+  int argc;
+  char **argv;
+
+  get_args (&argc, &argv);
+
+  return argc;
+}