From: Daniel Franke Date: Wed, 19 May 2010 11:43:53 +0000 (-0400) Subject: re PR fortran/34505 (FLOAT/SNGL: Not accepted as actual argument; diagnostics problems) X-Git-Tag: upstream/12.2.0~93039 X-Git-Url: http://review.tizen.org/git/?a=commitdiff_plain;h=c9018c71d3cbb2929ab53fa7a762ba43934785f5;p=platform%2Fupstream%2Fgcc.git re PR fortran/34505 (FLOAT/SNGL: Not accepted as actual argument; diagnostics problems) gcc/fortran/: 2010-05-19 Daniel Franke 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 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 --- 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 + + 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 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 + + 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 * 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