/* 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;
/* 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;
/* 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);
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;