From bae891736b7f378f46de7999db525829869ce456 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Fran=C3=A7ois-Xavier=20Coudert?= Date: Wed, 29 Aug 2007 15:16:00 +0000 Subject: re PR fortran/33105 (F2003: Support is_iostat_end & is_iostat_eor intrinsics) PR fortran/33105 * intrinsic.c (add_functions): Add IS_IOSTAT_END and IS_IOSTAT_EOR intrinsics. * gfortran.h (gfc_isym_id): Add GFC_ISYM_IS_IOSTAT_END and GFC_ISYM_IS_IOSTAT_EOR. * trans-intrinsic.c (gfc_conv_has_intvalue): New function. (gfc_conv_intrinsic_function): Call gfc_conv_has_intvalue for GFC_ISYM_IS_IOSTAT_END and GFC_ISYM_IS_IOSTAT_EOR. * intrinsic.texi: Add IS_IOSTAT_END and IS_IOSTAT_EOR. * gfortran.dg/is_iostat_end_eor_1.f90: New test. From-SVN: r127903 --- gcc/fortran/ChangeLog | 13 ++++ gcc/fortran/gfortran.h | 2 + gcc/fortran/intrinsic.c | 12 +++ gcc/fortran/intrinsic.texi | 92 +++++++++++++++++++++++ gcc/fortran/trans-intrinsic.c | 24 ++++++ gcc/testsuite/ChangeLog | 5 ++ gcc/testsuite/gfortran.dg/is_iostat_end_eor_1.f90 | 9 +++ 7 files changed, 157 insertions(+) create mode 100644 gcc/testsuite/gfortran.dg/is_iostat_end_eor_1.f90 diff --git a/gcc/fortran/ChangeLog b/gcc/fortran/ChangeLog index 7e5a7d8..8d5e19f 100644 --- a/gcc/fortran/ChangeLog +++ b/gcc/fortran/ChangeLog @@ -1,3 +1,16 @@ +2007-08-29 Francois-Xavier Coudert + Tobias Burnus + + PR fortran/33105 + * intrinsic.c (add_functions): Add IS_IOSTAT_END and + IS_IOSTAT_EOR intrinsics. + * gfortran.h (gfc_isym_id): Add GFC_ISYM_IS_IOSTAT_END and + GFC_ISYM_IS_IOSTAT_EOR. + * trans-intrinsic.c (gfc_conv_has_intvalue): New function. + (gfc_conv_intrinsic_function): Call gfc_conv_has_intvalue for + GFC_ISYM_IS_IOSTAT_END and GFC_ISYM_IS_IOSTAT_EOR. + * intrinsic.texi: Add IS_IOSTAT_END and IS_IOSTAT_EOR. + 2007-08-28 Christopher D. Rickett PR fortran/33215 diff --git a/gcc/fortran/gfortran.h b/gcc/fortran/gfortran.h index 1eb40c6..358055a 100644 --- a/gcc/fortran/gfortran.h +++ b/gcc/fortran/gfortran.h @@ -419,6 +419,8 @@ enum gfc_isym_id GFC_ISYM_IOR, GFC_ISYM_IRAND, GFC_ISYM_ISATTY, + GFC_ISYM_IS_IOSTAT_END, + GFC_ISYM_IS_IOSTAT_EOR, GFC_ISYM_ISNAN, GFC_ISYM_ISHFT, GFC_ISYM_ISHFTC, diff --git a/gcc/fortran/intrinsic.c b/gcc/fortran/intrinsic.c index d273f80..2bc8781 100644 --- a/gcc/fortran/intrinsic.c +++ b/gcc/fortran/intrinsic.c @@ -1633,6 +1633,18 @@ add_functions (void) make_generic ("isatty", GFC_ISYM_ISATTY, GFC_STD_GNU); + add_sym_1 ("is_iostat_end", GFC_ISYM_IS_IOSTAT_END, + CLASS_ELEMENTAL, ACTUAL_NO, BT_LOGICAL, dl, GFC_STD_F2003, + gfc_check_i, NULL, NULL, i, BT_INTEGER, 0, REQUIRED); + + make_generic ("is_iostat_end", GFC_ISYM_IS_IOSTAT_END, GFC_STD_F2003); + + add_sym_1 ("is_iostat_eor", GFC_ISYM_IS_IOSTAT_EOR, + CLASS_ELEMENTAL, ACTUAL_NO, BT_LOGICAL, dl, GFC_STD_F2003, + gfc_check_i, NULL, NULL, i, BT_INTEGER, 0, REQUIRED); + + make_generic ("is_iostat_eor", GFC_ISYM_IS_IOSTAT_EOR, GFC_STD_F2003); + add_sym_1 ("isnan", GFC_ISYM_ISNAN, CLASS_ELEMENTAL, ACTUAL_NO, BT_LOGICAL, dl, GFC_STD_GNU, gfc_check_isnan, NULL, NULL, x, BT_REAL, 0, REQUIRED); diff --git a/gcc/fortran/intrinsic.texi b/gcc/fortran/intrinsic.texi index e94a7e3..d70e819 100644 --- a/gcc/fortran/intrinsic.texi +++ b/gcc/fortran/intrinsic.texi @@ -152,6 +152,8 @@ Some basic guidelines for editing this document: * @code{INT8}: INT8, Convert to 64-bit integer type * @code{IOR}: IOR, Bitwise logical or * @code{IRAND}: IRAND, Integer pseudo-random number +* @code{IS_IOSTAT_END}: IS_IOSTAT_END, Test for end-of-file value +* @code{IS_IOSTAT_EOR}: IS_IOSTAT_EOR, Test for end-of-record value * @code{ISATTY}: ISATTY, Whether a unit is a terminal device * @code{ISHFT}: ISHFT, Shift bits * @code{ISHFTC}: ISHFTC, Shift bits circularly @@ -5878,6 +5880,96 @@ end program test_irand +@node IS_IOSTAT_END +@section @code{IS_IOSTAT_END} --- Test for end-of-file value +@fnindex IS_IOSTAT_END +@cindex IOSTAT, end of file + +@table @asis +@item @emph{Description}: +@code{IS_IOSTAT_END} tests whether an variable has the value of the I/O +status ``end of file''. The function is equivalent to comparing the variable +with the @code{IOSTAT_END} parameter of the intrinsic module +@code{ISO_FORTRAN_ENV}. + +@item @emph{Standard}: +Fortran 2003. + +@item @emph{Class}: +Elemental function + +@item @emph{Syntax}: +@code{RESULT = IS_IOSTAT_END(I)} + +@item @emph{Arguments}: +@multitable @columnfractions .15 .70 +@item @var{I} @tab Shall be of the type @code{INTEGER}. +@end multitable + +@item @emph{Return value}: +Returns a @code{LOGICAL} of the default kind, which @code{.TRUE.} if +@var{I} has the value which indicates an end of file condition for +IOSTAT= specifiers, and is @code{.FALSE.} otherwise. + +@item @emph{Example}: +@smallexample +PROGRAM iostat + IMPLICIT NONE + INTEGER :: stat, i + OPEN(88, FILE='test.dat') + READ(88, *, IOSTAT=stat) i + IF(IS_IOSTAT_END(stat)) STOP 'END OF FILE' +END PROGRAM +@end smallexample +@end table + + + +@node IS_IOSTAT_EOR +@section @code{IS_IOSTAT_EOR} --- Test for end-of-record value +@fnindex IS_IOSTAT_EOR +@cindex IOSTAT, end of record + +@table @asis +@item @emph{Description}: +@code{IS_IOSTAT_EOR} tests whether an variable has the value of the I/O +status ``end of record''. The function is equivalent to comparing the +variable with the @code{IOSTAT_EOR} parameter of the intrinsic module +@code{ISO_FORTRAN_ENV}. + +@item @emph{Standard}: +Fortran 2003. + +@item @emph{Class}: +Elemental function + +@item @emph{Syntax}: +@code{RESULT = IS_IOSTAT_EOR(I)} + +@item @emph{Arguments}: +@multitable @columnfractions .15 .70 +@item @var{I} @tab Shall be of the type @code{INTEGER}. +@end multitable + +@item @emph{Return value}: +Returns a @code{LOGICAL} of the default kind, which @code{.TRUE.} if +@var{I} has the value which indicates an end of file condition for +IOSTAT= specifiers, and is @code{.FALSE.} otherwise. + +@item @emph{Example}: +@smallexample +PROGRAM iostat + IMPLICIT NONE + INTEGER :: stat, i(50) + OPEN(88, FILE='test.dat', FORM='UNFORMATTED') + READ(88, IOSTAT=stat) i + IF(IS_IOSTAT_EOR(stat)) STOP 'END OF RECORD' +END PROGRAM +@end smallexample +@end table + + + @node ISATTY @section @code{ISATTY} --- Whether a unit is a terminal device. @fnindex ISATTY diff --git a/gcc/fortran/trans-intrinsic.c b/gcc/fortran/trans-intrinsic.c index a6802b3..3c43a84 100644 --- a/gcc/fortran/trans-intrinsic.c +++ b/gcc/fortran/trans-intrinsic.c @@ -2759,6 +2759,22 @@ gfc_conv_intrinsic_isnan (gfc_se * se, gfc_expr * expr) se->expr = fold_convert (gfc_typenode_for_spec (&expr->ts), se->expr); } + +/* Intrinsics IS_IOSTAT_END and IS_IOSTAT_EOR just need to compare + their argument against a constant integer value. */ + +static void +gfc_conv_has_intvalue (gfc_se * se, gfc_expr * expr, const int value) +{ + tree arg; + + gfc_conv_intrinsic_function_args (se, expr, &arg, 1); + se->expr = fold_build2 (EQ_EXPR, gfc_typenode_for_spec (&expr->ts), + arg, build_int_cst (TREE_TYPE (arg), value)); +} + + + /* MERGE (tsource, fsource, mask) = mask ? tsource : fsource. */ static void @@ -3911,6 +3927,14 @@ gfc_conv_intrinsic_function (gfc_se * se, gfc_expr * expr) gfc_conv_intrinsic_bitop (se, expr, BIT_IOR_EXPR); break; + case GFC_ISYM_IS_IOSTAT_END: + gfc_conv_has_intvalue (se, expr, -1); + break; + + case GFC_ISYM_IS_IOSTAT_EOR: + gfc_conv_has_intvalue (se, expr, -2); + break; + case GFC_ISYM_ISNAN: gfc_conv_intrinsic_isnan (se, expr); break; diff --git a/gcc/testsuite/ChangeLog b/gcc/testsuite/ChangeLog index 8005e0c..3c0ce89 100644 --- a/gcc/testsuite/ChangeLog +++ b/gcc/testsuite/ChangeLog @@ -1,3 +1,8 @@ +2007-08-29 Tobias Burnus + + PR fortran/33105 + * gfortran.dg/is_iostat_end_eor_1.f90: New test. + 2007-08-29 Uros Bizjak * gcc.dg/h8300-ice2.c: Remove target selector. diff --git a/gcc/testsuite/gfortran.dg/is_iostat_end_eor_1.f90 b/gcc/testsuite/gfortran.dg/is_iostat_end_eor_1.f90 new file mode 100644 index 0000000..dfa3a5c --- /dev/null +++ b/gcc/testsuite/gfortran.dg/is_iostat_end_eor_1.f90 @@ -0,0 +1,9 @@ +! { dg-do run } +! Test for the Fortran 2003 intrinsics is_iostat_end & is_iostat_eor +! +program test + use iso_fortran_env + implicit none + if ((.not. is_iostat_end(IOSTAT_END)) .or. is_iostat_end(0)) call abort() + if ((.not. is_iostat_eor(IOSTAT_EOR)) .or. is_iostat_end(0)) call abort() +end program test -- cgit v1.1