Add test for dirEntType

Author: sjshuck

tests/DirEnt.c

@@ -0,0 +1,56 @@
+#include <dirent.h>
+#include <errno.h>
+#include <stdio.h>
+#include <stdlib.h>
+#include <string.h>
+#include <sys/types.h>
+
+void check_error(const char *msg) {
+    if (errno) {
+        perror(msg);
+        exit(1);
+    }
+}
+
+int main() {
+    printf("Testing struct dirent d_type in C\n");
+    int status = 0;
+
+    DIR *dir = opendir(".");
+    check_error("opendir");
+
+    while (1) {
+        struct dirent *de = readdir(dir);
+        check_error("readdir");
+        if (!de) {
+            printf("Read the whole . dir without encountering \".\"!\n");
+            status = 1;
+            goto out;
+        }
+
+        if (strcmp(de->d_name, ".") != 0) {
+            continue;
+        }
+        // Otherwise, we found the . dir
+
+        if (de->d_type == DT_DIR) {
+            // Signal that we should run test for non-zero d_type
+            printf("Got DT_DIR for d_type for \".\"\n");
+            goto out;
+        } else if (de->d_type == DT_UNKNOWN) {
+            printf("Got DT_UNKNOWN for d_type for \".\"\n");
+            status = 2;
+            goto out;
+        } else {
+            // . is something other than a directory. Shouldn't happen
+            printf("Got %d for d_type for \".\"!", (int)de->d_type);
+            status = 1;
+            goto out;
+        }
+    }
+
+out:
+    closedir(dir);
+    check_error("closedir");
+    exit(status);
+}

tests/DirEnt.hs

@@ -0,0 +1,66 @@
+{-# LANGUAGE LambdaCase #-}
+
+module Main (main) where
+
+import Control.Exception                (bracket)
+import Foreign.C.String                 (peekCString)
+import System.Exit
+import System.Posix.Directory
+import System.Posix.Directory.Internals
+import System.Process                   (system)
+
+system_x :: String -> IO ExitCode
+system_x = system . ("set -x; " ++)
+
+done :: IO a
+done = system_x "rm -f DirEnt-test" >> exitSuccess
+
+peekDirEnt :: DirEnt -> IO (String, DirType)
+peekDirEnt dirEnt = do
+    dName <- dirEntName dirEnt >>= peekCString
+    dType <- dirEntType dirEnt
+    return (dName, dType)
+
+testDirTypeOfDot :: DirStream -> IO ()
+testDirTypeOfDot dirStream = go where
+    go = do
+        (dName, dType) <- readDirStreamWith peekDirEnt dirStream >>= maybe
+            (die "Read cwd in Haskell and didn't find . dir!")
+            return
+
+        case dName of
+            "." -> case dType of
+                DirectoryType -> putStrLn "Got DirectoryType for . dir" >> done
+                _             -> die $ "Got " ++ show dType ++ " for . dir!"
+            _ -> go
+
+main :: IO ()
+main = do
+    putStrLn "Preparing Haskell test of dirEntType"
+
+    system_x "cc --version" >>= \case
+        ExitSuccess -> return ()
+        ec          -> exitWith ec
+
+    system_x "[ -f tests/DirEnt.c ]" >>= \case
+        ExitSuccess -> return ()
+        ec          -> do
+            putStrLn "Not running tests from root of repo?"
+            exitWith ec
+
+    system_x "cc tests/DirEnt.c -o DirEnt-test" >>= \case
+        ExitSuccess   -> return ()
+        ExitFailure _ -> do
+            putStrLn "d_type not available? Skipping Haskell test"
+            done
+
+    -- As written, this C code exits with 2 if it determines the Haskell test
+    -- for broken dirEntType will be a false positive
+    system_x "./DirEnt-test" >>= \case
+        ExitSuccess   -> return ()
+        ExitFailure 2 -> putStrLn "Skipping Haskell test" >> done
+        ec            -> exitWith ec
+
+    putStrLn "Running Haskell test of dirEntType"
+
+    bracket (openDirStream "/home/steve/foo") closeDirStream testDirTypeOfDot

unix.cabal

@@ -382,3 +382,11 @@ test-suite T13660
     else
       build-depends: filepath >= 1.4.100.0 && < 1.5.0.0
     ghc-options: -Wall
+
+test-suite DirEnt
+    hs-source-dirs: tests
+    main-is: DirEnt.hs
+    type: exitcode-stdio-1.0
+    default-language: Haskell2010
+    build-depends: base, unix, process
+    ghc-options: -Wall