Changeset 15324

Timestamp:

02/22/07 09:47:16 (21 months ago)

Author:

audreyt

Message:

* Support for the full test of file test operators: oRWXOlpSbctugkTB

(the rest were already supported.) For example:

"README" :T # True

Thanks to jisom++ for prompting it.

Location:

src/Pugs/Prim

Files:

• FileTest.hs (modified) (2 diffs)
• Match.hs (modified) (1 diff)

src/Pugs/Prim/FileTest.hs

@@ -5 +5 @@
     fileSize, sizeIsZero,
     fileMTime, fileCTime, fileATime,
+    fileTestViaPerl5
 ) where
 import Pugs.Internals
+import Pugs.Embed
+import Pugs.Types
 import Pugs.AST hiding (isWritable)
 
@@ -42 +45 @@
 fileATime    :: Val -> Eval Val
 fileATime    = fileTime statFileATime
+
+fileTestViaPerl5 :: String -> Val -> Eval Val
+fileTestViaPerl5 testOp v = do
+    env     <- ask
+    envSV   <- liftIO $ mkEnv env
+    argSV   <- fromVal v
+    subSV   <- liftIO $ evalPerl5 ("sub { warn $_[0]; -" ++ testOp ++ " $_[0] }") envSV (enumCxt cxtItemAny)
+    rv      <- runInvokePerl5 subSV nullSV [argSV]
+    return $ case rv of
+        VStr "" -> VBool False
+        VNum 1  -> VBool True
+        VInt 1  -> VBool True
+        _       -> rv
 
 fileTime :: (FilePath -> IO Integer) -> Val -> Eval Val

src/Pugs/Prim/Match.hs

@@ -141 +141 @@
         "f" -> FileTest.isFile
         "d" -> FileTest.isDirectory
+        [op] | op `elem` "oRWXOlpSbctugkTB" -> FileTest.fileTestViaPerl5 testOp
         _   -> const $ die "Unknown file test operator" testOp
     if isTrue