From 987727ef0723fe3f5c879b5e2af226888254d4e0 Mon Sep 17 00:00:00 2001 From: pbrook Date: Sat, 12 Jun 2004 13:42:46 +0000 Subject: [PATCH 1/1] * 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 --- gcc/testsuite/ChangeLog | 4 ++ .../gfortran.fortran-torture/execute/getarg_1.f90 | 24 +++++++++ libgfortran/ChangeLog | 10 +++- libgfortran/Makefile.am | 1 + libgfortran/Makefile.in | 12 ++++- libgfortran/intrinsics/args.c | 58 ++++++++++++++++++++++ 6 files changed, 106 insertions(+), 3 deletions(-) create mode 100644 gcc/testsuite/gfortran.fortran-torture/execute/getarg_1.f90 create mode 100644 libgfortran/intrinsics/args.c diff --git a/gcc/testsuite/ChangeLog b/gcc/testsuite/ChangeLog index ec49a6676c8..8b009607343 100644 --- a/gcc/testsuite/ChangeLog +++ b/gcc/testsuite/ChangeLog @@ -1,5 +1,9 @@ 2004-06-12 Bud Davis + * gfortran.fortran-torture/execute/getarg_1.f90: New test. + +2004-06-12 Bud Davis + 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 index 00000000000..2d566862d2d --- /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 a00f03faf34..6b3b4301024 100644 --- a/libgfortran/ChangeLog +++ b/libgfortran/ChangeLog @@ -1,14 +1,20 @@ 2004-06-12 Bud Davis + * intrinsics/args.c: Implement GETARG and IARGC. + * Makefile.am: Add it. + * Makefile.in: Regenerate. + +2004-06-12 Bud Davis + 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 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 diff --git a/libgfortran/Makefile.am b/libgfortran/Makefile.am index 24a39e162a2..f77335d5f9c 100644 --- 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 afd486a6e23..9401231c684 100644 --- 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 index 00000000000..da684fd99d4 --- /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 +#include +#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; +} -- 2.11.0