intrinsic.c (add_functions): Add ACCESS, CHMOD, RSHIFT, LSHIFT.

	* intrinsic.c (add_functions): Add ACCESS, CHMOD, RSHIFT, LSHIFT.
	(add_subroutines): Add LTIME, GMTIME and CHMOD.
	* intrinsic.h (gfc_check_access_func, gfc_check_chmod,
	gfc_check_chmod_sub, gfc_check_ltime_gmtime, gfc_simplify_rshift,
	gfc_simplify_lshift, gfc_resolve_access, gfc_resolve_chmod,
	gfc_resolve_rshift, gfc_resolve_lshift, gfc_resolve_chmod_sub,
	gfc_resolve_gmtime, gfc_resolve_ltime): Add prototypes.
	* gfortran.h (gfc_generic_isym_id): Add GFC_ISYM_ACCESS,
	GFC_ISYM_CHMOD, GFC_ISYM_LSHIFT, GFC_ISYM_RSHIFT.
	* iresolve.c (gfc_resolve_access, gfc_resolve_chmod,
	gfc_resolve_rshift, gfc_resolve_lshift, gfc_resolve_chmod_sub,
	gfc_resolve_gmtime, gfc_resolve_ltime): New functions.
	* check.c (gfc_check_access_func, gfc_check_chmod,
	gfc_check_chmod_sub, gfc_check_ltime_gmtime): New functions.
	* trans-intrinsic.c (gfc_conv_intrinsic_rlshift): New function.
	(gfc_conv_intrinsic_function): Add cases for the new GFC_ISYM_*.

	* intrinsics/date_and_time.c: Add functions for GMTIME and LTIME.
	* intrinsics/access.c: New file.
	* intrinsics/chmod.c: New file.
	* configure.ac: Add checks for <sys/wait.h>, access, fork,execl
	and wait.
	* Makefile.am: Add new files intrinsics/access.c and
	intrinsics/chmod.c.
	* configure: Regenerate.
	* config.h.in: Regenerate.
	* Makefile.in: Regenerate.

	* gcc/testsuite/gfortran.dg/chmod_3.f90: New test.
	* gcc/testsuite/gfortran.dg/ltime_gmtime_1.f90: New test.
	* gcc/testsuite/gfortran.dg/ltime_gmtime_2.f90: New test.
	* gcc/testsuite/gfortran.dg/lrshift_1.f90: New test.
	* gcc/testsuite/gfortran.dg/chmod_1.f90: New test.
	* gcc/testsuite/gfortran.dg/chmod_2.f90: New test.

From-SVN: r115825

gcc/fortran/ChangeLog

+2006-07-30  Francois-Xavier Coudert  <coudert@clipper.ens.fr>
+
+	* intrinsic.c (add_functions): Add ACCESS, CHMOD, RSHIFT, LSHIFT.
+	(add_subroutines): Add LTIME, GMTIME and CHMOD.
+	* intrinsic.h (gfc_check_access_func, gfc_check_chmod,
+	gfc_check_chmod_sub, gfc_check_ltime_gmtime, gfc_simplify_rshift,
+	gfc_simplify_lshift, gfc_resolve_access, gfc_resolve_chmod,
+	gfc_resolve_rshift, gfc_resolve_lshift, gfc_resolve_chmod_sub,
+	gfc_resolve_gmtime, gfc_resolve_ltime): Add prototypes.
+	* gfortran.h (gfc_generic_isym_id): Add GFC_ISYM_ACCESS,
+	GFC_ISYM_CHMOD, GFC_ISYM_LSHIFT, GFC_ISYM_RSHIFT.
+	* iresolve.c (gfc_resolve_access, gfc_resolve_chmod,
+	gfc_resolve_rshift, gfc_resolve_lshift, gfc_resolve_chmod_sub,
+	gfc_resolve_gmtime, gfc_resolve_ltime): New functions.
+	* check.c (gfc_check_access_func, gfc_check_chmod,
+	gfc_check_chmod_sub, gfc_check_ltime_gmtime): New functions.
+	* trans-intrinsic.c (gfc_conv_intrinsic_rlshift): New function.
+	(gfc_conv_intrinsic_function): Add cases for the new GFC_ISYM_*.
+
 2006-07-28  Volker Reichelt  <reichelt@igpm.rwth-aachen.de>
 
 	* Make-lang.in: Use $(HEADER_H) instead of header.h in dependencies.

gcc/fortran/check.c

@@ -443,6 +443,22 @@ gfc_check_achar (gfc_expr * a)
 
 
 try
+gfc_check_access_func (gfc_expr * name, gfc_expr * mode)
+{
+  if (type_check (name, 0, BT_CHARACTER) == FAILURE
+      || scalar_check (name, 0) == FAILURE)
+    return FAILURE;
+
+
+  if (type_check (mode, 1, BT_CHARACTER) == FAILURE
+      || scalar_check (mode, 1) == FAILURE)
+    return FAILURE;
+
+  return SUCCESS;
+}
+
+
+try
 gfc_check_all_any (gfc_expr * mask, gfc_expr * dim)
 {
   if (logical_array_check (mask, 0) == FAILURE)
@@ -678,6 +694,41 @@ gfc_check_chdir_sub (gfc_expr * dir, gfc_expr * status)
 
 
 try
+gfc_check_chmod (gfc_expr * name, gfc_expr * mode)
+{
+  if (type_check (name, 0, BT_CHARACTER) == FAILURE)
+    return FAILURE;
+
+  if (type_check (mode, 1, BT_CHARACTER) == FAILURE)
+    return FAILURE;
+
+  return SUCCESS;
+}
+
+
+try
+gfc_check_chmod_sub (gfc_expr * name, gfc_expr * mode, gfc_expr * status)
+{
+  if (type_check (name, 0, BT_CHARACTER) == FAILURE)
+    return FAILURE;
+
+  if (type_check (mode, 1, BT_CHARACTER) == FAILURE)
+    return FAILURE;
+
+  if (status == NULL)
+    return SUCCESS;
+
+  if (type_check (status, 2, BT_INTEGER) == FAILURE)
+    return FAILURE;
+
+  if (scalar_check (status, 2) == FAILURE)
+    return FAILURE;
+
+  return SUCCESS;
+}
+
+
+try
 gfc_check_cmplx (gfc_expr * x, gfc_expr * y, gfc_expr * kind)
 {
   if (numeric_check (x, 0) == FAILURE)
@@ -3085,6 +3136,37 @@ gfc_check_itime_idate (gfc_expr * values)
 
 
 try
+gfc_check_ltime_gmtime (gfc_expr * time, gfc_expr * values)
+{
+  if (type_check (time, 0, BT_INTEGER) == FAILURE)
+    return FAILURE;
+
+  if (kind_value_check(time, 0, gfc_default_integer_kind) == FAILURE)
+    return FAILURE;
+
+  if (scalar_check (time, 0) == FAILURE)
+    return FAILURE;
+
+  if (array_check (values, 1) == FAILURE)
+    return FAILURE;
+
+  if (rank_check (values, 1, 1) == FAILURE)
+    return FAILURE;
+
+  if (variable_check (values, 1) == FAILURE)
+    return FAILURE;
+
+  if (type_check (values, 1, BT_INTEGER) == FAILURE)
+    return FAILURE;
+
+  if (kind_value_check(values, 1, gfc_default_integer_kind) == FAILURE)
+    return FAILURE;
+
+  return SUCCESS;
+}
+
+
+try
 gfc_check_ttynam_sub (gfc_expr * unit, gfc_expr * name)
 {
   if (scalar_check (unit, 0) == FAILURE)

gcc/fortran/gfortran.h

@@ -304,6 +304,7 @@ enum gfc_generic_isym_id
      the backend (eg. KIND).  */
   GFC_ISYM_NONE = 0,
   GFC_ISYM_ABS,
+  GFC_ISYM_ACCESS,
   GFC_ISYM_ACHAR,
   GFC_ISYM_ACOS,
   GFC_ISYM_ACOSH,
@@ -332,6 +333,7 @@ enum gfc_generic_isym_id
   GFC_ISYM_CEILING,
   GFC_ISYM_CHAR,
   GFC_ISYM_CHDIR,
+  GFC_ISYM_CHMOD,
   GFC_ISYM_CMPLX,
   GFC_ISYM_COMMAND_ARGUMENT_COUNT,
   GFC_ISYM_COMPLEX,
@@ -398,6 +400,7 @@ enum gfc_generic_isym_id
   GFC_ISYM_LOG10,
   GFC_ISYM_LOGICAL,
   GFC_ISYM_LONG,
+  GFC_ISYM_LSHIFT,
   GFC_ISYM_LSTAT,
   GFC_ISYM_MALLOC,
   GFC_ISYM_MATMUL,
@@ -424,6 +427,7 @@ enum gfc_generic_isym_id
   GFC_ISYM_RENAME,
   GFC_ISYM_REPEAT,
   GFC_ISYM_RESHAPE,
+  GFC_ISYM_RSHIFT,
   GFC_ISYM_RRSPACING,
   GFC_ISYM_SCALE,
   GFC_ISYM_SCAN,

gcc/fortran/intrinsic.c

@@ -880,7 +880,7 @@ add_functions (void)
     *x = "x", *sh = "shift", *stg = "string", *ssg = "substring",
     *y = "y", *sz = "size", *sta = "string_a", *stb = "string_b",
     *z = "z", *ln = "len", *ut = "unit", *han = "handler",
-    *num = "number", *tm = "time";
+    *num = "number", *tm = "time", *nm = "name", *md = "mode";
 
   int di, dr, dd, dl, dc, dz, ii;
 
@@ -916,6 +916,12 @@ add_functions (void)
 
   make_generic ("abs", GFC_ISYM_ABS, GFC_STD_F77);
 
+  add_sym_2 ("access", 0, 1, BT_INTEGER, di, GFC_STD_GNU,
+	     gfc_check_access_func, NULL, gfc_resolve_access,
+	     nm, BT_CHARACTER, dc, REQUIRED, md, BT_CHARACTER, dc, REQUIRED);
+
+  make_generic ("access", GFC_ISYM_ACCESS, GFC_STD_GNU);
+
   add_sym_1 ("achar", 1, 1, BT_CHARACTER, dc, GFC_STD_F95,
 	     gfc_check_achar, gfc_simplify_achar, NULL,
 	     i, BT_INTEGER, di, REQUIRED);
@@ -1152,7 +1158,13 @@ add_functions (void)
 	     a, BT_CHARACTER, dc, REQUIRED);
 
   make_generic ("chdir", GFC_ISYM_CHDIR, GFC_STD_GNU);
-  
+
+  add_sym_2 ("chmod", 0, 1, BT_INTEGER, di, GFC_STD_GNU,
+	     gfc_check_chmod, NULL, gfc_resolve_chmod,
+	     nm, BT_CHARACTER, dc, REQUIRED, md, BT_CHARACTER, dc, REQUIRED);
+
+  make_generic ("chmod", GFC_ISYM_CHMOD, 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,
@@ -1580,6 +1592,18 @@ add_functions (void)
 
   make_generic ("isatty", GFC_ISYM_ISATTY, GFC_STD_GNU);
 
+  add_sym_2 ("rshift", 1, 1, BT_INTEGER, di, GFC_STD_GNU,
+	     gfc_check_ishft, NULL, gfc_resolve_rshift,
+	     i, BT_INTEGER, di, REQUIRED, sh, BT_INTEGER, di, REQUIRED);
+
+  make_generic ("rshift", GFC_ISYM_RSHIFT, GFC_STD_GNU);
+
+  add_sym_2 ("lshift", 1, 1, BT_INTEGER, di, GFC_STD_GNU,
+	     gfc_check_ishft, NULL, gfc_resolve_lshift,
+	     i, BT_INTEGER, di, REQUIRED, sh, BT_INTEGER, di, REQUIRED);
+
+  make_generic ("lshift", GFC_ISYM_LSHIFT, GFC_STD_GNU);
+
   add_sym_2 ("ishft", 1, 1, BT_INTEGER, di, GFC_STD_F95,
 	     gfc_check_ishft, gfc_simplify_ishft, gfc_resolve_ishft,
 	     i, BT_INTEGER, di, REQUIRED, sh, BT_INTEGER, di, REQUIRED);
@@ -2256,7 +2280,7 @@ add_subroutines (void)
     *com = "command", *length = "length", *st = "status",
     *val = "value", *num = "number", *name = "name",
     *trim_name = "trim_name", *ut = "unit", *han = "handler",
-    *sec = "seconds", *res = "result", *of = "offset";
+    *sec = "seconds", *res = "result", *of = "offset", *md = "mode";
 
   int di, dr, dc, dl, ii;
 
@@ -2288,6 +2312,14 @@ add_subroutines (void)
 	      gfc_check_itime_idate, NULL, gfc_resolve_itime,
 	      vl, BT_INTEGER, 4, REQUIRED);
 
+  add_sym_2s ("ltime", 0, 1, BT_UNKNOWN, 0, GFC_STD_GNU,
+	      gfc_check_ltime_gmtime, NULL, gfc_resolve_ltime,
+	      tm, BT_INTEGER, di, REQUIRED, vl, BT_INTEGER, di, REQUIRED);
+
+  add_sym_2s ("gmtime", 0, 1, BT_UNKNOWN, 0, GFC_STD_GNU,
+	      gfc_check_ltime_gmtime, NULL, gfc_resolve_gmtime,
+	      tm, BT_INTEGER, di, REQUIRED, vl, BT_INTEGER, di, REQUIRED);
+
   add_sym_1s ("second", 0, 1, BT_UNKNOWN, 0, GFC_STD_GNU,
 	      gfc_check_second_sub, NULL, gfc_resolve_second_sub,
 	      tm, BT_REAL, dr, REQUIRED);
@@ -2296,6 +2328,11 @@ add_subroutines (void)
               gfc_check_chdir_sub, NULL, gfc_resolve_chdir_sub,
 	      name, BT_CHARACTER, dc, REQUIRED, st, BT_INTEGER, di, OPTIONAL);
 
+  add_sym_3s ("chmod", 0, 1, BT_UNKNOWN, 0, GFC_STD_GNU,
+              gfc_check_chmod_sub, NULL, gfc_resolve_chmod_sub,
+	      name, BT_CHARACTER, dc, REQUIRED, md, 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,

gcc/fortran/intrinsic.h

@@ -32,6 +32,7 @@ try gfc_check_a_xkind (gfc_expr *, gfc_expr *);
 try gfc_check_a_p (gfc_expr *, gfc_expr *);
 
 try gfc_check_abs (gfc_expr *);
+try gfc_check_access_func (gfc_expr *, gfc_expr *);
 try gfc_check_achar (gfc_expr *);
 try gfc_check_all_any (gfc_expr *, gfc_expr *);
 try gfc_check_allocated (gfc_expr *);
@@ -41,6 +42,7 @@ try gfc_check_besn (gfc_expr *, gfc_expr *);
 try gfc_check_btest (gfc_expr *, gfc_expr *);
 try gfc_check_char (gfc_expr *, gfc_expr *);
 try gfc_check_chdir (gfc_expr *);
+try gfc_check_chmod (gfc_expr *, gfc_expr *);
 try gfc_check_cmplx (gfc_expr *, gfc_expr *, gfc_expr *);
 try gfc_check_complex (gfc_expr *, gfc_expr *);
 try gfc_check_count (gfc_expr *, gfc_expr *);
@@ -139,6 +141,7 @@ try gfc_check_x (gfc_expr *);
 /* Intrinsic subroutines.  */
 try gfc_check_alarm_sub (gfc_expr *, gfc_expr *, gfc_expr *);
 try gfc_check_chdir_sub (gfc_expr *, gfc_expr *);
+try gfc_check_chmod_sub (gfc_expr *, gfc_expr *, gfc_expr *);
 try gfc_check_cpu_time (gfc_expr *);
 try gfc_check_ctime_sub (gfc_expr *, gfc_expr *);
 try gfc_check_system_clock (gfc_expr *, gfc_expr *, gfc_expr *);
@@ -162,6 +165,7 @@ try gfc_check_getcwd_sub (gfc_expr *, gfc_expr *);
 try gfc_check_hostnm_sub (gfc_expr *, gfc_expr *);
 try gfc_check_itime_idate (gfc_expr *);
 try gfc_check_kill_sub (gfc_expr *, gfc_expr *, gfc_expr *);
+try gfc_check_ltime_gmtime (gfc_expr *, gfc_expr *);
 try gfc_check_perror (gfc_expr *);
 try gfc_check_rename_sub (gfc_expr *, gfc_expr *, gfc_expr *);
 try gfc_check_link_sub (gfc_expr *, gfc_expr *, gfc_expr *);
@@ -293,6 +297,7 @@ gfc_expr *gfc_convert_constant (gfc_expr *, bt, int);
 
 /* Resolution functions.  */
 void gfc_resolve_abs (gfc_expr *, gfc_expr *);
+void gfc_resolve_access (gfc_expr *, gfc_expr *, gfc_expr *);
 void gfc_resolve_acos (gfc_expr *, gfc_expr *);
 void gfc_resolve_acosh (gfc_expr *, gfc_expr *);
 void gfc_resolve_aimag (gfc_expr *, gfc_expr *);
@@ -313,6 +318,7 @@ void gfc_resolve_btest (gfc_expr *, gfc_expr *, gfc_expr *);
 void gfc_resolve_ceiling (gfc_expr *, gfc_expr *, gfc_expr *);
 void gfc_resolve_char (gfc_expr *, gfc_expr *, gfc_expr *);
 void gfc_resolve_chdir (gfc_expr *, gfc_expr *);
+void gfc_resolve_chmod (gfc_expr *, gfc_expr *, gfc_expr *);
 void gfc_resolve_cmplx (gfc_expr *, gfc_expr *, gfc_expr *, gfc_expr *);
 void gfc_resolve_dcmplx (gfc_expr *, gfc_expr *, gfc_expr *);
 void gfc_resolve_complex (gfc_expr *, gfc_expr *, gfc_expr *);
@@ -361,6 +367,8 @@ void gfc_resolve_int8 (gfc_expr *, gfc_expr *);
 void gfc_resolve_long (gfc_expr *, gfc_expr *);
 void gfc_resolve_ior (gfc_expr *, gfc_expr *, gfc_expr *);
 void gfc_resolve_isatty (gfc_expr *, gfc_expr *);
+void gfc_resolve_rshift (gfc_expr *, gfc_expr *, gfc_expr *);
+void gfc_resolve_lshift (gfc_expr *, gfc_expr *, gfc_expr *);
 void gfc_resolve_ishft (gfc_expr *, gfc_expr *, gfc_expr *);
 void gfc_resolve_ishftc (gfc_expr *, gfc_expr *, gfc_expr *, gfc_expr *);
 void gfc_resolve_kill (gfc_expr *, gfc_expr *, gfc_expr *);
@@ -436,6 +444,7 @@ void gfc_resolve_xor (gfc_expr *, gfc_expr *, gfc_expr *);
 /* Intrinsic subroutine resolution.  */
 void gfc_resolve_alarm_sub (gfc_code *);
 void gfc_resolve_chdir_sub (gfc_code *);
+void gfc_resolve_chmod_sub (gfc_code *);
 void gfc_resolve_cpu_time (gfc_code *);
 void gfc_resolve_ctime_sub (gfc_code *);
 void gfc_resolve_exit (gfc_code *);
@@ -455,11 +464,13 @@ void gfc_resolve_getlog (gfc_code *);
 void gfc_resolve_get_command (gfc_code *);
 void gfc_resolve_get_command_argument (gfc_code *);
 void gfc_resolve_get_environment_variable (gfc_code *);
+void gfc_resolve_gmtime (gfc_code *);
 void gfc_resolve_hostnm_sub (gfc_code *);
 void gfc_resolve_idate (gfc_code *);
 void gfc_resolve_itime (gfc_code *);
-void gfc_resolve_lstat_sub (gfc_code *);
 void gfc_resolve_kill_sub (gfc_code *);
+void gfc_resolve_lstat_sub (gfc_code *);
+void gfc_resolve_ltime (gfc_code *);
 void gfc_resolve_mvbits (gfc_code *);
 void gfc_resolve_perror (gfc_code *);
 void gfc_resolve_random_number (gfc_code *);

gcc/fortran/iresolve.c

@@ -90,6 +90,16 @@ gfc_resolve_abs (gfc_expr * f, gfc_expr * a)
 
 
 void
+gfc_resolve_access (gfc_expr * f, gfc_expr * name ATTRIBUTE_UNUSED,
+	            gfc_expr * mode ATTRIBUTE_UNUSED)
+{
+  f->ts.type = BT_INTEGER;
+  f->ts.kind = gfc_c_int_kind;
+  f->value.function.name = PREFIX("access_func");
+}
+
+
+void
 gfc_resolve_acos (gfc_expr * f, gfc_expr * x)
 {
   f->ts = x->ts;
@@ -353,6 +363,32 @@ gfc_resolve_chdir_sub (gfc_code * c)
 
 
 void
+gfc_resolve_chmod (gfc_expr * f, gfc_expr * name ATTRIBUTE_UNUSED,
+		   gfc_expr * mode ATTRIBUTE_UNUSED)
+{
+  f->ts.type = BT_INTEGER;
+  f->ts.kind = gfc_c_int_kind;
+  f->value.function.name = PREFIX("chmod_func");
+}
+
+
+void
+gfc_resolve_chmod_sub (gfc_code * c)
+{
+  const char *name;
+  int kind;
+
+  if (c->ext.actual->next->next->expr != NULL)
+    kind = c->ext.actual->next->next->expr->ts.kind;
+  else
+    kind = gfc_default_integer_kind;
+
+  name = gfc_get_string (PREFIX("chmod_i%d_sub"), kind);
+  c->resolved_sym = gfc_get_intrinsic_sub_symbol (name);
+}
+
+
+void
 gfc_resolve_cmplx (gfc_expr * f, gfc_expr * x, gfc_expr * y, gfc_expr * kind)
 {
   f->ts.type = BT_COMPLEX;
@@ -919,6 +955,24 @@ gfc_resolve_ishft (gfc_expr * f, gfc_expr * i, gfc_expr * shift)
 
 
 void
+gfc_resolve_rshift (gfc_expr * f, gfc_expr * i, gfc_expr * shift)
+{
+  f->ts = i->ts;
+  f->value.function.name =
+    gfc_get_string ("__rshift_%d_%d", i->ts.kind, shift->ts.kind);
+}
+
+
+void
+gfc_resolve_lshift (gfc_expr * f, gfc_expr * i, gfc_expr * shift)
+{
+  f->ts = i->ts;
+  f->value.function.name =
+    gfc_get_string ("__lshift_%d_%d", i->ts.kind, shift->ts.kind);
+}
+
+
+void
 gfc_resolve_ishftc (gfc_expr * f, gfc_expr * i, gfc_expr * shift,
 		    gfc_expr * size)
 {
@@ -2398,7 +2452,7 @@ gfc_resolve_etime_sub (gfc_code * c)
 }
 
 
-/* G77 compatibility subroutines itime() and idate().  */
+/* G77 compatibility subroutines itime(), idate(), ltime() and gmtime().  */
 
 void
 gfc_resolve_itime (gfc_code * c)
@@ -2408,7 +2462,6 @@ gfc_resolve_itime (gfc_code * c)
 				       gfc_default_integer_kind));
 }
 
-
 void
 gfc_resolve_idate (gfc_code * c)
 {
@@ -2417,6 +2470,22 @@ gfc_resolve_idate (gfc_code * c)
 				       gfc_default_integer_kind));
 }
 
+void
+gfc_resolve_ltime (gfc_code * c)
+{
+  c->resolved_sym = gfc_get_intrinsic_sub_symbol
+		      (gfc_get_string (PREFIX("ltime_i%d"),
+				       gfc_default_integer_kind));
+}
+
+void
+gfc_resolve_gmtime (gfc_code * c)
+{
+  c->resolved_sym = gfc_get_intrinsic_sub_symbol
+		      (gfc_get_string (PREFIX("gmtime_i%d"),
+				       gfc_default_integer_kind));
+}
+
 
 /* G77 compatibility subroutine second().  */
 

gcc/fortran/trans-intrinsic.c

@@ -2110,6 +2110,22 @@ gfc_conv_intrinsic_ibits (gfc_se * se, gfc_expr * expr)
   se->expr = fold_build2 (BIT_AND_EXPR, type, tmp, mask);
 }
 
+/* RSHIFT (I, SHIFT) = I >> SHIFT
+   LSHIFT (I, SHIFT) = I << SHIFT  */
+static void
+gfc_conv_intrinsic_rlshift (gfc_se * se, gfc_expr * expr, int right_shift)
+{
+  tree arg;
+  tree arg2;
+
+  arg = gfc_conv_intrinsic_function_args (se, expr);
+  arg2 = TREE_VALUE (TREE_CHAIN (arg));
+  arg = TREE_VALUE (arg);
+
+  se->expr = fold_build2 (right_shift ? RSHIFT_EXPR : LSHIFT_EXPR,
+			  TREE_TYPE (arg), arg, arg2);
+}
+
 /* ISHFT (I, SHIFT) = (abs (shift) >= BIT_SIZE (i))
                         ? 0
 	 	        : ((shift >= 0) ? i << shift : i >> -shift)
@@ -3581,6 +3597,14 @@ gfc_conv_intrinsic_function (gfc_se * se, gfc_expr * expr)
       gfc_conv_intrinsic_bitop (se, expr, BIT_IOR_EXPR);
       break;
 
+    case GFC_ISYM_LSHIFT:
+      gfc_conv_intrinsic_rlshift (se, expr, 0);
+      break;
+
+    case GFC_ISYM_RSHIFT:
+      gfc_conv_intrinsic_rlshift (se, expr, 1);
+      break;
+
     case GFC_ISYM_ISHFT:
       gfc_conv_intrinsic_ishft (se, expr);
       break;
@@ -3716,7 +3740,9 @@ gfc_conv_intrinsic_function (gfc_se * se, gfc_expr * expr)
       gfc_conv_intrinsic_loc (se, expr);
       break;
 
+    case GFC_ISYM_ACCESS:
     case GFC_ISYM_CHDIR:
+    case GFC_ISYM_CHMOD:
     case GFC_ISYM_ETIME:
     case GFC_ISYM_FGET:
     case GFC_ISYM_FGETC:

gcc/testsuite/gfortran.dg/chmod_1.f90

+! { dg-do run }
+! { dg-options "-std=gnu" }
+  implicit none
+  character(len=*), parameter :: n = "foobar_file"
+  integer :: i
+
+  open (10,file=n)
+  close (10,status="delete")
+
+  open (10,file=n)
+  close (10,status="keep")
+
+  if (access(n,"") /= 0 .or. access(n," ") /= 0 .or. access(n,"r") /= 0 .or. &
+      access(n,"R") /= 0 .or. access(n,"w") /= 0 .or. access(n,"W") /= 0) &
+    call abort
+
+  call chmod (n, "a+x", i)
+  if (i == 0) then
+    if (access(n,"x") /= 0 .or. access(n,"X") /= 0) call abort
+  end if
+
+  call chmod (n, "a-w", i)
+  if (i == 0) then
+    if (access(n,"w") == 0 .or. access(n,"W") == 0) call abort
+  end if
+
+  open (10,file=n)
+  close (10,status="delete")
+
+  if (access(n,"") == 0 .or. access(n," ") == 0 .or. access(n,"r") == 0 .or. &
+      access(n,"R") == 0 .or. access(n,"w") == 0 .or. access(n,"W") == 0) &
+    call abort
+
+  end

gcc/testsuite/gfortran.dg/chmod_2.f90

+! { dg-do run }
+! { dg-options "-std=gnu" }
+  implicit none
+  character(len=*), parameter :: n = "foobar_file"
+  integer :: i
+
+  open (10,file=n)
+  close (10,status="delete")
+
+  open (10,file=n)
+  close (10,status="keep")
+
+  if (access(n,"") /= 0 .or. access(n," ") /= 0 .or. access(n,"r") /= 0 .or. &
+      access(n,"R") /= 0 .or. access(n,"w") /= 0 .or. access(n,"W") /= 0) &
+    call abort
+
+  i = chmod (n, "a+x")
+  if (i == 0) then
+    if (access(n,"x") /= 0 .or. access(n,"X") /= 0) call abort
+  end if
+
+  i = chmod (n, "a-w")
+  if (i == 0) then
+    if (access(n,"w") == 0 .or. access(n,"W") == 0) call abort
+  end if
+
+  open (10,file=n)
+  close (10,status="delete")
+
+  if (access(n,"") == 0 .or. access(n," ") == 0 .or. access(n,"r") == 0 .or. &
+      access(n,"R") == 0 .or. access(n,"w") == 0 .or. access(n,"W") == 0) &
+    call abort
+
+  end

gcc/testsuite/gfortran.dg/chmod_3.f90

+! { dg-do run }
+! { dg-options "-std=gnu -fdefault-integer-8" }
+  implicit none
+  character(len=*), parameter :: n = "foobar_file"
+  integer :: i
+
+  open (10,file=n)
+  close (10,status="delete")
+
+  open (10,file=n)
+  close (10,status="keep")
+
+  if (access(n,"") /= 0 .or. access(n," ") /= 0 .or. access(n,"r") /= 0 .or. &
+      access(n,"R") /= 0 .or. access(n,"w") /= 0 .or. access(n,"W") /= 0) &
+    call abort
+
+  i = chmod (n, "a+x")
+  if (i == 0) then
+    if (access(n,"x") /= 0 .or. access(n,"X") /= 0) call abort
+  end if
+
+  i = chmod (n, "a-w")
+  if (i == 0) then
+    if (access(n,"w") == 0 .or. access(n,"W") == 0) call abort
+  end if
+
+  open (10,file=n)
+  close (10,status="delete")
+
+  if (access(n,"") == 0 .or. access(n," ") == 0 .or. access(n,"r") == 0 .or. &
+      access(n,"R") == 0 .or. access(n,"w") == 0 .or. access(n,"W") == 0) &
+    call abort
+
+  end

gcc/testsuite/gfortran.dg/lrshift_1.f90

+! { dg-do run }
+! { dg-options "-std=gnu -w" }
+! { dg-additional-sources lrshift_1.c }
+program test_rshift_lshift
+  implicit none
+  integer :: i(15), j, n
+  integer, external :: c_lshift, c_rshift
+
+  i = (/ -huge(i), -huge(i)/2, -129, -128, -127, -2, -1, 0, &
+         1, 2, 127, 128, 129, huge(i)/2, huge(i) /)
+
+  do n = 1, size(i)
+    do j = -30, 30
+      if (lshift(i(n),j) /= c_lshift(i(n),j)) call abort
+      if (rshift(i(n),j) /= c_rshift(i(n),j)) call abort
+    end do
+  end do
+end program test_rshift_lshift

gcc/testsuite/gfortran.dg/ltime_gmtime_1.f90

+! { dg-do run }
+! { dg-options "-std=gnu" }
+  integer :: x(9), y(9), t
+
+  t = time()
+  call ltime(t,x)
+  call gmtime(t,y)
+  if (x(1) /= y(1) .or. x(2) /= y(2)) call abort
+  end

gcc/testsuite/gfortran.dg/ltime_gmtime_2.f90

+! { dg-do run }
+! { dg-options "-fdefault-integer-8 -std=gnu" }
+  integer :: x(9), y(9), t
+
+  t = time()
+  call ltime(t,x)
+  call gmtime(t,y)
+  if (x(1) /= y(1) .or. x(2) /= y(2)) call abort
+  end

libgfortran/Makefile.am

@@ -41,10 +41,12 @@ io/io.h
 gfor_helper_src= \
 intrinsics/associated.c \
 intrinsics/abort.c \
+intrinsics/access.c \
 intrinsics/args.c \
 intrinsics/bessel.c \
 intrinsics/c99_functions.c \
 intrinsics/chdir.c \
+intrinsics/chmod.c \
 intrinsics/clock.c \
 intrinsics/cpu_time.c \
 intrinsics/cshift0.c \

libgfortran/Makefile.in

@@ -161,9 +161,9 @@ am__objects_28 = $(am__objects_2) $(am__objects_3) $(am__objects_4) \
 am__objects_29 = close.lo file_pos.lo format.lo inquire.lo \
 	list_read.lo lock.lo open.lo read.lo size_from_kind.lo \
 	transfer.lo unit.lo unix.lo write.lo
-am__objects_30 = associated.lo abort.lo args.lo bessel.lo \
-	c99_functions.lo chdir.lo clock.lo cpu_time.lo cshift0.lo \
-	ctime.lo date_and_time.lo env.lo erf.lo eoshift0.lo \
+am__objects_30 = associated.lo abort.lo access.lo args.lo bessel.lo \
+	c99_functions.lo chdir.lo chmod.lo clock.lo cpu_time.lo \
+	cshift0.lo ctime.lo date_and_time.lo env.lo erf.lo eoshift0.lo \
 	eoshift2.lo etime.lo exit.lo fget.lo flush.lo fnum.lo ftell.lo \
 	gerror.lo getcwd.lo getlog.lo getXid.lo hyper.lo hostnm.lo \
 	kill.lo ierrno.lo ishftc.lo link.lo malloc.lo mvbits.lo \
@@ -385,10 +385,12 @@ io/io.h
 gfor_helper_src = \
 intrinsics/associated.c \
 intrinsics/abort.c \
+intrinsics/access.c \
 intrinsics/args.c \
 intrinsics/bessel.c \
 intrinsics/c99_functions.c \
 intrinsics/chdir.c \
+intrinsics/chmod.c \
 intrinsics/clock.c \
 intrinsics/cpu_time.c \
 intrinsics/cshift0.c \
@@ -2204,6 +2206,9 @@ associated.lo: intrinsics/associated.c
 abort.lo: intrinsics/abort.c
 	$(LIBTOOL) --mode=compile $(CC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(AM_CFLAGS) $(CFLAGS) -c -o abort.lo `test -f 'intrinsics/abort.c' || echo '$(srcdir)/'`intrinsics/abort.c
 
+access.lo: intrinsics/access.c
+	$(LIBTOOL) --mode=compile $(CC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(AM_CFLAGS) $(CFLAGS) -c -o access.lo `test -f 'intrinsics/access.c' || echo '$(srcdir)/'`intrinsics/access.c
+
 args.lo: intrinsics/args.c
 	$(LIBTOOL) --mode=compile $(CC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(AM_CFLAGS) $(CFLAGS) -c -o args.lo `test -f 'intrinsics/args.c' || echo '$(srcdir)/'`intrinsics/args.c
 
@@ -2216,6 +2221,9 @@ c99_functions.lo: intrinsics/c99_functions.c
 chdir.lo: intrinsics/chdir.c
 	$(LIBTOOL) --mode=compile $(CC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(AM_CFLAGS) $(CFLAGS) -c -o chdir.lo `test -f 'intrinsics/chdir.c' || echo '$(srcdir)/'`intrinsics/chdir.c
 
+chmod.lo: intrinsics/chmod.c
+	$(LIBTOOL) --mode=compile $(CC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(AM_CFLAGS) $(CFLAGS) -c -o chmod.lo `test -f 'intrinsics/chmod.c' || echo '$(srcdir)/'`intrinsics/chmod.c
+
 clock.lo: intrinsics/clock.c
 	$(LIBTOOL) --mode=compile $(CC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(AM_CFLAGS) $(CFLAGS) -c -o clock.lo `test -f 'intrinsics/clock.c' || echo '$(srcdir)/'`intrinsics/clock.c
 

libgfortran/config.h.in

@@ -6,6 +6,9 @@
 /* Define to 0 if the target shouldn't use #pragma weak */
 #undef GTHREAD_USE_WEAK
 
+/* Define to 1 if you have the `access' function. */
+#undef HAVE_ACCESS
+
 /* libm includes acos */
 #undef HAVE_ACOS
 
@@ -279,6 +282,9 @@
 /* libm includes erfl */
 #undef HAVE_ERFL
 
+/* Define to 1 if you have the `execl' function. */
+#undef HAVE_EXECL
+
 /* libm includes exp */
 #undef HAVE_EXP
 
@@ -321,6 +327,9 @@
 /* libm includes floorl */
 #undef HAVE_FLOORL
 
+/* Define to 1 if you have the `fork' function. */
+#undef HAVE_FORK
+
 /* Define if you have fpsetmask. */
 #undef HAVE_FPSETMASK
 
@@ -582,6 +591,9 @@
 /* Define to 1 if you have the <sys/types.h> header file. */
 #undef HAVE_SYS_TYPES_H
 
+/* Define to 1 if you have the <sys/wait.h> header file. */
+#undef HAVE_SYS_WAIT_H
+
 /* libm includes tan */
 #undef HAVE_TAN
 
@@ -630,6 +642,9 @@
 /* Define if target can unlink open files. */
 #undef HAVE_UNLINK_OPEN_FILE
 
+/* Define to 1 if you have the `wait' function. */
+#undef HAVE_WAIT
+
 /* Define if target has a reliable stat. */
 #undef HAVE_WORKING_STAT
 

libgfortran/configure

@@ -6114,7 +6114,8 @@ done
 
 
 
-for ac_header in sys/types.h sys/stat.h floatingpoint.h ieeefp.h
+
+for ac_header in sys/types.h sys/stat.h sys/wait.h floatingpoint.h ieeefp.h
 do
 as_ac_Header=`echo "ac_cv_header_$ac_header" | $as_tr_sh`
 if eval "test \"\${$as_ac_Header+set}\" = set"; then
@@ -6897,9 +6898,8 @@ fi
   break
 done
 if test "$acx_cv_header_stdint" = stddef.h; then
-  acx_cv_header_stdint_kind="(lacks uintmax_t)"
+  acx_cv_header_stdint_kind="(lacks uintptr_t)"
   for i in stdint.h $inttype_headers; do
-    unset ac_cv_type_uintptr_t
     unset ac_cv_type_uint32_t
     unset ac_cv_type_uint64_t
     echo $ECHO_N "looking for an incomplete stdint.h in $i, $ECHO_C" >&6
@@ -7025,65 +7025,11 @@ rm -f conftest.err conftest.$ac_objext conftest.$ac_ext
 fi
 echo "$as_me:$LINENO: result: $ac_cv_type_uint64_t" >&5
 echo "${ECHO_T}$ac_cv_type_uint64_t" >&6
-
-    echo "$as_me:$LINENO: checking for uintptr_t" >&5
-echo $ECHO_N "checking for uintptr_t... $ECHO_C" >&6
-if test "${ac_cv_type_uintptr_t+set}" = set; then
-  echo $ECHO_N "(cached) $ECHO_C" >&6
-else
-  cat >conftest.$ac_ext <<_ACEOF
-/* confdefs.h.  */
-_ACEOF
-cat confdefs.h >>conftest.$ac_ext
-cat >>conftest.$ac_ext <<_ACEOF
-/* end confdefs.h.  */
-#include <sys/types.h>
-#include <$i>
-
-int
-main ()
-{
-if ((uintptr_t *) 0)
-  return 0;
-if (sizeof (uintptr_t))
-  return 0;
-  ;
-  return 0;
-}
-_ACEOF
-rm -f conftest.$ac_objext
-if { (eval echo "$as_me:$LINENO: \"$ac_compile\"") >&5
-  (eval $ac_compile) 2>conftest.er1
-  ac_status=$?
-  grep -v '^ *+' conftest.er1 >conftest.err
-  rm -f conftest.er1
-  cat conftest.err >&5
-  echo "$as_me:$LINENO: \$? = $ac_status" >&5
-  (exit $ac_status); } &&
-	 { ac_try='test -z "$ac_c_werror_flag"
-			 || test ! -s conftest.err'
-  { (eval echo "$as_me:$LINENO: \"$ac_try\"") >&5
-  (eval $ac_try) 2>&5
-  ac_status=$?
-  echo "$as_me:$LINENO: \$? = $ac_status" >&5
-  (exit $ac_status); }; } &&
-	 { ac_try='test -s conftest.$ac_objext'
-  { (eval echo "$as_me:$LINENO: \"$ac_try\"") >&5
-  (eval $ac_try) 2>&5
-  ac_status=$?
-  echo "$as_me:$LINENO: \$? = $ac_status" >&5
-  (exit $ac_status); }; }; then
-  ac_cv_type_uintptr_t=yes
+if test $ac_cv_type_uint64_t = yes; then
+  :
 else
-  echo "$as_me: failed program was:" >&5
-sed 's/^/| /' conftest.$ac_ext >&5
-
-ac_cv_type_uintptr_t=no
-fi
-rm -f conftest.err conftest.$ac_objext conftest.$ac_ext
+  acx_cv_header_stdint_kind="(lacks uintptr_t and uint64_t)"
 fi
-echo "$as_me:$LINENO: result: $ac_cv_type_uintptr_t" >&5
-echo "${ECHO_T}$ac_cv_type_uintptr_t" >&6
 
     break
   done
@@ -7216,6 +7162,11 @@ rm -f conftest.err conftest.$ac_objext conftest.$ac_ext
 fi
 echo "$as_me:$LINENO: result: $ac_cv_type_u_int64_t" >&5
 echo "${ECHO_T}$ac_cv_type_u_int64_t" >&6
+if test $ac_cv_type_u_int64_t = yes; then
+  :
+else
+  acx_cv_header_stdint_kind="(u_intXX_t style, lacks u_int64_t)"
+fi
 
     break
   done
@@ -9976,7 +9927,117 @@ done
 
 
 
-for ac_func in sleep time ttyname signal alarm ctime clock
+
+
+
+for ac_func in sleep time ttyname signal alarm ctime clock access fork execl
+do
+as_ac_var=`echo "ac_cv_func_$ac_func" | $as_tr_sh`
+echo "$as_me:$LINENO: checking for $ac_func" >&5
+echo $ECHO_N "checking for $ac_func... $ECHO_C" >&6
+if eval "test \"\${$as_ac_var+set}\" = set"; then
+  echo $ECHO_N "(cached) $ECHO_C" >&6
+else
+  if test x$gcc_no_link = xyes; then
+  { { echo "$as_me:$LINENO: error: Link tests are not allowed after GCC_NO_EXECUTABLES." >&5
+echo "$as_me: error: Link tests are not allowed after GCC_NO_EXECUTABLES." >&2;}
+   { (exit 1); exit 1; }; }
+fi
+cat >conftest.$ac_ext <<_ACEOF
+/* confdefs.h.  */
+_ACEOF
+cat confdefs.h >>conftest.$ac_ext
+cat >>conftest.$ac_ext <<_ACEOF
+/* end confdefs.h.  */
+/* Define $ac_func to an innocuous variant, in case <limits.h> declares $ac_func.
+   For example, HP-UX 11i <limits.h> declares gettimeofday.  */
+#define $ac_func innocuous_$ac_func
+
+/* System header to define __stub macros and hopefully few prototypes,
+    which can conflict with char $ac_func (); below.
+    Prefer <limits.h> to <assert.h> if __STDC__ is defined, since
+    <limits.h> exists even on freestanding compilers.  */
+
+#ifdef __STDC__
+# include <limits.h>
+#else
+# include <assert.h>
+#endif
+
+#undef $ac_func
+
+/* Override any gcc2 internal prototype to avoid an error.  */
+#ifdef __cplusplus
+extern "C"
+{
+#endif
+/* We use char because int might match the return type of a gcc2
+   builtin and then its argument prototype would still apply.  */
+char $ac_func ();
+/* The GNU C library defines this for functions which it implements
+    to always fail with ENOSYS.  Some functions are actually named
+    something starting with __ and the normal name is an alias.  */
+#if defined (__stub_$ac_func) || defined (__stub___$ac_func)
+choke me
+#else
+char (*f) () = $ac_func;
+#endif
+#ifdef __cplusplus
+}
+#endif
+
+int
+main ()
+{
+return f != $ac_func;
+  ;
+  return 0;
+}
+_ACEOF
+rm -f conftest.$ac_objext conftest$ac_exeext
+if { (eval echo "$as_me:$LINENO: \"$ac_link\"") >&5
+  (eval $ac_link) 2>conftest.er1
+  ac_status=$?
+  grep -v '^ *+' conftest.er1 >conftest.err
+  rm -f conftest.er1
+  cat conftest.err >&5
+  echo "$as_me:$LINENO: \$? = $ac_status" >&5
+  (exit $ac_status); } &&
+	 { ac_try='test -z "$ac_c_werror_flag"
+			 || test ! -s conftest.err'
+  { (eval echo "$as_me:$LINENO: \"$ac_try\"") >&5
+  (eval $ac_try) 2>&5
+  ac_status=$?
+  echo "$as_me:$LINENO: \$? = $ac_status" >&5
+  (exit $ac_status); }; } &&
+	 { ac_try='test -s conftest$ac_exeext'
+  { (eval echo "$as_me:$LINENO: \"$ac_try\"") >&5
+  (eval $ac_try) 2>&5
+  ac_status=$?
+  echo "$as_me:$LINENO: \$? = $ac_status" >&5
+  (exit $ac_status); }; }; then
+  eval "$as_ac_var=yes"
+else
+  echo "$as_me: failed program was:" >&5
+sed 's/^/| /' conftest.$ac_ext >&5
+
+eval "$as_ac_var=no"
+fi
+rm -f conftest.err conftest.$ac_objext \
+      conftest$ac_exeext conftest.$ac_ext
+fi
+echo "$as_me:$LINENO: result: `eval echo '${'$as_ac_var'}'`" >&5
+echo "${ECHO_T}`eval echo '${'$as_ac_var'}'`" >&6
+if test `eval echo '${'$as_ac_var'}'` = yes; then
+  cat >>confdefs.h <<_ACEOF
+#define `echo "HAVE_$ac_func" | $as_tr_cpp` 1
+_ACEOF
+
+fi
+done
+
+
+for ac_func in wait
 do
 as_ac_var=`echo "ac_cv_func_$ac_func" | $as_tr_sh`
 echo "$as_me:$LINENO: checking for $ac_func" >&5

libgfortran/configure.ac

@@ -159,7 +159,7 @@ AC_TYPE_OFF_T
 AC_STDC_HEADERS
 AC_HAVE_HEADERS(stdlib.h stdio.h string.h stddef.h math.h unistd.h signal.h)
 AC_CHECK_HEADERS(time.h sys/params.h sys/time.h sys/times.h sys/resource.h)
-AC_CHECK_HEADERS(sys/types.h sys/stat.h floatingpoint.h ieeefp.h)
+AC_CHECK_HEADERS(sys/types.h sys/stat.h sys/wait.h floatingpoint.h ieeefp.h)
 AC_CHECK_HEADERS(fenv.h fptrap.h float.h)
 AC_CHECK_HEADER([complex.h],[AC_DEFINE([HAVE_COMPLEX_H], [1], [complex.h exists])])
 GCC_HEADER_STDINT(gstdint.h)
@@ -171,7 +171,8 @@ AC_CHECK_MEMBERS([struct stat.st_rdev])
 # Check for library functions.
 AC_CHECK_FUNCS(getrusage times mkstemp strtof strtold snprintf ftruncate chsize)
 AC_CHECK_FUNCS(chdir strerror getlogin gethostname kill link symlink perror)
-AC_CHECK_FUNCS(sleep time ttyname signal alarm ctime clock)
+AC_CHECK_FUNCS(sleep time ttyname signal alarm ctime clock access fork execl)
+AC_CHECK_FUNCS(wait)
 
 # Check libc for getgid, getpid, getuid
 AC_CHECK_LIB([c],[getgid],[AC_DEFINE([HAVE_GETGID],[1],[libc includes getgid])])

libgfortran/intrinsics/access.c

+/* Implementation of the ACCESS intrinsic.
+   Copyright (C) 2006 Free Software Foundation, Inc.
+   Contributed by François-Xavier Coudert <coudert@clipper.ens.fr>
+
+This file is part of the GNU Fortran 95 runtime library (libgfortran).
+
+Libgfortran is free software; you can redistribute it and/or
+modify it under the terms of the GNU General Public
+License as published by the Free Software Foundation; either
+version 2 of the License, or (at your option) any later version.
+
+In addition to the permissions in the GNU General Public License, the
+Free Software Foundation gives you unlimited permission to link the
+compiled version of this file into combinations with other programs,
+and to distribute those combinations without any restriction coming
+from the use of this file.  (The General Public License restrictions
+do apply in other respects; for example, they cover modification of
+the file, and distribution when not linked into a combine
+executable.)
+
+Libgfortran is distributed in the hope that it will be useful,
+but WITHOUT ANY WARRANTY; without even the implied warranty of
+MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+GNU General Public License for more details.
+
+You should have received a copy of the GNU General Public
+License along with libgfortran; see the file COPYING.  If not,
+write to the Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor,
+Boston, MA 02110-1301, USA.  */
+
+#include "config.h"
+#include "libgfortran.h"
+
+#include <errno.h>
+
+#ifdef HAVE_STRING_H
+#include <string.h>
+#endif
+#ifdef HAVE_UNISTD_H
+#include <unistd.h>
+#endif
+
+/* INTEGER FUNCTION ACCESS(NAME, MODE)
+   CHARACTER(len=*), INTENT(IN) :: NAME, MODE  */
+
+#ifdef HAVE_ACCESS
+extern int access_func (char *, char *, gfc_charlen_type, gfc_charlen_type);
+export_proto(access_func);
+
+int
+access_func (char *name, char *mode, gfc_charlen_type name_len,
+	     gfc_charlen_type mode_len)
+{
+  char * file;
+  gfc_charlen_type i;
+  int m;
+
+  /* Parse the MODE string.  */
+  m = F_OK;
+  for (i = 0; i < mode_len && mode[i]; i++)
+    switch (mode[i])
+      {
+	case ' ':
+	  break;
+
+	case 'r':
+	case 'R':
+	  m |= R_OK;
+	  break;
+
+	case 'w':
+	case 'W':
+	  m |= W_OK;
+	  break;
+
+	case 'x':
+	case 'X':
+	  m |= X_OK;
+	  break;
+
+	default:
+	  return -1;
+	  break;
+      }
+
+  /* Trim trailing spaces from NAME argument.  */
+  while (name_len > 0 && name[name_len - 1] == ' ')
+    name_len--;
+
+  /* Make a null terminated copy of the string.  */
+  file = gfc_alloca (name_len + 1);
+  memcpy (file, name, name_len);
+  file[name_len] = '\0';
+
+  /* And make the call to access().  */
+  return (access (file, m) == 0 ? 0 : errno);
+}
+export(access_func);
+#endif

libgfortran/intrinsics/chmod.c

+/* Implementation of the CHMOD intrinsic.
+   Copyright (C) 2006 Free Software Foundation, Inc.
+   Contributed by François-Xavier Coudert <coudert@clipper.ens.fr>
+
+This file is part of the GNU Fortran 95 runtime library (libgfortran).
+
+Libgfortran is free software; you can redistribute it and/or
+modify it under the terms of the GNU General Public
+License as published by the Free Software Foundation; either
+version 2 of the License, or (at your option) any later version.
+
+In addition to the permissions in the GNU General Public License, the
+Free Software Foundation gives you unlimited permission to link the
+compiled version of this file into combinations with other programs,
+and to distribute those combinations without any restriction coming
+from the use of this file.  (The General Public License restrictions
+do apply in other respects; for example, they cover modification of
+the file, and distribution when not linked into a combine
+executable.)
+
+Libgfortran is distributed in the hope that it will be useful,
+but WITHOUT ANY WARRANTY; without even the implied warranty of
+MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+GNU General Public License for more details.
+
+You should have received a copy of the GNU General Public
+License along with libgfortran; see the file COPYING.  If not,
+write to the Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor,
+Boston, MA 02110-1301, USA.  */
+
+#include "config.h"
+#include "libgfortran.h"
+
+#include <errno.h>
+
+#ifdef HAVE_STRING_H
+#include <string.h>
+#endif
+#ifdef HAVE_UNISTD_H
+#include <unistd.h>
+#endif
+#ifdef HAVE_SYS_TYPES_H
+#include <sys/types.h>
+#endif
+#ifdef  HAVE_SYS_WAIT_H
+#include <sys/wait.h>
+#endif
+
+/* INTEGER FUNCTION ACCESS(NAME, MODE)
+   CHARACTER(len=*), INTENT(IN) :: NAME, MODE  */
+
+#if defined(HAVE_FORK) && defined(HAVE_EXECL) && defined(HAVE_WAIT)
+
+extern int chmod_func (char *, char *, gfc_charlen_type, gfc_charlen_type);
+export_proto(chmod_func);
+
+int
+chmod_func (char *name, char *mode, gfc_charlen_type name_len,
+	    gfc_charlen_type mode_len)
+{
+  char * file, * m;
+  pid_t pid;
+  int status;
+
+  /* Trim trailing spaces.  */
+  while (name_len > 0 && name[name_len - 1] == ' ')
+    name_len--;
+  while (mode_len > 0 && mode[mode_len - 1] == ' ')
+    mode_len--;
+
+  /* Make a null terminated copy of the strings.  */
+  file = gfc_alloca (name_len + 1);
+  memcpy (file, name, name_len);
+  file[name_len] = '\0';
+
+  m = gfc_alloca (mode_len + 1);
+  memcpy (m, mode, mode_len);
+  m[mode_len]= '\0';
+
+  /* Execute /bin/chmod.  */
+  if ((pid = fork()) < 0)
+    return errno;
+  if (pid == 0)
+    {
+      /* Child process.  */
+      execl ("/bin/chmod", "chmod", m, file, (char *) NULL);
+      return errno;
+    }
+  else
+    wait (&status);
+
+  if (WIFEXITED(status))
+    return WEXITSTATUS(status);
+  else
+    return -1;
+}
+
+
+
+extern void chmod_i4_sub (char *, char *, GFC_INTEGER_4 *,
+			  gfc_charlen_type, gfc_charlen_type);
+export_proto(chmod_i4_sub);
+
+void
+chmod_i4_sub (char *name, char *mode, GFC_INTEGER_4 * status,
+	      gfc_charlen_type name_len, gfc_charlen_type mode_len)
+{
+  int val;
+
+  val = chmod_func (name, mode, name_len, mode_len);
+  if (status)
+    *status = val;
+}
+
+
+extern void chmod_i8_sub (char *, char *, GFC_INTEGER_8 *,
+			  gfc_charlen_type, gfc_charlen_type);
+export_proto(chmod_i8_sub);
+
+void
+chmod_i8_sub (char *name, char *mode, GFC_INTEGER_8 * status,
+	      gfc_charlen_type name_len, gfc_charlen_type mode_len)
+{
+  int val;
+
+  val = chmod_func (name, mode, name_len, mode_len);
+  if (status)
+    *status = val;
+}
+
+#endif

libgfortran/intrinsics/date_and_time.c

@@ -521,3 +521,188 @@ idate_i8 (gfc_array_i8 *__values)
   for (i = 0; i < 3; i++, vptr += delta)
     *vptr = x[i];
 }
+
+
+
+/* GMTIME(STIME, TARRAY) - Non-standard
+
+   Description: Given a system time value STime, fills TArray with values
+   extracted from it appropriate to the GMT time zone using gmtime(3).
+
+   The array elements are as follows:
+
+      1. Seconds after the minute, range 0-59 or 0-61 to allow for leap seconds
+      2. Minutes after the hour, range 0-59
+      3. Hours past midnight, range 0-23
+      4. Day of month, range 0-31
+      5. Number of months since January, range 0-11
+      6. Years since 1900
+      7. Number of days since Sunday, range 0-6
+      8. Days since January 1
+      9. Daylight savings indicator: positive if daylight savings is in effect,
+         zero if not, and negative if the information isn't available.  */
+
+static void
+gmtime_0 (const time_t * t, int x[9])
+{
+  struct tm lt;
+
+  lt = *gmtime (t);
+  x[0] = lt.tm_sec;
+  x[1] = lt.tm_min;
+  x[2] = lt.tm_hour;
+  x[3] = lt.tm_mday;
+  x[4] = lt.tm_mon;
+  x[5] = lt.tm_year;
+  x[6] = lt.tm_wday;
+  x[7] = lt.tm_yday;
+  x[8] = lt.tm_isdst;
+}
+
+extern void gmtime_i4 (GFC_INTEGER_4 *, gfc_array_i4 *);
+export_proto(gmtime_i4);
+
+void
+gmtime_i4 (GFC_INTEGER_4 * t, gfc_array_i4 * tarray)
+{
+  int x[9], i;
+  size_t len, delta;
+  GFC_INTEGER_4 *vptr;
+  time_t tt;
+  
+  /* Call helper function.  */
+  tt = (time_t) *t;
+  gmtime_0(&tt, x);
+
+  /* Copy the values into the array.  */
+  len = tarray->dim[0].ubound + 1 - tarray->dim[0].lbound;
+  assert (len >= 9);
+  delta = tarray->dim[0].stride;
+  if (delta == 0)
+    delta = 1;
+
+  vptr = tarray->data;
+  for (i = 0; i < 9; i++, vptr += delta)
+    *vptr = x[i];
+}
+
+extern void gmtime_i8 (GFC_INTEGER_8 *, gfc_array_i8 *);
+export_proto(gmtime_i8);
+
+void
+gmtime_i8 (GFC_INTEGER_8 * t, gfc_array_i8 * tarray)
+{
+  int x[9], i;
+  size_t len, delta;
+  GFC_INTEGER_8 *vptr;
+  time_t tt;
+  
+  /* Call helper function.  */
+  tt = (time_t) *t;
+  gmtime_0(&tt, x);
+
+  /* Copy the values into the array.  */
+  len = tarray->dim[0].ubound + 1 - tarray->dim[0].lbound;
+  assert (len >= 9);
+  delta = tarray->dim[0].stride;
+  if (delta == 0)
+    delta = 1;
+
+  vptr = tarray->data;
+  for (i = 0; i < 9; i++, vptr += delta)
+    *vptr = x[i];
+}
+
+
+
+
+/* LTIME(STIME, TARRAY) - Non-standard
+
+   Description: Given a system time value STime, fills TArray with values
+   extracted from it appropriate to the local time zone using localtime(3).
+
+   The array elements are as follows:
+
+      1. Seconds after the minute, range 0-59 or 0-61 to allow for leap seconds
+      2. Minutes after the hour, range 0-59
+      3. Hours past midnight, range 0-23
+      4. Day of month, range 0-31
+      5. Number of months since January, range 0-11
+      6. Years since 1900
+      7. Number of days since Sunday, range 0-6
+      8. Days since January 1
+      9. Daylight savings indicator: positive if daylight savings is in effect,
+         zero if not, and negative if the information isn't available.  */
+
+static void
+ltime_0 (const time_t * t, int x[9])
+{
+  struct tm lt;
+
+  lt = *localtime (t);
+  x[0] = lt.tm_sec;
+  x[1] = lt.tm_min;
+  x[2] = lt.tm_hour;
+  x[3] = lt.tm_mday;
+  x[4] = lt.tm_mon;
+  x[5] = lt.tm_year;
+  x[6] = lt.tm_wday;
+  x[7] = lt.tm_yday;
+  x[8] = lt.tm_isdst;
+}
+
+extern void ltime_i4 (GFC_INTEGER_4 *, gfc_array_i4 *);
+export_proto(ltime_i4);
+
+void
+ltime_i4 (GFC_INTEGER_4 * t, gfc_array_i4 * tarray)
+{
+  int x[9], i;
+  size_t len, delta;
+  GFC_INTEGER_4 *vptr;
+  time_t tt;
+  
+  /* Call helper function.  */
+  tt = (time_t) *t;
+  ltime_0(&tt, x);
+
+  /* Copy the values into the array.  */
+  len = tarray->dim[0].ubound + 1 - tarray->dim[0].lbound;
+  assert (len >= 9);
+  delta = tarray->dim[0].stride;
+  if (delta == 0)
+    delta = 1;
+
+  vptr = tarray->data;
+  for (i = 0; i < 9; i++, vptr += delta)
+    *vptr = x[i];
+}
+
+extern void ltime_i8 (GFC_INTEGER_8 *, gfc_array_i8 *);
+export_proto(ltime_i8);
+
+void
+ltime_i8 (GFC_INTEGER_8 * t, gfc_array_i8 * tarray)
+{
+  int x[9], i;
+  size_t len, delta;
+  GFC_INTEGER_8 *vptr;
+  time_t tt;
+  
+  /* Call helper function.  */
+  tt = (time_t) * t;
+  ltime_0(&tt, x);
+
+  /* Copy the values into the array.  */
+  len = tarray->dim[0].ubound + 1 - tarray->dim[0].lbound;
+  assert (len >= 9);
+  delta = tarray->dim[0].stride;
+  if (delta == 0)
+    delta = 1;
+
+  vptr = tarray->data;
+  for (i = 0; i < 9; i++, vptr += delta)
+    *vptr = x[i];
+}
+
+