2010-01-08 Tobias Burnus <burnus@net-b.de

[pf3gnuchains/gcc-fork.git] / gcc / fortran / intrinsic.c

diff --git a/gcc/fortran/intrinsic.c b/gcc/fortran/intrinsic.c
index a918ddf..859fd4b 100644 (file)
--- a/gcc/fortran/intrinsic.c
+++ b/gcc/fortran/intrinsic.c
@@ -1008,8 +1008,6 @@ make_generic (const char *name, gfc_isym_id id, int standard ATTRIBUTE_UNUSED)
 
   while (g->name != NULL)
     {
-      gcc_assert (g->id == id);
-
       g->next = g + 1;
       g->specific = 1;
       g++;
@@ -1134,7 +1132,7 @@ add_functions (void)
   make_generic ("achar", GFC_ISYM_ACHAR, GFC_STD_F95);
 
   add_sym_1 ("acos", GFC_ISYM_ACOS, CLASS_ELEMENTAL, ACTUAL_YES, BT_REAL, dr, GFC_STD_F77,
-            gfc_check_fn_r, gfc_simplify_acos, gfc_resolve_acos,
+            gfc_check_fn_rc2008, gfc_simplify_acos, gfc_resolve_acos,
             x, BT_REAL, dr, REQUIRED);
 
   add_sym_1 ("dacos", GFC_ISYM_ACOS, CLASS_ELEMENTAL, ACTUAL_YES, BT_REAL, dd, GFC_STD_F77,
@@ -1144,7 +1142,7 @@ add_functions (void)
   make_generic ("acos", GFC_ISYM_ACOS, GFC_STD_F77);
 
   add_sym_1 ("acosh", GFC_ISYM_ACOSH, CLASS_ELEMENTAL, ACTUAL_YES, BT_REAL, dr,
-            GFC_STD_F2008, gfc_check_fn_r, gfc_simplify_acosh,
+            GFC_STD_F2008, gfc_check_fn_rc2008, gfc_simplify_acosh,
             gfc_resolve_acosh, x, BT_REAL, dr, REQUIRED);
 
   add_sym_1 ("dacosh", GFC_ISYM_ACOSH, CLASS_ELEMENTAL, ACTUAL_YES, BT_REAL, dd, GFC_STD_GNU,
@@ -1217,7 +1215,7 @@ add_functions (void)
   make_generic ("any", GFC_ISYM_ANY, GFC_STD_F95);
 
   add_sym_1 ("asin", GFC_ISYM_ASIN, CLASS_ELEMENTAL, ACTUAL_YES, BT_REAL, dr, GFC_STD_F77,
-            gfc_check_fn_r, gfc_simplify_asin, gfc_resolve_asin,
+            gfc_check_fn_rc2008, gfc_simplify_asin, gfc_resolve_asin,
             x, BT_REAL, dr, REQUIRED);
 
   add_sym_1 ("dasin", GFC_ISYM_ASIN, CLASS_ELEMENTAL, ACTUAL_YES, BT_REAL, dd, GFC_STD_F77,
@@ -1227,7 +1225,7 @@ add_functions (void)
   make_generic ("asin", GFC_ISYM_ASIN, GFC_STD_F77);
   
   add_sym_1 ("asinh", GFC_ISYM_ASINH, CLASS_ELEMENTAL, ACTUAL_YES, BT_REAL, dr,
-            GFC_STD_F2008, gfc_check_fn_r, gfc_simplify_asinh,
+            GFC_STD_F2008, gfc_check_fn_rc2008, gfc_simplify_asinh,
             gfc_resolve_asinh, x, BT_REAL, dr, REQUIRED);
 
   add_sym_1 ("dasinh", GFC_ISYM_ASINH, CLASS_ELEMENTAL, ACTUAL_YES, BT_REAL, dd, GFC_STD_GNU,
@@ -1243,17 +1241,22 @@ add_functions (void)
   make_generic ("associated", GFC_ISYM_ASSOCIATED, GFC_STD_F95);
 
   add_sym_1 ("atan", GFC_ISYM_ATAN, CLASS_ELEMENTAL, ACTUAL_YES, BT_REAL, dr, GFC_STD_F77,
-            gfc_check_fn_r, gfc_simplify_atan, gfc_resolve_atan,
+            gfc_check_fn_rc2008, gfc_simplify_atan, gfc_resolve_atan,
             x, BT_REAL, dr, REQUIRED);
 
   add_sym_1 ("datan", GFC_ISYM_ATAN, CLASS_ELEMENTAL, ACTUAL_YES, BT_REAL, dd, GFC_STD_F77,
             gfc_check_fn_d, gfc_simplify_atan, gfc_resolve_atan,
             x, BT_REAL, dd, REQUIRED);
 
+  /* Two-argument version of atan, equivalent to atan2.  */
+  add_sym_2 ("atan", GFC_ISYM_ATAN2, CLASS_ELEMENTAL, ACTUAL_YES, BT_REAL, dr, GFC_STD_F2008,
+            gfc_check_atan_2, gfc_simplify_atan2, gfc_resolve_atan2,
+            y, BT_REAL, dr, REQUIRED, x, BT_REAL, dr, REQUIRED);
+
   make_generic ("atan", GFC_ISYM_ATAN, GFC_STD_F77);
   
   add_sym_1 ("atanh", GFC_ISYM_ATANH, CLASS_ELEMENTAL, ACTUAL_YES, BT_REAL, dr,
-            GFC_STD_F2008, gfc_check_fn_r, gfc_simplify_atanh,
+            GFC_STD_F2008, gfc_check_fn_rc2008, gfc_simplify_atanh,
             gfc_resolve_atanh, x, BT_REAL, dr, REQUIRED);
 
   add_sym_1 ("datanh", GFC_ISYM_ATANH, CLASS_ELEMENTAL, ACTUAL_YES, BT_REAL, dd, GFC_STD_GNU,
@@ -1596,6 +1599,12 @@ add_functions (void)
 
   make_generic ("exponent", GFC_ISYM_EXPONENT, GFC_STD_F95);
 
+  add_sym_2 ("extends_type_of", GFC_ISYM_EXTENDS_TYPE_OF, CLASS_INQUIRY,
+            ACTUAL_NO, BT_LOGICAL, dl, GFC_STD_F2003,
+            gfc_check_same_type_as, NULL, gfc_resolve_extends_type_of,
+            a, BT_UNKNOWN, 0, REQUIRED,
+            mo, BT_UNKNOWN, 0, REQUIRED);
+
   add_sym_0 ("fdate",  GFC_ISYM_FDATE, NO_CLASS, ACTUAL_NO, BT_CHARACTER, dc, GFC_STD_GNU,
             NULL, NULL, gfc_resolve_fdate);
 
@@ -2304,6 +2313,12 @@ add_functions (void)
 
   make_generic ("rrspacing", GFC_ISYM_RRSPACING, GFC_STD_F95);
 
+  add_sym_2 ("same_type_as", GFC_ISYM_SAME_TYPE_AS, CLASS_INQUIRY, ACTUAL_NO,
+            BT_LOGICAL, dl, GFC_STD_F2003,
+            gfc_check_same_type_as, NULL, NULL,
+            a, BT_UNKNOWN, 0, REQUIRED,
+            b, BT_UNKNOWN, 0, REQUIRED);
+
   add_sym_2 ("scale", GFC_ISYM_SCALE, CLASS_ELEMENTAL, ACTUAL_NO, BT_REAL, dr, GFC_STD_F95,
             gfc_check_scale, gfc_simplify_scale, gfc_resolve_scale,
             x, BT_REAL, dr, REQUIRED, i, BT_INTEGER, di, REQUIRED);
@@ -4039,14 +4054,12 @@ gfc_try
 gfc_convert_chartype (gfc_expr *expr, gfc_typespec *ts)
 {
   gfc_intrinsic_sym *sym;
-  gfc_typespec from_ts;
   locus old_where;
   gfc_expr *new_expr;
   int rank;
   mpz_t *shape;
 
   gcc_assert (expr->ts.type == BT_CHARACTER && ts->type == BT_CHARACTER);
-  from_ts = expr->ts;          /* expr->ts gets clobbered */
 
   sym = find_char_conv (&expr->ts, ts);
   gcc_assert (sym);