[Git][ghc/ghc][wip/drop-touch] Drop dependence on `touch`
Ben Gamari (@bgamari)
gitlab at gitlab.haskell.org
Fri Jun 30 14:53:36 UTC 2023
Ben Gamari pushed to branch wip/drop-touch at Glasgow Haskell Compiler / GHC
Commits:
32f586e6 by Ben Gamari at 2023-06-30T10:53:25-04:00
Drop dependence on `touch`
This drops GHC's dependence on the `touch` program, instead implementing
it within GHC. This eliminates an external dependency and means that we
have one fewer program to keep track of in the `configure` script
- - - - -
22 changed files:
- compiler/GHC/Driver/Main.hs
- compiler/GHC/Driver/Pipeline/Execute.hs
- compiler/GHC/Driver/Session.hs
- compiler/GHC/Settings.hs
- compiler/GHC/Settings/IO.hs
- compiler/GHC/SysTools/Tasks.hs
- + compiler/GHC/Utils/Touch.hs
- compiler/ghc.cabal.in
- hadrian/bindist/Makefile
- hadrian/bindist/config.mk.in
- hadrian/cfg/system.config.in
- hadrian/src/Builder.hs
- hadrian/src/Hadrian/Builder.hs
- hadrian/src/Oracles/Setting.hs
- hadrian/src/Packages.hs
- hadrian/src/Rules/Generate.hs
- hadrian/src/Rules/Program.hs
- hadrian/src/Settings/Default.hs
- m4/fp_settings.m4
- − utils/touchy/Makefile
- − utils/touchy/touchy.c
- − utils/touchy/touchy.cabal
Changes:
=====================================
compiler/GHC/Driver/Main.hs
=====================================
@@ -259,6 +259,7 @@ import GHC.Utils.Outputable
import GHC.Utils.Misc
import GHC.Utils.Logger
import GHC.Utils.TmpFs
+import GHC.Utils.Touch
import qualified GHC.LanguageExtensions as LangExt
@@ -1262,7 +1263,7 @@ hscMaybeWriteIface logger dflags is_simple iface old_iface mod_location = do
-- .hie files.
let hie_file = ml_hie_file mod_location
whenM (doesFileExist hie_file) $
- GHC.SysTools.touch logger dflags "Touching hie file" hie_file
+ GHC.Utils.Touch.touch hie_file
else
-- See Note [Strictness in ModIface]
forceModIface iface
=====================================
compiler/GHC/Driver/Pipeline/Execute.hs
=====================================
@@ -72,6 +72,7 @@ import System.IO
import GHC.Linker.ExtraObj
import GHC.Linker.Dynamic
import GHC.Utils.Panic
+import GHC.Utils.Touch
import GHC.Unit.Module.Env
import GHC.Driver.Env.KnotVars
import GHC.Driver.Config.Finder
@@ -369,7 +370,7 @@ runJsPhase _pipe_env hsc_env _location input_fn = do
-- The object file is already generated. We only touch it to ensure the
-- timestamp is refreshed, see Note [JS Backend .o file procedure].
- touchObjectFile logger dflags input_fn
+ touchObjectFile input_fn
return input_fn
@@ -552,7 +553,7 @@ runHscBackendPhase pipe_env hsc_env mod_name src_flavour location result = do
-- In the case of hs-boot files, generate a dummy .o-boot
-- stamp file for the benefit of Make
- HsBootFile -> touchObjectFile logger dflags o_file
+ HsBootFile -> touchObjectFile o_file
HsSrcFile -> panic "HscUpdate not relevant for HscSrcFile"
-- MP: I wonder if there are any lurking bugs here because we
@@ -1148,10 +1149,10 @@ linkDynLibCheck logger tmpfs dflags unit_env o_files dep_units = do
-touchObjectFile :: Logger -> DynFlags -> FilePath -> IO ()
-touchObjectFile logger dflags path = do
+touchObjectFile :: FilePath -> IO ()
+touchObjectFile path = do
createDirectoryIfMissing True $ takeDirectory path
- GHC.SysTools.touch logger dflags "Touching object file" path
+ GHC.Utils.Touch.touch path
-- Note [-fPIC for assembler]
-- ~~~~~~~~~~~~~~~~~~~~~~~~~~
=====================================
compiler/GHC/Driver/Session.hs
=====================================
@@ -102,7 +102,6 @@ module GHC.Driver.Session (
sPgm_l,
sPgm_lm,
sPgm_dll,
- sPgm_T,
sPgm_windres,
sPgm_ar,
sPgm_ranlib,
@@ -137,7 +136,7 @@ module GHC.Driver.Session (
versionedAppDir, versionedFilePath,
extraGccViaCFlags, globalPackageDatabasePath,
pgm_L, pgm_P, pgm_F, pgm_c, pgm_cxx, pgm_cpp, pgm_a, pgm_l, pgm_lm,
- pgm_dll, pgm_T, pgm_windres, pgm_ar,
+ pgm_dll, pgm_windres, pgm_ar,
pgm_ranlib, pgm_lo, pgm_lc, pgm_lcc, pgm_i,
opt_L, opt_P, opt_F, opt_c, opt_cxx, opt_a, opt_l, opt_lm, opt_i,
opt_P_signature,
@@ -406,8 +405,6 @@ pgm_lm :: DynFlags -> Maybe (String,[Option])
pgm_lm dflags = toolSettings_pgm_lm $ toolSettings dflags
pgm_dll :: DynFlags -> (String,[Option])
pgm_dll dflags = toolSettings_pgm_dll $ toolSettings dflags
-pgm_T :: DynFlags -> String
-pgm_T dflags = toolSettings_pgm_T $ toolSettings dflags
pgm_windres :: DynFlags -> String
pgm_windres dflags = toolSettings_pgm_windres $ toolSettings dflags
pgm_lcc :: DynFlags -> (String,[Option])
=====================================
compiler/GHC/Settings.hs
=====================================
@@ -34,7 +34,6 @@ module GHC.Settings
, sPgm_l
, sPgm_lm
, sPgm_dll
- , sPgm_T
, sPgm_windres
, sPgm_ar
, sPgm_otool
@@ -111,7 +110,6 @@ data ToolSettings = ToolSettings
-- merging, hence the 'Maybe'. See Note [Object merging] in
-- "GHC.Driver.Pipeline.Execute" for details.
, toolSettings_pgm_dll :: (String, [Option])
- , toolSettings_pgm_T :: String
, toolSettings_pgm_windres :: String
, toolSettings_pgm_ar :: String
, toolSettings_pgm_otool :: String
@@ -226,8 +224,6 @@ sPgm_lm :: Settings -> Maybe (String, [Option])
sPgm_lm = toolSettings_pgm_lm . sToolSettings
sPgm_dll :: Settings -> (String, [Option])
sPgm_dll = toolSettings_pgm_dll . sToolSettings
-sPgm_T :: Settings -> String
-sPgm_T = toolSettings_pgm_T . sToolSettings
sPgm_windres :: Settings -> String
sPgm_windres = toolSettings_pgm_windres . sToolSettings
sPgm_ar :: Settings -> String
=====================================
compiler/GHC/Settings/IO.hs
=====================================
@@ -125,8 +125,6 @@ initSettings top_dir = do
install_name_tool_path <- getToolSetting "install_name_tool command"
ranlib_path <- getToolSetting "ranlib command"
- touch_path <- getToolSetting "touch command"
-
mkdll_prog <- getToolSetting "dllwrap command"
let mkdll_args = []
@@ -191,7 +189,6 @@ initSettings top_dir = do
, toolSettings_pgm_l = (ld_prog, ld_args)
, toolSettings_pgm_lm = ld_r
, toolSettings_pgm_dll = (mkdll_prog,mkdll_args)
- , toolSettings_pgm_T = touch_path
, toolSettings_pgm_windres = windres_path
, toolSettings_pgm_ar = ar_path
, toolSettings_pgm_otool = otool_path
=====================================
compiler/GHC/SysTools/Tasks.hs
=====================================
@@ -395,6 +395,3 @@ runWindres logger dflags args = traceSystoolCommand logger "windres" $ do
mb_env <- getGccEnv cc_args
runSomethingFiltered logger id "Windres" windres (opts ++ args) Nothing mb_env
-touch :: Logger -> DynFlags -> String -> String -> IO ()
-touch logger dflags purpose arg = traceSystoolCommand logger "touch" $
- runSomething logger purpose (pgm_T dflags) [FileOption "" arg]
=====================================
compiler/GHC/Utils/Touch.hs
=====================================
@@ -0,0 +1,33 @@
+{-# LANGUAGE CPP #-}
+
+module GHC.Utils.Touch (touch) where
+
+import GHC.Prelude
+
+#if defined(mingw32_HOST_OS)
+import System.Win32.File
+import System.Win32.Time
+#else
+import System.Posix.Files
+import System.Posix.IO
+#endif
+
+-- | Set the mtime of the given file to the current time.
+touch :: FilePath -> IO ()
+touch file = do
+#if defined(mingw32_HOST_OS)
+ hdl <- createFile file gENERIC_WRITE fILE_SHARE_NONE Nothing oPEN_ALWAYS fILE_ATTRIBUTE_NORMAL Nothing
+ t <- getSystemTimeAsFileTime
+ setFileTime hdl Nothing Nothing (Just t)
+ closeHandle hdl
+#else
+ let oflags = defaultFileFlags { noctty = True }
+#if MIN_VERSION_unix(2,8,0)
+ fd <- openFd file WriteOnly oflags
+#else
+ fd <- openFd file WriteOnly (Just 0o666) oflags
+#endif
+ touchFd fd
+ closeFd fd
+#endif
+
=====================================
compiler/ghc.cabal.in
=====================================
@@ -902,6 +902,7 @@ Library
GHC.Utils.Ppr
GHC.Utils.Ppr.Colour
GHC.Utils.TmpFs
+ GHC.Utils.Touch
GHC.Utils.Trace
GHC.Wasm.ControlFlow
GHC.Wasm.ControlFlow.FromCmm
=====================================
hadrian/bindist/Makefile
=====================================
@@ -102,7 +102,6 @@ lib/settings : config.mk
@echo ',("ranlib command", "$(SettingsRanlibCommand)")' >> $@
@echo ',("otool command", "$(SettingsOtoolCommand)")' >> $@
@echo ',("install_name_tool command", "$(SettingsInstallNameToolCommand)")' >> $@
- @echo ',("touch command", "$(SettingsTouchCommand)")' >> $@
@echo ',("dllwrap command", "$(SettingsDllWrapCommand)")' >> $@
@echo ',("windres command", "$(SettingsWindresCommand)")' >> $@
@echo ',("unlit command", "$$topdir/bin/$(CrossCompilePrefix)unlit")' >> $@
=====================================
hadrian/bindist/config.mk.in
=====================================
@@ -274,7 +274,6 @@ SettingsRanlibCommand = @SettingsRanlibCommand@
SettingsDllWrapCommand = @SettingsDllWrapCommand@
SettingsWindresCommand = @SettingsWindresCommand@
SettingsLibtoolCommand = @SettingsLibtoolCommand@
-SettingsTouchCommand = @SettingsTouchCommand@
SettingsClangCommand = @SettingsClangCommand@
SettingsLlcCommand = @SettingsLlcCommand@
SettingsOptCommand = @SettingsOptCommand@
=====================================
hadrian/cfg/system.config.in
=====================================
@@ -158,7 +158,6 @@ settings-otool-command = @SettingsOtoolCommand@
settings-install_name_tool-command = @SettingsInstallNameToolCommand@
settings-dll-wrap-command = @SettingsDllWrapCommand@
settings-windres-command = @SettingsWindresCommand@
-settings-touch-command = @SettingsTouchCommand@
settings-clang-command = @SettingsClangCommand@
settings-llc-command = @SettingsLlcCommand@
settings-opt-command = @SettingsOptCommand@
=====================================
hadrian/src/Builder.hs
=====================================
@@ -236,7 +236,6 @@ instance H.Builder Builder where
pure []
Ghc _ stage -> do
root <- buildRoot
- touchyPath <- programPath (vanillaContext (Stage0 InTreeLibs) touchy)
unlitPath <- builderPath Unlit
-- GHC from the previous stage is used to build artifacts in the
@@ -245,7 +244,6 @@ instance H.Builder Builder where
return $ [ unlitPath ]
++ ghcdeps
- ++ [ touchyPath | windowsHost ]
++ [ root -/- mingwStamp | windowsHost ]
-- proxy for the entire mingw toolchain that
-- we have in inplace/mingw initially, and then at
=====================================
hadrian/src/Hadrian/Builder.hs
=====================================
@@ -49,8 +49,8 @@ class ShakeValue b => Builder b where
-- capture the @stdout@ result and return it.
askBuilderWith :: b -> BuildInfo -> Action String
- -- | Runtime dependencies of a builder. For example, on Windows GHC requires
- -- the utility @touchy.exe@ to be available on a specific path.
+ -- | Runtime dependencies of a builder. For example, GHC requires the
+ -- utility @unlit@ to be available on a specific path.
runtimeDependencies :: b -> Action [FilePath]
runtimeDependencies _ = return []
=====================================
hadrian/src/Oracles/Setting.hs
=====================================
@@ -125,7 +125,6 @@ data SettingsFileSetting
| SettingsFileSetting_InstallNameToolCommand
| SettingsFileSetting_DllWrapCommand
| SettingsFileSetting_WindresCommand
- | SettingsFileSetting_TouchCommand
| SettingsFileSetting_ClangCommand
| SettingsFileSetting_LlcCommand
| SettingsFileSetting_OptCommand
@@ -223,7 +222,6 @@ settingsFileSetting key = lookupSystemConfig $ case key of
SettingsFileSetting_InstallNameToolCommand -> "settings-install_name_tool-command"
SettingsFileSetting_DllWrapCommand -> "settings-dll-wrap-command"
SettingsFileSetting_WindresCommand -> "settings-windres-command"
- SettingsFileSetting_TouchCommand -> "settings-touch-command"
SettingsFileSetting_ClangCommand -> "settings-clang-command"
SettingsFileSetting_LlcCommand -> "settings-llc-command"
SettingsFileSetting_OptCommand -> "settings-opt-command"
=====================================
hadrian/src/Packages.hs
=====================================
@@ -8,7 +8,7 @@ module Packages (
ghcCompact, ghcConfig, ghcHeap, ghci, ghciWrapper, ghcPkg, ghcPrim, haddock, haskeline,
hsc2hs, hp2ps, hpc, hpcBin, integerGmp, integerSimple, iserv, iservProxy,
libffi, mtl, parsec, pretty, primitive, process, remoteIserv, rts,
- runGhc, semaphoreCompat, stm, templateHaskell, terminfo, text, time, timeout, touchy,
+ runGhc, semaphoreCompat, stm, templateHaskell, terminfo, text, time, timeout,
transformers, unlit, unix, win32, xhtml,
lintersCommon, lintNotes, lintCommitMsg, lintSubmoduleRefs, lintWhitespace,
ghcPackages, isGhcPackage,
@@ -40,7 +40,7 @@ ghcPackages =
, ghcCompact, ghcConfig, ghcHeap, ghci, ghciWrapper, ghcPkg, ghcPrim, haddock, haskeline, hsc2hs
, hp2ps, hpc, hpcBin, integerGmp, integerSimple, iserv, libffi, mtl
, parsec, pretty, process, rts, runGhc, stm, semaphoreCompat, templateHaskell
- , terminfo, text, time, touchy, transformers, unlit, unix, win32, xhtml
+ , terminfo, text, time, transformers, unlit, unix, win32, xhtml
, timeout
, lintersCommon
, lintNotes, lintCommitMsg, lintSubmoduleRefs, lintWhitespace ]
@@ -56,7 +56,7 @@ array, base, binary, bytestring, cabalSyntax, cabal, checkPpr, checkExact, count
ghcCompact, ghcConfig, ghcHeap, ghci, ghciWrapper, ghcPkg, ghcPrim, haddock, haskeline, hsc2hs,
hp2ps, hpc, hpcBin, integerGmp, integerSimple, iserv, iservProxy, remoteIserv, libffi, mtl,
parsec, pretty, primitive, process, rts, runGhc, semaphoreCompat, stm, templateHaskell,
- terminfo, text, time, touchy, transformers, unlit, unix, win32, xhtml,
+ terminfo, text, time, transformers, unlit, unix, win32, xhtml,
timeout,
lintersCommon, lintNotes, lintCommitMsg, lintSubmoduleRefs, lintWhitespace
:: Package
@@ -117,7 +117,6 @@ terminfo = lib "terminfo"
text = lib "text"
time = lib "time"
timeout = util "timeout" `setPath` "testsuite/timeout"
-touchy = util "touchy"
transformers = lib "transformers"
unlit = util "unlit"
unix = lib "unix"
@@ -192,12 +191,12 @@ programName Context {..} = do
-- | The 'FilePath' to a program executable in a given 'Context'.
programPath :: Context -> Action FilePath
programPath context at Context {..} = do
- -- TODO: The @touchy@ utility lives in the @lib/bin@ directory instead of
- -- @bin@, which is likely just a historical accident that should be fixed.
- -- See: https://github.com/snowleopard/hadrian/issues/570
- -- Likewise for @iserv@ and @unlit at .
+ -- TODO: The @iserv@ and @unlit@ utilities live in the @lib/bin@ directory
+ -- instead of @bin@, which is likely just a historical accident that should
+ -- be fixed. See:
+ -- https://github.com/snowleopard/hadrian/issues/570
name <- programName context
- path <- if package `elem` [iserv, touchy, unlit]
+ path <- if package `elem` [iserv, unlit]
then stageLibPath stage <&> (-/- "bin")
else stageBinPath stage
return $ path -/- name <.> exe
@@ -210,7 +209,7 @@ timeoutPath = "testsuite/timeout/install-inplace/bin/timeout" <.> exe
-- TODO: Can we extract this information from Cabal files?
-- | Some program packages should not be linked with Haskell main function.
nonHsMainPackage :: Package -> Bool
-nonHsMainPackage = (`elem` [hp2ps, iserv, touchy, unlit, ghciWrapper])
+nonHsMainPackage = (`elem` [hp2ps, iserv, unlit, ghciWrapper])
-- TODO: Combine this with 'programName'.
-- | Path to the @autogen@ directory generated by 'buildAutogenFiles'.
=====================================
hadrian/src/Rules/Generate.hs
=====================================
@@ -461,7 +461,6 @@ generateSettings = do
, ("ranlib command", expr $ settingsFileSetting SettingsFileSetting_RanlibCommand)
, ("otool command", expr $ settingsFileSetting SettingsFileSetting_OtoolCommand)
, ("install_name_tool command", expr $ settingsFileSetting SettingsFileSetting_InstallNameToolCommand)
- , ("touch command", expr $ settingsFileSetting SettingsFileSetting_TouchCommand)
, ("dllwrap command", expr $ settingsFileSetting SettingsFileSetting_DllWrapCommand)
, ("windres command", expr $ settingsFileSetting SettingsFileSetting_WindresCommand)
, ("unlit command", ("$topdir/bin/" <>) <$> expr (programName (ctx { Context.package = unlit })))
=====================================
hadrian/src/Rules/Program.hs
=====================================
@@ -105,7 +105,7 @@ buildProgram bin ctx@(Context{..}) rs = do
(True, s) | s > stage0InTree -> do
srcDir <- buildRoot <&> (-/- (stageString stage0InTree -/- "bin"))
copyFile (srcDir -/- takeFileName bin) bin
- (False, s) | s > stage0InTree && (package `elem` [touchy, unlit]) -> do
+ (False, s) | s > stage0InTree && (package `elem` [unlit]) -> do
srcDir <- stageLibPath stage0InTree <&> (-/- "bin")
copyFile (srcDir -/- takeFileName bin) bin
_ -> buildBinary rs bin ctx
=====================================
hadrian/src/Settings/Default.hs
=====================================
@@ -105,7 +105,6 @@ stage0Packages = do
]
++ [ terminfo | not windowsHost, not cross ]
++ [ timeout | windowsHost ]
- ++ [ touchy | windowsHost ]
-- | Packages built in 'Stage1' by default. You can change this in "UserSettings".
stage1Packages :: Action [Package]
@@ -155,9 +154,8 @@ stage1Packages = do
, runGhc
]
, when (winTarget && not cross)
- [ touchy
- -- See Note [Hadrian's ghci-wrapper package]
- , ghciWrapper
+ [ -- See Note [Hadrian's ghci-wrapper package]
+ ghciWrapper
]
]
@@ -185,16 +183,14 @@ defaultLibraryWays = Set.fromList <$>
defaultRtsWays :: Ways
defaultRtsWays = Set.fromList <$>
mconcat
- [ pure [vanilla]
+ [ pure [vanilla, threaded]
, notStage0 ? pure
- [ profiling, debugProfiling
- , debug
+ [ profiling, threadedProfiling, debugProfiling, threadedDebugProfiling
+ , debug, threadedDebug
]
- , notStage0 ? targetSupportsThreadedRts ? pure [threaded, threadedProfiling, threadedDebugProfiling, threadedDebug]
, notStage0 ? platformSupportsSharedLibs ? pure
- [ dynamic, debugDynamic
+ [ dynamic, threadedDynamic, debugDynamic, threadedDebugDynamic
]
- , notStage0 ? platformSupportsSharedLibs ? targetSupportsThreadedRts ? pure [ threadedDynamic, threadedDebugDynamic ]
]
-- TODO: Move C source arguments here
=====================================
m4/fp_settings.m4
=====================================
@@ -25,7 +25,6 @@ AC_DEFUN([FP_SETTINGS],
SettingsRanlibCommand="${mingw_bin_prefix}llvm-ranlib.exe"
SettingsDllWrapCommand="${mingw_bin_prefix}llvm-dllwrap.exe"
SettingsWindresCommand="${mingw_bin_prefix}llvm-windres.exe"
- SettingsTouchCommand='$$topdir/bin/touchy.exe'
else
# This case handles the "normal" platforms (e.g. not Windows) where we
@@ -56,12 +55,6 @@ AC_DEFUN([FP_SETTINGS],
SettingsWindresCommand="$WindresCmd"
fi
- if test "$HostOS" = "mingw32"; then
- SettingsTouchCommand='$$topdir/bin/touchy.exe'
- else
- SettingsTouchCommand='touch'
- fi
-
if test "$EnableDistroToolchain" = "YES"; then
# If the user specified --enable-distro-toolchain then we just use the
# executable names, not paths.
@@ -123,7 +116,6 @@ AC_DEFUN([FP_SETTINGS],
AC_SUBST(SettingsInstallNameToolCommand)
AC_SUBST(SettingsDllWrapCommand)
AC_SUBST(SettingsWindresCommand)
- AC_SUBST(SettingsTouchCommand)
AC_SUBST(SettingsClangCommand)
AC_SUBST(SettingsLlcCommand)
AC_SUBST(SettingsOptCommand)
=====================================
utils/touchy/Makefile deleted
=====================================
@@ -1,37 +0,0 @@
-# -----------------------------------------------------------------------------
-#
-# (c) 2009 The University of Glasgow
-#
-# This file is part of the GHC build system.
-#
-# To understand how the build system works and how to modify it, see
-# https://gitlab.haskell.org/ghc/ghc/wikis/building/architecture
-# https://gitlab.haskell.org/ghc/ghc/wikis/building/modifying
-#
-# -----------------------------------------------------------------------------
-
-#
-# Substitute for 'touch' on win32 platforms (without an Unix toolset installed).
-#
-TOP=../..
-include $(TOP)/mk/boilerplate.mk
-
-C_SRCS=touchy.c
-C_PROG=touchy
-SRC_CC_OPTS += -O
-
-#
-# Install touchy in lib/.*
-#
-INSTALL_LIBEXECS += $(C_PROG)
-
-include $(TOP)/mk/target.mk
-
-# Get it over with!
-boot :: all
-
-binary-dist:
- $(INSTALL_DIR) $(BIN_DIST_DIR)/utils/touchy
- $(INSTALL_DATA) Makefile $(BIN_DIST_DIR)/utils/touchy/
- $(INSTALL_PROGRAM) $(C_PROG) $(BIN_DIST_DIR)/utils/touchy/
-
=====================================
utils/touchy/touchy.c deleted
=====================================
@@ -1,123 +0,0 @@
-/*
- * Simple 'touch' program for Windows
- *
- */
-#if !defined(_WIN32)
-#error "Win32-only, the platform you're using is supposed to have 'touch' already."
-#else
-#include <stdio.h>
-#include <sys/stat.h>
-#include <sys/types.h>
-#include <fcntl.h>
-#include <errno.h>
-#include <utime.h>
-#include <windows.h>
-
-/*
-touch is used by GHC both during building and during compilation of
-Haskell files. Unfortunately this means we need a 'touch' like program
-in the GHC bindist. Since touch is not standard on Windows and msys2
-doesn't include a mingw-w64 build of coreutils we need touchy for now.
-
-With Windows 7 in a virtual box VM on OS X, some very odd things happen
-with dates and time stamps when SSHing into cygwin. e.g. here the
-"Change" time is in the past:
-
-$ date; touch foo; stat foo
-Fri Dec 2 16:58:07 GMTST 2011
- File: `foo'
- Size: 0 Blocks: 0 IO Block: 65536 regular
-empty file
-Device: 540aba0bh/1409989131d Inode: 562949953592977 Links: 1
-Access: (0644/-rw-r--r--) Uid: ( 1000/ ian) Gid: ( 513/ None)
-Access: 2011-12-02 16:58:07.414457900 +0000
-Modify: 2011-12-02 16:58:07.414457900 +0000
-Change: 2011-12-02 16:58:03.495141800 +0000
- Birth: 2011-12-02 16:57:57.731469900 +0000
-
-And if we copy such a file, then the copy is older (as determined by the
-"Modify" time) than the original:
-
-$ date; touch foo; stat foo; cp foo bar; stat bar
-Fri Dec 2 16:59:10 GMTST 2011
- File: `foo'
- Size: 0 Blocks: 0 IO Block: 65536 regular
-empty file
-Device: 540aba0bh/1409989131d Inode: 1407374883725128 Links: 1
-Access: (0644/-rw-r--r--) Uid: ( 1000/ ian) Gid: ( 513/ None)
-Access: 2011-12-02 16:59:10.118457900 +0000
-Modify: 2011-12-02 16:59:10.118457900 +0000
-Change: 2011-12-02 16:59:06.189477700 +0000
- Birth: 2011-12-02 16:57:57.731469900 +0000
- File: `bar'
- Size: 0 Blocks: 0 IO Block: 65536 regular
-empty file
-Device: 540aba0bh/1409989131d Inode: 281474976882512 Links: 1
-Access: (0644/-rw-r--r--) Uid: ( 1000/ ian) Gid: ( 513/ None)
-Access: 2011-12-02 16:59:06.394555800 +0000
-Modify: 2011-12-02 16:59:06.394555800 +0000
-Change: 2011-12-02 16:59:06.395532400 +0000
- Birth: 2011-12-02 16:58:40.921899600 +0000
-
-This means that make thinks that things are out of date when it
-shouldn't, so reinvokes itself repeatedly until the MAKE_RESTARTS
-infinite-recursion test triggers.
-
-The touchy program, like most other programs, creates files with both
-Modify and Change in the past, which is still a little odd, but is
-consistent, so doesn't break make.
-
-We used to use _utime(argv[i],NULL)) to set the file modification times,
-but after a BST -> GMT change this started giving files a modification
-time an hour in the future:
-
-$ date; utils/touchy/dist/build/tmp/touchy testfile; stat testfile
-Tue, Oct 30, 2012 11:33:06 PM
- File: `testfile'
- Size: 0 Blocks: 0 IO Block: 65536 regular empty file
-Device: 540aba0bh/1409989131d Inode: 9851624184986293 Links: 1
-Access: (0755/-rwxr-xr-x) Uid: ( 1000/ ian) Gid: ( 513/ None)
-Access: 2012-10-31 00:33:06.000000000 +0000
-Modify: 2012-10-31 00:33:06.000000000 +0000
-Change: 2012-10-30 23:33:06.769118900 +0000
- Birth: 2012-10-30 23:33:06.769118900 +0000
-
-so now we use the Win32 functions GetSystemTimeAsFileTime and SetFileTime.
-*/
-
-int
-main(int argc, char** argv)
-{
- int i;
- FILETIME ft;
- BOOL b;
- HANDLE hFile;
-
- if (argc == 1) {
- fprintf(stderr, "Usage: %s <files>\n", argv[0]);
- return 1;
- }
-
- for (i = 1; i < argc; i++) {
- hFile = CreateFile(argv[i], GENERIC_WRITE, 0, NULL, OPEN_ALWAYS,
- FILE_ATTRIBUTE_NORMAL, NULL);
- if (hFile == INVALID_HANDLE_VALUE) {
- fprintf(stderr, "Unable to open %s\n", argv[i]);
- exit(1);
- }
- GetSystemTimeAsFileTime(&ft);
- b = SetFileTime(hFile, (LPFILETIME) NULL, (LPFILETIME) NULL, &ft);
- if (b == 0) {
- fprintf(stderr, "Unable to change mod. time for %s\n", argv[i]);
- exit(1);
- }
- b = CloseHandle(hFile);
- if (b == 0) {
- fprintf(stderr, "Closing failed for %s\n", argv[i]);
- exit(1);
- }
- }
-
- return 0;
-}
-#endif
=====================================
utils/touchy/touchy.cabal deleted
=====================================
@@ -1,15 +0,0 @@
-cabal-version: 2.2
-Name: touchy
-Version: 0.1
-Copyright: XXX
-License: BSD-3-Clause
-Author: XXX
-Maintainer: XXX
-Synopsis: @touch@ for windows
-Description: XXX
-Category: Development
-build-type: Simple
-
-Executable touchy
- Default-Language: Haskell2010
- Main-Is: touchy.c
View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/32f586e61f7a3d3a1ca4971239ae5b60a58af7d1
--
View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/32f586e61f7a3d3a1ca4971239ae5b60a58af7d1
You're receiving this email because of your account on gitlab.haskell.org.
-------------- next part --------------
An HTML attachment was scrubbed...
URL: <http://mail.haskell.org/pipermail/ghc-commits/attachments/20230630/e1982cd0/attachment-0001.html>
More information about the ghc-commits
mailing list