re PR fortran/34505 (FLOAT/SNGL: Not accepted as actual argument; diagnostics problems)

gcc/fortran/:
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.

gcc/testsuite/:
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.

From-SVN: r159558

8 files changed, 76 insertions, 132 deletions

diff --git a/gcc/fortran/ChangeLog b/gcc/fortran/ChangeLog
index a6d2925..09d758a 100644
--- a/gcc/fortran/ChangeLog
+++ b/gcc/fortran/ChangeLog
@@ -1,3 +1,16 @@
+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
diff --git a/gcc/fortran/check.c b/gcc/fortran/check.c
index 799b8c9..3a68c29 100644
--- a/gcc/fortran/check.c
+++ b/gcc/fortran/check.c
@@ -1244,6 +1244,20 @@ gfc_check_eoshift (gfc_expr *array, gfc_expr *shift, gfc_expr *boundary,
   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)
diff --git a/gcc/fortran/intrinsic.c b/gcc/fortran/intrinsic.c
index ff0049b..02dea30 100644
--- a/gcc/fortran/intrinsic.c
+++ b/gcc/fortran/intrinsic.c
@@ -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,15 @@ 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_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);
diff --git a/gcc/fortran/intrinsic.h b/gcc/fortran/intrinsic.h
index 72dcc9c..2e1b95e 100644
--- a/gcc/fortran/intrinsic.h
+++ b/gcc/fortran/intrinsic.h
@@ -59,6 +59,7 @@ gfc_try gfc_check_eoshift (gfc_expr *, gfc_expr *, gfc_expr *, gfc_expr *);
 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_expr *, 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 *);
diff --git a/gcc/fortran/intrinsic.texi b/gcc/fortran/intrinsic.texi
index d8456e8..bc0ea8d 100644
--- a/gcc/fortran/intrinsic.texi
+++ b/gcc/fortran/intrinsic.texi
@@ -92,7 +92,6 @@ Some basic guidelines for editing this document:
 * @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 document:
 * @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 document:
 * @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
diff --git a/gcc/testsuite/ChangeLog b/gcc/testsuite/ChangeLog
index a014911..135c9b2 100644
--- a/gcc/testsuite/ChangeLog
+++ b/gcc/testsuite/ChangeLog
@@ -1,3 +1,10 @@
+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.
diff --git a/gcc/testsuite/gfortran.dg/dfloat_1.f90 b/gcc/testsuite/gfortran.dg/dfloat_1.f90
index 098f22e..6971c6a 100644
--- a/gcc/testsuite/gfortran.dg/dfloat_1.f90
+++ b/gcc/testsuite/gfortran.dg/dfloat_1.f90
@@ -8,8 +8,11 @@ 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()
+
+   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
diff --git a/gcc/testsuite/gfortran.dg/float_1.f90 b/gcc/testsuite/gfortran.dg/float_1.f90
index 224d31d..0f3c062 100644
--- a/gcc/testsuite/gfortran.dg/float_1.f90
+++ b/gcc/testsuite/gfortran.dg/float_1.f90
@@ -5,8 +5,11 @@ 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" }
+
+   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