OSDN Git Service

2010-04-20 Harald Anlauf <anlauf@gmx.de>
[pf3gnuchains/gcc-fork.git] / gcc / fortran / intrinsic.c
index 684b2cf..494b816 100644 (file)
@@ -1081,7 +1081,8 @@ add_functions (void)
     *y = "y", *sz = "size", *sta = "string_a", *stb = "string_b",
     *z = "z", *ln = "len", *ut = "unit", *han = "handler",
     *num = "number", *tm = "time", *nm = "name", *md = "mode",
-    *vl = "values", *p1 = "path1", *p2 = "path2", *com = "command";
+    *vl = "values", *p1 = "path1", *p2 = "path2", *com = "command",
+    *ca = "coarray", *sub = "sub";
 
   int di, dr, dd, dl, dc, dz, ii;
 
@@ -1784,6 +1785,10 @@ add_functions (void)
 
   make_generic ("ierrno", GFC_ISYM_IERRNO, GFC_STD_GNU);
 
+  add_sym_2 ("image_index", GFC_ISYM_IMAGE_INDEX, CLASS_INQUIRY, ACTUAL_NO, BT_INTEGER, di, GFC_STD_F2008,
+            gfc_check_image_index, gfc_simplify_image_index, NULL,
+            ca, BT_REAL, dr, REQUIRED, sub, BT_INTEGER, ii, REQUIRED);
+
   /* The resolution function for INDEX is called gfc_resolve_index_func
      because the name gfc_resolve_index is already used in resolve.c.  */
   add_sym_4 ("index", GFC_ISYM_INDEX, CLASS_ELEMENTAL, ACTUAL_YES,
@@ -1919,6 +1924,14 @@ add_functions (void)
 
   make_generic ("lbound", GFC_ISYM_LBOUND, GFC_STD_F95);
 
+  add_sym_3 ("lcobound", GFC_ISYM_LCOBOUND, CLASS_INQUIRY, ACTUAL_NO,
+            BT_INTEGER, di, GFC_STD_F95,
+            gfc_check_lcobound, gfc_simplify_lcobound, NULL,
+            ca, BT_REAL, dr, REQUIRED, dm, BT_INTEGER, ii, OPTIONAL,
+            kind, BT_INTEGER, di, OPTIONAL);
+
+  make_generic ("lcobound", GFC_ISYM_LCOBOUND, GFC_STD_F95);
+
   add_sym_1 ("leadz", GFC_ISYM_LEADZ, CLASS_ELEMENTAL, ACTUAL_NO,
             BT_INTEGER, di, GFC_STD_F2008,
             gfc_check_i, gfc_simplify_leadz, NULL,
@@ -2221,6 +2234,9 @@ add_functions (void)
 
   make_generic ("null", GFC_ISYM_NULL, GFC_STD_F95);
 
+  add_sym_0 ("num_images", GFC_ISYM_NUMIMAGES, CLASS_INQUIRY, ACTUAL_NO, BT_INTEGER, di, GFC_STD_F2008,
+            NULL, gfc_simplify_num_images, NULL);
+
   add_sym_3 ("pack", GFC_ISYM_PACK, CLASS_TRANSFORMATIONAL, ACTUAL_NO, BT_REAL, dr, GFC_STD_F95,
             gfc_check_pack, gfc_simplify_pack, gfc_resolve_pack,
             ar, BT_REAL, dr, REQUIRED, msk, BT_LOGICAL, dl, REQUIRED,
@@ -2523,6 +2539,10 @@ add_functions (void)
 
   make_generic ("tanh", GFC_ISYM_TANH, GFC_STD_F77);
 
+  add_sym_2 ("this_image", GFC_ISYM_THIS_IMAGE, CLASS_INQUIRY, ACTUAL_NO, BT_INTEGER, di, GFC_STD_F2008,
+            gfc_check_this_image, gfc_simplify_this_image, NULL,
+            ca, BT_REAL, dr, OPTIONAL, dm, BT_INTEGER, ii, OPTIONAL);
+
   add_sym_0 ("time", GFC_ISYM_TIME, NO_CLASS, ACTUAL_NO, BT_INTEGER, di, GFC_STD_GNU, 
             NULL, NULL, gfc_resolve_time);
 
@@ -2579,6 +2599,14 @@ add_functions (void)
 
   make_generic ("ubound", GFC_ISYM_UBOUND, GFC_STD_F95);
 
+  add_sym_3 ("ucobound", GFC_ISYM_UCOBOUND, CLASS_INQUIRY, ACTUAL_NO,
+            BT_INTEGER, di, GFC_STD_F95,
+            gfc_check_ucobound, gfc_simplify_ucobound, NULL,
+            ca, BT_REAL, dr, REQUIRED, dm, BT_INTEGER, ii, OPTIONAL,
+            kind, BT_INTEGER, di, OPTIONAL);
+
+  make_generic ("ucobound", GFC_ISYM_UCOBOUND, GFC_STD_F95);
+
   /* g77 compatibility for UMASK.  */
   add_sym_1 ("umask", GFC_ISYM_UMASK, NO_CLASS, ACTUAL_NO, BT_INTEGER, di,
             GFC_STD_GNU, gfc_check_umask, NULL, gfc_resolve_umask,
@@ -3264,7 +3292,7 @@ keywords:
 
       if (f->actual != NULL)
        {
-         gfc_error ("Argument '%s' is appears twice in call to '%s' at %L",
+         gfc_error ("Argument '%s' appears twice in call to '%s' at %L",
                     f->name, name, where);
          return FAILURE;
        }