mirror/gcc
2
0
Fork 0
mirror of git://gcc.gnu.org/git/gcc.git synced 2025-04-15 22:21:20 +08:00
Code Issues Packages Projects Releases Wiki Activity

re PR fortran/33105 (F2003: Support is_iostat_end & is_iostat_eor intrinsics)

Browse Source 
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
This commit is contained in:
François-Xavier Coudert 2007-08-29 15:16:00 +00:00
parent 3743c639c7
commit bae891736b
7 changed files with 157 additions and 0 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

13
gcc/fortran/ChangeLog
View File

@ -1,3 +1,16 @@
2007-08-29 Francois-Xavier Coudert <fxcoudert@gcc.gnu.org>
Tobias Burnus <burnus@gcc.gnu.org>
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 <crickett@lanl.gov>
PR fortran/33215

2
gcc/fortran/gfortran.h
View File

@ -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,

12
gcc/fortran/intrinsic.c
View File

@ -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);

92
gcc/fortran/intrinsic.texi
View File

@ -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

24
gcc/fortran/trans-intrinsic.c
View File

@ -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;

5
gcc/testsuite/ChangeLog
View File

@ -1,3 +1,8 @@
2007-08-29 Tobias Burnus <burnus@gcc.gnu.org>
PR fortran/33105
* gfortran.dg/is_iostat_end_eor_1.f90: New test.
2007-08-29 Uros Bizjak <ubizjak@gmail.com>
* gcc.dg/h8300-ice2.c: Remove target selector.

9
gcc/testsuite/gfortran.dg/is_iostat_end_eor_1.f90 Normal file
View File

@ -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