OSDN Git Service

PR fortran/33197
authorfxcoudert <fxcoudert@138bc75d-0d04-0410-961f-82ee72b054a4>
Thu, 6 Mar 2008 12:40:28 +0000 (12:40 +0000)
committerfxcoudert <fxcoudert@138bc75d-0d04-0410-961f-82ee72b054a4>
Thu, 6 Mar 2008 12:40:28 +0000 (12:40 +0000)
* 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.

git-svn-id: svn+ssh://gcc.gnu.org/svn/gcc/trunk@132970 138bc75d-0d04-0410-961f-82ee72b054a4

gcc/fortran/ChangeLog
gcc/fortran/decl.c
gcc/fortran/intrinsic.c
gcc/fortran/intrinsic.h
gcc/fortran/simplify.c

index 38686ee..51aeeaf 100644 (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
index 892c80a..d6a5633 100644 (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;
 
index e2f3517..258123b 100644 (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);
 
index 3ae4145..dc91e77 100644 (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 *);
index a8277ac..2272bb5 100644 (file)
@@ -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;