check.c (gfc_check_second_sub, [...]): New functions.
* check.c (gfc_check_second_sub, gfc_check_irand, gfc_check_rand
gfc_check_srand, gfc_check_etime, gfc_check_etime_sub): New functions.
* gfortran.h (gfc_generic_isym_id): New symbols GFC_ISYM_ETIME,
GFC_ISYM_IRAND, GFC_ISYM_RAND, GFC_ISYM_SECOND.
* trans-intrinsic.c: Use symbols.
* intrinsic.c (add_sym_2s): New function.
* intrinsic.c: Add etime, dtime, irand, rand, second, srand.
* intrinsic.h: Function prototypes.
* iresolve.c (gfc_resolve_etime_sub, gfc_resolve_second_sub
gfc_resolve_srand): New functions.
libgfortran
* Makefile.am: Add rand.c and etime.c
* Makefile.in: Regenerated.
* aclocal.in: Regenerated.
* cpu_time.c (second_sub, second): New functions.
* rand.c (irand, rand, srand): New file.
* etime.c (etime_sub, etime): New file.
From-SVN: r83034
2004-06-12 19:34:47 +02:00
|
|
|
/* Implementation of the DATE_AND_TIME intrinsic.
|
2009-04-08 18:48:07 +02:00
|
|
|
Copyright (C) 2003, 2004, 2005, 2006, 2007, 2009 Free Software Foundation, Inc.
|
check.c (gfc_check_second_sub, [...]): New functions.
* check.c (gfc_check_second_sub, gfc_check_irand, gfc_check_rand
gfc_check_srand, gfc_check_etime, gfc_check_etime_sub): New functions.
* gfortran.h (gfc_generic_isym_id): New symbols GFC_ISYM_ETIME,
GFC_ISYM_IRAND, GFC_ISYM_RAND, GFC_ISYM_SECOND.
* trans-intrinsic.c: Use symbols.
* intrinsic.c (add_sym_2s): New function.
* intrinsic.c: Add etime, dtime, irand, rand, second, srand.
* intrinsic.h: Function prototypes.
* iresolve.c (gfc_resolve_etime_sub, gfc_resolve_second_sub
gfc_resolve_srand): New functions.
libgfortran
* Makefile.am: Add rand.c and etime.c
* Makefile.in: Regenerated.
* aclocal.in: Regenerated.
* cpu_time.c (second_sub, second): New functions.
* rand.c (irand, rand, srand): New file.
* etime.c (etime_sub, etime): New file.
From-SVN: r83034
2004-06-12 19:34:47 +02:00
|
|
|
Contributed by Steven Bosscher.
|
|
|
|
|
2005-01-12 22:27:33 +01:00
|
|
|
This file is part of the GNU Fortran 95 runtime library (libgfortran).
|
check.c (gfc_check_second_sub, [...]): New functions.
* check.c (gfc_check_second_sub, gfc_check_irand, gfc_check_rand
gfc_check_srand, gfc_check_etime, gfc_check_etime_sub): New functions.
* gfortran.h (gfc_generic_isym_id): New symbols GFC_ISYM_ETIME,
GFC_ISYM_IRAND, GFC_ISYM_RAND, GFC_ISYM_SECOND.
* trans-intrinsic.c: Use symbols.
* intrinsic.c (add_sym_2s): New function.
* intrinsic.c: Add etime, dtime, irand, rand, second, srand.
* intrinsic.h: Function prototypes.
* iresolve.c (gfc_resolve_etime_sub, gfc_resolve_second_sub
gfc_resolve_srand): New functions.
libgfortran
* Makefile.am: Add rand.c and etime.c
* Makefile.in: Regenerated.
* aclocal.in: Regenerated.
* cpu_time.c (second_sub, second): New functions.
* rand.c (irand, rand, srand): New file.
* etime.c (etime_sub, etime): New file.
From-SVN: r83034
2004-06-12 19:34:47 +02:00
|
|
|
|
2005-01-12 22:27:33 +01:00
|
|
|
Libgfortran is free software; you can redistribute it and/or
|
|
|
|
modify it under the terms of the GNU General Public
|
check.c (gfc_check_second_sub, [...]): New functions.
* check.c (gfc_check_second_sub, gfc_check_irand, gfc_check_rand
gfc_check_srand, gfc_check_etime, gfc_check_etime_sub): New functions.
* gfortran.h (gfc_generic_isym_id): New symbols GFC_ISYM_ETIME,
GFC_ISYM_IRAND, GFC_ISYM_RAND, GFC_ISYM_SECOND.
* trans-intrinsic.c: Use symbols.
* intrinsic.c (add_sym_2s): New function.
* intrinsic.c: Add etime, dtime, irand, rand, second, srand.
* intrinsic.h: Function prototypes.
* iresolve.c (gfc_resolve_etime_sub, gfc_resolve_second_sub
gfc_resolve_srand): New functions.
libgfortran
* Makefile.am: Add rand.c and etime.c
* Makefile.in: Regenerated.
* aclocal.in: Regenerated.
* cpu_time.c (second_sub, second): New functions.
* rand.c (irand, rand, srand): New file.
* etime.c (etime_sub, etime): New file.
From-SVN: r83034
2004-06-12 19:34:47 +02:00
|
|
|
License as published by the Free Software Foundation; either
|
2009-04-09 17:00:19 +02:00
|
|
|
version 3 of the License, or (at your option) any later version.
|
2005-01-12 22:27:33 +01:00
|
|
|
|
|
|
|
Libgfortran is distributed in the hope that it will be useful,
|
check.c (gfc_check_second_sub, [...]): New functions.
* check.c (gfc_check_second_sub, gfc_check_irand, gfc_check_rand
gfc_check_srand, gfc_check_etime, gfc_check_etime_sub): New functions.
* gfortran.h (gfc_generic_isym_id): New symbols GFC_ISYM_ETIME,
GFC_ISYM_IRAND, GFC_ISYM_RAND, GFC_ISYM_SECOND.
* trans-intrinsic.c: Use symbols.
* intrinsic.c (add_sym_2s): New function.
* intrinsic.c: Add etime, dtime, irand, rand, second, srand.
* intrinsic.h: Function prototypes.
* iresolve.c (gfc_resolve_etime_sub, gfc_resolve_second_sub
gfc_resolve_srand): New functions.
libgfortran
* Makefile.am: Add rand.c and etime.c
* Makefile.in: Regenerated.
* aclocal.in: Regenerated.
* cpu_time.c (second_sub, second): New functions.
* rand.c (irand, rand, srand): New file.
* etime.c (etime_sub, etime): New file.
From-SVN: r83034
2004-06-12 19:34:47 +02:00
|
|
|
but WITHOUT ANY WARRANTY; without even the implied warranty of
|
|
|
|
MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
|
2005-01-12 22:27:33 +01:00
|
|
|
GNU General Public License for more details.
|
check.c (gfc_check_second_sub, [...]): New functions.
* check.c (gfc_check_second_sub, gfc_check_irand, gfc_check_rand
gfc_check_srand, gfc_check_etime, gfc_check_etime_sub): New functions.
* gfortran.h (gfc_generic_isym_id): New symbols GFC_ISYM_ETIME,
GFC_ISYM_IRAND, GFC_ISYM_RAND, GFC_ISYM_SECOND.
* trans-intrinsic.c: Use symbols.
* intrinsic.c (add_sym_2s): New function.
* intrinsic.c: Add etime, dtime, irand, rand, second, srand.
* intrinsic.h: Function prototypes.
* iresolve.c (gfc_resolve_etime_sub, gfc_resolve_second_sub
gfc_resolve_srand): New functions.
libgfortran
* Makefile.am: Add rand.c and etime.c
* Makefile.in: Regenerated.
* aclocal.in: Regenerated.
* cpu_time.c (second_sub, second): New functions.
* rand.c (irand, rand, srand): New file.
* etime.c (etime_sub, etime): New file.
From-SVN: r83034
2004-06-12 19:34:47 +02:00
|
|
|
|
2009-04-09 17:00:19 +02:00
|
|
|
Under Section 7 of GPL version 3, you are granted additional
|
|
|
|
permissions described in the GCC Runtime Library Exception, version
|
|
|
|
3.1, as published by the Free Software Foundation.
|
|
|
|
|
|
|
|
You should have received a copy of the GNU General Public License and
|
|
|
|
a copy of the GCC Runtime Library Exception along with this program;
|
|
|
|
see the files COPYING3 and COPYING.RUNTIME respectively. If not, see
|
|
|
|
<http://www.gnu.org/licenses/>. */
|
check.c (gfc_check_second_sub, [...]): New functions.
* check.c (gfc_check_second_sub, gfc_check_irand, gfc_check_rand
gfc_check_srand, gfc_check_etime, gfc_check_etime_sub): New functions.
* gfortran.h (gfc_generic_isym_id): New symbols GFC_ISYM_ETIME,
GFC_ISYM_IRAND, GFC_ISYM_RAND, GFC_ISYM_SECOND.
* trans-intrinsic.c: Use symbols.
* intrinsic.c (add_sym_2s): New function.
* intrinsic.c: Add etime, dtime, irand, rand, second, srand.
* intrinsic.h: Function prototypes.
* iresolve.c (gfc_resolve_etime_sub, gfc_resolve_second_sub
gfc_resolve_srand): New functions.
libgfortran
* Makefile.am: Add rand.c and etime.c
* Makefile.in: Regenerated.
* aclocal.in: Regenerated.
* cpu_time.c (second_sub, second): New functions.
* rand.c (irand, rand, srand): New file.
* etime.c (etime_sub, etime): New file.
From-SVN: r83034
2004-06-12 19:34:47 +02:00
|
|
|
|
2007-08-31 16:01:34 +02:00
|
|
|
#include "libgfortran.h"
|
check.c (gfc_check_second_sub, [...]): New functions.
* check.c (gfc_check_second_sub, gfc_check_irand, gfc_check_rand
gfc_check_srand, gfc_check_etime, gfc_check_etime_sub): New functions.
* gfortran.h (gfc_generic_isym_id): New symbols GFC_ISYM_ETIME,
GFC_ISYM_IRAND, GFC_ISYM_RAND, GFC_ISYM_SECOND.
* trans-intrinsic.c: Use symbols.
* intrinsic.c (add_sym_2s): New function.
* intrinsic.c: Add etime, dtime, irand, rand, second, srand.
* intrinsic.h: Function prototypes.
* iresolve.c (gfc_resolve_etime_sub, gfc_resolve_second_sub
gfc_resolve_srand): New functions.
libgfortran
* Makefile.am: Add rand.c and etime.c
* Makefile.in: Regenerated.
* aclocal.in: Regenerated.
* cpu_time.c (second_sub, second): New functions.
* rand.c (irand, rand, srand): New file.
* etime.c (etime_sub, etime): New file.
From-SVN: r83034
2004-06-12 19:34:47 +02:00
|
|
|
#include <string.h>
|
|
|
|
#include <assert.h>
|
|
|
|
#include <stdlib.h>
|
|
|
|
|
|
|
|
#undef HAVE_NO_DATE_TIME
|
|
|
|
#if TIME_WITH_SYS_TIME
|
|
|
|
# include <sys/time.h>
|
|
|
|
# include <time.h>
|
|
|
|
#else
|
|
|
|
# if HAVE_SYS_TIME_H
|
|
|
|
# include <sys/time.h>
|
|
|
|
# else
|
|
|
|
# ifdef HAVE_TIME_H
|
|
|
|
# include <time.h>
|
|
|
|
# else
|
|
|
|
# define HAVE_NO_DATE_TIME
|
|
|
|
# endif /* HAVE_TIME_H */
|
|
|
|
# endif /* HAVE_SYS_TIME_H */
|
|
|
|
#endif /* TIME_WITH_SYS_TIME */
|
|
|
|
|
|
|
|
#ifndef abs
|
|
|
|
#define abs(x) ((x)>=0 ? (x) : -(x))
|
|
|
|
#endif
|
|
|
|
|
|
|
|
/* DATE_AND_TIME ([DATE, TIME, ZONE, VALUES])
|
|
|
|
|
|
|
|
Description: Returns data on the real-time clock and date in a form
|
|
|
|
compatible with the representations defined in ISO 8601:1988.
|
|
|
|
|
|
|
|
Class: Non-elemental subroutine.
|
|
|
|
|
|
|
|
Arguments:
|
|
|
|
|
|
|
|
DATE (optional) shall be scalar and of type default character, and
|
|
|
|
shall be of length at least 8 in order to contain the complete
|
2005-02-19 19:06:00 +01:00
|
|
|
value. It is an INTENT(OUT) argument. Its leftmost 8 characters
|
check.c (gfc_check_second_sub, [...]): New functions.
* check.c (gfc_check_second_sub, gfc_check_irand, gfc_check_rand
gfc_check_srand, gfc_check_etime, gfc_check_etime_sub): New functions.
* gfortran.h (gfc_generic_isym_id): New symbols GFC_ISYM_ETIME,
GFC_ISYM_IRAND, GFC_ISYM_RAND, GFC_ISYM_SECOND.
* trans-intrinsic.c: Use symbols.
* intrinsic.c (add_sym_2s): New function.
* intrinsic.c: Add etime, dtime, irand, rand, second, srand.
* intrinsic.h: Function prototypes.
* iresolve.c (gfc_resolve_etime_sub, gfc_resolve_second_sub
gfc_resolve_srand): New functions.
libgfortran
* Makefile.am: Add rand.c and etime.c
* Makefile.in: Regenerated.
* aclocal.in: Regenerated.
* cpu_time.c (second_sub, second): New functions.
* rand.c (irand, rand, srand): New file.
* etime.c (etime_sub, etime): New file.
From-SVN: r83034
2004-06-12 19:34:47 +02:00
|
|
|
are assigned a value of the form CCYYMMDD, where CC is the century,
|
|
|
|
YY the year within the century, MM the month within the year, and
|
|
|
|
DD the day within the month. If there is no date available, they
|
|
|
|
are assigned blanks.
|
|
|
|
|
|
|
|
TIME (optional) shall be scalar and of type default character, and
|
|
|
|
shall be of length at least 10 in order to contain the complete
|
2005-02-19 19:06:00 +01:00
|
|
|
value. It is an INTENT(OUT) argument. Its leftmost 10 characters
|
check.c (gfc_check_second_sub, [...]): New functions.
* check.c (gfc_check_second_sub, gfc_check_irand, gfc_check_rand
gfc_check_srand, gfc_check_etime, gfc_check_etime_sub): New functions.
* gfortran.h (gfc_generic_isym_id): New symbols GFC_ISYM_ETIME,
GFC_ISYM_IRAND, GFC_ISYM_RAND, GFC_ISYM_SECOND.
* trans-intrinsic.c: Use symbols.
* intrinsic.c (add_sym_2s): New function.
* intrinsic.c: Add etime, dtime, irand, rand, second, srand.
* intrinsic.h: Function prototypes.
* iresolve.c (gfc_resolve_etime_sub, gfc_resolve_second_sub
gfc_resolve_srand): New functions.
libgfortran
* Makefile.am: Add rand.c and etime.c
* Makefile.in: Regenerated.
* aclocal.in: Regenerated.
* cpu_time.c (second_sub, second): New functions.
* rand.c (irand, rand, srand): New file.
* etime.c (etime_sub, etime): New file.
From-SVN: r83034
2004-06-12 19:34:47 +02:00
|
|
|
are assigned a value of the form hhmmss.sss, where hh is the hour
|
|
|
|
of the day, mm is the minutes of the hour, and ss.sss is the
|
|
|
|
seconds and milliseconds of the minute. If there is no clock
|
|
|
|
available, they are assigned blanks.
|
|
|
|
|
|
|
|
ZONE (optional) shall be scalar and of type default character, and
|
|
|
|
shall be of length at least 5 in order to contain the complete
|
2005-02-19 19:06:00 +01:00
|
|
|
value. It is an INTENT(OUT) argument. Its leftmost 5 characters
|
2006-07-04 13:39:46 +02:00
|
|
|
are assigned a value of the form [+-]hhmm, where hh and mm are the
|
check.c (gfc_check_second_sub, [...]): New functions.
* check.c (gfc_check_second_sub, gfc_check_irand, gfc_check_rand
gfc_check_srand, gfc_check_etime, gfc_check_etime_sub): New functions.
* gfortran.h (gfc_generic_isym_id): New symbols GFC_ISYM_ETIME,
GFC_ISYM_IRAND, GFC_ISYM_RAND, GFC_ISYM_SECOND.
* trans-intrinsic.c: Use symbols.
* intrinsic.c (add_sym_2s): New function.
* intrinsic.c: Add etime, dtime, irand, rand, second, srand.
* intrinsic.h: Function prototypes.
* iresolve.c (gfc_resolve_etime_sub, gfc_resolve_second_sub
gfc_resolve_srand): New functions.
libgfortran
* Makefile.am: Add rand.c and etime.c
* Makefile.in: Regenerated.
* aclocal.in: Regenerated.
* cpu_time.c (second_sub, second): New functions.
* rand.c (irand, rand, srand): New file.
* etime.c (etime_sub, etime): New file.
From-SVN: r83034
2004-06-12 19:34:47 +02:00
|
|
|
time difference with respect to Coordinated Universal Time (UTC) in
|
|
|
|
hours and parts of an hour expressed in minutes, respectively. If
|
|
|
|
there is no clock available, they are assigned blanks.
|
|
|
|
|
|
|
|
VALUES (optional) shall be of type default integer and of rank
|
2005-02-19 19:06:00 +01:00
|
|
|
one. It is an INTENT(OUT) argument. Its size shall be at least
|
check.c (gfc_check_second_sub, [...]): New functions.
* check.c (gfc_check_second_sub, gfc_check_irand, gfc_check_rand
gfc_check_srand, gfc_check_etime, gfc_check_etime_sub): New functions.
* gfortran.h (gfc_generic_isym_id): New symbols GFC_ISYM_ETIME,
GFC_ISYM_IRAND, GFC_ISYM_RAND, GFC_ISYM_SECOND.
* trans-intrinsic.c: Use symbols.
* intrinsic.c (add_sym_2s): New function.
* intrinsic.c: Add etime, dtime, irand, rand, second, srand.
* intrinsic.h: Function prototypes.
* iresolve.c (gfc_resolve_etime_sub, gfc_resolve_second_sub
gfc_resolve_srand): New functions.
libgfortran
* Makefile.am: Add rand.c and etime.c
* Makefile.in: Regenerated.
* aclocal.in: Regenerated.
* cpu_time.c (second_sub, second): New functions.
* rand.c (irand, rand, srand): New file.
* etime.c (etime_sub, etime): New file.
From-SVN: r83034
2004-06-12 19:34:47 +02:00
|
|
|
8. The values returned in VALUES are as follows:
|
|
|
|
|
2005-02-19 19:06:00 +01:00
|
|
|
VALUES(1) the year (for example, 2003), or -HUGE(0) if there is
|
check.c (gfc_check_second_sub, [...]): New functions.
* check.c (gfc_check_second_sub, gfc_check_irand, gfc_check_rand
gfc_check_srand, gfc_check_etime, gfc_check_etime_sub): New functions.
* gfortran.h (gfc_generic_isym_id): New symbols GFC_ISYM_ETIME,
GFC_ISYM_IRAND, GFC_ISYM_RAND, GFC_ISYM_SECOND.
* trans-intrinsic.c: Use symbols.
* intrinsic.c (add_sym_2s): New function.
* intrinsic.c: Add etime, dtime, irand, rand, second, srand.
* intrinsic.h: Function prototypes.
* iresolve.c (gfc_resolve_etime_sub, gfc_resolve_second_sub
gfc_resolve_srand): New functions.
libgfortran
* Makefile.am: Add rand.c and etime.c
* Makefile.in: Regenerated.
* aclocal.in: Regenerated.
* cpu_time.c (second_sub, second): New functions.
* rand.c (irand, rand, srand): New file.
* etime.c (etime_sub, etime): New file.
From-SVN: r83034
2004-06-12 19:34:47 +02:00
|
|
|
no date available;
|
|
|
|
|
2005-02-19 19:06:00 +01:00
|
|
|
VALUES(2) the month of the year, or -HUGE(0) if there
|
check.c (gfc_check_second_sub, [...]): New functions.
* check.c (gfc_check_second_sub, gfc_check_irand, gfc_check_rand
gfc_check_srand, gfc_check_etime, gfc_check_etime_sub): New functions.
* gfortran.h (gfc_generic_isym_id): New symbols GFC_ISYM_ETIME,
GFC_ISYM_IRAND, GFC_ISYM_RAND, GFC_ISYM_SECOND.
* trans-intrinsic.c: Use symbols.
* intrinsic.c (add_sym_2s): New function.
* intrinsic.c: Add etime, dtime, irand, rand, second, srand.
* intrinsic.h: Function prototypes.
* iresolve.c (gfc_resolve_etime_sub, gfc_resolve_second_sub
gfc_resolve_srand): New functions.
libgfortran
* Makefile.am: Add rand.c and etime.c
* Makefile.in: Regenerated.
* aclocal.in: Regenerated.
* cpu_time.c (second_sub, second): New functions.
* rand.c (irand, rand, srand): New file.
* etime.c (etime_sub, etime): New file.
From-SVN: r83034
2004-06-12 19:34:47 +02:00
|
|
|
is no date available;
|
|
|
|
|
2005-02-19 19:06:00 +01:00
|
|
|
VALUES(3) the day of the month, or -HUGE(0) if there is no date
|
check.c (gfc_check_second_sub, [...]): New functions.
* check.c (gfc_check_second_sub, gfc_check_irand, gfc_check_rand
gfc_check_srand, gfc_check_etime, gfc_check_etime_sub): New functions.
* gfortran.h (gfc_generic_isym_id): New symbols GFC_ISYM_ETIME,
GFC_ISYM_IRAND, GFC_ISYM_RAND, GFC_ISYM_SECOND.
* trans-intrinsic.c: Use symbols.
* intrinsic.c (add_sym_2s): New function.
* intrinsic.c: Add etime, dtime, irand, rand, second, srand.
* intrinsic.h: Function prototypes.
* iresolve.c (gfc_resolve_etime_sub, gfc_resolve_second_sub
gfc_resolve_srand): New functions.
libgfortran
* Makefile.am: Add rand.c and etime.c
* Makefile.in: Regenerated.
* aclocal.in: Regenerated.
* cpu_time.c (second_sub, second): New functions.
* rand.c (irand, rand, srand): New file.
* etime.c (etime_sub, etime): New file.
From-SVN: r83034
2004-06-12 19:34:47 +02:00
|
|
|
available;
|
|
|
|
|
2005-02-19 19:06:00 +01:00
|
|
|
VALUES(4) the time difference with respect to Coordinated
|
|
|
|
Universal Time (UTC) in minutes, or -HUGE(0) if this information
|
check.c (gfc_check_second_sub, [...]): New functions.
* check.c (gfc_check_second_sub, gfc_check_irand, gfc_check_rand
gfc_check_srand, gfc_check_etime, gfc_check_etime_sub): New functions.
* gfortran.h (gfc_generic_isym_id): New symbols GFC_ISYM_ETIME,
GFC_ISYM_IRAND, GFC_ISYM_RAND, GFC_ISYM_SECOND.
* trans-intrinsic.c: Use symbols.
* intrinsic.c (add_sym_2s): New function.
* intrinsic.c: Add etime, dtime, irand, rand, second, srand.
* intrinsic.h: Function prototypes.
* iresolve.c (gfc_resolve_etime_sub, gfc_resolve_second_sub
gfc_resolve_srand): New functions.
libgfortran
* Makefile.am: Add rand.c and etime.c
* Makefile.in: Regenerated.
* aclocal.in: Regenerated.
* cpu_time.c (second_sub, second): New functions.
* rand.c (irand, rand, srand): New file.
* etime.c (etime_sub, etime): New file.
From-SVN: r83034
2004-06-12 19:34:47 +02:00
|
|
|
is not available;
|
|
|
|
|
2005-02-19 19:06:00 +01:00
|
|
|
VALUES(5) the hour of the day, in the range of 0 to 23, or
|
|
|
|
-HUGE(0) if there is no clock;
|
check.c (gfc_check_second_sub, [...]): New functions.
* check.c (gfc_check_second_sub, gfc_check_irand, gfc_check_rand
gfc_check_srand, gfc_check_etime, gfc_check_etime_sub): New functions.
* gfortran.h (gfc_generic_isym_id): New symbols GFC_ISYM_ETIME,
GFC_ISYM_IRAND, GFC_ISYM_RAND, GFC_ISYM_SECOND.
* trans-intrinsic.c: Use symbols.
* intrinsic.c (add_sym_2s): New function.
* intrinsic.c: Add etime, dtime, irand, rand, second, srand.
* intrinsic.h: Function prototypes.
* iresolve.c (gfc_resolve_etime_sub, gfc_resolve_second_sub
gfc_resolve_srand): New functions.
libgfortran
* Makefile.am: Add rand.c and etime.c
* Makefile.in: Regenerated.
* aclocal.in: Regenerated.
* cpu_time.c (second_sub, second): New functions.
* rand.c (irand, rand, srand): New file.
* etime.c (etime_sub, etime): New file.
From-SVN: r83034
2004-06-12 19:34:47 +02:00
|
|
|
|
2005-02-19 19:06:00 +01:00
|
|
|
VALUES(6) the minutes of the hour, in the range 0 to 59, or
|
|
|
|
-HUGE(0) if there is no clock;
|
check.c (gfc_check_second_sub, [...]): New functions.
* check.c (gfc_check_second_sub, gfc_check_irand, gfc_check_rand
gfc_check_srand, gfc_check_etime, gfc_check_etime_sub): New functions.
* gfortran.h (gfc_generic_isym_id): New symbols GFC_ISYM_ETIME,
GFC_ISYM_IRAND, GFC_ISYM_RAND, GFC_ISYM_SECOND.
* trans-intrinsic.c: Use symbols.
* intrinsic.c (add_sym_2s): New function.
* intrinsic.c: Add etime, dtime, irand, rand, second, srand.
* intrinsic.h: Function prototypes.
* iresolve.c (gfc_resolve_etime_sub, gfc_resolve_second_sub
gfc_resolve_srand): New functions.
libgfortran
* Makefile.am: Add rand.c and etime.c
* Makefile.in: Regenerated.
* aclocal.in: Regenerated.
* cpu_time.c (second_sub, second): New functions.
* rand.c (irand, rand, srand): New file.
* etime.c (etime_sub, etime): New file.
From-SVN: r83034
2004-06-12 19:34:47 +02:00
|
|
|
|
2005-02-19 19:06:00 +01:00
|
|
|
VALUES(7) the seconds of the minute, in the range 0 to 60, or
|
|
|
|
-HUGE(0) if there is no clock;
|
check.c (gfc_check_second_sub, [...]): New functions.
* check.c (gfc_check_second_sub, gfc_check_irand, gfc_check_rand
gfc_check_srand, gfc_check_etime, gfc_check_etime_sub): New functions.
* gfortran.h (gfc_generic_isym_id): New symbols GFC_ISYM_ETIME,
GFC_ISYM_IRAND, GFC_ISYM_RAND, GFC_ISYM_SECOND.
* trans-intrinsic.c: Use symbols.
* intrinsic.c (add_sym_2s): New function.
* intrinsic.c: Add etime, dtime, irand, rand, second, srand.
* intrinsic.h: Function prototypes.
* iresolve.c (gfc_resolve_etime_sub, gfc_resolve_second_sub
gfc_resolve_srand): New functions.
libgfortran
* Makefile.am: Add rand.c and etime.c
* Makefile.in: Regenerated.
* aclocal.in: Regenerated.
* cpu_time.c (second_sub, second): New functions.
* rand.c (irand, rand, srand): New file.
* etime.c (etime_sub, etime): New file.
From-SVN: r83034
2004-06-12 19:34:47 +02:00
|
|
|
|
2005-02-19 19:06:00 +01:00
|
|
|
VALUES(8) the milliseconds of the second, in the range 0 to
|
|
|
|
999, or -HUGE(0) if there is no clock.
|
check.c (gfc_check_second_sub, [...]): New functions.
* check.c (gfc_check_second_sub, gfc_check_irand, gfc_check_rand
gfc_check_srand, gfc_check_etime, gfc_check_etime_sub): New functions.
* gfortran.h (gfc_generic_isym_id): New symbols GFC_ISYM_ETIME,
GFC_ISYM_IRAND, GFC_ISYM_RAND, GFC_ISYM_SECOND.
* trans-intrinsic.c: Use symbols.
* intrinsic.c (add_sym_2s): New function.
* intrinsic.c: Add etime, dtime, irand, rand, second, srand.
* intrinsic.h: Function prototypes.
* iresolve.c (gfc_resolve_etime_sub, gfc_resolve_second_sub
gfc_resolve_srand): New functions.
libgfortran
* Makefile.am: Add rand.c and etime.c
* Makefile.in: Regenerated.
* aclocal.in: Regenerated.
* cpu_time.c (second_sub, second): New functions.
* rand.c (irand, rand, srand): New file.
* etime.c (etime_sub, etime): New file.
From-SVN: r83034
2004-06-12 19:34:47 +02:00
|
|
|
|
|
|
|
NULL pointer represent missing OPTIONAL arguments. All arguments
|
|
|
|
have INTENT(OUT). Because of the -i8 option, we must implement
|
|
|
|
VALUES for INTEGER(kind=4) and INTEGER(kind=8).
|
|
|
|
|
|
|
|
Based on libU77's date_time_.c.
|
|
|
|
|
|
|
|
TODO :
|
|
|
|
- Check year boundaries.
|
|
|
|
*/
|
2005-02-19 19:06:00 +01:00
|
|
|
#define DATE_LEN 8
|
|
|
|
#define TIME_LEN 10
|
|
|
|
#define ZONE_LEN 5
|
|
|
|
#define VALUES_SIZE 8
|
check.c (gfc_check_second_sub, [...]): New functions.
* check.c (gfc_check_second_sub, gfc_check_irand, gfc_check_rand
gfc_check_srand, gfc_check_etime, gfc_check_etime_sub): New functions.
* gfortran.h (gfc_generic_isym_id): New symbols GFC_ISYM_ETIME,
GFC_ISYM_IRAND, GFC_ISYM_RAND, GFC_ISYM_SECOND.
* trans-intrinsic.c: Use symbols.
* intrinsic.c (add_sym_2s): New function.
* intrinsic.c: Add etime, dtime, irand, rand, second, srand.
* intrinsic.h: Function prototypes.
* iresolve.c (gfc_resolve_etime_sub, gfc_resolve_second_sub
gfc_resolve_srand): New functions.
libgfortran
* Makefile.am: Add rand.c and etime.c
* Makefile.in: Regenerated.
* aclocal.in: Regenerated.
* cpu_time.c (second_sub, second): New functions.
* rand.c (irand, rand, srand): New file.
* etime.c (etime_sub, etime): New file.
From-SVN: r83034
2004-06-12 19:34:47 +02:00
|
|
|
|
acinclude.m4 (LIBGFOR_CHECK_ATTRIBUTE_VISIBILITY): New.
* acinclude.m4 (LIBGFOR_CHECK_ATTRIBUTE_VISIBILITY): New.
(LIBGFOR_CHECK_ATTRIBUTE_DLLEXPORT): New.
(LIBGFOR_CHECK_ATTRIBUTE_ALIAS): New.
* configure.ac: Use them.
* configure, config.h.in, aclocal.m4: Rebuild.
* libgfortran.h (prefix): Remove.
(PREFIX, IPREFIX): New.
(sym_rename, sym_rename1, sym_rename2): New.
(internal_proto, export_proto, export_proto_np): New.
(iexport_proto, iexport): New.
(iexport_data_proto, iexport_data): New.
* intrinsics/abort.c, intrinsics/args.c, intrinsics/associated.c,
intrinsics/cpu_time.c, intrinsics/cshift0.c,
intrinsics/date_and_time.c, intrinsics/env.c, intrinsics/eoshift0.c,
intrinsics/eoshift2.c, intrinsics/etime.c, intrinsics/exit.c,
intrinsics/flush.c, intrinsics/fnum.c, intrinsics/getXid.c,
intrinsics/getcwd.c, intrinsics/ishftc.c, intrinsics/mvbits.c,
intrinsics/pack_generic.c, intrinsics/rand.c, intrinsics/random.c,
intrinsics/reshape_generic.c, intrinsics/size.c,
intrinsics/spread_generic.c, intrinsics/stat.c,
intrinsics/string_intrinsics.c, intrinsics/system.c,
intrinsics/system_clock.c, intrinsics/transpose_generic.c,
intrinsics/umask.c, intrinsics/unlink.c, intrinsics/unpack_generic.c,
io/backspace.c, io/close.c, io/endfile.c, io/inquire.c, io/io.h,
io/open.c, io/rewind.c, io/transfer.c, libgfortran.h, m4/cshift1.m4,
m4/dotprod.m4, m4/dotprodc.m4, m4/dotprodl.m4, m4/eoshift1.m4,
m4/eoshift3.m4, m4/exponent.m4, m4/fraction.m4, m4/iforeach.m4,
m4/ifunction.m4, m4/matmul.m4, m4/matmull.m4, m4/nearest.m4,
m4/pow.m4, m4/reshape.m4, m4/set_exponent.m4, m4/shape.m4,
m4/transpose.m4, runtime/environ.c, runtime/error.c,
runtime/in_pack_generic.c, runtime/in_unpack_generic.c,
runtime/main.c, runtime/memory.c, runtime/pause.c, runtime/select.c,
runtime/stop.c: Use them to mark symbols internal or external.
* generated/*: Rebuild.
From-SVN: r92045
2004-12-12 09:59:05 +01:00
|
|
|
extern void date_and_time (char *, char *, char *, gfc_array_i4 *,
|
|
|
|
GFC_INTEGER_4, GFC_INTEGER_4, GFC_INTEGER_4);
|
|
|
|
export_proto(date_and_time);
|
|
|
|
|
check.c (gfc_check_second_sub, [...]): New functions.
* check.c (gfc_check_second_sub, gfc_check_irand, gfc_check_rand
gfc_check_srand, gfc_check_etime, gfc_check_etime_sub): New functions.
* gfortran.h (gfc_generic_isym_id): New symbols GFC_ISYM_ETIME,
GFC_ISYM_IRAND, GFC_ISYM_RAND, GFC_ISYM_SECOND.
* trans-intrinsic.c: Use symbols.
* intrinsic.c (add_sym_2s): New function.
* intrinsic.c: Add etime, dtime, irand, rand, second, srand.
* intrinsic.h: Function prototypes.
* iresolve.c (gfc_resolve_etime_sub, gfc_resolve_second_sub
gfc_resolve_srand): New functions.
libgfortran
* Makefile.am: Add rand.c and etime.c
* Makefile.in: Regenerated.
* aclocal.in: Regenerated.
* cpu_time.c (second_sub, second): New functions.
* rand.c (irand, rand, srand): New file.
* etime.c (etime_sub, etime): New file.
From-SVN: r83034
2004-06-12 19:34:47 +02:00
|
|
|
void
|
2005-02-19 19:06:00 +01:00
|
|
|
date_and_time (char *__date, char *__time, char *__zone,
|
|
|
|
gfc_array_i4 *__values, GFC_INTEGER_4 __date_len,
|
|
|
|
GFC_INTEGER_4 __time_len, GFC_INTEGER_4 __zone_len)
|
check.c (gfc_check_second_sub, [...]): New functions.
* check.c (gfc_check_second_sub, gfc_check_irand, gfc_check_rand
gfc_check_srand, gfc_check_etime, gfc_check_etime_sub): New functions.
* gfortran.h (gfc_generic_isym_id): New symbols GFC_ISYM_ETIME,
GFC_ISYM_IRAND, GFC_ISYM_RAND, GFC_ISYM_SECOND.
* trans-intrinsic.c: Use symbols.
* intrinsic.c (add_sym_2s): New function.
* intrinsic.c: Add etime, dtime, irand, rand, second, srand.
* intrinsic.h: Function prototypes.
* iresolve.c (gfc_resolve_etime_sub, gfc_resolve_second_sub
gfc_resolve_srand): New functions.
libgfortran
* Makefile.am: Add rand.c and etime.c
* Makefile.in: Regenerated.
* aclocal.in: Regenerated.
* cpu_time.c (second_sub, second): New functions.
* rand.c (irand, rand, srand): New file.
* etime.c (etime_sub, etime): New file.
From-SVN: r83034
2004-06-12 19:34:47 +02:00
|
|
|
{
|
2005-02-19 19:06:00 +01:00
|
|
|
int i;
|
check.c (gfc_check_second_sub, [...]): New functions.
* check.c (gfc_check_second_sub, gfc_check_irand, gfc_check_rand
gfc_check_srand, gfc_check_etime, gfc_check_etime_sub): New functions.
* gfortran.h (gfc_generic_isym_id): New symbols GFC_ISYM_ETIME,
GFC_ISYM_IRAND, GFC_ISYM_RAND, GFC_ISYM_SECOND.
* trans-intrinsic.c: Use symbols.
* intrinsic.c (add_sym_2s): New function.
* intrinsic.c: Add etime, dtime, irand, rand, second, srand.
* intrinsic.h: Function prototypes.
* iresolve.c (gfc_resolve_etime_sub, gfc_resolve_second_sub
gfc_resolve_srand): New functions.
libgfortran
* Makefile.am: Add rand.c and etime.c
* Makefile.in: Regenerated.
* aclocal.in: Regenerated.
* cpu_time.c (second_sub, second): New functions.
* rand.c (irand, rand, srand): New file.
* etime.c (etime_sub, etime): New file.
From-SVN: r83034
2004-06-12 19:34:47 +02:00
|
|
|
char date[DATE_LEN + 1];
|
|
|
|
char timec[TIME_LEN + 1];
|
|
|
|
char zone[ZONE_LEN + 1];
|
|
|
|
GFC_INTEGER_4 values[VALUES_SIZE];
|
|
|
|
|
|
|
|
#ifndef HAVE_NO_DATE_TIME
|
2005-02-19 19:06:00 +01:00
|
|
|
time_t lt;
|
|
|
|
struct tm local_time;
|
|
|
|
struct tm UTC_time;
|
|
|
|
|
2007-01-21 17:16:10 +01:00
|
|
|
#if HAVE_GETTIMEOFDAY
|
|
|
|
{
|
|
|
|
struct timeval tp;
|
|
|
|
|
|
|
|
if (!gettimeofday (&tp, NULL))
|
|
|
|
{
|
|
|
|
lt = tp.tv_sec;
|
|
|
|
values[7] = tp.tv_usec / 1000;
|
|
|
|
}
|
|
|
|
else
|
|
|
|
{
|
|
|
|
lt = time (NULL);
|
|
|
|
values[7] = 0;
|
|
|
|
}
|
|
|
|
}
|
|
|
|
#else
|
2005-02-19 19:06:00 +01:00
|
|
|
lt = time (NULL);
|
2007-01-21 17:16:10 +01:00
|
|
|
values[7] = 0;
|
|
|
|
#endif /* HAVE_GETTIMEOFDAY */
|
2005-02-19 19:06:00 +01:00
|
|
|
|
|
|
|
if (lt != (time_t) -1)
|
|
|
|
{
|
|
|
|
local_time = *localtime (<);
|
|
|
|
UTC_time = *gmtime (<);
|
|
|
|
|
|
|
|
/* All arguments can be derived from VALUES. */
|
|
|
|
values[0] = 1900 + local_time.tm_year;
|
|
|
|
values[1] = 1 + local_time.tm_mon;
|
|
|
|
values[2] = local_time.tm_mday;
|
|
|
|
values[3] = (local_time.tm_min - UTC_time.tm_min +
|
|
|
|
60 * (local_time.tm_hour - UTC_time.tm_hour +
|
check.c (gfc_check_second_sub, [...]): New functions.
* check.c (gfc_check_second_sub, gfc_check_irand, gfc_check_rand
gfc_check_srand, gfc_check_etime, gfc_check_etime_sub): New functions.
* gfortran.h (gfc_generic_isym_id): New symbols GFC_ISYM_ETIME,
GFC_ISYM_IRAND, GFC_ISYM_RAND, GFC_ISYM_SECOND.
* trans-intrinsic.c: Use symbols.
* intrinsic.c (add_sym_2s): New function.
* intrinsic.c: Add etime, dtime, irand, rand, second, srand.
* intrinsic.h: Function prototypes.
* iresolve.c (gfc_resolve_etime_sub, gfc_resolve_second_sub
gfc_resolve_srand): New functions.
libgfortran
* Makefile.am: Add rand.c and etime.c
* Makefile.in: Regenerated.
* aclocal.in: Regenerated.
* cpu_time.c (second_sub, second): New functions.
* rand.c (irand, rand, srand): New file.
* etime.c (etime_sub, etime): New file.
From-SVN: r83034
2004-06-12 19:34:47 +02:00
|
|
|
24 * (local_time.tm_yday - UTC_time.tm_yday)));
|
2005-02-19 19:06:00 +01:00
|
|
|
values[4] = local_time.tm_hour;
|
|
|
|
values[5] = local_time.tm_min;
|
|
|
|
values[6] = local_time.tm_sec;
|
check.c (gfc_check_second_sub, [...]): New functions.
* check.c (gfc_check_second_sub, gfc_check_irand, gfc_check_rand
gfc_check_srand, gfc_check_etime, gfc_check_etime_sub): New functions.
* gfortran.h (gfc_generic_isym_id): New symbols GFC_ISYM_ETIME,
GFC_ISYM_IRAND, GFC_ISYM_RAND, GFC_ISYM_SECOND.
* trans-intrinsic.c: Use symbols.
* intrinsic.c (add_sym_2s): New function.
* intrinsic.c: Add etime, dtime, irand, rand, second, srand.
* intrinsic.h: Function prototypes.
* iresolve.c (gfc_resolve_etime_sub, gfc_resolve_second_sub
gfc_resolve_srand): New functions.
libgfortran
* Makefile.am: Add rand.c and etime.c
* Makefile.in: Regenerated.
* aclocal.in: Regenerated.
* cpu_time.c (second_sub, second): New functions.
* rand.c (irand, rand, srand): New file.
* etime.c (etime_sub, etime): New file.
From-SVN: r83034
2004-06-12 19:34:47 +02:00
|
|
|
|
2004-11-20 14:15:17 +01:00
|
|
|
#if HAVE_SNPRINTF
|
2005-02-19 19:06:00 +01:00
|
|
|
if (__date)
|
|
|
|
snprintf (date, DATE_LEN + 1, "%04d%02d%02d",
|
|
|
|
values[0], values[1], values[2]);
|
|
|
|
if (__time)
|
|
|
|
snprintf (timec, TIME_LEN + 1, "%02d%02d%02d.%03d",
|
|
|
|
values[4], values[5], values[6], values[7]);
|
|
|
|
|
|
|
|
if (__zone)
|
|
|
|
snprintf (zone, ZONE_LEN + 1, "%+03d%02d",
|
|
|
|
values[3] / 60, abs (values[3] % 60));
|
2004-11-20 14:15:17 +01:00
|
|
|
#else
|
2005-02-19 19:06:00 +01:00
|
|
|
if (__date)
|
|
|
|
sprintf (date, "%04d%02d%02d", values[0], values[1], values[2]);
|
check.c (gfc_check_second_sub, [...]): New functions.
* check.c (gfc_check_second_sub, gfc_check_irand, gfc_check_rand
gfc_check_srand, gfc_check_etime, gfc_check_etime_sub): New functions.
* gfortran.h (gfc_generic_isym_id): New symbols GFC_ISYM_ETIME,
GFC_ISYM_IRAND, GFC_ISYM_RAND, GFC_ISYM_SECOND.
* trans-intrinsic.c: Use symbols.
* intrinsic.c (add_sym_2s): New function.
* intrinsic.c: Add etime, dtime, irand, rand, second, srand.
* intrinsic.h: Function prototypes.
* iresolve.c (gfc_resolve_etime_sub, gfc_resolve_second_sub
gfc_resolve_srand): New functions.
libgfortran
* Makefile.am: Add rand.c and etime.c
* Makefile.in: Regenerated.
* aclocal.in: Regenerated.
* cpu_time.c (second_sub, second): New functions.
* rand.c (irand, rand, srand): New file.
* etime.c (etime_sub, etime): New file.
From-SVN: r83034
2004-06-12 19:34:47 +02:00
|
|
|
|
2005-02-19 19:06:00 +01:00
|
|
|
if (__time)
|
|
|
|
sprintf (timec, "%02d%02d%02d.%03d",
|
|
|
|
values[4], values[5], values[6], values[7]);
|
check.c (gfc_check_second_sub, [...]): New functions.
* check.c (gfc_check_second_sub, gfc_check_irand, gfc_check_rand
gfc_check_srand, gfc_check_etime, gfc_check_etime_sub): New functions.
* gfortran.h (gfc_generic_isym_id): New symbols GFC_ISYM_ETIME,
GFC_ISYM_IRAND, GFC_ISYM_RAND, GFC_ISYM_SECOND.
* trans-intrinsic.c: Use symbols.
* intrinsic.c (add_sym_2s): New function.
* intrinsic.c: Add etime, dtime, irand, rand, second, srand.
* intrinsic.h: Function prototypes.
* iresolve.c (gfc_resolve_etime_sub, gfc_resolve_second_sub
gfc_resolve_srand): New functions.
libgfortran
* Makefile.am: Add rand.c and etime.c
* Makefile.in: Regenerated.
* aclocal.in: Regenerated.
* cpu_time.c (second_sub, second): New functions.
* rand.c (irand, rand, srand): New file.
* etime.c (etime_sub, etime): New file.
From-SVN: r83034
2004-06-12 19:34:47 +02:00
|
|
|
|
2005-02-19 19:06:00 +01:00
|
|
|
if (__zone)
|
|
|
|
sprintf (zone, "%+03d%02d",
|
|
|
|
values[3] / 60, abs (values[3] % 60));
|
2004-11-20 14:15:17 +01:00
|
|
|
#endif
|
check.c (gfc_check_second_sub, [...]): New functions.
* check.c (gfc_check_second_sub, gfc_check_irand, gfc_check_rand
gfc_check_srand, gfc_check_etime, gfc_check_etime_sub): New functions.
* gfortran.h (gfc_generic_isym_id): New symbols GFC_ISYM_ETIME,
GFC_ISYM_IRAND, GFC_ISYM_RAND, GFC_ISYM_SECOND.
* trans-intrinsic.c: Use symbols.
* intrinsic.c (add_sym_2s): New function.
* intrinsic.c: Add etime, dtime, irand, rand, second, srand.
* intrinsic.h: Function prototypes.
* iresolve.c (gfc_resolve_etime_sub, gfc_resolve_second_sub
gfc_resolve_srand): New functions.
libgfortran
* Makefile.am: Add rand.c and etime.c
* Makefile.in: Regenerated.
* aclocal.in: Regenerated.
* cpu_time.c (second_sub, second): New functions.
* rand.c (irand, rand, srand): New file.
* etime.c (etime_sub, etime): New file.
From-SVN: r83034
2004-06-12 19:34:47 +02:00
|
|
|
}
|
2005-02-19 19:06:00 +01:00
|
|
|
else
|
check.c (gfc_check_second_sub, [...]): New functions.
* check.c (gfc_check_second_sub, gfc_check_irand, gfc_check_rand
gfc_check_srand, gfc_check_etime, gfc_check_etime_sub): New functions.
* gfortran.h (gfc_generic_isym_id): New symbols GFC_ISYM_ETIME,
GFC_ISYM_IRAND, GFC_ISYM_RAND, GFC_ISYM_SECOND.
* trans-intrinsic.c: Use symbols.
* intrinsic.c (add_sym_2s): New function.
* intrinsic.c: Add etime, dtime, irand, rand, second, srand.
* intrinsic.h: Function prototypes.
* iresolve.c (gfc_resolve_etime_sub, gfc_resolve_second_sub
gfc_resolve_srand): New functions.
libgfortran
* Makefile.am: Add rand.c and etime.c
* Makefile.in: Regenerated.
* aclocal.in: Regenerated.
* cpu_time.c (second_sub, second): New functions.
* rand.c (irand, rand, srand): New file.
* etime.c (etime_sub, etime): New file.
From-SVN: r83034
2004-06-12 19:34:47 +02:00
|
|
|
{
|
|
|
|
memset (date, ' ', DATE_LEN);
|
|
|
|
date[DATE_LEN] = '\0';
|
|
|
|
|
|
|
|
memset (timec, ' ', TIME_LEN);
|
2005-02-19 19:06:00 +01:00
|
|
|
timec[TIME_LEN] = '\0';
|
check.c (gfc_check_second_sub, [...]): New functions.
* check.c (gfc_check_second_sub, gfc_check_irand, gfc_check_rand
gfc_check_srand, gfc_check_etime, gfc_check_etime_sub): New functions.
* gfortran.h (gfc_generic_isym_id): New symbols GFC_ISYM_ETIME,
GFC_ISYM_IRAND, GFC_ISYM_RAND, GFC_ISYM_SECOND.
* trans-intrinsic.c: Use symbols.
* intrinsic.c (add_sym_2s): New function.
* intrinsic.c: Add etime, dtime, irand, rand, second, srand.
* intrinsic.h: Function prototypes.
* iresolve.c (gfc_resolve_etime_sub, gfc_resolve_second_sub
gfc_resolve_srand): New functions.
libgfortran
* Makefile.am: Add rand.c and etime.c
* Makefile.in: Regenerated.
* aclocal.in: Regenerated.
* cpu_time.c (second_sub, second): New functions.
* rand.c (irand, rand, srand): New file.
* etime.c (etime_sub, etime): New file.
From-SVN: r83034
2004-06-12 19:34:47 +02:00
|
|
|
|
|
|
|
memset (zone, ' ', ZONE_LEN);
|
|
|
|
zone[ZONE_LEN] = '\0';
|
|
|
|
|
|
|
|
for (i = 0; i < VALUES_SIZE; i++)
|
2005-02-19 19:06:00 +01:00
|
|
|
values[i] = - GFC_INTEGER_4_HUGE;
|
|
|
|
}
|
|
|
|
#else /* if defined HAVE_NO_DATE_TIME */
|
|
|
|
/* We really have *nothing* to return, so return blanks and HUGE(0). */
|
|
|
|
|
|
|
|
memset (date, ' ', DATE_LEN);
|
|
|
|
date[DATE_LEN] = '\0';
|
|
|
|
|
|
|
|
memset (timec, ' ', TIME_LEN);
|
|
|
|
timec[TIME_LEN] = '\0';
|
|
|
|
|
|
|
|
memset (zone, ' ', ZONE_LEN);
|
|
|
|
zone[ZONE_LEN] = '\0';
|
|
|
|
|
|
|
|
for (i = 0; i < VALUES_SIZE; i++)
|
|
|
|
values[i] = - GFC_INTEGER_4_HUGE;
|
check.c (gfc_check_second_sub, [...]): New functions.
* check.c (gfc_check_second_sub, gfc_check_irand, gfc_check_rand
gfc_check_srand, gfc_check_etime, gfc_check_etime_sub): New functions.
* gfortran.h (gfc_generic_isym_id): New symbols GFC_ISYM_ETIME,
GFC_ISYM_IRAND, GFC_ISYM_RAND, GFC_ISYM_SECOND.
* trans-intrinsic.c: Use symbols.
* intrinsic.c (add_sym_2s): New function.
* intrinsic.c: Add etime, dtime, irand, rand, second, srand.
* intrinsic.h: Function prototypes.
* iresolve.c (gfc_resolve_etime_sub, gfc_resolve_second_sub
gfc_resolve_srand): New functions.
libgfortran
* Makefile.am: Add rand.c and etime.c
* Makefile.in: Regenerated.
* aclocal.in: Regenerated.
* cpu_time.c (second_sub, second): New functions.
* rand.c (irand, rand, srand): New file.
* etime.c (etime_sub, etime): New file.
From-SVN: r83034
2004-06-12 19:34:47 +02:00
|
|
|
#endif /* HAVE_NO_DATE_TIME */
|
|
|
|
|
|
|
|
/* Copy the values into the arguments. */
|
|
|
|
if (__values)
|
|
|
|
{
|
2009-04-08 18:48:07 +02:00
|
|
|
index_type len, delta, elt_size;
|
check.c (gfc_check_second_sub, [...]): New functions.
* check.c (gfc_check_second_sub, gfc_check_irand, gfc_check_rand
gfc_check_srand, gfc_check_etime, gfc_check_etime_sub): New functions.
* gfortran.h (gfc_generic_isym_id): New symbols GFC_ISYM_ETIME,
GFC_ISYM_IRAND, GFC_ISYM_RAND, GFC_ISYM_SECOND.
* trans-intrinsic.c: Use symbols.
* intrinsic.c (add_sym_2s): New function.
* intrinsic.c: Add etime, dtime, irand, rand, second, srand.
* intrinsic.h: Function prototypes.
* iresolve.c (gfc_resolve_etime_sub, gfc_resolve_second_sub
gfc_resolve_srand): New functions.
libgfortran
* Makefile.am: Add rand.c and etime.c
* Makefile.in: Regenerated.
* aclocal.in: Regenerated.
* cpu_time.c (second_sub, second): New functions.
* rand.c (irand, rand, srand): New file.
* etime.c (etime_sub, etime): New file.
From-SVN: r83034
2004-06-12 19:34:47 +02:00
|
|
|
|
|
|
|
elt_size = GFC_DESCRIPTOR_SIZE (__values);
|
|
|
|
len = __values->dim[0].ubound + 1 - __values->dim[0].lbound;
|
|
|
|
delta = __values->dim[0].stride;
|
|
|
|
if (delta == 0)
|
|
|
|
delta = 1;
|
|
|
|
|
|
|
|
assert (len >= VALUES_SIZE);
|
|
|
|
/* Cope with different type kinds. */
|
|
|
|
if (elt_size == 4)
|
|
|
|
{
|
|
|
|
GFC_INTEGER_4 *vptr4 = __values->data;
|
|
|
|
|
|
|
|
for (i = 0; i < VALUES_SIZE; i++, vptr4 += delta)
|
2005-02-19 19:06:00 +01:00
|
|
|
*vptr4 = values[i];
|
check.c (gfc_check_second_sub, [...]): New functions.
* check.c (gfc_check_second_sub, gfc_check_irand, gfc_check_rand
gfc_check_srand, gfc_check_etime, gfc_check_etime_sub): New functions.
* gfortran.h (gfc_generic_isym_id): New symbols GFC_ISYM_ETIME,
GFC_ISYM_IRAND, GFC_ISYM_RAND, GFC_ISYM_SECOND.
* trans-intrinsic.c: Use symbols.
* intrinsic.c (add_sym_2s): New function.
* intrinsic.c: Add etime, dtime, irand, rand, second, srand.
* intrinsic.h: Function prototypes.
* iresolve.c (gfc_resolve_etime_sub, gfc_resolve_second_sub
gfc_resolve_srand): New functions.
libgfortran
* Makefile.am: Add rand.c and etime.c
* Makefile.in: Regenerated.
* aclocal.in: Regenerated.
* cpu_time.c (second_sub, second): New functions.
* rand.c (irand, rand, srand): New file.
* etime.c (etime_sub, etime): New file.
From-SVN: r83034
2004-06-12 19:34:47 +02:00
|
|
|
}
|
|
|
|
else if (elt_size == 8)
|
|
|
|
{
|
|
|
|
GFC_INTEGER_8 *vptr8 = (GFC_INTEGER_8 *)__values->data;
|
|
|
|
|
|
|
|
for (i = 0; i < VALUES_SIZE; i++, vptr8 += delta)
|
|
|
|
{
|
2005-02-19 19:06:00 +01:00
|
|
|
if (values[i] == - GFC_INTEGER_4_HUGE)
|
|
|
|
*vptr8 = - GFC_INTEGER_8_HUGE;
|
check.c (gfc_check_second_sub, [...]): New functions.
* check.c (gfc_check_second_sub, gfc_check_irand, gfc_check_rand
gfc_check_srand, gfc_check_etime, gfc_check_etime_sub): New functions.
* gfortran.h (gfc_generic_isym_id): New symbols GFC_ISYM_ETIME,
GFC_ISYM_IRAND, GFC_ISYM_RAND, GFC_ISYM_SECOND.
* trans-intrinsic.c: Use symbols.
* intrinsic.c (add_sym_2s): New function.
* intrinsic.c: Add etime, dtime, irand, rand, second, srand.
* intrinsic.h: Function prototypes.
* iresolve.c (gfc_resolve_etime_sub, gfc_resolve_second_sub
gfc_resolve_srand): New functions.
libgfortran
* Makefile.am: Add rand.c and etime.c
* Makefile.in: Regenerated.
* aclocal.in: Regenerated.
* cpu_time.c (second_sub, second): New functions.
* rand.c (irand, rand, srand): New file.
* etime.c (etime_sub, etime): New file.
From-SVN: r83034
2004-06-12 19:34:47 +02:00
|
|
|
else
|
|
|
|
*vptr8 = values[i];
|
|
|
|
}
|
|
|
|
}
|
|
|
|
else
|
|
|
|
abort ();
|
|
|
|
}
|
|
|
|
|
|
|
|
if (__zone)
|
|
|
|
{
|
|
|
|
assert (__zone_len >= ZONE_LEN);
|
|
|
|
fstrcpy (__zone, ZONE_LEN, zone, ZONE_LEN);
|
|
|
|
}
|
|
|
|
|
|
|
|
if (__time)
|
|
|
|
{
|
|
|
|
assert (__time_len >= TIME_LEN);
|
|
|
|
fstrcpy (__time, TIME_LEN, timec, TIME_LEN);
|
|
|
|
}
|
|
|
|
|
|
|
|
if (__date)
|
|
|
|
{
|
|
|
|
assert (__date_len >= DATE_LEN);
|
|
|
|
fstrcpy (__date, DATE_LEN, date, DATE_LEN);
|
|
|
|
}
|
|
|
|
}
|
2005-11-01 06:53:29 +01:00
|
|
|
|
|
|
|
|
|
|
|
/* SECNDS (X) - Non-standard
|
|
|
|
|
|
|
|
Description: Returns the system time of day, or elapsed time, as a GFC_REAL_4
|
|
|
|
in seconds.
|
|
|
|
|
|
|
|
Class: Non-elemental subroutine.
|
|
|
|
|
|
|
|
Arguments:
|
|
|
|
|
|
|
|
X must be REAL(4) and the result is of the same type. The accuracy is system
|
|
|
|
dependent.
|
|
|
|
|
|
|
|
Usage:
|
|
|
|
|
|
|
|
T = SECNDS (X)
|
|
|
|
|
|
|
|
yields the time in elapsed seconds since X. If X is 0.0, T is the time in
|
|
|
|
seconds since midnight. Note that a time that spans midnight but is less than
|
|
|
|
24hours will be calculated correctly. */
|
|
|
|
|
|
|
|
extern GFC_REAL_4 secnds (GFC_REAL_4 *);
|
|
|
|
export_proto(secnds);
|
|
|
|
|
|
|
|
GFC_REAL_4
|
|
|
|
secnds (GFC_REAL_4 *x)
|
|
|
|
{
|
|
|
|
GFC_INTEGER_4 values[VALUES_SIZE];
|
|
|
|
GFC_REAL_4 temp1, temp2;
|
|
|
|
|
|
|
|
/* Make the INTEGER*4 array for passing to date_and_time. */
|
|
|
|
gfc_array_i4 *avalues = internal_malloc_size (sizeof (gfc_array_i4));
|
|
|
|
avalues->data = &values[0];
|
|
|
|
GFC_DESCRIPTOR_DTYPE (avalues) = ((GFC_DTYPE_REAL << GFC_DTYPE_TYPE_SHIFT)
|
|
|
|
& GFC_DTYPE_TYPE_MASK) +
|
|
|
|
(4 << GFC_DTYPE_SIZE_SHIFT);
|
|
|
|
|
|
|
|
avalues->dim[0].ubound = 7;
|
|
|
|
avalues->dim[0].lbound = 0;
|
|
|
|
avalues->dim[0].stride = 1;
|
|
|
|
|
|
|
|
date_and_time (NULL, NULL, NULL, avalues, 0, 0, 0);
|
|
|
|
|
|
|
|
free_mem (avalues);
|
|
|
|
|
|
|
|
temp1 = 3600.0 * (GFC_REAL_4)values[4] +
|
|
|
|
60.0 * (GFC_REAL_4)values[5] +
|
|
|
|
(GFC_REAL_4)values[6] +
|
|
|
|
0.001 * (GFC_REAL_4)values[7];
|
|
|
|
temp2 = fmod (*x, 86400.0);
|
2006-09-15 18:03:52 +02:00
|
|
|
temp2 = (temp1 - temp2 >= 0.0) ? temp2 : (temp2 - 86400.0);
|
2005-11-01 06:53:29 +01:00
|
|
|
return temp1 - temp2;
|
|
|
|
}
|
2006-07-04 13:39:46 +02:00
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
/* ITIME(X) - Non-standard
|
|
|
|
|
|
|
|
Description: Returns the current local time hour, minutes, and seconds
|
|
|
|
in elements 1, 2, and 3 of X, respectively. */
|
|
|
|
|
|
|
|
static void
|
|
|
|
itime0 (int x[3])
|
|
|
|
{
|
|
|
|
#ifndef HAVE_NO_DATE_TIME
|
|
|
|
time_t lt;
|
|
|
|
struct tm local_time;
|
|
|
|
|
|
|
|
lt = time (NULL);
|
|
|
|
|
|
|
|
if (lt != (time_t) -1)
|
|
|
|
{
|
|
|
|
local_time = *localtime (<);
|
|
|
|
|
|
|
|
x[0] = local_time.tm_hour;
|
|
|
|
x[1] = local_time.tm_min;
|
|
|
|
x[2] = local_time.tm_sec;
|
|
|
|
}
|
|
|
|
#else
|
|
|
|
x[0] = x[1] = x[2] = -1;
|
|
|
|
#endif
|
|
|
|
}
|
|
|
|
|
|
|
|
extern void itime_i4 (gfc_array_i4 *);
|
|
|
|
export_proto(itime_i4);
|
|
|
|
|
|
|
|
void
|
|
|
|
itime_i4 (gfc_array_i4 *__values)
|
|
|
|
{
|
|
|
|
int x[3], i;
|
2009-04-08 18:48:07 +02:00
|
|
|
index_type len, delta;
|
2006-07-04 13:39:46 +02:00
|
|
|
GFC_INTEGER_4 *vptr;
|
|
|
|
|
|
|
|
/* Call helper function. */
|
|
|
|
itime0(x);
|
|
|
|
|
|
|
|
/* Copy the value into the array. */
|
|
|
|
len = __values->dim[0].ubound + 1 - __values->dim[0].lbound;
|
|
|
|
assert (len >= 3);
|
|
|
|
delta = __values->dim[0].stride;
|
|
|
|
if (delta == 0)
|
|
|
|
delta = 1;
|
|
|
|
|
|
|
|
vptr = __values->data;
|
|
|
|
for (i = 0; i < 3; i++, vptr += delta)
|
|
|
|
*vptr = x[i];
|
|
|
|
}
|
|
|
|
|
|
|
|
|
|
|
|
extern void itime_i8 (gfc_array_i8 *);
|
|
|
|
export_proto(itime_i8);
|
|
|
|
|
|
|
|
void
|
|
|
|
itime_i8 (gfc_array_i8 *__values)
|
|
|
|
{
|
|
|
|
int x[3], i;
|
2009-04-08 18:48:07 +02:00
|
|
|
index_type len, delta;
|
2006-07-04 13:39:46 +02:00
|
|
|
GFC_INTEGER_8 *vptr;
|
|
|
|
|
|
|
|
/* Call helper function. */
|
|
|
|
itime0(x);
|
|
|
|
|
|
|
|
/* Copy the value into the array. */
|
|
|
|
len = __values->dim[0].ubound + 1 - __values->dim[0].lbound;
|
|
|
|
assert (len >= 3);
|
|
|
|
delta = __values->dim[0].stride;
|
|
|
|
if (delta == 0)
|
|
|
|
delta = 1;
|
|
|
|
|
|
|
|
vptr = __values->data;
|
|
|
|
for (i = 0; i < 3; i++, vptr += delta)
|
|
|
|
*vptr = x[i];
|
|
|
|
}
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
/* IDATE(X) - Non-standard
|
|
|
|
|
|
|
|
Description: Fills TArray with the numerical values at the current
|
|
|
|
local time. The day (in the range 1-31), month (in the range 1-12),
|
|
|
|
and year appear in elements 1, 2, and 3 of X, respectively.
|
|
|
|
The year has four significant digits. */
|
|
|
|
|
|
|
|
static void
|
|
|
|
idate0 (int x[3])
|
|
|
|
{
|
|
|
|
#ifndef HAVE_NO_DATE_TIME
|
|
|
|
time_t lt;
|
|
|
|
struct tm local_time;
|
|
|
|
|
|
|
|
lt = time (NULL);
|
|
|
|
|
|
|
|
if (lt != (time_t) -1)
|
|
|
|
{
|
|
|
|
local_time = *localtime (<);
|
|
|
|
|
|
|
|
x[0] = local_time.tm_mday;
|
|
|
|
x[1] = 1 + local_time.tm_mon;
|
|
|
|
x[2] = 1900 + local_time.tm_year;
|
|
|
|
}
|
|
|
|
#else
|
|
|
|
x[0] = x[1] = x[2] = -1;
|
|
|
|
#endif
|
|
|
|
}
|
|
|
|
|
|
|
|
extern void idate_i4 (gfc_array_i4 *);
|
|
|
|
export_proto(idate_i4);
|
|
|
|
|
|
|
|
void
|
|
|
|
idate_i4 (gfc_array_i4 *__values)
|
|
|
|
{
|
|
|
|
int x[3], i;
|
2009-04-08 18:48:07 +02:00
|
|
|
index_type len, delta;
|
2006-07-04 13:39:46 +02:00
|
|
|
GFC_INTEGER_4 *vptr;
|
|
|
|
|
|
|
|
/* Call helper function. */
|
|
|
|
idate0(x);
|
|
|
|
|
|
|
|
/* Copy the value into the array. */
|
|
|
|
len = __values->dim[0].ubound + 1 - __values->dim[0].lbound;
|
|
|
|
assert (len >= 3);
|
|
|
|
delta = __values->dim[0].stride;
|
|
|
|
if (delta == 0)
|
|
|
|
delta = 1;
|
|
|
|
|
|
|
|
vptr = __values->data;
|
|
|
|
for (i = 0; i < 3; i++, vptr += delta)
|
|
|
|
*vptr = x[i];
|
|
|
|
}
|
|
|
|
|
|
|
|
|
|
|
|
extern void idate_i8 (gfc_array_i8 *);
|
|
|
|
export_proto(idate_i8);
|
|
|
|
|
|
|
|
void
|
|
|
|
idate_i8 (gfc_array_i8 *__values)
|
|
|
|
{
|
|
|
|
int x[3], i;
|
2009-04-08 18:48:07 +02:00
|
|
|
index_type len, delta;
|
2006-07-04 13:39:46 +02:00
|
|
|
GFC_INTEGER_8 *vptr;
|
|
|
|
|
|
|
|
/* Call helper function. */
|
|
|
|
idate0(x);
|
|
|
|
|
|
|
|
/* Copy the value into the array. */
|
|
|
|
len = __values->dim[0].ubound + 1 - __values->dim[0].lbound;
|
|
|
|
assert (len >= 3);
|
|
|
|
delta = __values->dim[0].stride;
|
|
|
|
if (delta == 0)
|
|
|
|
delta = 1;
|
|
|
|
|
|
|
|
vptr = __values->data;
|
|
|
|
for (i = 0; i < 3; i++, vptr += delta)
|
|
|
|
*vptr = x[i];
|
|
|
|
}
|
intrinsic.c (add_functions): Add ACCESS, CHMOD, RSHIFT, LSHIFT.
* intrinsic.c (add_functions): Add ACCESS, CHMOD, RSHIFT, LSHIFT.
(add_subroutines): Add LTIME, GMTIME and CHMOD.
* intrinsic.h (gfc_check_access_func, gfc_check_chmod,
gfc_check_chmod_sub, gfc_check_ltime_gmtime, gfc_simplify_rshift,
gfc_simplify_lshift, gfc_resolve_access, gfc_resolve_chmod,
gfc_resolve_rshift, gfc_resolve_lshift, gfc_resolve_chmod_sub,
gfc_resolve_gmtime, gfc_resolve_ltime): Add prototypes.
* gfortran.h (gfc_generic_isym_id): Add GFC_ISYM_ACCESS,
GFC_ISYM_CHMOD, GFC_ISYM_LSHIFT, GFC_ISYM_RSHIFT.
* iresolve.c (gfc_resolve_access, gfc_resolve_chmod,
gfc_resolve_rshift, gfc_resolve_lshift, gfc_resolve_chmod_sub,
gfc_resolve_gmtime, gfc_resolve_ltime): New functions.
* check.c (gfc_check_access_func, gfc_check_chmod,
gfc_check_chmod_sub, gfc_check_ltime_gmtime): New functions.
* trans-intrinsic.c (gfc_conv_intrinsic_rlshift): New function.
(gfc_conv_intrinsic_function): Add cases for the new GFC_ISYM_*.
* intrinsics/date_and_time.c: Add functions for GMTIME and LTIME.
* intrinsics/access.c: New file.
* intrinsics/chmod.c: New file.
* configure.ac: Add checks for <sys/wait.h>, access, fork,execl
and wait.
* Makefile.am: Add new files intrinsics/access.c and
intrinsics/chmod.c.
* configure: Regenerate.
* config.h.in: Regenerate.
* Makefile.in: Regenerate.
* gcc/testsuite/gfortran.dg/chmod_3.f90: New test.
* gcc/testsuite/gfortran.dg/ltime_gmtime_1.f90: New test.
* gcc/testsuite/gfortran.dg/ltime_gmtime_2.f90: New test.
* gcc/testsuite/gfortran.dg/lrshift_1.f90: New test.
* gcc/testsuite/gfortran.dg/chmod_1.f90: New test.
* gcc/testsuite/gfortran.dg/chmod_2.f90: New test.
From-SVN: r115825
2006-07-30 22:48:00 +02:00
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
/* GMTIME(STIME, TARRAY) - Non-standard
|
|
|
|
|
|
|
|
Description: Given a system time value STime, fills TArray with values
|
|
|
|
extracted from it appropriate to the GMT time zone using gmtime(3).
|
|
|
|
|
|
|
|
The array elements are as follows:
|
|
|
|
|
|
|
|
1. Seconds after the minute, range 0-59 or 0-61 to allow for leap seconds
|
|
|
|
2. Minutes after the hour, range 0-59
|
|
|
|
3. Hours past midnight, range 0-23
|
|
|
|
4. Day of month, range 0-31
|
|
|
|
5. Number of months since January, range 0-11
|
|
|
|
6. Years since 1900
|
|
|
|
7. Number of days since Sunday, range 0-6
|
|
|
|
8. Days since January 1
|
|
|
|
9. Daylight savings indicator: positive if daylight savings is in effect,
|
|
|
|
zero if not, and negative if the information isn't available. */
|
|
|
|
|
|
|
|
static void
|
|
|
|
gmtime_0 (const time_t * t, int x[9])
|
|
|
|
{
|
|
|
|
struct tm lt;
|
|
|
|
|
|
|
|
lt = *gmtime (t);
|
|
|
|
x[0] = lt.tm_sec;
|
|
|
|
x[1] = lt.tm_min;
|
|
|
|
x[2] = lt.tm_hour;
|
|
|
|
x[3] = lt.tm_mday;
|
|
|
|
x[4] = lt.tm_mon;
|
|
|
|
x[5] = lt.tm_year;
|
|
|
|
x[6] = lt.tm_wday;
|
|
|
|
x[7] = lt.tm_yday;
|
|
|
|
x[8] = lt.tm_isdst;
|
|
|
|
}
|
|
|
|
|
|
|
|
extern void gmtime_i4 (GFC_INTEGER_4 *, gfc_array_i4 *);
|
|
|
|
export_proto(gmtime_i4);
|
|
|
|
|
|
|
|
void
|
|
|
|
gmtime_i4 (GFC_INTEGER_4 * t, gfc_array_i4 * tarray)
|
|
|
|
{
|
|
|
|
int x[9], i;
|
2009-04-08 18:48:07 +02:00
|
|
|
index_type len, delta;
|
intrinsic.c (add_functions): Add ACCESS, CHMOD, RSHIFT, LSHIFT.
* intrinsic.c (add_functions): Add ACCESS, CHMOD, RSHIFT, LSHIFT.
(add_subroutines): Add LTIME, GMTIME and CHMOD.
* intrinsic.h (gfc_check_access_func, gfc_check_chmod,
gfc_check_chmod_sub, gfc_check_ltime_gmtime, gfc_simplify_rshift,
gfc_simplify_lshift, gfc_resolve_access, gfc_resolve_chmod,
gfc_resolve_rshift, gfc_resolve_lshift, gfc_resolve_chmod_sub,
gfc_resolve_gmtime, gfc_resolve_ltime): Add prototypes.
* gfortran.h (gfc_generic_isym_id): Add GFC_ISYM_ACCESS,
GFC_ISYM_CHMOD, GFC_ISYM_LSHIFT, GFC_ISYM_RSHIFT.
* iresolve.c (gfc_resolve_access, gfc_resolve_chmod,
gfc_resolve_rshift, gfc_resolve_lshift, gfc_resolve_chmod_sub,
gfc_resolve_gmtime, gfc_resolve_ltime): New functions.
* check.c (gfc_check_access_func, gfc_check_chmod,
gfc_check_chmod_sub, gfc_check_ltime_gmtime): New functions.
* trans-intrinsic.c (gfc_conv_intrinsic_rlshift): New function.
(gfc_conv_intrinsic_function): Add cases for the new GFC_ISYM_*.
* intrinsics/date_and_time.c: Add functions for GMTIME and LTIME.
* intrinsics/access.c: New file.
* intrinsics/chmod.c: New file.
* configure.ac: Add checks for <sys/wait.h>, access, fork,execl
and wait.
* Makefile.am: Add new files intrinsics/access.c and
intrinsics/chmod.c.
* configure: Regenerate.
* config.h.in: Regenerate.
* Makefile.in: Regenerate.
* gcc/testsuite/gfortran.dg/chmod_3.f90: New test.
* gcc/testsuite/gfortran.dg/ltime_gmtime_1.f90: New test.
* gcc/testsuite/gfortran.dg/ltime_gmtime_2.f90: New test.
* gcc/testsuite/gfortran.dg/lrshift_1.f90: New test.
* gcc/testsuite/gfortran.dg/chmod_1.f90: New test.
* gcc/testsuite/gfortran.dg/chmod_2.f90: New test.
From-SVN: r115825
2006-07-30 22:48:00 +02:00
|
|
|
GFC_INTEGER_4 *vptr;
|
|
|
|
time_t tt;
|
|
|
|
|
|
|
|
/* Call helper function. */
|
|
|
|
tt = (time_t) *t;
|
|
|
|
gmtime_0(&tt, x);
|
|
|
|
|
|
|
|
/* Copy the values into the array. */
|
|
|
|
len = tarray->dim[0].ubound + 1 - tarray->dim[0].lbound;
|
|
|
|
assert (len >= 9);
|
|
|
|
delta = tarray->dim[0].stride;
|
|
|
|
if (delta == 0)
|
|
|
|
delta = 1;
|
|
|
|
|
|
|
|
vptr = tarray->data;
|
|
|
|
for (i = 0; i < 9; i++, vptr += delta)
|
|
|
|
*vptr = x[i];
|
|
|
|
}
|
|
|
|
|
|
|
|
extern void gmtime_i8 (GFC_INTEGER_8 *, gfc_array_i8 *);
|
|
|
|
export_proto(gmtime_i8);
|
|
|
|
|
|
|
|
void
|
|
|
|
gmtime_i8 (GFC_INTEGER_8 * t, gfc_array_i8 * tarray)
|
|
|
|
{
|
|
|
|
int x[9], i;
|
2009-04-08 18:48:07 +02:00
|
|
|
index_type len, delta;
|
intrinsic.c (add_functions): Add ACCESS, CHMOD, RSHIFT, LSHIFT.
* intrinsic.c (add_functions): Add ACCESS, CHMOD, RSHIFT, LSHIFT.
(add_subroutines): Add LTIME, GMTIME and CHMOD.
* intrinsic.h (gfc_check_access_func, gfc_check_chmod,
gfc_check_chmod_sub, gfc_check_ltime_gmtime, gfc_simplify_rshift,
gfc_simplify_lshift, gfc_resolve_access, gfc_resolve_chmod,
gfc_resolve_rshift, gfc_resolve_lshift, gfc_resolve_chmod_sub,
gfc_resolve_gmtime, gfc_resolve_ltime): Add prototypes.
* gfortran.h (gfc_generic_isym_id): Add GFC_ISYM_ACCESS,
GFC_ISYM_CHMOD, GFC_ISYM_LSHIFT, GFC_ISYM_RSHIFT.
* iresolve.c (gfc_resolve_access, gfc_resolve_chmod,
gfc_resolve_rshift, gfc_resolve_lshift, gfc_resolve_chmod_sub,
gfc_resolve_gmtime, gfc_resolve_ltime): New functions.
* check.c (gfc_check_access_func, gfc_check_chmod,
gfc_check_chmod_sub, gfc_check_ltime_gmtime): New functions.
* trans-intrinsic.c (gfc_conv_intrinsic_rlshift): New function.
(gfc_conv_intrinsic_function): Add cases for the new GFC_ISYM_*.
* intrinsics/date_and_time.c: Add functions for GMTIME and LTIME.
* intrinsics/access.c: New file.
* intrinsics/chmod.c: New file.
* configure.ac: Add checks for <sys/wait.h>, access, fork,execl
and wait.
* Makefile.am: Add new files intrinsics/access.c and
intrinsics/chmod.c.
* configure: Regenerate.
* config.h.in: Regenerate.
* Makefile.in: Regenerate.
* gcc/testsuite/gfortran.dg/chmod_3.f90: New test.
* gcc/testsuite/gfortran.dg/ltime_gmtime_1.f90: New test.
* gcc/testsuite/gfortran.dg/ltime_gmtime_2.f90: New test.
* gcc/testsuite/gfortran.dg/lrshift_1.f90: New test.
* gcc/testsuite/gfortran.dg/chmod_1.f90: New test.
* gcc/testsuite/gfortran.dg/chmod_2.f90: New test.
From-SVN: r115825
2006-07-30 22:48:00 +02:00
|
|
|
GFC_INTEGER_8 *vptr;
|
|
|
|
time_t tt;
|
|
|
|
|
|
|
|
/* Call helper function. */
|
|
|
|
tt = (time_t) *t;
|
|
|
|
gmtime_0(&tt, x);
|
|
|
|
|
|
|
|
/* Copy the values into the array. */
|
|
|
|
len = tarray->dim[0].ubound + 1 - tarray->dim[0].lbound;
|
|
|
|
assert (len >= 9);
|
|
|
|
delta = tarray->dim[0].stride;
|
|
|
|
if (delta == 0)
|
|
|
|
delta = 1;
|
|
|
|
|
|
|
|
vptr = tarray->data;
|
|
|
|
for (i = 0; i < 9; i++, vptr += delta)
|
|
|
|
*vptr = x[i];
|
|
|
|
}
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
/* LTIME(STIME, TARRAY) - Non-standard
|
|
|
|
|
|
|
|
Description: Given a system time value STime, fills TArray with values
|
|
|
|
extracted from it appropriate to the local time zone using localtime(3).
|
|
|
|
|
|
|
|
The array elements are as follows:
|
|
|
|
|
|
|
|
1. Seconds after the minute, range 0-59 or 0-61 to allow for leap seconds
|
|
|
|
2. Minutes after the hour, range 0-59
|
|
|
|
3. Hours past midnight, range 0-23
|
|
|
|
4. Day of month, range 0-31
|
|
|
|
5. Number of months since January, range 0-11
|
|
|
|
6. Years since 1900
|
|
|
|
7. Number of days since Sunday, range 0-6
|
|
|
|
8. Days since January 1
|
|
|
|
9. Daylight savings indicator: positive if daylight savings is in effect,
|
|
|
|
zero if not, and negative if the information isn't available. */
|
|
|
|
|
|
|
|
static void
|
|
|
|
ltime_0 (const time_t * t, int x[9])
|
|
|
|
{
|
|
|
|
struct tm lt;
|
|
|
|
|
|
|
|
lt = *localtime (t);
|
|
|
|
x[0] = lt.tm_sec;
|
|
|
|
x[1] = lt.tm_min;
|
|
|
|
x[2] = lt.tm_hour;
|
|
|
|
x[3] = lt.tm_mday;
|
|
|
|
x[4] = lt.tm_mon;
|
|
|
|
x[5] = lt.tm_year;
|
|
|
|
x[6] = lt.tm_wday;
|
|
|
|
x[7] = lt.tm_yday;
|
|
|
|
x[8] = lt.tm_isdst;
|
|
|
|
}
|
|
|
|
|
|
|
|
extern void ltime_i4 (GFC_INTEGER_4 *, gfc_array_i4 *);
|
|
|
|
export_proto(ltime_i4);
|
|
|
|
|
|
|
|
void
|
|
|
|
ltime_i4 (GFC_INTEGER_4 * t, gfc_array_i4 * tarray)
|
|
|
|
{
|
|
|
|
int x[9], i;
|
2009-04-08 18:48:07 +02:00
|
|
|
index_type len, delta;
|
intrinsic.c (add_functions): Add ACCESS, CHMOD, RSHIFT, LSHIFT.
* intrinsic.c (add_functions): Add ACCESS, CHMOD, RSHIFT, LSHIFT.
(add_subroutines): Add LTIME, GMTIME and CHMOD.
* intrinsic.h (gfc_check_access_func, gfc_check_chmod,
gfc_check_chmod_sub, gfc_check_ltime_gmtime, gfc_simplify_rshift,
gfc_simplify_lshift, gfc_resolve_access, gfc_resolve_chmod,
gfc_resolve_rshift, gfc_resolve_lshift, gfc_resolve_chmod_sub,
gfc_resolve_gmtime, gfc_resolve_ltime): Add prototypes.
* gfortran.h (gfc_generic_isym_id): Add GFC_ISYM_ACCESS,
GFC_ISYM_CHMOD, GFC_ISYM_LSHIFT, GFC_ISYM_RSHIFT.
* iresolve.c (gfc_resolve_access, gfc_resolve_chmod,
gfc_resolve_rshift, gfc_resolve_lshift, gfc_resolve_chmod_sub,
gfc_resolve_gmtime, gfc_resolve_ltime): New functions.
* check.c (gfc_check_access_func, gfc_check_chmod,
gfc_check_chmod_sub, gfc_check_ltime_gmtime): New functions.
* trans-intrinsic.c (gfc_conv_intrinsic_rlshift): New function.
(gfc_conv_intrinsic_function): Add cases for the new GFC_ISYM_*.
* intrinsics/date_and_time.c: Add functions for GMTIME and LTIME.
* intrinsics/access.c: New file.
* intrinsics/chmod.c: New file.
* configure.ac: Add checks for <sys/wait.h>, access, fork,execl
and wait.
* Makefile.am: Add new files intrinsics/access.c and
intrinsics/chmod.c.
* configure: Regenerate.
* config.h.in: Regenerate.
* Makefile.in: Regenerate.
* gcc/testsuite/gfortran.dg/chmod_3.f90: New test.
* gcc/testsuite/gfortran.dg/ltime_gmtime_1.f90: New test.
* gcc/testsuite/gfortran.dg/ltime_gmtime_2.f90: New test.
* gcc/testsuite/gfortran.dg/lrshift_1.f90: New test.
* gcc/testsuite/gfortran.dg/chmod_1.f90: New test.
* gcc/testsuite/gfortran.dg/chmod_2.f90: New test.
From-SVN: r115825
2006-07-30 22:48:00 +02:00
|
|
|
GFC_INTEGER_4 *vptr;
|
|
|
|
time_t tt;
|
|
|
|
|
|
|
|
/* Call helper function. */
|
|
|
|
tt = (time_t) *t;
|
|
|
|
ltime_0(&tt, x);
|
|
|
|
|
|
|
|
/* Copy the values into the array. */
|
|
|
|
len = tarray->dim[0].ubound + 1 - tarray->dim[0].lbound;
|
|
|
|
assert (len >= 9);
|
|
|
|
delta = tarray->dim[0].stride;
|
|
|
|
if (delta == 0)
|
|
|
|
delta = 1;
|
|
|
|
|
|
|
|
vptr = tarray->data;
|
|
|
|
for (i = 0; i < 9; i++, vptr += delta)
|
|
|
|
*vptr = x[i];
|
|
|
|
}
|
|
|
|
|
|
|
|
extern void ltime_i8 (GFC_INTEGER_8 *, gfc_array_i8 *);
|
|
|
|
export_proto(ltime_i8);
|
|
|
|
|
|
|
|
void
|
|
|
|
ltime_i8 (GFC_INTEGER_8 * t, gfc_array_i8 * tarray)
|
|
|
|
{
|
|
|
|
int x[9], i;
|
2009-04-08 18:48:07 +02:00
|
|
|
index_type len, delta;
|
intrinsic.c (add_functions): Add ACCESS, CHMOD, RSHIFT, LSHIFT.
* intrinsic.c (add_functions): Add ACCESS, CHMOD, RSHIFT, LSHIFT.
(add_subroutines): Add LTIME, GMTIME and CHMOD.
* intrinsic.h (gfc_check_access_func, gfc_check_chmod,
gfc_check_chmod_sub, gfc_check_ltime_gmtime, gfc_simplify_rshift,
gfc_simplify_lshift, gfc_resolve_access, gfc_resolve_chmod,
gfc_resolve_rshift, gfc_resolve_lshift, gfc_resolve_chmod_sub,
gfc_resolve_gmtime, gfc_resolve_ltime): Add prototypes.
* gfortran.h (gfc_generic_isym_id): Add GFC_ISYM_ACCESS,
GFC_ISYM_CHMOD, GFC_ISYM_LSHIFT, GFC_ISYM_RSHIFT.
* iresolve.c (gfc_resolve_access, gfc_resolve_chmod,
gfc_resolve_rshift, gfc_resolve_lshift, gfc_resolve_chmod_sub,
gfc_resolve_gmtime, gfc_resolve_ltime): New functions.
* check.c (gfc_check_access_func, gfc_check_chmod,
gfc_check_chmod_sub, gfc_check_ltime_gmtime): New functions.
* trans-intrinsic.c (gfc_conv_intrinsic_rlshift): New function.
(gfc_conv_intrinsic_function): Add cases for the new GFC_ISYM_*.
* intrinsics/date_and_time.c: Add functions for GMTIME and LTIME.
* intrinsics/access.c: New file.
* intrinsics/chmod.c: New file.
* configure.ac: Add checks for <sys/wait.h>, access, fork,execl
and wait.
* Makefile.am: Add new files intrinsics/access.c and
intrinsics/chmod.c.
* configure: Regenerate.
* config.h.in: Regenerate.
* Makefile.in: Regenerate.
* gcc/testsuite/gfortran.dg/chmod_3.f90: New test.
* gcc/testsuite/gfortran.dg/ltime_gmtime_1.f90: New test.
* gcc/testsuite/gfortran.dg/ltime_gmtime_2.f90: New test.
* gcc/testsuite/gfortran.dg/lrshift_1.f90: New test.
* gcc/testsuite/gfortran.dg/chmod_1.f90: New test.
* gcc/testsuite/gfortran.dg/chmod_2.f90: New test.
From-SVN: r115825
2006-07-30 22:48:00 +02:00
|
|
|
GFC_INTEGER_8 *vptr;
|
|
|
|
time_t tt;
|
|
|
|
|
|
|
|
/* Call helper function. */
|
|
|
|
tt = (time_t) * t;
|
|
|
|
ltime_0(&tt, x);
|
|
|
|
|
|
|
|
/* Copy the values into the array. */
|
|
|
|
len = tarray->dim[0].ubound + 1 - tarray->dim[0].lbound;
|
|
|
|
assert (len >= 9);
|
|
|
|
delta = tarray->dim[0].stride;
|
|
|
|
if (delta == 0)
|
|
|
|
delta = 1;
|
|
|
|
|
|
|
|
vptr = tarray->data;
|
|
|
|
for (i = 0; i < 9; i++, vptr += delta)
|
|
|
|
*vptr = x[i];
|
|
|
|
}
|
|
|
|
|
|
|
|
|