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


git-svn-id: http://svn.pugscode.org/pugs@14599 c213334d-75ef-0310-aa23-eaa082d1ae64

AUTHORS

@@ -34,6 +34,7 @@ Benjamin "integral" Smith        (BSMITH)
 Bestian Tang                                 唐宗浩
 Brad "bsb" Bowman                (BOWMANBS)
 Brandon Michael "skew" Moore
+Brandon S Allbery KF8NH
 Bryan Donlan                     (BDONLAN)
 Bryan "mrborisguy" Burgers
 Caio Marcelo de Oliveira Filho

src/Pugs/AST.hs

@@ -341,17 +341,25 @@ isPrim tv = do
     isPrimVal (VCode MkCode{ subBody = Prim _ }) = True
     isPrimVal _ = False
 
+{-|
+Filter out reserved symbols from the specified Pad.
+-}
 filterUserDefinedPad :: Pad -> Pad
 filterUserDefinedPad (MkPad pad) = MkPad $ Map.filterWithKey doFilter pad
     where
     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 $
     "@*ARGS @*INC %*INC $*PUGS_HAS_HSPLUGINS $*EXECUTABLE_NAME " ++
     "$*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
 typeOfParam p = case v_sigil (paramName p) of

src/Pugs/Compat.hs

@@ -24,6 +24,9 @@ module Pugs.Compat (
     getEnvironment,
     getArg0,
     statFileSize,
+    statFileMTime,
+    statFileCTime,
+    statFileATime,
     getProcessID,
     getRealUserID,
     getEffectiveUserID,
@@ -96,6 +99,20 @@ statFileSize f = do
     s <- getFileStatus f
     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 ()
 signalProcess = System.Posix.Signals.signalProcess

src/Pugs/Internals.hs

@@ -91,7 +91,8 @@ module Pugs.Internals (
 
     __, (+++), nullID, addressOf, showAddressOf,
 
-    hashNew, hashList
+    hashNew, hashList,
+    pugsTimeSpec,
 ) where
 
 import Pugs.Compat
@@ -574,3 +575,17 @@ showAddressOf :: String -> a -> String
 showAddressOf typ x = addr `seq` ('<' : typ ++ ":0x" ++ showHex addr ">")
     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

@@ -72,14 +72,7 @@ op0 "True"  = constMacro . Val $ VBool True
 op0 "False" = constMacro . Val $ VBool False
 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
     return . VList $ map (castV . (% (clocksPerSecond :: VInt)) . toInteger . fromEnum)
@@ -429,6 +422,9 @@ op1 "-x"    = FileTest.isExecutable
 op1 "-e"    = FileTest.exists
 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
 op1 "graphs"= op1Cast (VInt . (genericLength :: String -> VInt)) -- XXX Wrong
@@ -1823,6 +1819,9 @@ initSyms = seq (length syms) $ do
 \\n   Bool      spre    -x      unsafe (Str)\
 \\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)\
 \\n   Num       spre    -       safe   (Num)\

src/Pugs/Prim/FileTest.hs

@@ -2,6 +2,7 @@ module Pugs.Prim.FileTest (
     isReadable, isWritable, isExecutable,
     exists, isFile, isDirectory,
     fileSize, sizeIsZero,
+    fileMTime, fileCTime, fileATime,
 ) where
 import Pugs.Internals
 import Pugs.AST hiding (isWritable)
@@ -33,6 +34,20 @@ fileSize     :: Val -> Eval Val
 fileSize     = fileTestIO fileTestFileSize
 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
 fileTestIO f v = do
@@ -73,3 +88,6 @@ fileTestSizeIsZero :: FilePath -> IO Val
 fileTestSizeIsZero f = do
     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

@@ -35,6 +35,7 @@ import Data.Yaml.Syck
 --import Data.Generics.Schemes
 import System.IO
 import System.FilePath (joinFileName)
+import System.Posix.Time
 
 
 {-|
@@ -114,6 +115,8 @@ prepareEnv name args = do
     autoSV  <- newScalar undef
     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)
 #else
@@ -163,6 +166,8 @@ prepareEnv name args = do
         , gen "$*_" $ MkRef defSV
         , 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
     let env' = env

t/operators/filetest.t

@@ -8,7 +8,7 @@ This test tests the various filetest operators.
 
 =cut
 
-plan 41;
+plan 50;
 
 #if $*OS eq any <MSWin32 mingw msys cygwin> {
 #    skip 30, "file tests not fully available on win32";
@@ -117,8 +117,20 @@ ok -e $sb, 'false stat buffers can still be used', :todo<bug>;
 
 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";