summaryrefslogtreecommitdiff
diff options
context:
space:
mode:
authorfxcoudert <fxcoudert@138bc75d-0d04-0410-961f-82ee72b054a4>2006-07-30 20:48:00 +0000
committerfxcoudert <fxcoudert@138bc75d-0d04-0410-961f-82ee72b054a4>2006-07-30 20:48:00 +0000
commitd2fc5bb1c109c1afbe52c970650c2cc250b95459 (patch)
tree42900f38bd309eacda612a5027a33176a6f75fb0
parent5d87d34c2adc7950a04fda3147e59ab7ff527639 (diff)
downloadgcc-d2fc5bb1c109c1afbe52c970650c2cc250b95459.tar.gz
* 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. git-svn-id: svn+ssh://gcc.gnu.org/svn/gcc/trunk@115825 138bc75d-0d04-0410-961f-82ee72b054a4
-rw-r--r--gcc/fortran/ChangeLog19
-rw-r--r--gcc/fortran/check.c82
-rw-r--r--gcc/fortran/gfortran.h4
-rw-r--r--gcc/fortran/intrinsic.c43
-rw-r--r--gcc/fortran/intrinsic.h13
-rw-r--r--gcc/fortran/iresolve.c73
-rw-r--r--gcc/fortran/trans-intrinsic.c26
-rw-r--r--gcc/testsuite/gfortran.dg/chmod_1.f9034
-rw-r--r--gcc/testsuite/gfortran.dg/chmod_2.f9034
-rw-r--r--gcc/testsuite/gfortran.dg/chmod_3.f9034
-rw-r--r--gcc/testsuite/gfortran.dg/lrshift_1.f9018
-rw-r--r--gcc/testsuite/gfortran.dg/ltime_gmtime_1.f909
-rw-r--r--gcc/testsuite/gfortran.dg/ltime_gmtime_2.f909
-rw-r--r--libgfortran/Makefile.am2
-rw-r--r--libgfortran/Makefile.in14
-rw-r--r--libgfortran/config.h.in15
-rwxr-xr-xlibgfortran/configure183
-rw-r--r--libgfortran/configure.ac5
-rw-r--r--libgfortran/intrinsics/access.c99
-rw-r--r--libgfortran/intrinsics/chmod.c131
-rw-r--r--libgfortran/intrinsics/date_and_time.c185
21 files changed, 960 insertions, 72 deletions
diff --git a/gcc/fortran/ChangeLog b/gcc/fortran/ChangeLog
index 3d893ed587d..bb84735d21a 100644
--- a/gcc/fortran/ChangeLog
+++ b/gcc/fortran/ChangeLog
@@ -1,3 +1,22 @@
+2006-07-30 Francois-Xavier Coudert <coudert@clipper.ens.fr>
+
+ * 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_*.
+
2006-07-28 Volker Reichelt <reichelt@igpm.rwth-aachen.de>
* Make-lang.in: Use $(HEADER_H) instead of header.h in dependencies.
diff --git a/gcc/fortran/check.c b/gcc/fortran/check.c
index 4384fdb01cd..23658221705 100644
--- a/gcc/fortran/check.c
+++ b/gcc/fortran/check.c
@@ -443,6 +443,22 @@ gfc_check_achar (gfc_expr * a)
try
+gfc_check_access_func (gfc_expr * name, gfc_expr * mode)
+{
+ if (type_check (name, 0, BT_CHARACTER) == FAILURE
+ || scalar_check (name, 0) == FAILURE)
+ return FAILURE;
+
+
+ if (type_check (mode, 1, BT_CHARACTER) == FAILURE
+ || scalar_check (mode, 1) == FAILURE)
+ return FAILURE;
+
+ return SUCCESS;
+}
+
+
+try
gfc_check_all_any (gfc_expr * mask, gfc_expr * dim)
{
if (logical_array_check (mask, 0) == FAILURE)
@@ -678,6 +694,41 @@ gfc_check_chdir_sub (gfc_expr * dir, gfc_expr * status)
try
+gfc_check_chmod (gfc_expr * name, gfc_expr * mode)
+{
+ if (type_check (name, 0, BT_CHARACTER) == FAILURE)
+ return FAILURE;
+
+ if (type_check (mode, 1, BT_CHARACTER) == FAILURE)
+ return FAILURE;
+
+ return SUCCESS;
+}
+
+
+try
+gfc_check_chmod_sub (gfc_expr * name, gfc_expr * mode, gfc_expr * status)
+{
+ if (type_check (name, 0, BT_CHARACTER) == FAILURE)
+ return FAILURE;
+
+ if (type_check (mode, 1, BT_CHARACTER) == FAILURE)
+ return FAILURE;
+
+ if (status == NULL)
+ return SUCCESS;
+
+ if (type_check (status, 2, BT_INTEGER) == FAILURE)
+ return FAILURE;
+
+ if (scalar_check (status, 2) == FAILURE)
+ return FAILURE;
+
+ return SUCCESS;
+}
+
+
+try
gfc_check_cmplx (gfc_expr * x, gfc_expr * y, gfc_expr * kind)
{
if (numeric_check (x, 0) == FAILURE)
@@ -3085,6 +3136,37 @@ gfc_check_itime_idate (gfc_expr * values)
try
+gfc_check_ltime_gmtime (gfc_expr * time, gfc_expr * values)
+{
+ if (type_check (time, 0, BT_INTEGER) == FAILURE)
+ return FAILURE;
+
+ if (kind_value_check(time, 0, gfc_default_integer_kind) == FAILURE)
+ return FAILURE;
+
+ if (scalar_check (time, 0) == FAILURE)
+ return FAILURE;
+
+ if (array_check (values, 1) == FAILURE)
+ return FAILURE;
+
+ if (rank_check (values, 1, 1) == FAILURE)
+ return FAILURE;
+
+ if (variable_check (values, 1) == FAILURE)
+ return FAILURE;
+
+ if (type_check (values, 1, BT_INTEGER) == FAILURE)
+ return FAILURE;
+
+ if (kind_value_check(values, 1, gfc_default_integer_kind) == FAILURE)
+ return FAILURE;
+
+ return SUCCESS;
+}
+
+
+try
gfc_check_ttynam_sub (gfc_expr * unit, gfc_expr * name)
{
if (scalar_check (unit, 0) == FAILURE)
diff --git a/gcc/fortran/gfortran.h b/gcc/fortran/gfortran.h
index ba73d1d05d0..7335d942d48 100644
--- a/gcc/fortran/gfortran.h
+++ b/gcc/fortran/gfortran.h
@@ -304,6 +304,7 @@ enum gfc_generic_isym_id
the backend (eg. KIND). */
GFC_ISYM_NONE = 0,
GFC_ISYM_ABS,
+ GFC_ISYM_ACCESS,
GFC_ISYM_ACHAR,
GFC_ISYM_ACOS,
GFC_ISYM_ACOSH,
@@ -332,6 +333,7 @@ enum gfc_generic_isym_id
GFC_ISYM_CEILING,
GFC_ISYM_CHAR,
GFC_ISYM_CHDIR,
+ GFC_ISYM_CHMOD,
GFC_ISYM_CMPLX,
GFC_ISYM_COMMAND_ARGUMENT_COUNT,
GFC_ISYM_COMPLEX,
@@ -398,6 +400,7 @@ enum gfc_generic_isym_id
GFC_ISYM_LOG10,
GFC_ISYM_LOGICAL,
GFC_ISYM_LONG,
+ GFC_ISYM_LSHIFT,
GFC_ISYM_LSTAT,
GFC_ISYM_MALLOC,
GFC_ISYM_MATMUL,
@@ -424,6 +427,7 @@ enum gfc_generic_isym_id
GFC_ISYM_RENAME,
GFC_ISYM_REPEAT,
GFC_ISYM_RESHAPE,
+ GFC_ISYM_RSHIFT,
GFC_ISYM_RRSPACING,
GFC_ISYM_SCALE,
GFC_ISYM_SCAN,
diff --git a/gcc/fortran/intrinsic.c b/gcc/fortran/intrinsic.c
index 1b8e7cdcd28..53f157e3c90 100644
--- a/gcc/fortran/intrinsic.c
+++ b/gcc/fortran/intrinsic.c
@@ -880,7 +880,7 @@ add_functions (void)
*x = "x", *sh = "shift", *stg = "string", *ssg = "substring",
*y = "y", *sz = "size", *sta = "string_a", *stb = "string_b",
*z = "z", *ln = "len", *ut = "unit", *han = "handler",
- *num = "number", *tm = "time";
+ *num = "number", *tm = "time", *nm = "name", *md = "mode";
int di, dr, dd, dl, dc, dz, ii;
@@ -916,6 +916,12 @@ add_functions (void)
make_generic ("abs", GFC_ISYM_ABS, GFC_STD_F77);
+ add_sym_2 ("access", 0, 1, BT_INTEGER, di, GFC_STD_GNU,
+ gfc_check_access_func, NULL, gfc_resolve_access,
+ nm, BT_CHARACTER, dc, REQUIRED, md, BT_CHARACTER, dc, REQUIRED);
+
+ make_generic ("access", GFC_ISYM_ACCESS, GFC_STD_GNU);
+
add_sym_1 ("achar", 1, 1, BT_CHARACTER, dc, GFC_STD_F95,
gfc_check_achar, gfc_simplify_achar, NULL,
i, BT_INTEGER, di, REQUIRED);
@@ -1152,7 +1158,13 @@ add_functions (void)
a, BT_CHARACTER, dc, REQUIRED);
make_generic ("chdir", GFC_ISYM_CHDIR, GFC_STD_GNU);
-
+
+ add_sym_2 ("chmod", 0, 1, BT_INTEGER, di, GFC_STD_GNU,
+ gfc_check_chmod, NULL, gfc_resolve_chmod,
+ nm, BT_CHARACTER, dc, REQUIRED, md, BT_CHARACTER, dc, REQUIRED);
+
+ make_generic ("chmod", GFC_ISYM_CHMOD, GFC_STD_GNU);
+
add_sym_3 ("cmplx", 1, 1, BT_COMPLEX, dz, GFC_STD_F77,
gfc_check_cmplx, gfc_simplify_cmplx, gfc_resolve_cmplx,
x, BT_UNKNOWN, dr, REQUIRED, y, BT_UNKNOWN, dr, OPTIONAL,
@@ -1580,6 +1592,18 @@ add_functions (void)
make_generic ("isatty", GFC_ISYM_ISATTY, GFC_STD_GNU);
+ add_sym_2 ("rshift", 1, 1, BT_INTEGER, di, GFC_STD_GNU,
+ gfc_check_ishft, NULL, gfc_resolve_rshift,
+ i, BT_INTEGER, di, REQUIRED, sh, BT_INTEGER, di, REQUIRED);
+
+ make_generic ("rshift", GFC_ISYM_RSHIFT, GFC_STD_GNU);
+
+ add_sym_2 ("lshift", 1, 1, BT_INTEGER, di, GFC_STD_GNU,
+ gfc_check_ishft, NULL, gfc_resolve_lshift,
+ i, BT_INTEGER, di, REQUIRED, sh, BT_INTEGER, di, REQUIRED);
+
+ make_generic ("lshift", GFC_ISYM_LSHIFT, GFC_STD_GNU);
+
add_sym_2 ("ishft", 1, 1, BT_INTEGER, di, GFC_STD_F95,
gfc_check_ishft, gfc_simplify_ishft, gfc_resolve_ishft,
i, BT_INTEGER, di, REQUIRED, sh, BT_INTEGER, di, REQUIRED);
@@ -2256,7 +2280,7 @@ add_subroutines (void)
*com = "command", *length = "length", *st = "status",
*val = "value", *num = "number", *name = "name",
*trim_name = "trim_name", *ut = "unit", *han = "handler",
- *sec = "seconds", *res = "result", *of = "offset";
+ *sec = "seconds", *res = "result", *of = "offset", *md = "mode";
int di, dr, dc, dl, ii;
@@ -2288,6 +2312,14 @@ add_subroutines (void)
gfc_check_itime_idate, NULL, gfc_resolve_itime,
vl, BT_INTEGER, 4, REQUIRED);
+ add_sym_2s ("ltime", 0, 1, BT_UNKNOWN, 0, GFC_STD_GNU,
+ gfc_check_ltime_gmtime, NULL, gfc_resolve_ltime,
+ tm, BT_INTEGER, di, REQUIRED, vl, BT_INTEGER, di, REQUIRED);
+
+ add_sym_2s ("gmtime", 0, 1, BT_UNKNOWN, 0, GFC_STD_GNU,
+ gfc_check_ltime_gmtime, NULL, gfc_resolve_gmtime,
+ tm, BT_INTEGER, di, REQUIRED, vl, BT_INTEGER, di, REQUIRED);
+
add_sym_1s ("second", 0, 1, BT_UNKNOWN, 0, GFC_STD_GNU,
gfc_check_second_sub, NULL, gfc_resolve_second_sub,
tm, BT_REAL, dr, REQUIRED);
@@ -2296,6 +2328,11 @@ add_subroutines (void)
gfc_check_chdir_sub, NULL, gfc_resolve_chdir_sub,
name, BT_CHARACTER, dc, REQUIRED, st, BT_INTEGER, di, OPTIONAL);
+ add_sym_3s ("chmod", 0, 1, BT_UNKNOWN, 0, GFC_STD_GNU,
+ gfc_check_chmod_sub, NULL, gfc_resolve_chmod_sub,
+ name, BT_CHARACTER, dc, REQUIRED, md, BT_CHARACTER, dc, REQUIRED,
+ st, BT_INTEGER, di, OPTIONAL);
+
add_sym_4s ("date_and_time", 0, 1, BT_UNKNOWN, 0, GFC_STD_F95,
gfc_check_date_and_time, NULL, NULL,
dt, BT_CHARACTER, dc, OPTIONAL, tm, BT_CHARACTER, dc, OPTIONAL,
diff --git a/gcc/fortran/intrinsic.h b/gcc/fortran/intrinsic.h
index e2a81c82a9a..c325a0555a0 100644
--- a/gcc/fortran/intrinsic.h
+++ b/gcc/fortran/intrinsic.h
@@ -32,6 +32,7 @@ try gfc_check_a_xkind (gfc_expr *, gfc_expr *);
try gfc_check_a_p (gfc_expr *, gfc_expr *);
try gfc_check_abs (gfc_expr *);
+try gfc_check_access_func (gfc_expr *, gfc_expr *);
try gfc_check_achar (gfc_expr *);
try gfc_check_all_any (gfc_expr *, gfc_expr *);
try gfc_check_allocated (gfc_expr *);
@@ -41,6 +42,7 @@ try gfc_check_besn (gfc_expr *, gfc_expr *);
try gfc_check_btest (gfc_expr *, gfc_expr *);
try gfc_check_char (gfc_expr *, gfc_expr *);
try gfc_check_chdir (gfc_expr *);
+try gfc_check_chmod (gfc_expr *, gfc_expr *);
try gfc_check_cmplx (gfc_expr *, gfc_expr *, gfc_expr *);
try gfc_check_complex (gfc_expr *, gfc_expr *);
try gfc_check_count (gfc_expr *, gfc_expr *);
@@ -139,6 +141,7 @@ try gfc_check_x (gfc_expr *);
/* Intrinsic subroutines. */
try gfc_check_alarm_sub (gfc_expr *, gfc_expr *, gfc_expr *);
try gfc_check_chdir_sub (gfc_expr *, gfc_expr *);
+try gfc_check_chmod_sub (gfc_expr *, gfc_expr *, gfc_expr *);
try gfc_check_cpu_time (gfc_expr *);
try gfc_check_ctime_sub (gfc_expr *, gfc_expr *);
try gfc_check_system_clock (gfc_expr *, gfc_expr *, gfc_expr *);
@@ -162,6 +165,7 @@ try gfc_check_getcwd_sub (gfc_expr *, gfc_expr *);
try gfc_check_hostnm_sub (gfc_expr *, gfc_expr *);
try gfc_check_itime_idate (gfc_expr *);
try gfc_check_kill_sub (gfc_expr *, gfc_expr *, gfc_expr *);
+try gfc_check_ltime_gmtime (gfc_expr *, gfc_expr *);
try gfc_check_perror (gfc_expr *);
try gfc_check_rename_sub (gfc_expr *, gfc_expr *, gfc_expr *);
try gfc_check_link_sub (gfc_expr *, gfc_expr *, gfc_expr *);
@@ -293,6 +297,7 @@ gfc_expr *gfc_convert_constant (gfc_expr *, bt, int);
/* Resolution functions. */
void gfc_resolve_abs (gfc_expr *, gfc_expr *);
+void gfc_resolve_access (gfc_expr *, gfc_expr *, gfc_expr *);
void gfc_resolve_acos (gfc_expr *, gfc_expr *);
void gfc_resolve_acosh (gfc_expr *, gfc_expr *);
void gfc_resolve_aimag (gfc_expr *, gfc_expr *);
@@ -313,6 +318,7 @@ void gfc_resolve_btest (gfc_expr *, gfc_expr *, gfc_expr *);
void gfc_resolve_ceiling (gfc_expr *, gfc_expr *, gfc_expr *);
void gfc_resolve_char (gfc_expr *, gfc_expr *, gfc_expr *);
void gfc_resolve_chdir (gfc_expr *, gfc_expr *);
+void gfc_resolve_chmod (gfc_expr *, gfc_expr *, gfc_expr *);
void gfc_resolve_cmplx (gfc_expr *, gfc_expr *, gfc_expr *, gfc_expr *);
void gfc_resolve_dcmplx (gfc_expr *, gfc_expr *, gfc_expr *);
void gfc_resolve_complex (gfc_expr *, gfc_expr *, gfc_expr *);
@@ -361,6 +367,8 @@ void gfc_resolve_int8 (gfc_expr *, gfc_expr *);
void gfc_resolve_long (gfc_expr *, gfc_expr *);
void gfc_resolve_ior (gfc_expr *, gfc_expr *, gfc_expr *);
void gfc_resolve_isatty (gfc_expr *, gfc_expr *);
+void gfc_resolve_rshift (gfc_expr *, gfc_expr *, gfc_expr *);
+void gfc_resolve_lshift (gfc_expr *, gfc_expr *, gfc_expr *);
void gfc_resolve_ishft (gfc_expr *, gfc_expr *, gfc_expr *);
void gfc_resolve_ishftc (gfc_expr *, gfc_expr *, gfc_expr *, gfc_expr *);
void gfc_resolve_kill (gfc_expr *, gfc_expr *, gfc_expr *);
@@ -436,6 +444,7 @@ void gfc_resolve_xor (gfc_expr *, gfc_expr *, gfc_expr *);
/* Intrinsic subroutine resolution. */
void gfc_resolve_alarm_sub (gfc_code *);
void gfc_resolve_chdir_sub (gfc_code *);
+void gfc_resolve_chmod_sub (gfc_code *);
void gfc_resolve_cpu_time (gfc_code *);
void gfc_resolve_ctime_sub (gfc_code *);
void gfc_resolve_exit (gfc_code *);
@@ -455,11 +464,13 @@ void gfc_resolve_getlog (gfc_code *);
void gfc_resolve_get_command (gfc_code *);
void gfc_resolve_get_command_argument (gfc_code *);
void gfc_resolve_get_environment_variable (gfc_code *);
+void gfc_resolve_gmtime (gfc_code *);
void gfc_resolve_hostnm_sub (gfc_code *);
void gfc_resolve_idate (gfc_code *);
void gfc_resolve_itime (gfc_code *);
-void gfc_resolve_lstat_sub (gfc_code *);
void gfc_resolve_kill_sub (gfc_code *);
+void gfc_resolve_lstat_sub (gfc_code *);
+void gfc_resolve_ltime (gfc_code *);
void gfc_resolve_mvbits (gfc_code *);
void gfc_resolve_perror (gfc_code *);
void gfc_resolve_random_number (gfc_code *);
diff --git a/gcc/fortran/iresolve.c b/gcc/fortran/iresolve.c
index a65992eca2e..a9a98588c49 100644
--- a/gcc/fortran/iresolve.c
+++ b/gcc/fortran/iresolve.c
@@ -90,6 +90,16 @@ gfc_resolve_abs (gfc_expr * f, gfc_expr * a)
void
+gfc_resolve_access (gfc_expr * f, gfc_expr * name ATTRIBUTE_UNUSED,
+ gfc_expr * mode ATTRIBUTE_UNUSED)
+{
+ f->ts.type = BT_INTEGER;
+ f->ts.kind = gfc_c_int_kind;
+ f->value.function.name = PREFIX("access_func");
+}
+
+
+void
gfc_resolve_acos (gfc_expr * f, gfc_expr * x)
{
f->ts = x->ts;
@@ -353,6 +363,32 @@ gfc_resolve_chdir_sub (gfc_code * c)
void
+gfc_resolve_chmod (gfc_expr * f, gfc_expr * name ATTRIBUTE_UNUSED,
+ gfc_expr * mode ATTRIBUTE_UNUSED)
+{
+ f->ts.type = BT_INTEGER;
+ f->ts.kind = gfc_c_int_kind;
+ f->value.function.name = PREFIX("chmod_func");
+}
+
+
+void
+gfc_resolve_chmod_sub (gfc_code * c)
+{
+ const char *name;
+ int kind;
+
+ if (c->ext.actual->next->next->expr != NULL)
+ kind = c->ext.actual->next->next->expr->ts.kind;
+ else
+ kind = gfc_default_integer_kind;
+
+ name = gfc_get_string (PREFIX("chmod_i%d_sub"), kind);
+ c->resolved_sym = gfc_get_intrinsic_sub_symbol (name);
+}
+
+
+void
gfc_resolve_cmplx (gfc_expr * f, gfc_expr * x, gfc_expr * y, gfc_expr * kind)
{
f->ts.type = BT_COMPLEX;
@@ -919,6 +955,24 @@ gfc_resolve_ishft (gfc_expr * f, gfc_expr * i, gfc_expr * shift)
void
+gfc_resolve_rshift (gfc_expr * f, gfc_expr * i, gfc_expr * shift)
+{
+ f->ts = i->ts;
+ f->value.function.name =
+ gfc_get_string ("__rshift_%d_%d", i->ts.kind, shift->ts.kind);
+}
+
+
+void
+gfc_resolve_lshift (gfc_expr * f, gfc_expr * i, gfc_expr * shift)
+{
+ f->ts = i->ts;
+ f->value.function.name =
+ gfc_get_string ("__lshift_%d_%d", i->ts.kind, shift->ts.kind);
+}
+
+
+void
gfc_resolve_ishftc (gfc_expr * f, gfc_expr * i, gfc_expr * shift,
gfc_expr * size)
{
@@ -2398,7 +2452,7 @@ gfc_resolve_etime_sub (gfc_code * c)
}
-/* G77 compatibility subroutines itime() and idate(). */
+/* G77 compatibility subroutines itime(), idate(), ltime() and gmtime(). */
void
gfc_resolve_itime (gfc_code * c)
@@ -2408,7 +2462,6 @@ gfc_resolve_itime (gfc_code * c)
gfc_default_integer_kind));
}
-
void
gfc_resolve_idate (gfc_code * c)
{
@@ -2417,6 +2470,22 @@ gfc_resolve_idate (gfc_code * c)
gfc_default_integer_kind));
}
+void
+gfc_resolve_ltime (gfc_code * c)
+{
+ c->resolved_sym = gfc_get_intrinsic_sub_symbol
+ (gfc_get_string (PREFIX("ltime_i%d"),
+ gfc_default_integer_kind));
+}
+
+void
+gfc_resolve_gmtime (gfc_code * c)
+{
+ c->resolved_sym = gfc_get_intrinsic_sub_symbol
+ (gfc_get_string (PREFIX("gmtime_i%d"),
+ gfc_default_integer_kind));
+}
+
/* G77 compatibility subroutine second(). */
diff --git a/gcc/fortran/trans-intrinsic.c b/gcc/fortran/trans-intrinsic.c
index 472d982d902..cef767d40d6 100644
--- a/gcc/fortran/trans-intrinsic.c
+++ b/gcc/fortran/trans-intrinsic.c
@@ -2110,6 +2110,22 @@ gfc_conv_intrinsic_ibits (gfc_se * se, gfc_expr * expr)
se->expr = fold_build2 (BIT_AND_EXPR, type, tmp, mask);
}
+/* RSHIFT (I, SHIFT) = I >> SHIFT
+ LSHIFT (I, SHIFT) = I << SHIFT */
+static void
+gfc_conv_intrinsic_rlshift (gfc_se * se, gfc_expr * expr, int right_shift)
+{
+ tree arg;
+ tree arg2;
+
+ arg = gfc_conv_intrinsic_function_args (se, expr);
+ arg2 = TREE_VALUE (TREE_CHAIN (arg));
+ arg = TREE_VALUE (arg);
+
+ se->expr = fold_build2 (right_shift ? RSHIFT_EXPR : LSHIFT_EXPR,
+ TREE_TYPE (arg), arg, arg2);
+}
+
/* ISHFT (I, SHIFT) = (abs (shift) >= BIT_SIZE (i))
? 0
: ((shift >= 0) ? i << shift : i >> -shift)
@@ -3581,6 +3597,14 @@ gfc_conv_intrinsic_function (gfc_se * se, gfc_expr * expr)
gfc_conv_intrinsic_bitop (se, expr, BIT_IOR_EXPR);
break;
+ case GFC_ISYM_LSHIFT:
+ gfc_conv_intrinsic_rlshift (se, expr, 0);
+ break;
+
+ case GFC_ISYM_RSHIFT:
+ gfc_conv_intrinsic_rlshift (se, expr, 1);
+ break;
+
case GFC_ISYM_ISHFT:
gfc_conv_intrinsic_ishft (se, expr);
break;
@@ -3716,7 +3740,9 @@ gfc_conv_intrinsic_function (gfc_se * se, gfc_expr * expr)
gfc_conv_intrinsic_loc (se, expr);
break;
+ case GFC_ISYM_ACCESS:
case GFC_ISYM_CHDIR:
+ case GFC_ISYM_CHMOD:
case GFC_ISYM_ETIME:
case GFC_ISYM_FGET:
case GFC_ISYM_FGETC:
diff --git a/gcc/testsuite/gfortran.dg/chmod_1.f90 b/gcc/testsuite/gfortran.dg/chmod_1.f90
new file mode 100644
index 00000000000..e9ea27f1b1d
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/chmod_1.f90
@@ -0,0 +1,34 @@
+! { dg-do run }
+! { dg-options "-std=gnu" }
+ implicit none
+ character(len=*), parameter :: n = "foobar_file"
+ integer :: i
+
+ open (10,file=n)
+ close (10,status="delete")
+
+ open (10,file=n)
+ close (10,status="keep")
+
+ if (access(n,"") /= 0 .or. access(n," ") /= 0 .or. access(n,"r") /= 0 .or. &
+ access(n,"R") /= 0 .or. access(n,"w") /= 0 .or. access(n,"W") /= 0) &
+ call abort
+
+ call chmod (n, "a+x", i)
+ if (i == 0) then
+ if (access(n,"x") /= 0 .or. access(n,"X") /= 0) call abort
+ end if
+
+ call chmod (n, "a-w", i)
+ if (i == 0) then
+ if (access(n,"w") == 0 .or. access(n,"W") == 0) call abort
+ end if
+
+ open (10,file=n)
+ close (10,status="delete")
+
+ if (access(n,"") == 0 .or. access(n," ") == 0 .or. access(n,"r") == 0 .or. &
+ access(n,"R") == 0 .or. access(n,"w") == 0 .or. access(n,"W") == 0) &
+ call abort
+
+ end
diff --git a/gcc/testsuite/gfortran.dg/chmod_2.f90 b/gcc/testsuite/gfortran.dg/chmod_2.f90
new file mode 100644
index 00000000000..e413fcad8f3
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/chmod_2.f90
@@ -0,0 +1,34 @@
+! { dg-do run }
+! { dg-options "-std=gnu" }
+ implicit none
+ character(len=*), parameter :: n = "foobar_file"
+ integer :: i
+
+ open (10,file=n)
+ close (10,status="delete")
+
+ open (10,file=n)
+ close (10,status="keep")
+
+ if (access(n,"") /= 0 .or. access(n," ") /= 0 .or. access(n,"r") /= 0 .or. &
+ access(n,"R") /= 0 .or. access(n,"w") /= 0 .or. access(n,"W") /= 0) &
+ call abort
+
+ i = chmod (n, "a+x")
+ if (i == 0) then
+ if (access(n,"x") /= 0 .or. access(n,"X") /= 0) call abort
+ end if
+
+ i = chmod (n, "a-w")
+ if (i == 0) then
+ if (access(n,"w") == 0 .or. access(n,"W") == 0) call abort
+ end if
+
+ open (10,file=n)
+ close (10,status="delete")
+
+ if (access(n,"") == 0 .or. access(n," ") == 0 .or. access(n,"r") == 0 .or. &
+ access(n,"R") == 0 .or. access(n,"w") == 0 .or. access(n,"W") == 0) &
+ call abort
+
+ end
diff --git a/gcc/testsuite/gfortran.dg/chmod_3.f90 b/gcc/testsuite/gfortran.dg/chmod_3.f90
new file mode 100644
index 00000000000..4ea34eb8cf4
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/chmod_3.f90
@@ -0,0 +1,34 @@
+! { dg-do run }
+! { dg-options "-std=gnu -fdefault-integer-8" }
+ implicit none
+ character(len=*), parameter :: n = "foobar_file"
+ integer :: i
+
+ open (10,file=n)
+ close (10,status="delete")
+
+ open (10,file=n)
+ close (10,status="keep")
+
+ if (access(n,"") /= 0 .or. access(n," ") /= 0 .or. access(n,"r") /= 0 .or. &
+ access(n,"R") /= 0 .or. access(n,"w") /= 0 .or. access(n,"W") /= 0) &
+ call abort
+
+ i = chmod (n, "a+x")
+ if (i == 0) then
+ if (access(n,"x") /= 0 .or. access(n,"X") /= 0) call abort
+ end if
+
+ i = chmod (n, "a-w")
+ if (i == 0) then
+ if (access(n,"w") == 0 .or. access(n,"W") == 0) call abort
+ end if
+
+ open (10,file=n)
+ close (10,status="delete")
+
+ if (access(n,"") == 0 .or. access(n," ") == 0 .or. access(n,"r") == 0 .or. &
+ access(n,"R") == 0 .or. access(n,"w") == 0 .or. access(n,"W") == 0) &
+ call abort
+
+ end
diff --git a/gcc/testsuite/gfortran.dg/lrshift_1.f90 b/gcc/testsuite/gfortran.dg/lrshift_1.f90
new file mode 100644
index 00000000000..7feed2962ea
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/lrshift_1.f90
@@ -0,0 +1,18 @@
+! { dg-do run }
+! { dg-options "-std=gnu -w" }
+! { dg-additional-sources lrshift_1.c }
+program test_rshift_lshift
+ implicit none
+ integer :: i(15), j, n
+ integer, external :: c_lshift, c_rshift
+
+ i = (/ -huge(i), -huge(i)/2, -129, -128, -127, -2, -1, 0, &
+ 1, 2, 127, 128, 129, huge(i)/2, huge(i) /)
+
+ do n = 1, size(i)
+ do j = -30, 30
+ if (lshift(i(n),j) /= c_lshift(i(n),j)) call abort
+ if (rshift(i(n),j) /= c_rshift(i(n),j)) call abort
+ end do
+ end do
+end program test_rshift_lshift
diff --git a/gcc/testsuite/gfortran.dg/ltime_gmtime_1.f90 b/gcc/testsuite/gfortran.dg/ltime_gmtime_1.f90
new file mode 100644
index 00000000000..9babbaf1e5d
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/ltime_gmtime_1.f90
@@ -0,0 +1,9 @@
+! { dg-do run }
+! { dg-options "-std=gnu" }
+ integer :: x(9), y(9), t
+
+ t = time()
+ call ltime(t,x)
+ call gmtime(t,y)
+ if (x(1) /= y(1) .or. x(2) /= y(2)) call abort
+ end
diff --git a/gcc/testsuite/gfortran.dg/ltime_gmtime_2.f90 b/gcc/testsuite/gfortran.dg/ltime_gmtime_2.f90
new file mode 100644
index 00000000000..870f011692e
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/ltime_gmtime_2.f90
@@ -0,0 +1,9 @@
+! { dg-do run }
+! { dg-options "-fdefault-integer-8 -std=gnu" }
+ integer :: x(9), y(9), t
+
+ t = time()
+ call ltime(t,x)
+ call gmtime(t,y)
+ if (x(1) /= y(1) .or. x(2) /= y(2)) call abort
+ end
diff --git a/libgfortran/Makefile.am b/libgfortran/Makefile.am
index ff1211a7d85..cae0f8a50b1 100644
--- a/libgfortran/Makefile.am
+++ b/libgfortran/Makefile.am
@@ -41,10 +41,12 @@ io/io.h
gfor_helper_src= \
intrinsics/associated.c \
intrinsics/abort.c \
+intrinsics/access.c \
intrinsics/args.c \
intrinsics/bessel.c \
intrinsics/c99_functions.c \
intrinsics/chdir.c \
+intrinsics/chmod.c \
intrinsics/clock.c \
intrinsics/cpu_time.c \
intrinsics/cshift0.c \
diff --git a/libgfortran/Makefile.in b/libgfortran/Makefile.in
index ba3c3b0e2a6..1a0665e0ee4 100644
--- a/libgfortran/Makefile.in
+++ b/libgfortran/Makefile.in
@@ -161,9 +161,9 @@ am__objects_28 = $(am__objects_2) $(am__objects_3) $(am__objects_4) \
am__objects_29 = close.lo file_pos.lo format.lo inquire.lo \
list_read.lo lock.lo open.lo read.lo size_from_kind.lo \
transfer.lo unit.lo unix.lo write.lo
-am__objects_30 = associated.lo abort.lo args.lo bessel.lo \
- c99_functions.lo chdir.lo clock.lo cpu_time.lo cshift0.lo \
- ctime.lo date_and_time.lo env.lo erf.lo eoshift0.lo \
+am__objects_30 = associated.lo abort.lo access.lo args.lo bessel.lo \
+ c99_functions.lo chdir.lo chmod.lo clock.lo cpu_time.lo \
+ cshift0.lo ctime.lo date_and_time.lo env.lo erf.lo eoshift0.lo \
eoshift2.lo etime.lo exit.lo fget.lo flush.lo fnum.lo ftell.lo \
gerror.lo getcwd.lo getlog.lo getXid.lo hyper.lo hostnm.lo \
kill.lo ierrno.lo ishftc.lo link.lo malloc.lo mvbits.lo \
@@ -385,10 +385,12 @@ io/io.h
gfor_helper_src = \
intrinsics/associated.c \
intrinsics/abort.c \
+intrinsics/access.c \
intrinsics/args.c \
intrinsics/bessel.c \
intrinsics/c99_functions.c \
intrinsics/chdir.c \
+intrinsics/chmod.c \
intrinsics/clock.c \
intrinsics/cpu_time.c \
intrinsics/cshift0.c \
@@ -2204,6 +2206,9 @@ associated.lo: intrinsics/associated.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
+access.lo: intrinsics/access.c
+ $(LIBTOOL) --mode=compile $(CC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(AM_CFLAGS) $(CFLAGS) -c -o access.lo `test -f 'intrinsics/access.c' || echo '$(srcdir)/'`intrinsics/access.c
+
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
@@ -2216,6 +2221,9 @@ c99_functions.lo: intrinsics/c99_functions.c
chdir.lo: intrinsics/chdir.c
$(LIBTOOL) --mode=compile $(CC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(AM_CFLAGS) $(CFLAGS) -c -o chdir.lo `test -f 'intrinsics/chdir.c' || echo '$(srcdir)/'`intrinsics/chdir.c
+chmod.lo: intrinsics/chmod.c
+ $(LIBTOOL) --mode=compile $(CC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(AM_CFLAGS) $(CFLAGS) -c -o chmod.lo `test -f 'intrinsics/chmod.c' || echo '$(srcdir)/'`intrinsics/chmod.c
+
clock.lo: intrinsics/clock.c
$(LIBTOOL) --mode=compile $(CC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(AM_CFLAGS) $(CFLAGS) -c -o clock.lo `test -f 'intrinsics/clock.c' || echo '$(srcdir)/'`intrinsics/clock.c
diff --git a/libgfortran/config.h.in b/libgfortran/config.h.in
index 573c0938f07..11f8e72e1bc 100644
--- a/libgfortran/config.h.in
+++ b/libgfortran/config.h.in
@@ -6,6 +6,9 @@
/* Define to 0 if the target shouldn't use #pragma weak */
#undef GTHREAD_USE_WEAK
+/* Define to 1 if you have the `access' function. */
+#undef HAVE_ACCESS
+
/* libm includes acos */
#undef HAVE_ACOS
@@ -279,6 +282,9 @@
/* libm includes erfl */
#undef HAVE_ERFL
+/* Define to 1 if you have the `execl' function. */
+#undef HAVE_EXECL
+
/* libm includes exp */
#undef HAVE_EXP
@@ -321,6 +327,9 @@
/* libm includes floorl */
#undef HAVE_FLOORL
+/* Define to 1 if you have the `fork' function. */
+#undef HAVE_FORK
+
/* Define if you have fpsetmask. */
#undef HAVE_FPSETMASK
@@ -582,6 +591,9 @@
/* Define to 1 if you have the <sys/types.h> header file. */
#undef HAVE_SYS_TYPES_H
+/* Define to 1 if you have the <sys/wait.h> header file. */
+#undef HAVE_SYS_WAIT_H
+
/* libm includes tan */
#undef HAVE_TAN
@@ -630,6 +642,9 @@
/* Define if target can unlink open files. */
#undef HAVE_UNLINK_OPEN_FILE
+/* Define to 1 if you have the `wait' function. */
+#undef HAVE_WAIT
+
/* Define if target has a reliable stat. */
#undef HAVE_WORKING_STAT
diff --git a/libgfortran/configure b/libgfortran/configure
index 6cb118b88e2..7af0b3209e1 100755
--- a/libgfortran/configure
+++ b/libgfortran/configure
@@ -6114,7 +6114,8 @@ done
-for ac_header in sys/types.h sys/stat.h floatingpoint.h ieeefp.h
+
+for ac_header in sys/types.h sys/stat.h sys/wait.h floatingpoint.h ieeefp.h
do
as_ac_Header=`echo "ac_cv_header_$ac_header" | $as_tr_sh`
if eval "test \"\${$as_ac_Header+set}\" = set"; then
@@ -6897,9 +6898,8 @@ fi
break
done
if test "$acx_cv_header_stdint" = stddef.h; then
- acx_cv_header_stdint_kind="(lacks uintmax_t)"
+ acx_cv_header_stdint_kind="(lacks uintptr_t)"
for i in stdint.h $inttype_headers; do
- unset ac_cv_type_uintptr_t
unset ac_cv_type_uint32_t
unset ac_cv_type_uint64_t
echo $ECHO_N "looking for an incomplete stdint.h in $i, $ECHO_C" >&6
@@ -7025,65 +7025,11 @@ rm -f conftest.err conftest.$ac_objext conftest.$ac_ext
fi
echo "$as_me:$LINENO: result: $ac_cv_type_uint64_t" >&5
echo "${ECHO_T}$ac_cv_type_uint64_t" >&6
-
- echo "$as_me:$LINENO: checking for uintptr_t" >&5
-echo $ECHO_N "checking for uintptr_t... $ECHO_C" >&6
-if test "${ac_cv_type_uintptr_t+set}" = set; then
- echo $ECHO_N "(cached) $ECHO_C" >&6
-else
- cat >conftest.$ac_ext <<_ACEOF
-/* confdefs.h. */
-_ACEOF
-cat confdefs.h >>conftest.$ac_ext
-cat >>conftest.$ac_ext <<_ACEOF
-/* end confdefs.h. */
-#include <sys/types.h>
-#include <$i>
-
-int
-main ()
-{
-if ((uintptr_t *) 0)
- return 0;
-if (sizeof (uintptr_t))
- return 0;
- ;
- return 0;
-}
-_ACEOF
-rm -f conftest.$ac_objext
-if { (eval echo "$as_me:$LINENO: \"$ac_compile\"") >&5
- (eval $ac_compile) 2>conftest.er1
- ac_status=$?
- grep -v '^ *+' conftest.er1 >conftest.err
- rm -f conftest.er1
- cat conftest.err >&5
- echo "$as_me:$LINENO: \$? = $ac_status" >&5
- (exit $ac_status); } &&
- { ac_try='test -z "$ac_c_werror_flag"
- || test ! -s conftest.err'
- { (eval echo "$as_me:$LINENO: \"$ac_try\"") >&5
- (eval $ac_try) 2>&5
- ac_status=$?
- echo "$as_me:$LINENO: \$? = $ac_status" >&5
- (exit $ac_status); }; } &&
- { ac_try='test -s conftest.$ac_objext'
- { (eval echo "$as_me:$LINENO: \"$ac_try\"") >&5
- (eval $ac_try) 2>&5
- ac_status=$?
- echo "$as_me:$LINENO: \$? = $ac_status" >&5
- (exit $ac_status); }; }; then
- ac_cv_type_uintptr_t=yes
+if test $ac_cv_type_uint64_t = yes; then
+ :
else
- echo "$as_me: failed program was:" >&5
-sed 's/^/| /' conftest.$ac_ext >&5
-
-ac_cv_type_uintptr_t=no
-fi
-rm -f conftest.err conftest.$ac_objext conftest.$ac_ext
+ acx_cv_header_stdint_kind="(lacks uintptr_t and uint64_t)"
fi
-echo "$as_me:$LINENO: result: $ac_cv_type_uintptr_t" >&5
-echo "${ECHO_T}$ac_cv_type_uintptr_t" >&6
break
done
@@ -7216,6 +7162,11 @@ rm -f conftest.err conftest.$ac_objext conftest.$ac_ext
fi
echo "$as_me:$LINENO: result: $ac_cv_type_u_int64_t" >&5
echo "${ECHO_T}$ac_cv_type_u_int64_t" >&6
+if test $ac_cv_type_u_int64_t = yes; then
+ :
+else
+ acx_cv_header_stdint_kind="(u_intXX_t style, lacks u_int64_t)"
+fi
break
done
@@ -9976,7 +9927,117 @@ done
-for ac_func in sleep time ttyname signal alarm ctime clock
+
+
+
+for ac_func in sleep time ttyname signal alarm ctime clock access fork execl
+do
+as_ac_var=`echo "ac_cv_func_$ac_func" | $as_tr_sh`
+echo "$as_me:$LINENO: checking for $ac_func" >&5
+echo $ECHO_N "checking for $ac_func... $ECHO_C" >&6
+if eval "test \"\${$as_ac_var+set}\" = set"; then
+ echo $ECHO_N "(cached) $ECHO_C" >&6
+else
+ if test x$gcc_no_link = xyes; then
+ { { echo "$as_me:$LINENO: error: Link tests are not allowed after GCC_NO_EXECUTABLES." >&5
+echo "$as_me: error: Link tests are not allowed after GCC_NO_EXECUTABLES." >&2;}
+ { (exit 1); exit 1; }; }
+fi
+cat >conftest.$ac_ext <<_ACEOF
+/* confdefs.h. */
+_ACEOF
+cat confdefs.h >>conftest.$ac_ext
+cat >>conftest.$ac_ext <<_ACEOF
+/* end confdefs.h. */
+/* Define $ac_func to an innocuous variant, in case <limits.h> declares $ac_func.
+ For example, HP-UX 11i <limits.h> declares gettimeofday. */
+#define $ac_func innocuous_$ac_func
+
+/* System header to define __stub macros and hopefully few prototypes,
+ which can conflict with char $ac_func (); below.
+ Prefer <limits.h> to <assert.h> if __STDC__ is defined, since
+ <limits.h> exists even on freestanding compilers. */
+
+#ifdef __STDC__
+# include <limits.h>
+#else
+# include <assert.h>
+#endif
+
+#undef $ac_func
+
+/* Override any gcc2 internal prototype to avoid an error. */
+#ifdef __cplusplus
+extern "C"
+{
+#endif
+/* We use char because int might match the return type of a gcc2
+ builtin and then its argument prototype would still apply. */
+char $ac_func ();
+/* The GNU C library defines this for functions which it implements
+ to always fail with ENOSYS. Some functions are actually named
+ something starting with __ and the normal name is an alias. */
+#if defined (__stub_$ac_func) || defined (__stub___$ac_func)
+choke me
+#else
+char (*f) () = $ac_func;
+#endif
+#ifdef __cplusplus
+}
+#endif
+
+int
+main ()
+{
+return f != $ac_func;
+ ;
+ return 0;
+}
+_ACEOF
+rm -f conftest.$ac_objext conftest$ac_exeext
+if { (eval echo "$as_me:$LINENO: \"$ac_link\"") >&5
+ (eval $ac_link) 2>conftest.er1
+ ac_status=$?
+ grep -v '^ *+' conftest.er1 >conftest.err
+ rm -f conftest.er1
+ cat conftest.err >&5
+ echo "$as_me:$LINENO: \$? = $ac_status" >&5
+ (exit $ac_status); } &&
+ { ac_try='test -z "$ac_c_werror_flag"
+ || test ! -s conftest.err'
+ { (eval echo "$as_me:$LINENO: \"$ac_try\"") >&5
+ (eval $ac_try) 2>&5
+ ac_status=$?
+ echo "$as_me:$LINENO: \$? = $ac_status" >&5
+ (exit $ac_status); }; } &&
+ { ac_try='test -s conftest$ac_exeext'
+ { (eval echo "$as_me:$LINENO: \"$ac_try\"") >&5
+ (eval $ac_try) 2>&5
+ ac_status=$?
+ echo "$as_me:$LINENO: \$? = $ac_status" >&5
+ (exit $ac_status); }; }; then
+ eval "$as_ac_var=yes"
+else
+ echo "$as_me: failed program was:" >&5
+sed 's/^/| /' conftest.$ac_ext >&5
+
+eval "$as_ac_var=no"
+fi
+rm -f conftest.err conftest.$ac_objext \
+ conftest$ac_exeext conftest.$ac_ext
+fi
+echo "$as_me:$LINENO: result: `eval echo '${'$as_ac_var'}'`" >&5
+echo "${ECHO_T}`eval echo '${'$as_ac_var'}'`" >&6
+if test `eval echo '${'$as_ac_var'}'` = yes; then
+ cat >>confdefs.h <<_ACEOF
+#define `echo "HAVE_$ac_func" | $as_tr_cpp` 1
+_ACEOF
+
+fi
+done
+
+
+for ac_func in wait
do
as_ac_var=`echo "ac_cv_func_$ac_func" | $as_tr_sh`
echo "$as_me:$LINENO: checking for $ac_func" >&5
diff --git a/libgfortran/configure.ac b/libgfortran/configure.ac
index 51756597d03..5e8efd49b35 100644
--- a/libgfortran/configure.ac
+++ b/libgfortran/configure.ac
@@ -159,7 +159,7 @@ AC_TYPE_OFF_T
AC_STDC_HEADERS
AC_HAVE_HEADERS(stdlib.h stdio.h string.h stddef.h math.h unistd.h signal.h)
AC_CHECK_HEADERS(time.h sys/params.h sys/time.h sys/times.h sys/resource.h)
-AC_CHECK_HEADERS(sys/types.h sys/stat.h floatingpoint.h ieeefp.h)
+AC_CHECK_HEADERS(sys/types.h sys/stat.h sys/wait.h floatingpoint.h ieeefp.h)
AC_CHECK_HEADERS(fenv.h fptrap.h float.h)
AC_CHECK_HEADER([complex.h],[AC_DEFINE([HAVE_COMPLEX_H], [1], [complex.h exists])])
GCC_HEADER_STDINT(gstdint.h)
@@ -171,7 +171,8 @@ AC_CHECK_MEMBERS([struct stat.st_rdev])
# Check for library functions.
AC_CHECK_FUNCS(getrusage times mkstemp strtof strtold snprintf ftruncate chsize)
AC_CHECK_FUNCS(chdir strerror getlogin gethostname kill link symlink perror)
-AC_CHECK_FUNCS(sleep time ttyname signal alarm ctime clock)
+AC_CHECK_FUNCS(sleep time ttyname signal alarm ctime clock access fork execl)
+AC_CHECK_FUNCS(wait)
# Check libc for getgid, getpid, getuid
AC_CHECK_LIB([c],[getgid],[AC_DEFINE([HAVE_GETGID],[1],[libc includes getgid])])
diff --git a/libgfortran/intrinsics/access.c b/libgfortran/intrinsics/access.c
new file mode 100644
index 00000000000..b0af0475f62
--- /dev/null
+++ b/libgfortran/intrinsics/access.c
@@ -0,0 +1,99 @@
+/* Implementation of the ACCESS intrinsic.
+ Copyright (C) 2006 Free Software Foundation, Inc.
+ Contributed by François-Xavier Coudert <coudert@clipper.ens.fr>
+
+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 General Public
+License as published by the Free Software Foundation; either
+version 2 of the License, or (at your option) any later version.
+
+In addition to the permissions in the GNU General Public License, the
+Free Software Foundation gives you unlimited permission to link the
+compiled version of this file into combinations with other programs,
+and to distribute those combinations without any restriction coming
+from the use of this file. (The General Public License restrictions
+do apply in other respects; for example, they cover modification of
+the file, and distribution when not linked into a combine
+executable.)
+
+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 General Public License for more details.
+
+You should have received a copy of the GNU General Public
+License along with libgfortran; see the file COPYING. If not,
+write to the Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor,
+Boston, MA 02110-1301, USA. */
+
+#include "config.h"
+#include "libgfortran.h"
+
+#include <errno.h>
+
+#ifdef HAVE_STRING_H
+#include <string.h>
+#endif
+#ifdef HAVE_UNISTD_H
+#include <unistd.h>
+#endif
+
+/* INTEGER FUNCTION ACCESS(NAME, MODE)
+ CHARACTER(len=*), INTENT(IN) :: NAME, MODE */
+
+#ifdef HAVE_ACCESS
+extern int access_func (char *, char *, gfc_charlen_type, gfc_charlen_type);
+export_proto(access_func);
+
+int
+access_func (char *name, char *mode, gfc_charlen_type name_len,
+ gfc_charlen_type mode_len)
+{
+ char * file;
+ gfc_charlen_type i;
+ int m;
+
+ /* Parse the MODE string. */
+ m = F_OK;
+ for (i = 0; i < mode_len && mode[i]; i++)
+ switch (mode[i])
+ {
+ case ' ':
+ break;
+
+ case 'r':
+ case 'R':
+ m |= R_OK;
+ break;
+
+ case 'w':
+ case 'W':
+ m |= W_OK;
+ break;
+
+ case 'x':
+ case 'X':
+ m |= X_OK;
+ break;
+
+ default:
+ return -1;
+ break;
+ }
+
+ /* Trim trailing spaces from NAME argument. */
+ while (name_len > 0 && name[name_len - 1] == ' ')
+ name_len--;
+
+ /* Make a null terminated copy of the string. */
+ file = gfc_alloca (name_len + 1);
+ memcpy (file, name, name_len);
+ file[name_len] = '\0';
+
+ /* And make the call to access(). */
+ return (access (file, m) == 0 ? 0 : errno);
+}
+export(access_func);
+#endif
diff --git a/libgfortran/intrinsics/chmod.c b/libgfortran/intrinsics/chmod.c
new file mode 100644
index 00000000000..abc5b99a1a2
--- /dev/null
+++ b/libgfortran/intrinsics/chmod.c
@@ -0,0 +1,131 @@
+/* Implementation of the CHMOD intrinsic.
+ Copyright (C) 2006 Free Software Foundation, Inc.
+ Contributed by François-Xavier Coudert <coudert@clipper.ens.fr>
+
+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 General Public
+License as published by the Free Software Foundation; either
+version 2 of the License, or (at your option) any later version.
+
+In addition to the permissions in the GNU General Public License, the
+Free Software Foundation gives you unlimited permission to link the
+compiled version of this file into combinations with other programs,
+and to distribute those combinations without any restriction coming
+from the use of this file. (The General Public License restrictions
+do apply in other respects; for example, they cover modification of
+the file, and distribution when not linked into a combine
+executable.)
+
+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 General Public License for more details.
+
+You should have received a copy of the GNU General Public
+License along with libgfortran; see the file COPYING. If not,
+write to the Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor,
+Boston, MA 02110-1301, USA. */
+
+#include "config.h"
+#include "libgfortran.h"
+
+#include <errno.h>
+
+#ifdef HAVE_STRING_H
+#include <string.h>
+#endif
+#ifdef HAVE_UNISTD_H
+#include <unistd.h>
+#endif
+#ifdef HAVE_SYS_TYPES_H
+#include <sys/types.h>
+#endif
+#ifdef HAVE_SYS_WAIT_H
+#include <sys/wait.h>
+#endif
+
+/* INTEGER FUNCTION ACCESS(NAME, MODE)
+ CHARACTER(len=*), INTENT(IN) :: NAME, MODE */
+
+#if defined(HAVE_FORK) && defined(HAVE_EXECL) && defined(HAVE_WAIT)
+
+extern int chmod_func (char *, char *, gfc_charlen_type, gfc_charlen_type);
+export_proto(chmod_func);
+
+int
+chmod_func (char *name, char *mode, gfc_charlen_type name_len,
+ gfc_charlen_type mode_len)
+{
+ char * file, * m;
+ pid_t pid;
+ int status;
+
+ /* Trim trailing spaces. */
+ while (name_len > 0 && name[name_len - 1] == ' ')
+ name_len--;
+ while (mode_len > 0 && mode[mode_len - 1] == ' ')
+ mode_len--;
+
+ /* Make a null terminated copy of the strings. */
+ file = gfc_alloca (name_len + 1);
+ memcpy (file, name, name_len);
+ file[name_len] = '\0';
+
+ m = gfc_alloca (mode_len + 1);
+ memcpy (m, mode, mode_len);
+ m[mode_len]= '\0';
+
+ /* Execute /bin/chmod. */
+ if ((pid = fork()) < 0)
+ return errno;
+ if (pid == 0)
+ {
+ /* Child process. */
+ execl ("/bin/chmod", "chmod", m, file, (char *) NULL);
+ return errno;
+ }
+ else
+ wait (&status);
+
+ if (WIFEXITED(status))
+ return WEXITSTATUS(status);
+ else
+ return -1;
+}
+
+
+
+extern void chmod_i4_sub (char *, char *, GFC_INTEGER_4 *,
+ gfc_charlen_type, gfc_charlen_type);
+export_proto(chmod_i4_sub);
+
+void
+chmod_i4_sub (char *name, char *mode, GFC_INTEGER_4 * status,
+ gfc_charlen_type name_len, gfc_charlen_type mode_len)
+{
+ int val;
+
+ val = chmod_func (name, mode, name_len, mode_len);
+ if (status)
+ *status = val;
+}
+
+
+extern void chmod_i8_sub (char *, char *, GFC_INTEGER_8 *,
+ gfc_charlen_type, gfc_charlen_type);
+export_proto(chmod_i8_sub);
+
+void
+chmod_i8_sub (char *name, char *mode, GFC_INTEGER_8 * status,
+ gfc_charlen_type name_len, gfc_charlen_type mode_len)
+{
+ int val;
+
+ val = chmod_func (name, mode, name_len, mode_len);
+ if (status)
+ *status = val;
+}
+
+#endif
diff --git a/libgfortran/intrinsics/date_and_time.c b/libgfortran/intrinsics/date_and_time.c
index 68c8cef107a..6a4131f7ddc 100644
--- a/libgfortran/intrinsics/date_and_time.c
+++ b/libgfortran/intrinsics/date_and_time.c
@@ -521,3 +521,188 @@ idate_i8 (gfc_array_i8 *__values)
for (i = 0; i < 3; i++, vptr += delta)
*vptr = x[i];
}
+
+
+
+/* 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;
+ size_t len, delta;
+ 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;
+ size_t len, delta;
+ 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;
+ size_t len, delta;
+ 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;
+ size_t len, delta;
+ 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];
+}
+
+