OpenE2K/gcc
2
0
Fork 0
Code Issues Pull Requests Projects Releases Wiki Activity

re PR fortran/33197 (Fortran 2008: math functions)

Browse Source 
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.

From-SVN: r132970
This commit is contained in:
Francois-Xavier Coudert 2008-03-06 12:40:28 +00:00 committed by François-Xavier Coudert
parent fc0f49f351
commit fdc54e8854
5 changed files with 61 additions and 16 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

11
gcc/fortran/ChangeLog
View File

@ -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

12
gcc/fortran/decl.c
View File

@ -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;

20
gcc/fortran/intrinsic.c
View File

@ -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);

2
gcc/fortran/intrinsic.h
View File

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

32
gcc/fortran/simplify.c
View File

@ -1060,6 +1060,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)
{