diff options
Diffstat (limited to 'gcc')
| -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 |
13 files changed, 392 insertions, 6 deletions
diff --git a/gcc/fortran/ChangeLog b/gcc/fortran/ChangeLog index 3d893ed..bb84735 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 4384fdb..2365822 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 ba73d1d..7335d94 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 1b8e7cd..53f157e 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 e2a81c8..c325a05 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 a65992e..a9a9858 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 472d982d9..cef767d 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 0000000..e9ea27f --- /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 0000000..e413fca --- /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 0000000..4ea34eb --- /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 0000000..7feed29 --- /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 0000000..9babbaf --- /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 0000000..870f011 --- /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 |