Fix struct dirent d_type macro test

cbits/HsUnix.c

@@ -106,7 +106,7 @@ char *__hscore_d_name( struct dirent* d )
 
 char __hscore_d_type( struct dirent* d )
 {
-#ifdef HAVE_DIRENT_D_TYPE
+#ifdef HAVE_STRUCT_DIRENT_D_TYPE
   return (d->d_type);
 #else
   return CONST_DT_UNKNOWN;

tests/DirEnt.c

@@ -0,0 +1,73 @@
+/*
+ * The purpose of this C program is to do one of 4 things.  Which one it does,
+ * indicates to the DirEnt test suite something it ought to do.
+ *
+ * fail to compile
+ *   This means d_type is undefined.  It should be enough to test for
+ *   HAVE_STRUCT_DIRENT_D_TYPE, but this test suite came about because of
+ *   https://github.com/haskell/unix/issues/347 which was caused by a
+ *   misspelling of that macro, so we're testing it another way.
+ *   Absence of d_type means the test suite ought to skip testing for non-
+ *   DT_UNKNOWN values for d_type, since dirEntType returns UnknownType in this
+ *   case.
+ * exit with status 0
+ *   This means the "." entry in the DIR stream opened at ".", guaranteed to be
+ *   a directory, has a d_type of DT_DIR.  We should proceed with a test for it
+ *   in Haskell.
+ * exit with status 1
+ *   This means something unexpected went wrong.  Fail the Haskell test also.
+ * exit with stauts 2
+ *   This means the "." entry has a d_type of DT_UNKNOWN.  This is valid; no
+ *   filesystem or operating system is required to yield a useful d_type.
+ *   We should skip testing for non-DT_UNKNOWN values in Haskell.
+ */
+
+#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");
+
+    DIR *dir = opendir(".");
+    check_error("opendir");
+
+    struct dirent *de = NULL;
+
+    do {
+        de = readdir(dir);
+        check_error("readdir");
+    } while (de && strcmp(de->d_name, ".") != 0);
+    // We found the . dir or encountered end of dir stream
+
+    int status = 0;
+
+    if (!de) {
+        printf("Read the whole . dir without encountering \".\"!\n");
+        status = 1;
+    } else if (de->d_type == DT_DIR) {
+        printf("Got DT_DIR for d_type for \".\"\n");
+    } else if (de->d_type == DT_UNKNOWN) {
+        printf("Got DT_UNKNOWN for d_type for \".\"\n");
+        // Signal that we should skip test for non-zero d_type
+        status = 2;
+    } else {
+        printf("Got %d for d_type for \".\"!\n", (int)de->d_type);
+        status = 1;
+    }
+
+    closedir(dir);
+    check_error("closedir");
+
+    exit(status);
+}

tests/DirEnt.hs

@@ -0,0 +1,58 @@
+{-# LANGUAGE LambdaCase #-}
+
+module Main (main) where
+
+import Control.Exception                (bracket, finally)
+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 cmd = system $ "set -x; " ++ cmd
+
+onFailure :: IO ExitCode -> (ExitCode -> IO ()) -> IO ()
+action `onFailure` after = action >>= \case
+    ExitSuccess -> return ()
+    ec          -> after ec
+infixr 9 `onFailure`
+
+prepareTest :: IO ()
+prepareTest = do
+    system_x "cc --version" `onFailure` exitWith
+    system_x "[ -f tests/DirEnt.c ]" `onFailure` \ec -> do
+        putStrLn "Not running tests from root of repo?"
+        exitWith ec
+    system_x "cc tests/DirEnt.c -o DirEnt-test" `onFailure` \_ -> do
+        putStrLn "d_type not available? Skipping Haskell test"
+        exitSuccess
+    -- 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" `onFailure` \case
+        ExitFailure 2 -> putStrLn "Skipping Haskell test" >> exitSuccess
+        ec            -> exitWith ec
+
+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 = readDirStreamWith peekDirEnt dirStream >>= \case
+        Just (".", DirectoryType) -> do
+            putStrLn "Got DirectoryType for . dir"
+            exitSuccess
+        Just (".", dType) -> die $ "Got " ++ show dType ++ " for . dir!"
+        Just _ -> go
+        Nothing -> die "Read cwd in Haskell and didn't find . dir!"
+
+main :: IO ()
+main = do
+    putStrLn "Preparing Haskell test of dirEntType"
+    prepareTest `finally` system_x "rm -f DirEnt-test"
+
+    putStrLn "Running Haskell test of dirEntType"
+    bracket (openDirStream ".") 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