mirrors/gcc
1
0
Fork 0
mirror of https://gcc.gnu.org/git/gcc.git synced 2024-11-25 11:54:01 +08:00
Code Issues Actions Packages Projects Releases Wiki Activity

args.c: Implement GETARG and IARGC.

Browse Source 
* 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:
Bud Davis 2004-06-12 13:42:46 +00:00 committed by Paul Brook
parent 7b1b4aed94
commit 4aef80f8e0
6 changed files with 106 additions and 3 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

4
gcc/testsuite/ChangeLog
View File

@ -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
View 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

10
libgfortran/ChangeLog
View File

@ -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>

1
libgfortran/Makefile.am
View File

@ -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 \

12
libgfortran/Makefile.in
View File

@ -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
View 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;
}