+2010-05-19 Daniel Franke <franke.daniel@gmail.com>
+
+ PR fortran/34505
+ * intrinsic.h (gfc_check_float): New prototype.
+ (gfc_check_sngl): New prototype.
+ * check.c (gfc_check_float): New.
+ (gfc_check_sngl): New.
+ * intrinsic.c (add_functions): Moved DFLOAT from aliasing DBLE
+ to be a specific for REAL. Added check routines for FLOAT, DFLOAT
+ and SNGL.
+ * intrinsic.texi: Removed individual nodes of FLOAT, DFLOAT and SNGL,
+ added them to the list of specifics of REAL instead.
+
2010-05-17 Janus Weil <janus@gcc.gnu.org>
PR fortran/43990
return SUCCESS;
}
+gfc_try
+gfc_check_float (gfc_expr *a)
+{
+ if (type_check (a, 0, BT_INTEGER) == FAILURE)
+ return FAILURE;
+
+ if ((a->ts.kind != gfc_default_integer_kind)
+ && gfc_notify_std (GFC_STD_GNU, "GNU extension: non-default INTEGER"
+ "kind argument to %s intrinsic at %L",
+ gfc_current_intrinsic, &a->where) == FAILURE )
+ return FAILURE;
+
+ return SUCCESS;
+}
/* A single complex argument. */
return SUCCESS;
}
-
/* A single real argument. */
gfc_try
return SUCCESS;
}
+gfc_try
+gfc_check_sngl (gfc_expr *a)
+{
+ if (type_check (a, 0, BT_REAL) == FAILURE)
+ return FAILURE;
+
+ if ((a->ts.kind != gfc_default_double_kind)
+ && gfc_notify_std (GFC_STD_GNU, "GNU extension: non double precision"
+ "REAL argument to %s intrinsic at %L",
+ gfc_current_intrinsic, &a->where) == FAILURE)
+ return FAILURE;
+
+ return SUCCESS;
+}
gfc_try
gfc_check_spread (gfc_expr *source, gfc_expr *dim, gfc_expr *ncopies)
gfc_check_dble, gfc_simplify_dble, gfc_resolve_dble,
a, BT_REAL, dr, REQUIRED);
- make_alias ("dfloat", GFC_STD_GNU);
-
make_generic ("dble", GFC_ISYM_DBLE, GFC_STD_F77);
add_sym_1 ("digits", GFC_ISYM_DIGITS, CLASS_INQUIRY, ACTUAL_NO, BT_INTEGER, di, GFC_STD_F95,
a, BT_UNKNOWN, dr, REQUIRED);
add_sym_1 ("float", GFC_ISYM_REAL, CLASS_ELEMENTAL, ACTUAL_NO, BT_REAL, dr, GFC_STD_F77,
- gfc_check_i, gfc_simplify_float, NULL,
+ gfc_check_float, gfc_simplify_float, NULL,
a, BT_INTEGER, di, REQUIRED);
+ add_sym_1 ("dfloat", GFC_ISYM_REAL, CLASS_ELEMENTAL, ACTUAL_NO, BT_REAL, dd, GFC_STD_GNU,
+ gfc_check_float, gfc_simplify_dble, gfc_resolve_dble,
+ a, BT_REAL, dr, REQUIRED);
+
add_sym_1 ("sngl", GFC_ISYM_REAL, CLASS_ELEMENTAL, ACTUAL_NO, BT_REAL, dr, GFC_STD_F77,
- NULL, gfc_simplify_sngl, NULL,
+ gfc_check_sngl, gfc_simplify_sngl, NULL,
a, BT_REAL, dd, REQUIRED);
make_generic ("real", GFC_ISYM_REAL, GFC_STD_F77);
gfc_try gfc_check_dtime_etime (gfc_expr *);
gfc_try gfc_check_fgetputc (gfc_expr *, gfc_expr *);
gfc_try gfc_check_fgetput (gfc_expr *);
+gfc_try gfc_check_float (gfc_expr *);
gfc_try gfc_check_fstat (gfc_expr *, gfc_expr *);
gfc_try gfc_check_ftell (gfc_expr *);
gfc_try gfc_check_fn_c (gfc_expr *);
gfc_try gfc_check_sign (gfc_expr *, gfc_expr *);
gfc_try gfc_check_signal (gfc_expr *, gfc_expr *);
gfc_try gfc_check_sizeof (gfc_expr *);
+gfc_try gfc_check_sngl (gfc_expr *);
gfc_try gfc_check_spread (gfc_expr *, gfc_expr *, gfc_expr *);
gfc_try gfc_check_srand (gfc_expr *);
gfc_try gfc_check_stat (gfc_expr *, gfc_expr *);
* @code{DATE_AND_TIME}: DATE_AND_TIME, Date and time subroutine
* @code{DBLE}: DBLE, Double precision conversion function
* @code{DCMPLX}: DCMPLX, Double complex conversion function
-* @code{DFLOAT}: DFLOAT, Double precision conversion function
* @code{DIGITS}: DIGITS, Significant digits function
* @code{DIM}: DIM, Positive difference
* @code{DOT_PRODUCT}: DOT_PRODUCT, Dot product function
* @code{FDATE}: FDATE, Subroutine (or function) to get the current time as a string
* @code{FGET}: FGET, Read a single character in stream mode from stdin
* @code{FGETC}: FGETC, Read a single character in stream mode
-* @code{FLOAT}: FLOAT, Convert integer to default real
* @code{FLOOR}: FLOOR, Integer floor function
* @code{FLUSH}: FLUSH, Flush I/O unit(s)
* @code{FNUM}: FNUM, File number function
* @code{SIZE}: SIZE, Function to determine the size of an array
* @code{SIZEOF}: SIZEOF, Determine the size in bytes of an expression
* @code{SLEEP}: SLEEP, Sleep for the specified number of seconds
-* @code{SNGL}: SNGL, Convert double precision real to default real
* @code{SPACING}: SPACING, Smallest distance between two numbers of a given type
* @code{SPREAD}: SPREAD, Add a dimension to an array
* @code{SQRT}: SQRT, Square-root function
@end smallexample
@item @emph{See also}:
-@ref{DFLOAT}, @ref{FLOAT}, @ref{REAL}
+@ref{REAL}
@end table
@end table
-
-@node DFLOAT
-@section @code{DFLOAT} --- Double conversion function
-@fnindex DFLOAT
-@cindex conversion, to real
-
-@table @asis
-@item @emph{Description}:
-@code{DFLOAT(A)} Converts @var{A} to double precision real type.
-
-@item @emph{Standard}:
-GNU extension
-
-@item @emph{Class}:
-Elemental function
-
-@item @emph{Syntax}:
-@code{RESULT = DFLOAT(A)}
-
-@item @emph{Arguments}:
-@multitable @columnfractions .15 .70
-@item @var{A} @tab The type shall be @code{INTEGER}.
-@end multitable
-
-@item @emph{Return value}:
-The return value is of type double precision real.
-
-@item @emph{Example}:
-@smallexample
-program test_dfloat
- integer :: i = 5
- print *, dfloat(i)
-end program test_dfloat
-@end smallexample
-
-@item @emph{See also}:
-@ref{DBLE}, @ref{FLOAT}, @ref{REAL}
-@end table
-
-
-
@node DIGITS
@section @code{DIGITS} --- Significant binary digits function
@fnindex DIGITS
-@node FLOAT
-@section @code{FLOAT} --- Convert integer to default real
-@fnindex FLOAT
-@cindex conversion, to real
-
-@table @asis
-@item @emph{Description}:
-@code{FLOAT(A)} converts the integer @var{A} to a default real value.
-
-@item @emph{Standard}:
-Fortran 77 and later
-
-@item @emph{Class}:
-Elemental function
-
-@item @emph{Syntax}:
-@code{RESULT = FLOAT(A)}
-
-@item @emph{Arguments}:
-@multitable @columnfractions .15 .70
-@item @var{A} @tab The type shall be @code{INTEGER}.
-@end multitable
-
-@item @emph{Return value}:
-The return value is of type default @code{REAL}.
-
-@item @emph{Example}:
-@smallexample
-program test_float
- integer :: i = 1
- if (float(i) /= 1.) call abort
-end program test_float
-@end smallexample
-
-@item @emph{See also}:
-@ref{DBLE}, @ref{DFLOAT}, @ref{REAL}
-@end table
-
-
-
@node FGET
@section @code{FGET} --- Read a single character in stream mode from stdin
@fnindex FGET
@section @code{REAL} --- Convert to real type
@fnindex REAL
@fnindex REALPART
+@fnindex FLOAT
+@fnindex DFLOAT
+@fnindex SNGL
@cindex conversion, to real
@cindex complex numbers, real part
@item @emph{Specific names}:
@multitable @columnfractions .20 .20 .20 .25
-@item Name @tab Argument @tab Return type @tab Standard
-@item @code{REAL(A)} @tab @code{INTEGER(4)} @tab @code{REAL(4)} @tab Fortran 77 and later
+@item Name @tab Argument @tab Return type @tab Standard
+@item @code{FLOAT(A)} @tab @code{INTEGER(4)} @tab @code{REAL(4)} @tab Fortran 77 and later
+@item @code{DFLOAT(A)} @tab @code{INTEGER(4)} @tab @code{REAL(8)} @tab GNU extension
+@item @code{SNGL(A)} @tab @code{INTEGER(8)} @tab @code{REAL(4)} @tab Fortran 77 and later
@end multitable
@item @emph{See also}:
-@ref{DBLE}, @ref{DFLOAT}, @ref{FLOAT}
+@ref{DBLE}
@end table
-@node SNGL
-@section @code{SNGL} --- Convert double precision real to default real
-@fnindex SNGL
-@cindex conversion, to real
-
-@table @asis
-@item @emph{Description}:
-@code{SNGL(A)} converts the double precision real @var{A}
-to a default real value. This is an archaic form of @code{REAL}
-that is specific to one type for @var{A}.
-
-@item @emph{Standard}:
-Fortran 77 and later
-
-@item @emph{Class}:
-Elemental function
-
-@item @emph{Syntax}:
-@code{RESULT = SNGL(A)}
-
-@item @emph{Arguments}:
-@multitable @columnfractions .15 .70
-@item @var{A} @tab The type shall be a double precision @code{REAL}.
-@end multitable
-
-@item @emph{Return value}:
-The return value is of type default @code{REAL}.
-
-@item @emph{See also}:
-@ref{DBLE}
-@end table
-
-
-
@node SPACING
@section @code{SPACING} --- Smallest distance between two numbers of a given type
@fnindex SPACING
+2010-05-19 Daniel Franke <franke.daniel@gmail.com>
+
+ PR fortran/34505
+ * gfortran.dg/dfloat_1.f90: Add warnings for non-default kind
+ arguments; add check for return value kind.
+ * gfortran.dg/float_1.f90: Likewise.
+
2010-05-18 Rainer Orth <ro@CeBiTec.Uni-Bielefeld.DE>
* gcc.target/i386/20011009-1.c (COMMENT): Define.
i2 = -4_2
i4 = 4_4
i8 = 10_8
- if (dfloat(i2) /= -4.d0) call abort()
+ if (dfloat(i2) /= -4.d0) call abort() ! { dg-warning "non-default INTEGER" }
if (dfloat(i4) /= 4.d0) call abort()
- if (dfloat(i8) /= 10.d0) call abort()
+ if (dfloat(i8) /= 10.d0) call abort() ! { dg-warning "non-default INTEGER" }
if (dfloat(i4*i2) /= -16.d0) call abort()
+
+ if (kind(dfloat(i4)) /= kind(1.0_8)) call abort
+ if (kind(dfloat(i8)) /= kind(1.0_8)) call abort ! { dg-warning "non-default INTEGER" }
end program dfloat_1
integer(2) :: i2 = 1
integer(4) :: i4 = 1
integer(8) :: i8 = 1
- if (float(i1) /= 1.) call abort
- if (float(i2) /= 1.) call abort
+ if (float(i1) /= 1.) call abort ! { dg-warning "non-default INTEGER" }
+ if (float(i2) /= 1.) call abort ! { dg-warning "non-default INTEGER" }
if (float(i4) /= 1.) call abort
- if (float(i8) /= 1.) call abort
+ if (float(i8) /= 1.) call abort ! { dg-warning "non-default INTEGER" }
+
+ if (kind(float(i4)) /= kind(1.0)) call abort
+ if (kind(float(i8)) /= kind(1.0)) call abort ! { dg-warning "non-default INTEGER" }
end program test_float