[Git][ghc/ghc][master] JS: correct file size and times
Marge Bot (@marge-bot)
gitlab at gitlab.haskell.org
Thu Sep 21 16:57:38 UTC 2023
Marge Bot pushed to branch master at Glasgow Haskell Compiler / GHC
Commits:
11ecc37b by Luite Stegeman at 2023-09-21T12:57:03-04:00
JS: correct file size and times
Programs produced by the JavaScript backend were returning
incorrect file sizes and modification times, causing cabal
related tests to fail.
This fixes the problem and adds an additional test that verifies
basic file information operations.
fixes #23980
- - - - -
5 changed files:
- libraries/base/configure.ac
- libraries/base/jsbits/base.js
- testsuite/tests/cabal/all.T
- + testsuite/tests/cabal/fileStatus.hs
- + testsuite/tests/cabal/fileStatus.stdout
Changes:
=====================================
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>])
=====================================
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);
}
=====================================
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, [''])
=====================================
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
+
=====================================
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
View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/11ecc37bc27ffa1cf31358e21e09e140befa940c
--
View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/11ecc37bc27ffa1cf31358e21e09e140befa940c
You're receiving this email because of your account on gitlab.haskell.org.
-------------- next part --------------
An HTML attachment was scrubbed...
URL: <http://mail.haskell.org/pipermail/ghc-commits/attachments/20230921/efe4bff7/attachment-0001.html>
More information about the ghc-commits
mailing list