diff options
author | François-Xavier Coudert <fxcoudert@gcc.gnu.org> | 2006-07-26 11:58:48 +0000 |
---|---|---|
committer | François-Xavier Coudert <fxcoudert@gcc.gnu.org> | 2006-07-26 11:58:48 +0000 |
commit | bf3fb7e43c8d1f22edda0c427a2ac194e8db104b (patch) | |
tree | c7642810eb626a8e434832e2f5f5bee64e4bbc84 /gcc | |
parent | 0fb2088c6a08cf849bda7138603045b2f6d8869b (diff) | |
download | gcc-bf3fb7e43c8d1f22edda0c427a2ac194e8db104b.zip gcc-bf3fb7e43c8d1f22edda0c427a2ac194e8db104b.tar.gz gcc-bf3fb7e43c8d1f22edda0c427a2ac194e8db104b.tar.bz2 |
intrinsic.c (add_functions): Add INT2, SHORT, INT8, LONG, LSTAT, MCLOCK and MCLOCK8 intrinsic functions.
* intrinsic.c (add_functions): Add INT2, SHORT, INT8, LONG,
LSTAT, MCLOCK and MCLOCK8 intrinsic functions.
(add_subroutines): Add LSTAT intrinsic subroutine.
* gfortran.h (gfc_generic_isym_id): Add GFC_ISYM_INT2,
GFC_ISYM_INT8, GFC_ISYM_LONG, GFC_ISYM_LSTAT, GFC_ISYM_MCLOCK
and GFC_ISYM_MCLOCK8.
* iresolve.c (gfc_resolve_int2, gfc_resolve_int8,
gfc_resolve_long, gfc_resolve_lstat, gfc_resolve_mclock,
gfc_resolve_mclock8, gfc_resolve_lstat_sub): New functions.
* check.c (gfc_check_intconv): New function.
* trans-intrinsic.c (gfc_conv_intrinsic_function): Add cases for
the added GFC_ISYM_*.
* simplify.c (gfc_simplify_intconv, gfc_simplify_int2,
gfc_simplify_int8, gfc_simplify_long): New functions.
* intrinsic.h (gfc_check_intconv, gfc_simplify_int2,
gfc_simplify_int8, gfc_simplify_long, gfc_resolve_int2,
gfc_resolve_int8, gfc_resolve_long, gfc_resolve_lstat,
gfc_resolve_mclock, gfc_resolve_mclock8, gfc_resolve_lstat_sub):
Add prototypes.
* gfortran.dg/mclock.f90: New test.
* gfortran.dg/int_conv_1.f90: New test.
* gfortran.dg/stat_1.f90: New test.
* gfortran.dg/stat_2.f90: New test.
* configure.ac: Check for function clock.
* Makefile.am: Compile new file intrinsics/clock.c.
* intrinsics/clock.c: New file.
* Makefile.in: Regenerate.
* configure: Regenerate.
* config.h.in: Regenerate.
* intrinsics/stat.c: Rename the old stat_i?_sub functions to
helper functions stat_i?_sub_0, and use them for both STAT and
LSTAT.
From-SVN: r115754
Diffstat (limited to 'gcc')
-rw-r--r-- | gcc/fortran/ChangeLog | 24 | ||||
-rw-r--r-- | gcc/fortran/check.c | 10 | ||||
-rw-r--r-- | gcc/fortran/gfortran.h | 8 | ||||
-rw-r--r-- | gcc/fortran/intrinsic.c | 41 | ||||
-rw-r--r-- | gcc/fortran/intrinsic.h | 11 | ||||
-rw-r--r-- | gcc/fortran/iresolve.c | 74 | ||||
-rw-r--r-- | gcc/fortran/simplify.c | 60 | ||||
-rw-r--r-- | gcc/fortran/trans-intrinsic.c | 6 | ||||
-rw-r--r-- | gcc/testsuite/ChangeLog | 7 | ||||
-rw-r--r-- | gcc/testsuite/gfortran.dg/int_conv_1.f90 | 36 | ||||
-rw-r--r-- | gcc/testsuite/gfortran.dg/mclock.f90 | 13 | ||||
-rw-r--r-- | gcc/testsuite/gfortran.dg/stat_1.f90 | 22 | ||||
-rw-r--r-- | gcc/testsuite/gfortran.dg/stat_2.f90 | 22 |
13 files changed, 332 insertions, 2 deletions
diff --git a/gcc/fortran/ChangeLog b/gcc/fortran/ChangeLog index 7940ea5..e863f2d 100644 --- a/gcc/fortran/ChangeLog +++ b/gcc/fortran/ChangeLog @@ -1,3 +1,25 @@ +2006-07-26 Francois-Xavier Coudert <coudert@clipper.ens.fr> + + * intrinsic.c (add_functions): Add INT2, SHORT, INT8, LONG, + LSTAT, MCLOCK and MCLOCK8 intrinsic functions. + (add_subroutines): Add LSTAT intrinsic subroutine. + * gfortran.h (gfc_generic_isym_id): Add GFC_ISYM_INT2, + GFC_ISYM_INT8, GFC_ISYM_LONG, GFC_ISYM_LSTAT, GFC_ISYM_MCLOCK + and GFC_ISYM_MCLOCK8. + * iresolve.c (gfc_resolve_int2, gfc_resolve_int8, + gfc_resolve_long, gfc_resolve_lstat, gfc_resolve_mclock, + gfc_resolve_mclock8, gfc_resolve_lstat_sub): New functions. + * check.c (gfc_check_intconv): New function. + * trans-intrinsic.c (gfc_conv_intrinsic_function): Add cases for + the added GFC_ISYM_*. + * simplify.c (gfc_simplify_intconv, gfc_simplify_int2, + gfc_simplify_int8, gfc_simplify_long): New functions. + * intrinsic.h (gfc_check_intconv, gfc_simplify_int2, + gfc_simplify_int8, gfc_simplify_long, gfc_resolve_int2, + gfc_resolve_int8, gfc_resolve_long, gfc_resolve_lstat, + gfc_resolve_mclock, gfc_resolve_mclock8, gfc_resolve_lstat_sub): + Add prototypes. + 2006-07-24 Erik Edelmann <eedelman@gcc.gnu.org> PR fortran/28416 @@ -17,7 +39,7 @@ 2006-07-22 Steven Bosscher <steven@gcc.gnu.org> - PR fortran/28439 + PR fortran/28439 * trans-stmt.c (gfc_trans_arithmetic_if): Evaluate the condition once. 2006-07-16 Jakub Jelinek <jakub@redhat.com> diff --git a/gcc/fortran/check.c b/gcc/fortran/check.c index 1332c2b..4384fdb 100644 --- a/gcc/fortran/check.c +++ b/gcc/fortran/check.c @@ -1200,6 +1200,16 @@ gfc_check_int (gfc_expr * x, gfc_expr * kind) try +gfc_check_intconv (gfc_expr * x) +{ + if (numeric_check (x, 0) == FAILURE) + return FAILURE; + + return SUCCESS; +} + + +try gfc_check_ior (gfc_expr * i, gfc_expr * j) { if (type_check (i, 0, BT_INTEGER) == FAILURE) diff --git a/gcc/fortran/gfortran.h b/gcc/fortran/gfortran.h index 37d70f3..ba73d1d 100644 --- a/gcc/fortran/gfortran.h +++ b/gcc/fortran/gfortran.h @@ -377,6 +377,8 @@ enum gfc_generic_isym_id GFC_ISYM_IERRNO, GFC_ISYM_INDEX, GFC_ISYM_INT, + GFC_ISYM_INT2, + GFC_ISYM_INT8, GFC_ISYM_IOR, GFC_ISYM_IRAND, GFC_ISYM_ISATTY, @@ -391,15 +393,19 @@ enum gfc_generic_isym_id GFC_ISYM_LGT, GFC_ISYM_LLE, GFC_ISYM_LLT, - GFC_ISYM_LOG, GFC_ISYM_LOC, + GFC_ISYM_LOG, GFC_ISYM_LOG10, GFC_ISYM_LOGICAL, + GFC_ISYM_LONG, + GFC_ISYM_LSTAT, GFC_ISYM_MALLOC, GFC_ISYM_MATMUL, GFC_ISYM_MAX, GFC_ISYM_MAXLOC, GFC_ISYM_MAXVAL, + GFC_ISYM_MCLOCK, + GFC_ISYM_MCLOCK8, GFC_ISYM_MERGE, GFC_ISYM_MIN, GFC_ISYM_MINLOC, diff --git a/gcc/fortran/intrinsic.c b/gcc/fortran/intrinsic.c index 3ee0829..1b8e7cd 100644 --- a/gcc/fortran/intrinsic.c +++ b/gcc/fortran/intrinsic.c @@ -1535,6 +1535,26 @@ add_functions (void) make_generic ("int", GFC_ISYM_INT, GFC_STD_F77); + add_sym_1 ("int2", 1, 0, BT_INTEGER, di, GFC_STD_GNU, + gfc_check_intconv, gfc_simplify_int2, gfc_resolve_int2, + a, BT_REAL, dr, REQUIRED); + + make_alias ("short", GFC_STD_GNU); + + make_generic ("int2", GFC_ISYM_INT2, GFC_STD_GNU); + + add_sym_1 ("int8", 1, 0, BT_INTEGER, di, GFC_STD_GNU, + gfc_check_intconv, gfc_simplify_int8, gfc_resolve_int8, + a, BT_REAL, dr, REQUIRED); + + make_generic ("int8", GFC_ISYM_INT8, GFC_STD_GNU); + + add_sym_1 ("long", 1, 0, BT_INTEGER, di, GFC_STD_GNU, + gfc_check_intconv, gfc_simplify_long, gfc_resolve_long, + a, BT_REAL, dr, REQUIRED); + + make_generic ("long", GFC_ISYM_LONG, GFC_STD_GNU); + add_sym_2 ("ior", 1, 1, BT_INTEGER, di, GFC_STD_F95, gfc_check_ior, gfc_simplify_ior, gfc_resolve_ior, i, BT_INTEGER, di, REQUIRED, j, BT_INTEGER, di, REQUIRED); @@ -1679,6 +1699,12 @@ add_functions (void) make_generic ("logical", GFC_ISYM_LOGICAL, GFC_STD_F95); + add_sym_2 ("lstat", 0, 1, BT_INTEGER, di, GFC_STD_GNU, + gfc_check_stat, NULL, gfc_resolve_lstat, + a, BT_CHARACTER, dc, REQUIRED, b, BT_INTEGER, di, REQUIRED); + + make_generic ("lstat", GFC_ISYM_LSTAT, GFC_STD_GNU); + add_sym_1 ("malloc", 0, 1, BT_INTEGER, ii, GFC_STD_GNU, gfc_check_malloc, NULL, gfc_resolve_malloc, a, BT_INTEGER, di, REQUIRED); @@ -1739,6 +1765,16 @@ add_functions (void) make_generic ("maxval", GFC_ISYM_MAXVAL, GFC_STD_F95); + add_sym_0 ("mclock", 1, 0, BT_INTEGER, di, GFC_STD_GNU, + NULL, NULL, gfc_resolve_mclock); + + make_generic ("mclock", GFC_ISYM_MCLOCK, GFC_STD_GNU); + + add_sym_0 ("mclock8", 1, 0, BT_INTEGER, di, GFC_STD_GNU, + NULL, NULL, gfc_resolve_mclock8); + + make_generic ("mclock8", GFC_ISYM_MCLOCK8, GFC_STD_GNU); + add_sym_3 ("merge", 1, 1, BT_REAL, dr, GFC_STD_F95, gfc_check_merge, NULL, gfc_resolve_merge, ts, BT_REAL, dr, REQUIRED, fs, BT_REAL, dr, REQUIRED, @@ -2410,6 +2446,11 @@ add_subroutines (void) ut, BT_INTEGER, di, REQUIRED, vl, BT_INTEGER, di, REQUIRED, st, BT_INTEGER, di, OPTIONAL); + add_sym_3s ("lstat", 0, 1, BT_UNKNOWN, 0, GFC_STD_GNU, + gfc_check_stat_sub, NULL, gfc_resolve_lstat_sub, + name, BT_CHARACTER, dc, REQUIRED, vl, BT_INTEGER, di, REQUIRED, + st, BT_INTEGER, di, OPTIONAL); + add_sym_3s ("stat", 0, 1, BT_UNKNOWN, 0, GFC_STD_GNU, gfc_check_stat_sub, NULL, gfc_resolve_stat_sub, name, BT_CHARACTER, dc, REQUIRED, vl, BT_INTEGER, di, REQUIRED, diff --git a/gcc/fortran/intrinsic.h b/gcc/fortran/intrinsic.h index 63e0ff0..e2a81c8 100644 --- a/gcc/fortran/intrinsic.h +++ b/gcc/fortran/intrinsic.h @@ -74,6 +74,7 @@ try gfc_check_idnint (gfc_expr *); try gfc_check_ieor (gfc_expr *, gfc_expr *); try gfc_check_index (gfc_expr *, gfc_expr *, gfc_expr *); try gfc_check_int (gfc_expr *, gfc_expr *); +try gfc_check_intconv (gfc_expr *); try gfc_check_ior (gfc_expr *, gfc_expr *); try gfc_check_irand (gfc_expr *); try gfc_check_isatty (gfc_expr *); @@ -222,6 +223,9 @@ gfc_expr *gfc_simplify_ichar (gfc_expr *); gfc_expr *gfc_simplify_ieor (gfc_expr *, gfc_expr *); gfc_expr *gfc_simplify_index (gfc_expr *, gfc_expr *, gfc_expr *); gfc_expr *gfc_simplify_int (gfc_expr *, gfc_expr *); +gfc_expr *gfc_simplify_int2 (gfc_expr *); +gfc_expr *gfc_simplify_int8 (gfc_expr *); +gfc_expr *gfc_simplify_long (gfc_expr *); gfc_expr *gfc_simplify_ifix (gfc_expr *); gfc_expr *gfc_simplify_idint (gfc_expr *); gfc_expr *gfc_simplify_ior (gfc_expr *, gfc_expr *); @@ -352,6 +356,9 @@ void gfc_resolve_ieor (gfc_expr *, gfc_expr *, gfc_expr *); void gfc_resolve_ichar (gfc_expr *, gfc_expr *); void gfc_resolve_idnint (gfc_expr *, gfc_expr *); void gfc_resolve_int (gfc_expr *, gfc_expr *, gfc_expr *); +void gfc_resolve_int2 (gfc_expr *, gfc_expr *); +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_ishft (gfc_expr *, gfc_expr *, gfc_expr *); @@ -365,11 +372,14 @@ void gfc_resolve_loc (gfc_expr *, gfc_expr *); void gfc_resolve_log (gfc_expr *, gfc_expr *); void gfc_resolve_log10 (gfc_expr *, gfc_expr *); void gfc_resolve_logical (gfc_expr *, gfc_expr *, gfc_expr *); +void gfc_resolve_lstat (gfc_expr *, gfc_expr *, gfc_expr *); void gfc_resolve_malloc (gfc_expr *, gfc_expr *); void gfc_resolve_matmul (gfc_expr *, gfc_expr *, gfc_expr *); void gfc_resolve_max (gfc_expr *, gfc_actual_arglist *); void gfc_resolve_maxloc (gfc_expr *, gfc_expr *, gfc_expr *, gfc_expr *); void gfc_resolve_maxval (gfc_expr *, gfc_expr *, gfc_expr *, gfc_expr *); +void gfc_resolve_mclock (gfc_expr *); +void gfc_resolve_mclock8 (gfc_expr *); void gfc_resolve_merge (gfc_expr *, gfc_expr *, gfc_expr *, gfc_expr *); void gfc_resolve_min (gfc_expr *, gfc_actual_arglist *); void gfc_resolve_minloc (gfc_expr *, gfc_expr *, gfc_expr *, gfc_expr *); @@ -448,6 +458,7 @@ void gfc_resolve_get_environment_variable (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_mvbits (gfc_code *); void gfc_resolve_perror (gfc_code *); diff --git a/gcc/fortran/iresolve.c b/gcc/fortran/iresolve.c index 3eeebc7..a65992e 100644 --- a/gcc/fortran/iresolve.c +++ b/gcc/fortran/iresolve.c @@ -854,6 +854,42 @@ gfc_resolve_int (gfc_expr * f, gfc_expr * a, gfc_expr * kind) void +gfc_resolve_int2 (gfc_expr * f, gfc_expr * a) +{ + f->ts.type = BT_INTEGER; + f->ts.kind = 2; + + f->value.function.name = + gfc_get_string ("__int_%d_%c%d", f->ts.kind, gfc_type_letter (a->ts.type), + a->ts.kind); +} + + +void +gfc_resolve_int8 (gfc_expr * f, gfc_expr * a) +{ + f->ts.type = BT_INTEGER; + f->ts.kind = 8; + + f->value.function.name = + gfc_get_string ("__int_%d_%c%d", f->ts.kind, gfc_type_letter (a->ts.type), + a->ts.kind); +} + + +void +gfc_resolve_long (gfc_expr * f, gfc_expr * a) +{ + f->ts.type = BT_INTEGER; + f->ts.kind = 4; + + f->value.function.name = + gfc_get_string ("__int_%d_%c%d", f->ts.kind, gfc_type_letter (a->ts.type), + a->ts.kind); +} + + +void gfc_resolve_isatty (gfc_expr * f, gfc_expr * u) { gfc_typespec ts; @@ -1191,6 +1227,24 @@ gfc_resolve_maxval (gfc_expr * f, gfc_expr * array, gfc_expr * dim, void +gfc_resolve_mclock (gfc_expr * f) +{ + f->ts.type = BT_INTEGER; + f->ts.kind = 4; + f->value.function.name = PREFIX("mclock"); +} + + +void +gfc_resolve_mclock8 (gfc_expr * f) +{ + f->ts.type = BT_INTEGER; + f->ts.kind = 8; + f->value.function.name = PREFIX("mclock8"); +} + + +void gfc_resolve_merge (gfc_expr * f, gfc_expr * tsource, gfc_expr * fsource ATTRIBUTE_UNUSED, gfc_expr * mask ATTRIBUTE_UNUSED) @@ -1804,6 +1858,16 @@ gfc_resolve_stat (gfc_expr * f, gfc_expr * n ATTRIBUTE_UNUSED, void +gfc_resolve_lstat (gfc_expr * f, gfc_expr * n ATTRIBUTE_UNUSED, + gfc_expr * a ATTRIBUTE_UNUSED) +{ + f->ts.type = BT_INTEGER; + f->ts.kind = gfc_default_integer_kind; + f->value.function.name = gfc_get_string (PREFIX("lstat_i%d"), f->ts.kind); +} + + +void gfc_resolve_fstat (gfc_expr * f, gfc_expr * n, gfc_expr * a ATTRIBUTE_UNUSED) { f->ts.type = BT_INTEGER; @@ -2656,6 +2720,16 @@ gfc_resolve_stat_sub (gfc_code * c) void +gfc_resolve_lstat_sub (gfc_code * c) +{ + const char *name; + + name = gfc_get_string (PREFIX("lstat_i%d_sub"), gfc_default_integer_kind); + c->resolved_sym = gfc_get_intrinsic_sub_symbol (name); +} + + +void gfc_resolve_fstat_sub (gfc_code * c) { const char *name; diff --git a/gcc/fortran/simplify.c b/gcc/fortran/simplify.c index b77537c..8a7d79b 100644 --- a/gcc/fortran/simplify.c +++ b/gcc/fortran/simplify.c @@ -1610,6 +1610,66 @@ gfc_simplify_int (gfc_expr * e, gfc_expr * k) } +static gfc_expr * +gfc_simplify_intconv (gfc_expr * e, int kind, const char *name) +{ + gfc_expr *rpart, *rtrunc, *result; + + if (e->expr_type != EXPR_CONSTANT) + return NULL; + + result = gfc_constant_result (BT_INTEGER, kind, &e->where); + + switch (e->ts.type) + { + case BT_INTEGER: + mpz_set (result->value.integer, e->value.integer); + break; + + case BT_REAL: + rtrunc = gfc_copy_expr (e); + mpfr_trunc (rtrunc->value.real, e->value.real); + gfc_mpfr_to_mpz (result->value.integer, rtrunc->value.real); + gfc_free_expr (rtrunc); + break; + + case BT_COMPLEX: + rpart = gfc_complex2real (e, kind); + rtrunc = gfc_copy_expr (rpart); + mpfr_trunc (rtrunc->value.real, rpart->value.real); + gfc_mpfr_to_mpz (result->value.integer, rtrunc->value.real); + gfc_free_expr (rpart); + gfc_free_expr (rtrunc); + break; + + default: + gfc_error ("Argument of %s at %L is not a valid type", name, &e->where); + gfc_free_expr (result); + return &gfc_bad_expr; + } + + return range_check (result, name); +} + +gfc_expr * +gfc_simplify_int2 (gfc_expr * e) +{ + return gfc_simplify_intconv (e, 2, "INT2"); +} + +gfc_expr * +gfc_simplify_int8 (gfc_expr * e) +{ + return gfc_simplify_intconv (e, 8, "INT8"); +} + +gfc_expr * +gfc_simplify_long (gfc_expr * e) +{ + return gfc_simplify_intconv (e, 4, "LONG"); +} + + gfc_expr * gfc_simplify_ifix (gfc_expr * e) { diff --git a/gcc/fortran/trans-intrinsic.c b/gcc/fortran/trans-intrinsic.c index b23fc5f..472d982d9 100644 --- a/gcc/fortran/trans-intrinsic.c +++ b/gcc/fortran/trans-intrinsic.c @@ -3477,6 +3477,9 @@ gfc_conv_intrinsic_function (gfc_se * se, gfc_expr * expr) /* Integer conversions are handled separately to make sure we get the correct rounding mode. */ case GFC_ISYM_INT: + case GFC_ISYM_INT2: + case GFC_ISYM_INT8: + case GFC_ISYM_LONG: gfc_conv_intrinsic_int (se, expr, FIX_TRUNC_EXPR); break; @@ -3732,8 +3735,11 @@ gfc_conv_intrinsic_function (gfc_se * se, gfc_expr * expr) case GFC_ISYM_IRAND: case GFC_ISYM_ISATTY: case GFC_ISYM_LINK: + case GFC_ISYM_LSTAT: case GFC_ISYM_MALLOC: case GFC_ISYM_MATMUL: + case GFC_ISYM_MCLOCK: + case GFC_ISYM_MCLOCK8: case GFC_ISYM_RAND: case GFC_ISYM_RENAME: case GFC_ISYM_SECOND: diff --git a/gcc/testsuite/ChangeLog b/gcc/testsuite/ChangeLog index 26a25b9..5f5bdcc 100644 --- a/gcc/testsuite/ChangeLog +++ b/gcc/testsuite/ChangeLog @@ -1,3 +1,10 @@ +2006-07-26 Francois-Xavier Coudert <coudert@clipper.ens.fr> + + * gfortran.dg/mclock.f90: New test. + * gfortran.dg/int_conv_1.f90: New test. + * gfortran.dg/stat_1.f90: New test. + * gfortran.dg/stat_2.f90: New test. + 2006-07-25 Jerry DeLisle <jvdelisle@gcc.gnu.org> PR libgfortran/28335 diff --git a/gcc/testsuite/gfortran.dg/int_conv_1.f90 b/gcc/testsuite/gfortran.dg/int_conv_1.f90 new file mode 100644 index 0000000..15f71f9 --- /dev/null +++ b/gcc/testsuite/gfortran.dg/int_conv_1.f90 @@ -0,0 +1,36 @@ +! { dg-do run } +! { dg-options "-std=gnu" } + integer(kind=2) :: i2, j2, k2, l2, m2, n2, o2 + integer(kind=4) :: i4, j4 + integer(kind=8) :: i8, j8 + real :: x + complex :: z + + i2 = huge(i2) / 3 + i8 = int8(i2) + i4 = long(i2) + j2 = short(i2) + k2 = int2(i2) + l2 = int2(i8) + m2 = short(i8) + n2 = int2(i4) + o2 = short(i4) + + if (i8 /= i2 .or. i4 /= i2 .or. j2 /= i2 .or. k2 /= i2 & + .or. l2 /= i2 .or. m2 /= i2 .or. n2 /= i2 .or. o2 /= i2) call abort + + x = i2 + i8 = int8(x) + i4 = long(x) + j2 = short(x) + k2 = int2(x) + if (i8 /= i2 .or. i4 /= i2 .or. j2 /= i2 .or. k2 /= i2) call abort + + z = i2 + (0.,-42.) + i8 = int8(z) + i4 = long(z) + j2 = short(z) + k2 = int2(z) + if (i8 /= i2 .or. i4 /= i2 .or. j2 /= i2 .or. k2 /= i2) call abort + + end diff --git a/gcc/testsuite/gfortran.dg/mclock.f90 b/gcc/testsuite/gfortran.dg/mclock.f90 new file mode 100644 index 0000000..5af96d0 --- /dev/null +++ b/gcc/testsuite/gfortran.dg/mclock.f90 @@ -0,0 +1,13 @@ +! { dg-do run } +! { dg-options "-std=gnu" } + integer(kind=4) :: i4, j4 + integer(kind=8) :: i8, j8 + + i4 = mclock() + i8 = mclock8() + j4 = mclock() + j8 = mclock8() + + if (i4 > j4 .or. i8 > j8 .or. i4 > i8 .or. j4 > j8) call abort + + end diff --git a/gcc/testsuite/gfortran.dg/stat_1.f90 b/gcc/testsuite/gfortran.dg/stat_1.f90 new file mode 100644 index 0000000..c8e3881 --- /dev/null +++ b/gcc/testsuite/gfortran.dg/stat_1.f90 @@ -0,0 +1,22 @@ +! { dg-do run } +! { dg-options "-std=gnu" } + character(len=*), parameter :: f = "testfile" + integer :: s1(13), r1, s2(13), r2, s3(13), r3 + + open (10,file=f) + write (10,"(A)") "foo" + close (10,status="keep") + + open (10,file=f) + call lstat (f, s1, r1) + call stat (f, s2, r2) + call fstat (10, s3, r3) + + if (r1 /= 0 .or. r2 /= 0 .or. r3 /= 0) call abort + if (any (s1 /= s2) .or. any (s1 /= s3)) call abort + if (s1(5) /= getuid()) call abort + if (s1(6) /= getgid()) call abort + if (s1(8) < 3 .or. s1(8) > 5) call abort + + close (10,status="delete") + end diff --git a/gcc/testsuite/gfortran.dg/stat_2.f90 b/gcc/testsuite/gfortran.dg/stat_2.f90 new file mode 100644 index 0000000..7ebd057 --- /dev/null +++ b/gcc/testsuite/gfortran.dg/stat_2.f90 @@ -0,0 +1,22 @@ +! { dg-do run } +! { dg-options "-std=gnu" } + character(len=*), parameter :: f = "testfile" + integer :: s1(13), r1, s2(13), r2, s3(13), r3 + + open (10,file=f) + write (10,"(A)") "foo" + close (10,status="keep") + + open (10,file=f) + r1 = lstat (f, s1) + r2 = stat (f, s2) + r3 = fstat (10, s3) + + if (r1 /= 0 .or. r2 /= 0 .or. r3 /= 0) call abort + if (any (s1 /= s2) .or. any (s1 /= s3)) call abort + if (s1(5) /= getuid()) call abort + if (s1(6) /= getgid()) call abort + if (s1(8) < 3 .or. s1(8) > 5) call abort + + close (10,status="delete") + end |