[Git][ghc/ghc][wip/drop-touch] Drop dependence on `touch`
Ben Gamari (@bgamari)
gitlab at gitlab.haskell.org
Fri Feb 16 15:32:35 UTC 2024
Ben Gamari pushed to branch wip/drop-touch at Glasgow Haskell Compiler / GHC
Commits:
d1846954 by Ben Gamari at 2024-02-16T10:32:18-05: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
- - - - -
21 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/Settings/Default.hs
- m4/fp_settings.m4
- − utils/touchy/Makefile
- − utils/touchy/touchy.c
- − utils/touchy/touchy.cabal
Changes:
=====================================
compiler/GHC/Driver/Main.hs
=====================================
@@ -254,6 +254,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
@@ -264,7 +265,6 @@ import qualified GHC.Data.Stream as Stream
import GHC.Data.Stream (Stream)
import GHC.Data.Maybe
-import qualified GHC.SysTools
import GHC.SysTools (initSysTools)
import GHC.SysTools.BaseDir (findTopDir)
@@ -1260,7 +1260,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
=====================================
@@ -71,6 +71,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
@@ -376,14 +377,10 @@ runAsPhase =
-- | Run the JS Backend postHsc phase.
runJsPhase :: PipeEnv -> HscEnv -> Maybe ModLocation -> FilePath -> IO FilePath
-runJsPhase _pipe_env hsc_env _location input_fn = do
- let dflags = hsc_dflags hsc_env
- let logger = hsc_logger hsc_env
-
+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
-- | Deal with foreign JS files (embed them into .o files)
@@ -551,7 +548,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
@@ -1141,10 +1138,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_a,
sPgm_l,
sPgm_lm,
- sPgm_T,
sPgm_windres,
sPgm_ar,
sPgm_ranlib,
@@ -136,7 +135,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_T, pgm_windres, pgm_ar,
+ pgm_windres, pgm_ar,
pgm_ranlib, pgm_lo, pgm_lc, pgm_las, pgm_i,
opt_L, opt_P, opt_F, opt_c, opt_cxx, opt_a, opt_l, opt_lm, opt_i,
opt_P_signature,
@@ -405,8 +404,6 @@ pgm_l :: DynFlags -> (String,[Option])
pgm_l dflags = toolSettings_pgm_l $ toolSettings dflags
pgm_lm :: DynFlags -> Maybe (String,[Option])
pgm_lm dflags = toolSettings_pgm_lm $ 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_ar :: DynFlags -> String
=====================================
compiler/GHC/Settings.hs
=====================================
@@ -33,7 +33,6 @@ module GHC.Settings
, sPgm_a
, sPgm_l
, sPgm_lm
- , sPgm_T
, sPgm_windres
, sPgm_ar
, sPgm_otool
@@ -109,7 +108,6 @@ data ToolSettings = ToolSettings
-- ^ N.B. On Windows we don't have a linker which supports object
-- merging, hence the 'Maybe'. See Note [Object merging] in
-- "GHC.Driver.Pipeline.Execute" for details.
- , toolSettings_pgm_T :: String
, toolSettings_pgm_windres :: String
, toolSettings_pgm_ar :: String
, toolSettings_pgm_otool :: String
@@ -221,8 +219,6 @@ sPgm_l :: Settings -> (String, [Option])
sPgm_l = toolSettings_pgm_l . sToolSettings
sPgm_lm :: Settings -> Maybe (String, [Option])
sPgm_lm = toolSettings_pgm_lm . 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
=====================================
@@ -126,8 +126,6 @@ initSettings top_dir = do
install_name_tool_path <- getToolSetting "install_name_tool command"
ranlib_path <- getToolSetting "ranlib command"
- touch_path <- getToolSetting "touch command"
-
-- HACK, see setPgmP below. We keep 'words' here to remember to fix
-- Config.hs one day.
@@ -189,7 +187,6 @@ initSettings top_dir = do
, toolSettings_pgm_a = (as_prog, as_args)
, toolSettings_pgm_l = (ld_prog, ld_args)
, toolSettings_pgm_lm = ld_r
- , 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
=====================================
@@ -317,6 +317,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,34 @@
+{-# 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
+#if MIN_VERSION_unix(2,8,0)
+ let oflags = defaultFileFlags { noctty = True, creat = Just 0o666 }
+ fd <- openFd file WriteOnly oflags
+#else
+ let oflags = defaultFileFlags { noctty = True }
+ fd <- openFd file WriteOnly (Just 0o666) oflags
+#endif
+ touchFd fd
+ closeFd fd
+#endif
+
=====================================
compiler/ghc.cabal.in
=====================================
@@ -931,6 +931,7 @@ Library
GHC.Utils.Ppr
GHC.Utils.Ppr.Colour
GHC.Utils.TmpFs
+ GHC.Utils.Touch
GHC.Utils.Trace
GHC.Utils.Unique
GHC.Utils.Word64
=====================================
hadrian/bindist/Makefile
=====================================
@@ -116,7 +116,6 @@ lib/settings : config.mk
@echo ',("ranlib command", "$(SettingsRanlibCommand)")' >> $@
@echo ',("otool command", "$(SettingsOtoolCommand)")' >> $@
@echo ',("install_name_tool command", "$(SettingsInstallNameToolCommand)")' >> $@
- @echo ',("touch command", "$(SettingsTouchCommand)")' >> $@
@echo ',("windres command", "$(SettingsWindresCommand)")' >> $@
@echo ',("unlit command", "$$topdir/../bin/$(CrossCompilePrefix)unlit")' >> $@
@echo ',("cross compiling", "$(CrossCompiling)")' >> $@
=====================================
hadrian/bindist/config.mk.in
=====================================
@@ -227,7 +227,6 @@ SettingsInstallNameToolCommand = @SettingsInstallNameToolCommand@
SettingsRanlibCommand = @SettingsRanlibCommand@
SettingsWindresCommand = @SettingsWindresCommand@
SettingsLibtoolCommand = @SettingsLibtoolCommand@
-SettingsTouchCommand = @SettingsTouchCommand@
SettingsLlcCommand = @SettingsLlcCommand@
SettingsOptCommand = @SettingsOptCommand@
SettingsLlvmAsCommand = @SettingsLlvmAsCommand@
=====================================
hadrian/cfg/system.config.in
=====================================
@@ -82,7 +82,6 @@ project-git-commit-id = @ProjectGitCommitId@
settings-otool-command = @SettingsOtoolCommand@
settings-install_name_tool-command = @SettingsInstallNameToolCommand@
-settings-touch-command = @SettingsTouchCommand@
settings-llc-command = @SettingsLlcCommand@
settings-opt-command = @SettingsOptCommand@
settings-llvm-as-command = @SettingsLlvmAsCommand@
=====================================
hadrian/src/Builder.hs
=====================================
@@ -240,11 +240,9 @@ instance H.Builder Builder where
pure []
Ghc {} -> do
root <- buildRoot
- touchyPath <- programPath (vanillaContext (Stage0 InTreeLibs) touchy)
unlitPath <- builderPath Unlit
return $ [ unlitPath ]
- ++ [ 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
=====================================
@@ -86,7 +86,6 @@ data Setting = CursesIncludeDir
data ToolchainSetting
= ToolchainSetting_OtoolCommand
| ToolchainSetting_InstallNameToolCommand
- | ToolchainSetting_TouchCommand
| ToolchainSetting_LlcCommand
| ToolchainSetting_OptCommand
| ToolchainSetting_LlvmAsCommand
@@ -138,7 +137,6 @@ settingsFileSetting :: ToolchainSetting -> Action String
settingsFileSetting key = lookupSystemConfig $ case key of
ToolchainSetting_OtoolCommand -> "settings-otool-command"
ToolchainSetting_InstallNameToolCommand -> "settings-install_name_tool-command"
- ToolchainSetting_TouchCommand -> "settings-touch-command"
ToolchainSetting_LlcCommand -> "settings-llc-command"
ToolchainSetting_OptCommand -> "settings-opt-command"
ToolchainSetting_LlvmAsCommand -> "settings-llvm-as-command"
=====================================
hadrian/src/Packages.hs
=====================================
@@ -9,7 +9,7 @@ module Packages (
ghcToolchain, ghcToolchainBin, haddock, haskeline,
hsc2hs, hp2ps, hpc, hpcBin, integerGmp, integerSimple, iserv, iservProxy,
libffi, mtl, osString, 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, lintCodes, lintCommitMsg, lintSubmoduleRefs, lintWhitespace,
ghcPackages, isGhcPackage,
@@ -42,7 +42,7 @@ ghcPackages =
, ghcToolchain, ghcToolchainBin, haddock, haskeline, hsc2hs
, hp2ps, hpc, hpcBin, integerGmp, integerSimple, iserv, libffi, mtl, osString
, 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, lintCodes, lintCommitMsg, lintSubmoduleRefs, lintWhitespace ]
@@ -59,7 +59,7 @@ array, base, binary, bytestring, cabalSyntax, cabal, checkPpr, checkExact, count
ghcToolchain, ghcToolchainBin, haddock, haskeline, hsc2hs,
hp2ps, hpc, hpcBin, integerGmp, integerSimple, iserv, iservProxy, remoteIserv, libffi, mtl,
osString, 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, lintCodes, lintCommitMsg, lintSubmoduleRefs, lintWhitespace
:: Package
@@ -127,7 +127,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"
@@ -215,7 +214,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
=====================================
@@ -392,7 +392,6 @@ generateSettings = do
, ("ranlib command", queryTarget ranlibPath)
, ("otool command", expr $ settingsFileSetting ToolchainSetting_OtoolCommand)
, ("install_name_tool command", expr $ settingsFileSetting ToolchainSetting_InstallNameToolCommand)
- , ("touch command", expr $ settingsFileSetting ToolchainSetting_TouchCommand)
, ("windres command", queryTarget (maybe "/bin/false" prgPath . tgtWindres)) -- TODO: /bin/false is not available on many distributions by default, but we keep it as it were before the ghc-toolchain patch. Fix-me.
, ("unlit command", ("$topdir/../bin/" <>) <$> expr (programName (ctx { Context.package = unlit })))
, ("cross compiling", expr $ yesNo <$> flag CrossCompiling)
=====================================
hadrian/src/Settings/Default.hs
=====================================
@@ -117,7 +117,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]
@@ -170,9 +169,8 @@ stage1Packages = do
, ghcToolchainBin
]
, when (winTarget && not cross)
- [ touchy
- -- See Note [Hadrian's ghci-wrapper package]
- , ghciWrapper
+ [ -- See Note [Hadrian's ghci-wrapper package]
+ ghciWrapper
]
]
=====================================
m4/fp_settings.m4
=====================================
@@ -74,12 +74,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.
@@ -109,7 +103,6 @@ AC_DEFUN([FP_SETTINGS],
SUBST_TOOLDIR([SettingsArCommand])
SUBST_TOOLDIR([SettingsRanlibCommand])
SUBST_TOOLDIR([SettingsWindresCommand])
- SettingsTouchCommand='$$topdir/../bin/touchy.exe'
fi
# LLVM backend tools
@@ -158,7 +151,6 @@ AC_DEFUN([FP_SETTINGS],
AC_SUBST(SettingsOtoolCommand)
AC_SUBST(SettingsInstallNameToolCommand)
AC_SUBST(SettingsWindresCommand)
- AC_SUBST(SettingsTouchCommand)
AC_SUBST(SettingsLlcCommand)
AC_SUBST(SettingsOptCommand)
AC_SUBST(SettingsLlvmAsCommand)
=====================================
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/d18469540a356915656e4fbc8d8ea4bf34df76da
--
View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/d18469540a356915656e4fbc8d8ea4bf34df76da
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/20240216/5a2a88a5/attachment-0001.html>
More information about the ghc-commits
mailing list