* gcc.target/cris/torture/cris-torture.exp: New driver in new

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

diff --git a/gcc/fortran/intrinsic.c b/gcc/fortran/intrinsic.c
index f28317c..7336e63 100644 (file)
--- a/gcc/fortran/intrinsic.c
+++ b/gcc/fortran/intrinsic.c
@@ -37,7 +37,8 @@ int gfc_init_expr = 0;
 /* Pointers to an intrinsic function and its argument names that are being
    checked.  */
 
-char *gfc_current_intrinsic, *gfc_current_intrinsic_arg[MAX_INTRINSIC_ARGS];
+const char *gfc_current_intrinsic;
+const char *gfc_current_intrinsic_arg[MAX_INTRINSIC_ARGS];
 locus *gfc_current_intrinsic_where;
 
 static gfc_intrinsic_sym *functions, *subroutines, *conversion, *next_sym;
@@ -107,7 +108,7 @@ gfc_get_intrinsic_sub_symbol (const char * name)
 /* Return a pointer to the name of a conversion function given two
    typespecs.  */
 
-static char *
+static const char *
 conv_name (gfc_typespec * from, gfc_typespec * to)
 {
   static char name[30];
@@ -115,7 +116,7 @@ conv_name (gfc_typespec * from, gfc_typespec * to)
   sprintf (name, "__convert_%c%d_%c%d", gfc_type_letter (from->type),
           from->kind, gfc_type_letter (to->type), to->kind);
 
-  return name;
+  return gfc_get_string (name);
 }
 
 
@@ -127,7 +128,7 @@ static gfc_intrinsic_sym *
 find_conv (gfc_typespec * from, gfc_typespec * to)
 {
   gfc_intrinsic_sym *sym;
-  char *target;
+  const char *target;
   int i;
 
   target = conv_name (from, to);
@@ -213,7 +214,7 @@ add_sym (const char *name, int elemental, int actual_ok ATTRIBUTE_UNUSED,
         bt type, int kind, int standard, gfc_check_f check,
         gfc_simplify_f simplify, gfc_resolve_f resolve, ...)
 {
-
+  char buf[GFC_MAX_SYMBOL_LEN + 11]; /* 10 for '_gfortran_', 1 for '\0'  */
   int optional, first_flag;
   va_list argp;
 
@@ -233,10 +234,11 @@ add_sym (const char *name, int elemental, int actual_ok ATTRIBUTE_UNUSED,
       break;
 
     case SZ_NOTHING:
-      strcpy (next_sym->name, name);
+      next_sym->name = gfc_get_string (name);
 
-      strcpy (next_sym->lib_name, "_gfortran_");
-      strcat (next_sym->lib_name, name);
+      strcpy (buf, "_gfortran_");
+      strcat (buf, name);
+      next_sym->lib_name = gfc_get_string (buf);
 
       next_sym->elemental = elemental;
       next_sym->ts.type = type;
@@ -785,11 +787,11 @@ make_generic (const char *name, gfc_generic_isym_id generic_id, int standard)
   g->generic = 1;
   g->specific = 1;
   g->generic_id = generic_id;
-  if ((g + 1)->name[0] != '\0')
+  if ((g + 1)->name != NULL)
     g->specific_head = g + 1;
   g++;
 
-  while (g->name[0] != '\0')
+  while (g->name != NULL)
     {
       g->next = g + 1;
       g->specific = 1;
@@ -828,7 +830,7 @@ make_alias (const char *name, int standard)
 
     case SZ_NOTHING:
       next_sym[0] = next_sym[-1];
-      strcpy (next_sym->name, name);
+      next_sym->name = gfc_get_string (name);
       next_sym++;
       break;
 
@@ -1090,6 +1092,12 @@ add_functions (void)
 
   make_generic ("char", GFC_ISYM_CHAR, GFC_STD_F77);
 
+  add_sym_1 ("chdir", 0, 1, BT_INTEGER, di, GFC_STD_GNU,
+            gfc_check_chdir, NULL, gfc_resolve_chdir,
+            a, BT_CHARACTER, dc, REQUIRED);
+
+  make_generic ("chdir", GFC_ISYM_CHDIR, GFC_STD_GNU);
+  
   add_sym_3 ("cmplx", 1, 1, BT_COMPLEX, dz, GFC_STD_F77,
             gfc_check_cmplx, gfc_simplify_cmplx, gfc_resolve_cmplx,
             x, BT_UNKNOWN, dr, REQUIRED, y, BT_UNKNOWN, dr, OPTIONAL,
@@ -1321,6 +1329,12 @@ add_functions (void)
 
   make_generic ("getuid", GFC_ISYM_GETUID, GFC_STD_GNU);
 
+  add_sym_1 ("hostnm", 0, 1, BT_INTEGER, di, GFC_STD_GNU,
+            gfc_check_hostnm, NULL, gfc_resolve_hostnm,
+            a, BT_CHARACTER, dc, REQUIRED);
+
+  make_generic ("hostnm", GFC_ISYM_HOSTNM, GFC_STD_GNU);
+
   add_sym_1 ("huge", 0, 1, BT_REAL, dr, GFC_STD_F95,
             gfc_check_huge, gfc_simplify_huge, NULL,
             x, BT_UNKNOWN, dr, REQUIRED);
@@ -1381,6 +1395,11 @@ add_functions (void)
 
   make_generic ("ieor", GFC_ISYM_IEOR, GFC_STD_F95);
 
+  add_sym_0 ("ierrno", 1, 0, BT_INTEGER, di, GFC_STD_GNU,
+            NULL, NULL, gfc_resolve_ierrno);
+
+  make_generic ("ierrno", GFC_ISYM_IERRNO, GFC_STD_GNU);
+
   add_sym_3 ("index", 1, 1, BT_INTEGER, di, GFC_STD_F77,
             gfc_check_index, gfc_simplify_index, NULL,
             stg, BT_CHARACTER, dc, REQUIRED, ssg, BT_CHARACTER, dc, REQUIRED,
@@ -1428,6 +1447,12 @@ add_functions (void)
 
   make_generic ("ishftc", GFC_ISYM_ISHFTC, GFC_STD_F95);
 
+  add_sym_2 ("kill", 1, 1, BT_INTEGER, di, GFC_STD_GNU,
+            gfc_check_kill, NULL, gfc_resolve_kill,
+            a, BT_INTEGER, di, REQUIRED, b, BT_INTEGER, di, REQUIRED);
+
+  make_generic ("kill", GFC_ISYM_KILL, GFC_STD_GNU);
+
   add_sym_1 ("kind", 0, 1, BT_INTEGER, di, GFC_STD_F95,
             gfc_check_kind, gfc_simplify_kind, NULL,
             x, BT_REAL, dr, REQUIRED);
@@ -1450,6 +1475,8 @@ add_functions (void)
             NULL, gfc_simplify_len_trim, gfc_resolve_len_trim,
             stg, BT_CHARACTER, dc, REQUIRED);
 
+  make_alias ("lnblnk", GFC_STD_GNU);
+
   make_generic ("len_trim", GFC_ISYM_LEN_TRIM, GFC_STD_F95);
 
   add_sym_2 ("lge", 1, 0, BT_LOGICAL, dl, GFC_STD_F77,
@@ -1476,6 +1503,12 @@ add_functions (void)
 
   make_generic ("llt", GFC_ISYM_LLT, GFC_STD_F77);
 
+  add_sym_2 ("link", 0, 1, BT_INTEGER, di, GFC_STD_GNU,
+            gfc_check_link, NULL, gfc_resolve_link,
+            a, BT_CHARACTER, dc, REQUIRED, b, BT_CHARACTER, dc, REQUIRED);
+
+  make_generic ("link", GFC_ISYM_LINK, GFC_STD_GNU);
+  
   add_sym_1 ("log", 1, 1, BT_REAL, dr, GFC_STD_F77,
             gfc_check_fn_rc, gfc_simplify_log, gfc_resolve_log,
             x, BT_REAL, dr, REQUIRED);
@@ -1742,6 +1775,12 @@ add_functions (void)
 
   make_generic ("real", GFC_ISYM_REAL, GFC_STD_F77);
 
+  add_sym_2 ("rename", 0, 1, BT_INTEGER, di, GFC_STD_GNU,
+            gfc_check_rename, NULL, gfc_resolve_rename,
+            a, BT_CHARACTER, dc, REQUIRED, b, BT_CHARACTER, dc, REQUIRED);
+
+  make_generic ("rename", GFC_ISYM_RENAME, GFC_STD_GNU);
+  
   add_sym_2 ("repeat", 0, 1, BT_CHARACTER, dc, GFC_STD_F95,
             gfc_check_repeat, gfc_simplify_repeat, gfc_resolve_repeat,
             stg, BT_CHARACTER, dc, REQUIRED, n, BT_INTEGER, di, REQUIRED);
@@ -1902,6 +1941,12 @@ add_functions (void)
 
   make_generic ("sum", GFC_ISYM_SUM, GFC_STD_F95);
 
+  add_sym_2 ("symlnk", 0, 1, BT_INTEGER, di, GFC_STD_GNU,
+            gfc_check_symlnk, NULL, gfc_resolve_symlnk,
+            a, BT_CHARACTER, dc, REQUIRED, b, BT_CHARACTER, dc, REQUIRED);
+
+  make_generic ("symlnk", GFC_ISYM_SYMLNK, GFC_STD_GNU);
+
   add_sym_1 ("system", 1, 1, BT_INTEGER, di, GFC_STD_GNU,
             NULL, NULL, NULL,
             c, BT_CHARACTER, dc, REQUIRED);
@@ -1928,6 +1973,16 @@ add_functions (void)
 
   make_generic ("tanh", GFC_ISYM_TANH, GFC_STD_F77);
 
+  add_sym_0 ("time", 1, 0, BT_INTEGER, di, GFC_STD_GNU, 
+            NULL, NULL, gfc_resolve_time);
+
+  make_generic ("time", GFC_ISYM_TIME, GFC_STD_GNU);
+
+  add_sym_0 ("time8", 1, 0, BT_INTEGER, di, GFC_STD_GNU, 
+            NULL, NULL, gfc_resolve_time8);
+
+  make_generic ("time8", GFC_ISYM_TIME8, GFC_STD_GNU);
+
   add_sym_1 ("tiny", 0, 1, BT_REAL, dr, GFC_STD_F95,
             gfc_check_x, gfc_simplify_tiny, NULL,
             x, BT_REAL, dr, REQUIRED);
@@ -2022,6 +2077,10 @@ add_subroutines (void)
              gfc_check_second_sub, NULL, gfc_resolve_second_sub,
              tm, BT_REAL, dr, REQUIRED);
 
+  add_sym_2s ("chdir", 0, 1, BT_UNKNOWN, 0, GFC_STD_GNU,
+              gfc_check_chdir_sub, NULL, gfc_resolve_chdir_sub,
+             name, BT_CHARACTER, dc, REQUIRED, st, BT_INTEGER, di, OPTIONAL);
+
   add_sym_4s ("date_and_time", 0, 1, BT_UNKNOWN, 0, GFC_STD_F95,
              gfc_check_date_and_time, NULL, NULL,
              dt, BT_CHARACTER, dc, OPTIONAL, tm, BT_CHARACTER, dc, OPTIONAL,
@@ -2036,6 +2095,10 @@ add_subroutines (void)
             gfc_check_etime_sub, NULL, gfc_resolve_etime_sub,
              vl, BT_REAL, 4, REQUIRED, tm, BT_REAL, 4, REQUIRED);
 
+  add_sym_1s ("gerror", 0, 1, BT_UNKNOWN, 0, GFC_STD_GNU,
+              gfc_check_gerror, NULL, gfc_resolve_gerror, c, BT_CHARACTER,
+             dc, REQUIRED);
+
   add_sym_2s ("getcwd", 0, 1, BT_UNKNOWN, 0, GFC_STD_GNU,
           gfc_check_getcwd_sub, NULL, gfc_resolve_getcwd_sub,
              c, BT_CHARACTER, dc, REQUIRED, st, BT_INTEGER, di, OPTIONAL);
@@ -2048,6 +2111,10 @@ add_subroutines (void)
              NULL, NULL, gfc_resolve_getarg,
              c, BT_INTEGER, di, REQUIRED, vl, BT_CHARACTER, dc, REQUIRED);
 
+  add_sym_1s ("getlog", 0, 1, BT_UNKNOWN, 0, GFC_STD_GNU,
+              gfc_check_getlog, NULL, gfc_resolve_getlog, c, BT_CHARACTER,
+             dc, REQUIRED);
+
   /* F2003 commandline routines.  */
 
   add_sym_3s ("get_command", 0, 1, BT_UNKNOWN, 0, GFC_STD_F2003,
@@ -2096,6 +2163,32 @@ add_subroutines (void)
              gfc_check_flush, NULL, gfc_resolve_flush,
              c, BT_INTEGER, di, OPTIONAL);
 
+  add_sym_2s ("hostnm", 0, 1, BT_UNKNOWN, 0, GFC_STD_GNU,
+          gfc_check_hostnm_sub, NULL, gfc_resolve_hostnm_sub,
+             c, BT_CHARACTER, dc, REQUIRED, st, BT_INTEGER, di, OPTIONAL);
+
+  add_sym_3s ("kill", 0, 1, BT_UNKNOWN, 0, GFC_STD_GNU, gfc_check_kill_sub,
+             NULL, gfc_resolve_kill_sub, c, BT_INTEGER, di, REQUIRED,
+             val, BT_INTEGER, di, REQUIRED, st, BT_INTEGER, di, OPTIONAL);
+
+  add_sym_3s ("link", 0, 1, BT_UNKNOWN, 0, GFC_STD_GNU,
+              gfc_check_link_sub, NULL, gfc_resolve_link_sub,
+             name, BT_CHARACTER, dc, REQUIRED, val, BT_CHARACTER,
+             dc, REQUIRED, st, BT_INTEGER, di, OPTIONAL);
+
+  add_sym_1s ("perror", 0, 1, BT_UNKNOWN, 0, GFC_STD_GNU,
+          gfc_check_perror, NULL, gfc_resolve_perror,
+             c, BT_CHARACTER, dc, REQUIRED);
+
+  add_sym_3s ("rename", 0, 1, BT_UNKNOWN, 0, GFC_STD_GNU,
+              gfc_check_rename_sub, NULL, gfc_resolve_rename_sub,
+             name, BT_CHARACTER, dc, REQUIRED, val, BT_CHARACTER,
+             dc, REQUIRED, st, BT_INTEGER, di, OPTIONAL);
+
+  add_sym_1s ("sleep", 0, 1, BT_UNKNOWN, 0, GFC_STD_GNU,
+              gfc_check_sleep_sub, NULL, gfc_resolve_sleep_sub,
+             val, BT_CHARACTER, dc, REQUIRED);
+
   add_sym_3s ("fstat", 0, 1, BT_UNKNOWN, 0, GFC_STD_GNU,
              gfc_check_fstat_sub, NULL, gfc_resolve_fstat_sub,
              ut, BT_INTEGER, di, REQUIRED, vl, BT_INTEGER, di, REQUIRED,
@@ -2106,6 +2199,11 @@ add_subroutines (void)
              name, BT_CHARACTER, dc, REQUIRED, vl, BT_INTEGER, di, REQUIRED,
              st, BT_INTEGER, di, OPTIONAL);
 
+  add_sym_3s ("symlnk", 0, 1, BT_UNKNOWN, 0, GFC_STD_GNU,
+              gfc_check_symlnk_sub, NULL, gfc_resolve_symlnk_sub,
+             name, BT_CHARACTER, dc, REQUIRED, val, BT_CHARACTER,
+             dc, REQUIRED, st, BT_INTEGER, di, OPTIONAL);
+
   add_sym_2s ("system", 0, 1, BT_UNKNOWN, 0, GFC_STD_GNU,
              NULL, NULL, gfc_resolve_system_sub,
              c, BT_CHARACTER, dc, REQUIRED, st, BT_INTEGER, di, OPTIONAL);
@@ -2152,8 +2250,8 @@ add_conv (bt from_type, int from_kind, bt to_type, int to_kind,
 
   sym = conversion + nconv;
 
-  strcpy (sym->name, conv_name (&from, &to));
-  strcpy (sym->lib_name, sym->name);
+  sym->name =  conv_name (&from, &to);
+  sym->lib_name = sym->name;
   sym->simplify.cc = simplify;
   sym->elemental = 1;
   sym->ts = to;
@@ -2241,7 +2339,7 @@ gfc_intrinsic_init_1 (void)
   nargs = nfunc = nsub = nconv = 0;
 
   /* Create a namespace to hold the resolved intrinsic symbols.  */
-  gfc_intrinsic_namespace = gfc_get_namespace (NULL);
+  gfc_intrinsic_namespace = gfc_get_namespace (NULL, 0);
 
   sizing = SZ_FUNCS;
   add_functions ();
@@ -2359,7 +2457,7 @@ sort_actual (const char *name, gfc_actual_arglist ** ap,
       if (a == NULL)
        goto optional;
 
-      if (a->name[0] != '\0')
+      if (a->name != NULL)
        goto keywords;
 
       f->actual = a;