Changeset 14599

Timestamp:

11/03/06 05:30:51 (2 years ago)

Author:

allbery_b

svk:copy_cache_prev:

41990

Message:

AUTHORS: hello, world\n :)
src/Pugs/Compat.hs: added file time tests
src/Pugs/Internals.hs, src/Pugs/Prim.hs: abstract out guts of "time" for

use in $*BASETIME and file tests

src/Pugs/Run.hs: add $*BASETIME
src/Pugs/AST.hs: document _reserved and filterUserDefinedPad; add $*BASETIME

to _reserved

src/Pugs/Prim.hs: add file time operators -M, -C, -A
src/Pugs/Prim/FileTest.hs: add implementation of file time operators
t/operators/filetest.t: correct existing file time operator tests, add a few

more, add all of them to the plan

Files:

• AUTHORS (modified) (1 diff)
• src/Pugs/AST.hs (modified) (3 diffs)
• src/Pugs/Compat.hs (modified) (2 diffs)
• src/Pugs/Internals.hs (modified) (2 diffs)
• src/Pugs/Prim.hs (modified) (3 diffs)
• src/Pugs/Prim/FileTest.hs (modified) (3 diffs)
• src/Pugs/Run.hs (modified) (3 diffs)
• t/operators/filetest.t (modified) (2 diffs)

AUTHORS

@@ -35 +35 @@
 Brad "bsb" Bowman                (BOWMANBS)
 Brandon Michael "skew" Moore
+Brandon S Allbery KF8NH
 Bryan Donlan                     (BDONLAN)
 Bryan "mrborisguy" Burgers

src/Pugs/AST.hs

@@ -342 +342 @@
     isPrimVal _ = False
 
+{-|
+Filter out reserved symbols from the specified Pad.
+-}
 filterUserDefinedPad :: Pad -> Pad
 filterUserDefinedPad (MkPad pad) = MkPad $ Map.filterWithKey doFilter pad
@@ -347 +350 @@
     doFilter key _ = (not . Set.member key) _reserved
 
+{-|
+Symbols which are reserved for the current interpreter/compiler instance and
+should not be set from the preamble or other sources.  See
+@Pugs.AST.filterUserDefinedPad@.
+-}
 _reserved :: Set Var
 _reserved = Set.fromList . cast . words $
@@ -352 +360 @@
     "$*PROGRAM_NAME $*PID $*UID $*EUID $*GID $*EGID @*CHECK @*INIT $*IN " ++
     "$*OUT $*ERR $*ARGS $/ %*ENV $*CWD @=POD $=POD $?PUGS_VERSION " ++
-    "$*OS %?CONFIG $*_ $*AUTOLOAD $*PUGS_VERSION"
+    "$*OS %?CONFIG $*_ $*AUTOLOAD $*PUGS_VERSION $*BASETIME"
 
 typeOfParam :: Param -> Type

src/Pugs/Compat.hs

@@ -25 +25 @@
     getArg0,
     statFileSize,
+    statFileMTime,
+    statFileCTime,
+    statFileATime,
     getProcessID,
     getRealUserID,
@@ -97 +100 @@
     return (toInteger (fileSize s))
 
+statFileTime :: (FileStatus -> EpochTime) -> FilePath -> IO Integer
+statFileTime op f = do
+    s <- getFileStatus f
+    return (toInteger $ fromEnum $ op s)
+
+statFileMTime :: FilePath -> IO Integer
+statFileMTime f = statFileTime modificationTime f >>= return
+
+statFileCTime :: FilePath -> IO Integer
+statFileCTime f = statFileTime statusChangeTime f >>= return
+
+statFileATime :: FilePath -> IO Integer
+statFileATime f = statFileTime accessTime f >>= return
+
 type Signal = System.Posix.Signals.Signal
 signalProcess :: Signal -> ProcessID -> IO ()

src/Pugs/Internals.hs

@@ -92 +92 @@
     __, (+++), nullID, addressOf, showAddressOf,
 
-    hashNew, hashList
+    hashNew, hashList,
+    pugsTimeSpec,
 ) where
 
@@ -575 +576 @@
     where
     addr = addressOf x
+
+{-|
+Convert an internal @ClockTime@ to a Pugs-style fractional time.
+Used by op0 "time", @Pugs.Run.prepareEnv@, and the file time tests.
+-}
+pugsTimeSpec :: ClockTime -> Rational
+pugsTimeSpec clkt = fdiff $ diffClockTimes clkt epochClkT
+    where
+       epochClkT = toClockTime epoch
+       epoch = CalendarTime 2000 January 1 0 0 0 0 Saturday 0 "UTC" 0 False
+       -- 10^12 is expanded because the alternatives tried gave type warnings.
+       fdiff = \d -> (fromInteger $ tdPicosec d)
+                   / (clocksPerSecond * clocksPerSecond)
+                   + (fromIntegral $ tdSec d)

src/Pugs/Prim.hs

@@ -73 +73 @@
 op0 "time"  = const $ do
     clkt <- guardIO getClockTime
-    return $ VRat $ fdiff $ diffClockTimes clkt epochClkT
-    where
-       epochClkT = toClockTime epoch
-       epoch = CalendarTime 2000 January 1 0 0 0 0 Saturday 0 "UTC" 0 False
-       -- 10^12 is expanded because the alternatives tried gave type warnings.
-       fdiff = \d -> (fromInteger $ tdPicosec d)
-                   / (clocksPerSecond * clocksPerSecond)
-                   + (fromIntegral $ tdSec d)
+    return $ VRat $ pugsTimeSpec clkt
 op0 "times"  = const $ do
     ProcessTimes _ u s cu cs <- guardIO getProcessTimes
@@ -430 +423 @@
 op1 "-z"    = FileTest.sizeIsZero
 op1 "-s"    = FileTest.fileSize
+op1 "-M"    = FileTest.fileMTime
+op1 "-A"    = FileTest.fileATime
+op1 "-C"    = FileTest.fileCTime
 op1 "-f"    = FileTest.isFile
 op1 "-d"    = FileTest.isDirectory
@@ -1824 +1820 @@
 \\n   Bool      spre    -e      unsafe (Str)\
 \\n   Int       spre    -s      unsafe (Str)\
+\\n   Num       spre    -M      unsafe (Str)\
+\\n   Num       spre    -A      unsafe (Str)\
+\\n   Num       spre    -C      unsafe (Str)\
 \\n   Bool      spre    -f      unsafe (Str)\
 \\n   Bool      spre    -d      unsafe (Str)\

src/Pugs/Prim/FileTest.hs

@@ -3 +3 @@
     exists, isFile, isDirectory,
     fileSize, sizeIsZero,
+    fileMTime, fileCTime, fileATime,
 ) where
 import Pugs.Internals
@@ -34 +35 @@
 sizeIsZero   :: Val -> Eval Val
 sizeIsZero   = fileTestIO fileTestSizeIsZero
+fileMTime    :: Val -> Eval Val
+fileMTime    = fileTime statFileMTime
+fileCTime    :: Val -> Eval Val
+fileCTime    = fileTime statFileCTime
+fileATime    :: Val -> Eval Val
+fileATime    = fileTime statFileATime
+
+fileTime :: (FilePath -> IO Integer) -> Val -> Eval Val
+fileTime test f = do
+    t <- fileTestIO (fileTestDo test) f
+    if (t == undef) then return VUndef else do
+    t' <- fromVal t
+    b <- (readVar $ cast "$*BASETIME") >>= fromVal
+    return $ VRat $ (b - (pugsTimeSpec $ TOD t' 0)) / 86400
 
 fileTestIO :: (Value n) => (n -> IO Val) -> Val -> Eval Val
@@ -74 +89 @@
     n <- statFileSize f
     return $ if n == 0 then VBool True else VBool False
+
+fileTestDo :: (FilePath -> IO Integer) -> FilePath -> IO Val
+fileTestDo test f = test f >>= return . VInt

src/Pugs/Run.hs

@@ -36 +36 @@
 import System.IO
 import System.FilePath (joinFileName)
+import System.Posix.Time
 
 
@@ -115 +116 @@
     classes <- initClassObjects (MkObjectId $ -1) [] initTree
     strictSV <- newScalar $ VBool (name /= "-e")
+    -- XXX factor "time" and use it here and in filetime tests
+    baset <- getClockTime
 #if defined(PUGS_HAVE_HSPLUGINS)
     hspluginsSV <- newScalar (VInt 1)
@@ -164 +167 @@
         , gen "$*AUTOLOAD" $ MkRef autoSV
         , gen "$*STRICT" $ MkRef strictSV
+        -- XXX do we want hideInSafemode?
+        , gen "$*BASETIME" $ MkRef $ constScalar (VRat $ pugsTimeSpec baset)
         ] ++ classes
     -- defSVcell <- (gen "$_" . MkRef) =<< newScalar undef

t/operators/filetest.t

@@ -9 +9 @@
 =cut
 
-plan 41;
+plan 50;
 
 #if $*OS eq any <MSWin32 mingw msys cygwin> {
@@ -118 +118 @@
 my $fh = open("test_file", :w);
 close $fh;
-ok (-M "test_file") > 0,      "-M works";
-ok (-C "test_file") > 0,      "-C works";
-ok (-A "test_file") > 0,      "-A works";
+sleep 1; # just to make sure
+ok (-M "test_file") < 0,      "-M works on new file";
+ok (-C "test_file") < 0,      "-C works on new file";
+ok (-A "test_file") < 0,      "-A works on new file";
 unlink "test_file";
 
+if (! -f "README") {
+  skip 3, "no file README";
+} else {
+  ok (-M "README") > 0, "-M works on existing file";
+  ok (-C "README") > 0, "-C works on existing file";
+  ok (-A "README") > 0, "-A works on existing file";
+}
+
+ok not -M "xyzzy", "-M returns undef when no file";
+ok not -C "xyzzy", "-C returns undef when no file";
+ok not -A "xyzzy", "-A returns undef when no file";