mirror of
https://gcc.gnu.org/git/gcc.git
synced 2024-11-25 20:03:58 +08:00
args.c: Implement GETARG and IARGC.
* intrinsics/args.c: Implement GETARG and IARGC. * Makefile.am: Add it. * Makefile.in: Regenerate. testsuite/ * gfortran.fortran-torture/execute/getarg_1.f90: New test. From-SVN: r83027
This commit is contained in:
parent
7b1b4aed94
commit
4aef80f8e0
@ -1,3 +1,7 @@
|
||||
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
|
||||
|
24
gcc/testsuite/gfortran.fortran-torture/execute/getarg_1.f90
Normal file
24
gcc/testsuite/gfortran.fortran-torture/execute/getarg_1.f90
Normal file
@ -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
|
@ -1,7 +1,13 @@
|
||||
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>
|
||||
|
||||
|
@ -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 \
|
||||
|
@ -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
|
||||
|
||||
|
58
libgfortran/intrinsics/args.c
Normal file
58
libgfortran/intrinsics/args.c
Normal file
@ -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;
|
||||
}
|
Loading…
Reference in New Issue
Block a user