diff options
Diffstat (limited to 'libgfortran/intrinsics/stat.c')
| -rw-r--r-- | libgfortran/intrinsics/stat.c | 113 |
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) |