diff options
| author | Daniel Franke <franke.daniel@gmail.com> | 2010-05-19 07:43:53 -0400 |
|---|---|---|
| committer | Daniel Franke <dfranke@gcc.gnu.org> | 2010-05-19 07:43:53 -0400 |
| commit | c9018c71d3cbb2929ab53fa7a762ba43934785f5 (patch) | |
| tree | f42d8a016dbee6c93a1f1d422d13a0837cba65d8 /gcc/fortran/check.c | |
| parent | 81f3232690f1ad1fea044d6e6b60930acd7f16e7 (diff) | |
| download | gcc-c9018c71d3cbb2929ab53fa7a762ba43934785f5.zip gcc-c9018c71d3cbb2929ab53fa7a762ba43934785f5.tar.gz gcc-c9018c71d3cbb2929ab53fa7a762ba43934785f5.tar.bz2 | |
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
Diffstat (limited to 'gcc/fortran/check.c')
| -rw-r--r-- | gcc/fortran/check.c | 29 |
1 files changed, 28 insertions, 1 deletions
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) |