diff options
author | fxcoudert <fxcoudert@138bc75d-0d04-0410-961f-82ee72b054a4> | 2006-07-30 20:48:00 +0000 |
---|---|---|
committer | fxcoudert <fxcoudert@138bc75d-0d04-0410-961f-82ee72b054a4> | 2006-07-30 20:48:00 +0000 |
commit | d2fc5bb1c109c1afbe52c970650c2cc250b95459 (patch) | |
tree | 42900f38bd309eacda612a5027a33176a6f75fb0 | |
parent | 5d87d34c2adc7950a04fda3147e59ab7ff527639 (diff) | |
download | gcc-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/ChangeLog | 19 | ||||
-rw-r--r-- | gcc/fortran/check.c | 82 | ||||
-rw-r--r-- | gcc/fortran/gfortran.h | 4 | ||||
-rw-r--r-- | gcc/fortran/intrinsic.c | 43 | ||||
-rw-r--r-- | gcc/fortran/intrinsic.h | 13 | ||||
-rw-r--r-- | gcc/fortran/iresolve.c | 73 | ||||
-rw-r--r-- | gcc/fortran/trans-intrinsic.c | 26 | ||||
-rw-r--r-- | gcc/testsuite/gfortran.dg/chmod_1.f90 | 34 | ||||
-rw-r--r-- | gcc/testsuite/gfortran.dg/chmod_2.f90 | 34 | ||||
-rw-r--r-- | gcc/testsuite/gfortran.dg/chmod_3.f90 | 34 | ||||
-rw-r--r-- | gcc/testsuite/gfortran.dg/lrshift_1.f90 | 18 | ||||
-rw-r--r-- | gcc/testsuite/gfortran.dg/ltime_gmtime_1.f90 | 9 | ||||
-rw-r--r-- | gcc/testsuite/gfortran.dg/ltime_gmtime_2.f90 | 9 | ||||
-rw-r--r-- | libgfortran/Makefile.am | 2 | ||||
-rw-r--r-- | libgfortran/Makefile.in | 14 | ||||
-rw-r--r-- | libgfortran/config.h.in | 15 | ||||
-rwxr-xr-x | libgfortran/configure | 183 | ||||
-rw-r--r-- | libgfortran/configure.ac | 5 | ||||
-rw-r--r-- | libgfortran/intrinsics/access.c | 99 | ||||
-rw-r--r-- | libgfortran/intrinsics/chmod.c | 131 | ||||
-rw-r--r-- | libgfortran/intrinsics/date_and_time.c | 185 |
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]; +} + + |