This is the mail archive of the
fortran@gcc.gnu.org
mailing list for the GNU Fortran project.
[patch, fortran] Fix PR34505 - improved checking for [D]FLOAT and SNGL
- From: Daniel Franke <franke at embl-hamburg dot de>
- To: fortran at gcc dot gnu dot org
- Cc: gcc-patches at gcc dot gnu dot org
- Date: Thu, 13 May 2010 18:44:28 +0200
- Subject: [patch, fortran] Fix PR34505 - improved checking for [D]FLOAT and SNGL
Attached patch improves the checking of [D]FLOAT and SNGL by rejecting the
wrong types and adding a -std= warning/error if used with other kinds than the
expected ones.
Further, I removed the individual docs of FLOAT, DFLOAT and SNGL and added
them as specific names to REAL instead.
gcc/fortran/:
2010-05-13 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 spedicif nodes for FLOAT, DFLOAT and SNGL,
added them to the list of specifics of REAL instead.
gcc/testsuite/:
2010-05-13 Daniel Franke <franke.daniel@gmail.com>
PR fortran/34505
* gfortran.dg/dfloat_1.f90: Add warnings for non-default kind
arguments.
* gfortran.dg/float_1.f90: Likewise.
Regression tested on i686-pc-linux-gnu. Checked docs with `make html`.
Ok for trunk?
Daniel
Index: fortran/intrinsic.h
===================================================================
--- fortran/intrinsic.h (revision 159348)
+++ fortran/intrinsic.h (working copy)
@@ -59,6 +59,7 @@ gfc_try gfc_check_eoshift (gfc_expr *, g
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 *);
@@ -134,6 +135,7 @@ gfc_try gfc_check_size (gfc_expr *, gfc_
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 *);
Index: fortran/check.c
===================================================================
--- fortran/check.c (revision 159348)
+++ fortran/check.c (working copy)
@@ -1244,6 +1244,20 @@ gfc_check_eoshift (gfc_expr *array, gfc_
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. */
@@ -1256,7 +1270,6 @@ gfc_check_fn_c (gfc_expr *a)
return SUCCESS;
}
-
/* A single real argument. */
gfc_try
@@ -2953,6 +2966,20 @@ gfc_check_sleep_sub (gfc_expr *seconds)
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)
Index: fortran/intrinsic.c
===================================================================
--- fortran/intrinsic.c (revision 159366)
+++ fortran/intrinsic.c (working copy)
@@ -1476,8 +1476,6 @@ add_functions (void)
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,
@@ -2293,11 +2291,17 @@ add_functions (void)
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_float, NULL,
a, BT_INTEGER, di, REQUIRED);
+/* make_generic ("float", GFC_ISYM_REAL, GFC_STD_F77);*/
+
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);
Index: fortran/intrinsic.texi
===================================================================
--- fortran/intrinsic.texi (revision 159348)
+++ fortran/intrinsic.texi (working copy)
@@ -92,7 +92,6 @@ Some basic guidelines for editing this d
* @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
@@ -111,7 +110,6 @@ Some basic guidelines for editing this d
* @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
@@ -241,7 +239,6 @@ Some basic guidelines for editing this d
* @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
@@ -3102,7 +3099,7 @@ end program test_dble
@end smallexample
@item @emph{See also}:
-@ref{DFLOAT}, @ref{FLOAT}, @ref{REAL}
+@ref{REAL}
@end table
@@ -3156,47 +3153,6 @@ end program test_dcmplx
@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
@@ -4030,46 +3986,6 @@ end program test_fdate
-@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
@@ -9154,6 +9070,9 @@ See @code{PRECISION} for an example.
@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
@@ -9210,13 +9129,15 @@ end program test_real
@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
@@ -10215,40 +10136,6 @@ end
-@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
Index: testsuite/gfortran.dg/dfloat_1.f90
===================================================================
--- testsuite/gfortran.dg/dfloat_1.f90 (revision 159348)
+++ testsuite/gfortran.dg/dfloat_1.f90 (working copy)
@@ -8,8 +8,8 @@ program dfloat_1
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()
end program dfloat_1
Index: testsuite/gfortran.dg/float_1.f90
===================================================================
--- testsuite/gfortran.dg/float_1.f90 (revision 159348)
+++ testsuite/gfortran.dg/float_1.f90 (working copy)
@@ -5,8 +5,8 @@ program test_float
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" }
end program test_float