* intrinsic.c (add_functions): Add INT2, SHORT, INT8, LONG,

	LSTAT, MCLOCK and MCLOCK8 intrinsic functions.
	(add_subroutines): Add LSTAT intrinsic subroutine.
	* gfortran.h (gfc_generic_isym_id): Add GFC_ISYM_INT2,
	GFC_ISYM_INT8, GFC_ISYM_LONG, GFC_ISYM_LSTAT, GFC_ISYM_MCLOCK
	and GFC_ISYM_MCLOCK8.
	* iresolve.c (gfc_resolve_int2, gfc_resolve_int8,
	gfc_resolve_long, gfc_resolve_lstat, gfc_resolve_mclock,
	gfc_resolve_mclock8, gfc_resolve_lstat_sub): New functions.
	* check.c (gfc_check_intconv): New function.
	* trans-intrinsic.c (gfc_conv_intrinsic_function): Add cases for
	the added GFC_ISYM_*.
	* simplify.c (gfc_simplify_intconv, gfc_simplify_int2,
	gfc_simplify_int8, gfc_simplify_long): New functions.
	* intrinsic.h (gfc_check_intconv, gfc_simplify_int2,
	gfc_simplify_int8, gfc_simplify_long, gfc_resolve_int2,
	gfc_resolve_int8, gfc_resolve_long, gfc_resolve_lstat,
	gfc_resolve_mclock, gfc_resolve_mclock8, gfc_resolve_lstat_sub):
	Add prototypes.

	* gfortran.dg/mclock.f90: New test.
	* gfortran.dg/int_conv_1.f90: New test.
	* gfortran.dg/stat_1.f90: New test.
	* gfortran.dg/stat_2.f90: New test.

	* configure.ac: Check for function clock.
	* Makefile.am: Compile new file intrinsics/clock.c.
	* intrinsics/clock.c: New file.
	* Makefile.in: Regenerate.
	* configure: Regenerate.
	* config.h.in: Regenerate.
	* intrinsics/stat.c: Rename the old stat_i?_sub functions to
	helper functions stat_i?_sub_0, and use them for both STAT and
	LSTAT.


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

1 files changed, 102 insertions, 11 deletions

diff --git a/libgfortran/intrinsics/stat.c b/libgfortran/intrinsics/stat.c
index 98511640f56..150387dad5b 100644
--- a/libgfortran/intrinsics/stat.c
+++ b/libgfortran/intrinsics/stat.c
@@ -59,13 +59,13 @@ Boston, MA 02110-1301, USA.  */
    CHARACTER(len=*), INTENT(IN) :: FILE
    INTEGER, INTENT(OUT), :: SARRAY(13)  */
 
-extern void stat_i4_sub (char *, gfc_array_i4 *, GFC_INTEGER_4 *,
-			 gfc_charlen_type);
-iexport_proto(stat_i4_sub);
+/*extern void stat_i4_sub_0 (char *, gfc_array_i4 *, GFC_INTEGER_4 *,
+			   gfc_charlen_type, int);
+internal_proto(stat_i4_sub_0);*/
 
-void
-stat_i4_sub (char *name, gfc_array_i4 *sarray, GFC_INTEGER_4 *status,
-	     gfc_charlen_type name_len)
+static void
+stat_i4_sub_0 (char *name, gfc_array_i4 *sarray, GFC_INTEGER_4 *status,
+	       gfc_charlen_type name_len, int is_lstat)
 {
   int val;
   char *str;
@@ -88,7 +88,10 @@ stat_i4_sub (char *name, gfc_array_i4 *sarray, GFC_INTEGER_4 *status,
   memcpy (str, name, name_len);
   str[name_len] = '\0';
 
-  val = stat(str, &sb);
+  if (is_lstat)
+    val = lstat(str, &sb);
+  else
+    val = stat(str, &sb);
 
   if (val == 0)
     {
@@ -147,16 +150,39 @@ stat_i4_sub (char *name, gfc_array_i4 *sarray, GFC_INTEGER_4 *status,
   if (status != NULL)
     *status = (val == 0) ? 0 : errno;
 }
+
+
+extern void stat_i4_sub (char *, gfc_array_i4 *, GFC_INTEGER_4 *,
+			 gfc_charlen_type);
+iexport_proto(stat_i4_sub);
+
+void
+stat_i4_sub (char *name, gfc_array_i4 *sarray, GFC_INTEGER_4 *status,
+	     gfc_charlen_type name_len)
+{
+  stat_i4_sub_0 (name, sarray, status, name_len, 0);
+}
 iexport(stat_i4_sub);
 
-extern void stat_i8_sub (char *, gfc_array_i8 *, GFC_INTEGER_8 *,
+
+extern void lstat_i4_sub (char *, gfc_array_i4 *, GFC_INTEGER_4 *,
 			 gfc_charlen_type);
-iexport_proto(stat_i8_sub);
+iexport_proto(lstat_i4_sub);
 
 void
-stat_i8_sub (char *name, gfc_array_i8 *sarray, GFC_INTEGER_8 *status,
+lstat_i4_sub (char *name, gfc_array_i4 *sarray, GFC_INTEGER_4 *status,
 	     gfc_charlen_type name_len)
 {
+  stat_i4_sub_0 (name, sarray, status, name_len, 1);
+}
+iexport(lstat_i4_sub);
+
+
+
+static void
+stat_i8_sub_0 (char *name, gfc_array_i8 *sarray, GFC_INTEGER_8 *status,
+	       gfc_charlen_type name_len, int is_lstat)
+{
   int val;
   char *str;
   struct stat sb;
@@ -178,7 +204,10 @@ stat_i8_sub (char *name, gfc_array_i8 *sarray, GFC_INTEGER_8 *status,
   memcpy (str, name, name_len);
   str[name_len] = '\0';
 
-  val = stat(str, &sb);
+  if (is_lstat)
+    val = lstat(str, &sb);
+  else
+    val = stat(str, &sb);
 
   if (val == 0)
     {
@@ -237,8 +266,36 @@ stat_i8_sub (char *name, gfc_array_i8 *sarray, GFC_INTEGER_8 *status,
   if (status != NULL)
     *status = (val == 0) ? 0 : errno;
 }
+
+
+extern void stat_i8_sub (char *, gfc_array_i8 *, GFC_INTEGER_8 *,
+			 gfc_charlen_type);
+iexport_proto(stat_i8_sub);
+
+void
+stat_i8_sub (char *name, gfc_array_i8 *sarray, GFC_INTEGER_8 *status,
+	     gfc_charlen_type name_len)
+{
+  stat_i8_sub_0 (name, sarray, status, name_len, 0);
+}
+
 iexport(stat_i8_sub);
 
+
+extern void lstat_i8_sub (char *, gfc_array_i8 *, GFC_INTEGER_8 *,
+			 gfc_charlen_type);
+iexport_proto(lstat_i8_sub);
+
+void
+lstat_i8_sub (char *name, gfc_array_i8 *sarray, GFC_INTEGER_8 *status,
+	     gfc_charlen_type name_len)
+{
+  stat_i8_sub_0 (name, sarray, status, name_len, 1);
+}
+
+iexport(lstat_i8_sub);
+
+
 extern GFC_INTEGER_4 stat_i4 (char *, gfc_array_i4 *, gfc_charlen_type);
 export_proto(stat_i4);
 
@@ -262,6 +319,40 @@ stat_i8 (char *name, gfc_array_i8 *sarray, gfc_charlen_type name_len)
 }
 
 
+/* SUBROUTINE STAT(FILE, SARRAY, STATUS)
+   CHARACTER(len=*), INTENT(IN) :: FILE
+   INTEGER, INTENT(OUT), :: SARRAY(13)
+   INTEGER, INTENT(OUT), OPTIONAL :: STATUS
+
+   FUNCTION STAT(FILE, SARRAY)
+   INTEGER STAT
+   CHARACTER(len=*), INTENT(IN) :: FILE
+   INTEGER, INTENT(OUT), :: SARRAY(13)  */
+
+extern GFC_INTEGER_4 lstat_i4 (char *, gfc_array_i4 *, gfc_charlen_type);
+export_proto(lstat_i4);
+
+GFC_INTEGER_4
+lstat_i4 (char *name, gfc_array_i4 *sarray, gfc_charlen_type name_len)
+{
+  GFC_INTEGER_4 val;
+  lstat_i4_sub (name, sarray, &val, name_len);
+  return val;
+}
+
+extern GFC_INTEGER_8 lstat_i8 (char *, gfc_array_i8 *, gfc_charlen_type);
+export_proto(lstat_i8);
+
+GFC_INTEGER_8
+lstat_i8 (char *name, gfc_array_i8 *sarray, gfc_charlen_type name_len)
+{
+  GFC_INTEGER_8 val;
+  lstat_i8_sub (name, sarray, &val, name_len);
+  return val;
+}
+
+
+
 /* SUBROUTINE FSTAT(UNIT, SARRAY, STATUS)
    INTEGER, INTENT(IN) :: UNIT
    INTEGER, INTENT(OUT) :: SARRAY(13)