intrinsic.c (add_functions): Add ACCESS, CHMOD, RSHIFT, LSHIFT.
* intrinsic.c (add_functions): Add ACCESS, CHMOD, RSHIFT, LSHIFT. (add_subroutines): Add LTIME, GMTIME and CHMOD. * intrinsic.h (gfc_check_access_func, gfc_check_chmod, gfc_check_chmod_sub, gfc_check_ltime_gmtime, gfc_simplify_rshift, gfc_simplify_lshift, gfc_resolve_access, gfc_resolve_chmod, gfc_resolve_rshift, gfc_resolve_lshift, gfc_resolve_chmod_sub, gfc_resolve_gmtime, gfc_resolve_ltime): Add prototypes. * gfortran.h (gfc_generic_isym_id): Add GFC_ISYM_ACCESS, GFC_ISYM_CHMOD, GFC_ISYM_LSHIFT, GFC_ISYM_RSHIFT. * iresolve.c (gfc_resolve_access, gfc_resolve_chmod, gfc_resolve_rshift, gfc_resolve_lshift, gfc_resolve_chmod_sub, gfc_resolve_gmtime, gfc_resolve_ltime): New functions. * check.c (gfc_check_access_func, gfc_check_chmod, gfc_check_chmod_sub, gfc_check_ltime_gmtime): New functions. * trans-intrinsic.c (gfc_conv_intrinsic_rlshift): New function. (gfc_conv_intrinsic_function): Add cases for the new GFC_ISYM_*. * intrinsics/date_and_time.c: Add functions for GMTIME and LTIME. * intrinsics/access.c: New file. * intrinsics/chmod.c: New file. * configure.ac: Add checks for <sys/wait.h>, access, fork,execl and wait. * Makefile.am: Add new files intrinsics/access.c and intrinsics/chmod.c. * configure: Regenerate. * config.h.in: Regenerate. * Makefile.in: Regenerate. * gcc/testsuite/gfortran.dg/chmod_3.f90: New test. * gcc/testsuite/gfortran.dg/ltime_gmtime_1.f90: New test. * gcc/testsuite/gfortran.dg/ltime_gmtime_2.f90: New test. * gcc/testsuite/gfortran.dg/lrshift_1.f90: New test. * gcc/testsuite/gfortran.dg/chmod_1.f90: New test. * gcc/testsuite/gfortran.dg/chmod_2.f90: New test. From-SVN: r115825
This commit is contained in:
Francois-Xavier Coudert
François-Xavier Coudert
parent
bd11bebe1b
commit
a119fc1ca8
|
|
@ -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.
|
||||
|
|
|
|||
|
|
@ -442,6 +442,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)
|
||||
{
|
||||
|
|
@ -677,6 +693,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)
|
||||
{
|
||||
|
|
@ -3084,6 +3135,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)
|
||||
{
|
||||
|
|
|
|||
|
|
@ -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,
|
||||
|
|
|
|||
|
|
@ -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,
|
||||
|
|
|
|||
|
|
@ -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 *);
|
||||
|
|
|
|||
|
|
@ -89,6 +89,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)
|
||||
{
|
||||
|
|
@ -352,6 +362,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)
|
||||
{
|
||||
|
|
@ -918,6 +954,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(). */
|
||||
|
||||
|
|
|
|||
|
|
@ -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:
|
||||
|
|
|
|||
|
|
@ -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
|
||||
|
|
@ -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
|
||||
|
|
@ -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
|
||||
|
|
@ -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
|
||||
|
|
@ -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
|
||||
|
|
@ -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
|
||||
|
|
@ -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 \
|
||||
|
|
|
|||
|
|
@ -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
|
||||
|
||||
|
|
|
|||
|
|
@ -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
|
||||
|
||||
|
|
|
|||
|
|
@ -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
|
||||
if test $ac_cv_type_uint64_t = yes; then
|
||||
:
|
||||
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
|
||||
else
|
||||
echo "$as_me: failed program was:" >&5
|
||||
sed 's/^/| /' conftest.$ac_ext >&5
|
||||
|
||||
ac_cv_type_uintptr_t=no
|
||||
acx_cv_header_stdint_kind="(lacks uintptr_t and uint64_t)"
|
||||
fi
|
||||
rm -f conftest.err conftest.$ac_objext conftest.$ac_ext
|
||||
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
|
||||
|
|
|
|||
|
|
@ -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])])
|
||||
|
|
|
|||
|
|
@ -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
|
||||
|
|
@ -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
|
||||
|
|
@ -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];
|
||||
}
|
||||
|
||||
|
||||
|
|
|
|||
Loading…
Reference in New Issue