diff --git a/libraries/base/configure.ac b/libraries/base/configure.ac
index 55a5df9d9549886291e0d7494621c0cb1f9afe45..f27a03439501a5cbed2943118fe9a12f90a3d7fc 100644
--- a/libraries/base/configure.ac
+++ b/libraries/base/configure.ac
@@ -141,8 +141,11 @@ then
FP_COMPUTE_OFFSET([OFFSET_STAT_ST_BLOCKS], [stat], [st_blocks], [#include <sys/stat.h>])
FP_COMPUTE_OFFSET([OFFSET_STAT_ST_INO], [stat], [st_ino], [#include <sys/stat.h>])
FP_COMPUTE_OFFSET([OFFSET_STAT_ST_ATIME], [stat], [st_atime], [#include <sys/stat.h>])
+ FP_COMPUTE_OFFSET([OFFSET_STAT_ST_ATIM_TV_NSEC], [stat], [st_atim.tv_nsec], [#include <sys/stat.h>])
FP_COMPUTE_OFFSET([OFFSET_STAT_ST_MTIME], [stat], [st_mtime], [#include <sys/stat.h>])
+ FP_COMPUTE_OFFSET([OFFSET_STAT_ST_MTIM_TV_NSEC], [stat], [st_mtim.tv_nsec], [#include <sys/stat.h>])
FP_COMPUTE_OFFSET([OFFSET_STAT_ST_CTIME], [stat], [st_ctime], [#include <sys/stat.h>])
+ FP_COMPUTE_OFFSET([OFFSET_STAT_ST_CTIM_TV_NSEC], [stat], [st_ctim.tv_nsec], [#include <sys/stat.h>])
FP_COMPUTE_SIZE([SIZEOF_STAT_ST_MODE], [stat], [st_mode], [#include <sys/stat.h>])
FP_COMPUTE_SIZE([SIZEOF_STAT_ST_DEV], [stat], [st_dev], [#include <sys/stat.h>])
FP_COMPUTE_SIZE([SIZEOF_STAT_ST_UID], [stat], [st_uid], [#include <sys/stat.h>])
@@ -154,8 +157,11 @@ then
FP_COMPUTE_SIZE([SIZEOF_STAT_ST_BLOCKS], [stat], [st_blocks], [#include <sys/stat.h>])
FP_COMPUTE_SIZE([SIZEOF_STAT_ST_INO], [stat], [st_ino], [#include <sys/stat.h>])
FP_COMPUTE_SIZE([SIZEOF_STAT_ST_ATIME], [stat], [st_atime], [#include <sys/stat.h>])
+ FP_COMPUTE_SIZE([SIZEOF_STAT_ST_ATIM_TV_NSEC], [stat], [st_atim.tv_nsec], [#include <sys/stat.h>])
FP_COMPUTE_SIZE([SIZEOF_STAT_ST_MTIME], [stat], [st_mtime], [#include <sys/stat.h>])
+ FP_COMPUTE_SIZE([SIZEOF_STAT_ST_MTIM_TV_NSEC], [stat], [st_mtim.tv_nsec], [#include <sys/stat.h>])
FP_COMPUTE_SIZE([SIZEOF_STAT_ST_CTIME], [stat], [st_ctime], [#include <sys/stat.h>])
+ FP_COMPUTE_SIZE([SIZEOF_STAT_ST_CTIM_TV_NSEC], [stat], [st_ctim.tv_nsec], [#include <sys/stat.h>])
AC_CHECK_SIZEOF([struct stat], [], [#include <sys/stat.h>])
FP_COMPUTE_OFFSET([OFFSET_UTIMBUF_ACTIME], [utimbuf], [actime], [#include <utime.h>])
diff --git a/libraries/base/jsbits/base.js b/libraries/base/jsbits/base.js
index f654432fccdcddf3b8d56a287e574663b305dbd0..9c06cd2702a143074cf302710bfe6765ea1ad95d 100644
--- a/libraries/base/jsbits/base.js
+++ b/libraries/base/jsbits/base.js
@@ -648,13 +648,16 @@ function h$base_fillStat(fs, b, off) {
var atimeS = Math.floor(fs.atimeMs/1000);
var atimeNs = (fs.atimeMs/1000 - atimeS) * 1000000000;
- h$base_store_field_number_2(b, off, OFFSET_STAT_ST_ATIME, SIZEOF_STAT_ST_ATIME, atimeS, atimeNs);
+ h$base_store_field_number(b, off, OFFSET_STAT_ST_ATIME, SIZEOF_STAT_ST_ATIME, atimeS);
+ h$base_store_field_number(b, off, OFFSET_STAT_ST_ATIM_TV_NSEC, SIZEOF_STAT_ST_ATIM_TV_NSEC, atimeNs);
var mtimeS = Math.floor(fs.mtimeMs/1000);
var mtimeNs = (fs.mtimeMs/1000 - mtimeS) * 1000000000;
- h$base_store_field_number_2(b, off, OFFSET_STAT_ST_MTIME, SIZEOF_STAT_ST_MTIME, mtimeS, mtimeNs);
+ h$base_store_field_number(b, off, OFFSET_STAT_ST_MTIME, SIZEOF_STAT_ST_MTIME, mtimeS);
+ h$base_store_field_number(b, off, OFFSET_STAT_ST_MTIM_TV_NSEC, SIZEOF_STAT_ST_MTIM_TV_NSEC, mtimeNs);
var ctimeS = Math.floor(fs.ctimeMs/1000);
var ctimeNs = (fs.ctimeMs/1000 - ctimeS) * 1000000000;
- h$base_store_field_number_2(b, off, OFFSET_STAT_ST_CTIME, SIZEOF_STAT_ST_CTIME, ctimeS, ctimeNs);
+ h$base_store_field_number(b, off, OFFSET_STAT_ST_CTIME, SIZEOF_STAT_ST_CTIME, ctimeS);
+ h$base_store_field_number(b, off, OFFSET_STAT_ST_CTIM_TV_NSEC, SIZEOF_STAT_ST_CTIM_TV_NSEC, ctimeNs);
}
#endif
@@ -666,28 +669,21 @@ function h$base_store_field_number(ptr, ptr_off, field_off, field_size, val) {
ptr.i3[(ptr_off>>2)+(field_off>>2)] = val;
} else if(field_size === 8) {
h$long_from_number(val, (h,l) => {
- ptr.i3[(ptr_off>>2)+(field_off>>2)] = h;
- ptr.i3[(ptr_off>>2)+(field_off>>2)+1] = l;
+ ptr.i3[(ptr_off>>2)+(field_off>>2)] = l;
+ ptr.i3[(ptr_off>>2)+(field_off>>2)+1] = h;
});
} else {
throw new Error("unsupported field size: " + field_size);
}
}
-function h$base_store_field_number_2(ptr, ptr_off, field_off, field_size, val1, val2) {
- if(field_size%2) throw new Error("unsupported field size: " + field_size);
- var half_field_size = field_size>>1;
- h$base_store_field_number(ptr, ptr_off, field_off, half_field_size, val1);
- h$base_store_field_number(ptr, ptr_off, field_off+half_field_size, half_field_size, val2);
-}
-
function h$base_return_field(ptr, ptr_off, field_off, field_size) {
if(ptr_off%4) throw new Error("ptr not aligned");
if(field_off%4) throw new Error("field not aligned");
if(field_size === 4) {
return ptr.i3[(ptr_off>>2) + (field_off>>2)];
} else if(field_size === 8) {
- RETURN_UBX_TUP2(ptr.i3[(ptr_off>>2) + (field_off>>2)], ptr.i3[(ptr_off>>2) + (field_off>>2)+1]);
+ RETURN_UBX_TUP2(ptr.i3[(ptr_off>>2) + (field_off>>2)+1], ptr.i3[(ptr_off>>2) + (field_off>>2)]);
} else {
throw new Error("unsupported field size: " + field_size);
}
diff --git a/testsuite/tests/cabal/all.T b/testsuite/tests/cabal/all.T
index caa3286f792bbef917654dbf4f017a8526aa67c9..a308556faf668184d059f520be59e0abde64be96 100644
--- a/testsuite/tests/cabal/all.T
+++ b/testsuite/tests/cabal/all.T
@@ -54,3 +54,5 @@ test('shadow', [], makefile_test, [])
test('T12485a', [extra_files(['shadow1.pkg', 'shadow2.pkg', 'shadow3.pkg'])], makefile_test, [])
test('T13703', [extra_files(['test13703a.pkg', 'test13703b.pkg'])], makefile_test, [])
+
+test('fileStatus', normal, compile_and_run, [''])
diff --git a/testsuite/tests/cabal/fileStatus.hs b/testsuite/tests/cabal/fileStatus.hs
new file mode 100644
index 0000000000000000000000000000000000000000..bb5b2b8dd4f6eb999df0ae17d7a21e8998ccc939
--- /dev/null
+++ b/testsuite/tests/cabal/fileStatus.hs
@@ -0,0 +1,110 @@
+{-
+ This is a simple test program for file metadata. It tests a few
+ operations on files and directories, to ensure that our compiler
+ and filesystem produce sensible results.
+
+ If this test fails, it is likely that cabal or backpack tests
+ will fail too.
+
+ Some properties tested:
+
+ * temporary files are regular files and not directories
+ * the current directory is a directory
+ * file size of small temporary files is correct
+ * modification time of created temporary files is close to current time (60s)
+ * modification time of a second temporary file is later than the first
+
+ -}
+{-# LANGUAGE CPP #-}
+
+import Control.Monad (replicateM_)
+
+import Data.Time.Clock
+import System.IO
+import qualified System.Directory as D
+import System.IO.Error
+import Control.Exception
+import Control.Concurrent (threadDelay)
+
+#if !defined(mingw32_HOST_OS)
+import qualified System.Posix.Files as P
+import Data.Time.Clock.POSIX
+#endif
+
+data FileInfo = FileInfo { fiSize :: Integer
+ , fiModified :: UTCTime
+ , fiIsRegularFile :: Bool
+ , fiIsDirectory :: Bool
+ } deriving (Eq, Show)
+
+testFile1, testFile2 :: FilePath
+testFile1 = "test1.out"
+testFile2 = "test2.out"
+
+main :: IO ()
+main = do
+ putStrLn ("checking file " ++ testFile1)
+ handleFileSize1 <- withBinaryFile testFile1 WriteMode $ \h -> do
+ replicateM_ 50 (hPutChar h 'a')
+ hFileSize h
+ fi1 <- getFileInfo testFile1
+ D.removeFile testFile1
+ putStrLn ("handle file size: " ++ show handleFileSize1)
+ currentTime1 <- getCurrentTime
+ printFileInfo currentTime1 fi1
+
+ putStrLn ("\nchecking current directory")
+ currentDir <- D.getCurrentDirectory
+ di <- getFileInfo currentDir
+ putStrLn ("is regular file: " ++ show (fiIsRegularFile di))
+ putStrLn ("is directory: " ++ show (fiIsDirectory di))
+
+ -- wait two seconds before testing the second file
+ threadDelay 2000000
+
+ putStrLn ("\nchecking file " ++ testFile2)
+ handleFileSize2 <- withBinaryFile testFile2 WriteMode $ \h -> do
+ replicateM_ 75 (hPutChar h 'b')
+ hFileSize h
+ fi2 <- getFileInfo testFile2
+ D.removeFile testFile2
+ currentTime2 <- getCurrentTime
+ putStrLn ("handle file size: " ++ show handleFileSize2)
+ printFileInfo currentTime2 fi2
+
+ -- check that the second file was modified after the first
+ putStrLn ("second file modified after first: " ++ show (diffUTCTime (fiModified fi2) (fiModified fi1) >= 1))
+
+
+printFileInfo :: UTCTime -> FileInfo -> IO ()
+printFileInfo time fi = do
+ putStrLn $ "file size: " ++ show (fiSize fi)
+ putStrLn $ "is regular file: " ++ show (fiIsRegularFile fi)
+ putStrLn $ "is directory: " ++ show (fiIsDirectory fi)
+ putStrLn $ "time stamp close enough: " ++ show (closeEnough time (fiModified fi))
+
+getFileInfo :: FilePath -> IO FileInfo
+getFileInfo path = do
+ -- get some basic info about the path
+ dirExists <- D.doesDirectoryExist path
+ fileExists <- D.doesFileExist path
+ fileSize <- if fileExists then D.getFileSize path else pure 0
+ modTime <- D.getModificationTime path
+#if !defined(mingw32_HOST_OS)
+ -- check against unix package (which uses a different way to access some fields of the stat structure)
+ fs <- P.getFileStatus path
+ check "isRegularFile" (P.isRegularFile fs == fileExists)
+ check "isDirectory" (P.isDirectory fs == dirExists)
+ check "modificationTime" (closeEnough (posixSecondsToUTCTime (realToFrac (P.modificationTime fs))) modTime)
+ check "fileSize" (fromIntegral (P.fileSize fs) == fileSize || not fileExists)
+#endif
+ pure (FileInfo fileSize modTime fileExists dirExists)
+
+
+check :: String -> Bool -> IO ()
+check err False = throwIO (userError err)
+check _ True = pure ()
+
+closeEnough :: UTCTime -> UTCTime -> Bool
+closeEnough a b = abs (diffUTCTime a b) < 60
+
diff --git a/testsuite/tests/cabal/fileStatus.stdout b/testsuite/tests/cabal/fileStatus.stdout
new file mode 100644
index 0000000000000000000000000000000000000000..821f787291d4367aa505051b85a352317d69fa34
--- /dev/null
+++ b/testsuite/tests/cabal/fileStatus.stdout
@@ -0,0 +1,18 @@
+checking file test1.out
+handle file size: 50
+file size: 50
+is regular file: True
+is directory: False
+time stamp close enough: True
+
+checking current directory
+is regular file: False
+is directory: True
+
+checking file test2.out
+handle file size: 75
+file size: 75
+is regular file: True
+is directory: False
+time stamp close enough: True
+second file modified after first: True