diff options
| -rw-r--r-- | gcc/fortran/ChangeLog | 11 | ||||
| -rw-r--r-- | gcc/fortran/decl.c | 12 | ||||
| -rw-r--r-- | gcc/fortran/intrinsic.c | 20 | ||||
| -rw-r--r-- | gcc/fortran/intrinsic.h | 2 | ||||
| -rw-r--r-- | gcc/fortran/simplify.c | 32 |
5 files changed, 61 insertions, 16 deletions
diff --git a/gcc/fortran/ChangeLog b/gcc/fortran/ChangeLog index 38686eeb1a5..51aeeaf14b1 100644 --- a/gcc/fortran/ChangeLog +++ b/gcc/fortran/ChangeLog @@ -1,3 +1,14 @@ +2008-03-06 Francois-Xavier Coudert <fxcoudert@gcc.gnu.org> + + PR fortran/33197 + * intrinsic.c (add_functions): Add simplification routines for + ERF, DERF, ERFC and DERFC. + * decl.c (gfc_match_suffix, gfc_match_subroutine): Change GNU + extensions into Fortran 2008 features. + * intrinsic.h (gfc_simplify_erf, gfc_simplify_erfc): New + prototypes. + * simplify.c (gfc_simplify_erf, gfc_simplify_erfc): New functions. + 2008-03-03 Francois-Xavier Coudert <fxcoudert@gcc.gnu.org> PR fortran/33197 diff --git a/gcc/fortran/decl.c b/gcc/fortran/decl.c index 892c80a46d3..d6a5633a2f6 100644 --- a/gcc/fortran/decl.c +++ b/gcc/fortran/decl.c @@ -3999,9 +3999,9 @@ gfc_match_suffix (gfc_symbol *sym, gfc_symbol **result) /* Fortran 2008 draft allows BIND(C) for internal procedures. */ if (gfc_current_state () == COMP_CONTAINS && sym->ns->proc_name->attr.flavor != FL_MODULE - && gfc_notify_std (GFC_STD_GNU, "Extension: BIND(C) attribute at %L " - "may not be specified for an internal procedure", - &gfc_current_locus) + && gfc_notify_std (GFC_STD_F2008, "Fortran 2008: BIND(C) attribute " + "at %L may not be specified for an internal " + "procedure", &gfc_current_locus) == FAILURE) return MATCH_ERROR; @@ -4733,9 +4733,9 @@ gfc_match_subroutine (void) /* The following is allowed in the Fortran 2008 draft. */ if (gfc_current_state () == COMP_CONTAINS && sym->ns->proc_name->attr.flavor != FL_MODULE - && gfc_notify_std (GFC_STD_GNU, "Extension: BIND(C) attribute at " - "%L may not be specified for an internal procedure", - &gfc_current_locus) + && gfc_notify_std (GFC_STD_F2008, "Fortran 2008: BIND(C) attribute " + "at %L may not be specified for an internal " + "procedure", &gfc_current_locus) == FAILURE) return MATCH_ERROR; diff --git a/gcc/fortran/intrinsic.c b/gcc/fortran/intrinsic.c index e2f3517b47c..258123b92b5 100644 --- a/gcc/fortran/intrinsic.c +++ b/gcc/fortran/intrinsic.c @@ -1352,22 +1352,22 @@ add_functions (void) /* G77 compatibility for the ERF() and ERFC() functions. */ add_sym_1 ("erf", GFC_ISYM_ERF, CLASS_ELEMENTAL, ACTUAL_NO, BT_REAL, dr, - GFC_STD_F2008, gfc_check_fn_r, NULL, gfc_resolve_g77_math1, - x, BT_REAL, dr, REQUIRED); + GFC_STD_F2008, gfc_check_fn_r, gfc_simplify_erf, + gfc_resolve_g77_math1, x, BT_REAL, dr, REQUIRED); - add_sym_1 ("derf", GFC_ISYM_ERF, CLASS_ELEMENTAL, ACTUAL_NO, BT_REAL, dd, GFC_STD_GNU, - gfc_check_fn_d, NULL, gfc_resolve_g77_math1, - x, BT_REAL, dd, REQUIRED); + add_sym_1 ("derf", GFC_ISYM_ERF, CLASS_ELEMENTAL, ACTUAL_NO, BT_REAL, dd, + GFC_STD_GNU, gfc_check_fn_d, gfc_simplify_erf, + gfc_resolve_g77_math1, x, BT_REAL, dd, REQUIRED); make_generic ("erf", GFC_ISYM_ERF, GFC_STD_F2008); add_sym_1 ("erfc", GFC_ISYM_ERFC, CLASS_ELEMENTAL, ACTUAL_NO, BT_REAL, dr, - GFC_STD_F2008, gfc_check_fn_r, NULL, gfc_resolve_g77_math1, - x, BT_REAL, dr, REQUIRED); + GFC_STD_F2008, gfc_check_fn_r, gfc_simplify_erfc, + gfc_resolve_g77_math1, x, BT_REAL, dr, REQUIRED); - add_sym_1 ("derfc", GFC_ISYM_ERFC, CLASS_ELEMENTAL, ACTUAL_NO, BT_REAL, dd, GFC_STD_GNU, - gfc_check_fn_d, NULL, gfc_resolve_g77_math1, - x, BT_REAL, dd, REQUIRED); + add_sym_1 ("derfc", GFC_ISYM_ERFC, CLASS_ELEMENTAL, ACTUAL_NO, BT_REAL, dd, + GFC_STD_GNU, gfc_check_fn_d, gfc_simplify_erfc, + gfc_resolve_g77_math1, x, BT_REAL, dd, REQUIRED); make_generic ("erfc", GFC_ISYM_ERFC, GFC_STD_F2008); diff --git a/gcc/fortran/intrinsic.h b/gcc/fortran/intrinsic.h index 3ae41451742..dc91e77caaf 100644 --- a/gcc/fortran/intrinsic.h +++ b/gcc/fortran/intrinsic.h @@ -222,6 +222,8 @@ gfc_expr *gfc_simplify_digits (gfc_expr *); gfc_expr *gfc_simplify_dim (gfc_expr *, gfc_expr *); gfc_expr *gfc_simplify_dprod (gfc_expr *, gfc_expr *); gfc_expr *gfc_simplify_epsilon (gfc_expr *); +gfc_expr *gfc_simplify_erf (gfc_expr *); +gfc_expr *gfc_simplify_erfc (gfc_expr *); gfc_expr *gfc_simplify_exp (gfc_expr *); gfc_expr *gfc_simplify_exponent (gfc_expr *); gfc_expr *gfc_simplify_float (gfc_expr *); diff --git a/gcc/fortran/simplify.c b/gcc/fortran/simplify.c index a8277ac7046..2272bb567b5 100644 --- a/gcc/fortran/simplify.c +++ b/gcc/fortran/simplify.c @@ -1061,6 +1061,38 @@ gfc_simplify_dprod (gfc_expr *x, gfc_expr *y) gfc_expr * +gfc_simplify_erf (gfc_expr *x) +{ + gfc_expr *result; + + if (x->expr_type != EXPR_CONSTANT) + return NULL; + + result = gfc_constant_result (x->ts.type, x->ts.kind, &x->where); + + mpfr_erf (result->value.real, x->value.real, GFC_RND_MODE); + + return range_check (result, "ERF"); +} + + +gfc_expr * +gfc_simplify_erfc (gfc_expr *x) +{ + gfc_expr *result; + + if (x->expr_type != EXPR_CONSTANT) + return NULL; + + result = gfc_constant_result (x->ts.type, x->ts.kind, &x->where); + + mpfr_erfc (result->value.real, x->value.real, GFC_RND_MODE); + + return range_check (result, "ERFC"); +} + + +gfc_expr * gfc_simplify_epsilon (gfc_expr *e) { gfc_expr *result; |