diff --git a/compiler/GHC/Driver/Main.hs b/compiler/GHC/Driver/Main.hs index 8b609454ebc36035775e7b73e5fd752b81fe1673..fb18eb0970ed77e33243f0522599c883f8f57113 100644 --- a/compiler/GHC/Driver/Main.hs +++ b/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 diff --git a/compiler/GHC/Driver/Pipeline/Execute.hs b/compiler/GHC/Driver/Pipeline/Execute.hs index 5b4ad24cd344c5d94925e1010c73d4cf7425409a..74ba1e739d056fff5c190c540d53625436149f1f 100644 --- a/compiler/GHC/Driver/Pipeline/Execute.hs +++ b/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] -- ~~~~~~~~~~~~~~~~~~~~~~~~~~ diff --git a/compiler/GHC/Driver/Session.hs b/compiler/GHC/Driver/Session.hs index 3aad8f53f0f51cf1e602501a3e3e72c41a15a1dc..b36a9a7f148855e37d2d00f87c976de22ba83a93 100644 --- a/compiler/GHC/Driver/Session.hs +++ b/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 diff --git a/compiler/GHC/Settings.hs b/compiler/GHC/Settings.hs index 58325f6a7b6d7b13b378026283fd78bc13f2fc78..2e69c261625b89771a8df9750c2078559fa7f68f 100644 --- a/compiler/GHC/Settings.hs +++ b/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 diff --git a/compiler/GHC/Settings/IO.hs b/compiler/GHC/Settings/IO.hs index 9893e8032ace60040091aaa5c1b3f972369c137e..9b13e19fbd3665ab079e1f07e9cd4212d4cde46c 100644 --- a/compiler/GHC/Settings/IO.hs +++ b/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 diff --git a/compiler/GHC/SysTools/Tasks.hs b/compiler/GHC/SysTools/Tasks.hs index da56f2fe1a001af3517024b6977fc8fc03525833..95976f1c3c4ff199e95cdcdc551ddb363281aeaa 100644 --- a/compiler/GHC/SysTools/Tasks.hs +++ b/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] diff --git a/compiler/GHC/Utils/Touch.hs b/compiler/GHC/Utils/Touch.hs new file mode 100644 index 0000000000000000000000000000000000000000..f490637dbb7928c29922a08d2c21fa09069697a1 --- /dev/null +++ b/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 + diff --git a/compiler/ghc.cabal.in b/compiler/ghc.cabal.in index 733abff3a0b0ee94d76f13f58eadb94f77ef618c..805b01042ec78a77632e17d0171526738b39e1d2 100644 --- a/compiler/ghc.cabal.in +++ b/compiler/ghc.cabal.in @@ -933,6 +933,7 @@ Library GHC.Utils.Ppr GHC.Utils.Ppr.Colour GHC.Utils.TmpFs + GHC.Utils.Touch GHC.Utils.Trace GHC.Utils.Unique GHC.Utils.Word64 diff --git a/hadrian/bindist/Makefile b/hadrian/bindist/Makefile index d8e7846806efb0757b377668993b5e54dacab3ba..845189f5526396cc4e8fc5d22425a6f00f004109 100644 --- a/hadrian/bindist/Makefile +++ b/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)")' >> $@ diff --git a/hadrian/bindist/config.mk.in b/hadrian/bindist/config.mk.in index 99b000412063dda954e4fd34ea8c42d72b10e835..f3ef11ef1cbed6ea8fc0e23a7360629e45739da2 100644 --- a/hadrian/bindist/config.mk.in +++ b/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@ diff --git a/hadrian/cfg/system.config.in b/hadrian/cfg/system.config.in index b776b391514eeea9188d5efe426616e5506fb3a0..1d27cae69e2004472785bd34a8489cd0206f6dba 100644 --- a/hadrian/cfg/system.config.in +++ b/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@ diff --git a/hadrian/src/Builder.hs b/hadrian/src/Builder.hs index dbe6f4b735f4039b043b0168bf2356b8b1eb3728..e96872d89e9042667e2d846ff16f0ca90963bd88 100644 --- a/hadrian/src/Builder.hs +++ b/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 diff --git a/hadrian/src/Hadrian/Builder.hs b/hadrian/src/Hadrian/Builder.hs index 630c58d6035b05d976e970f5c7cf21b504758399..682ac4d06b4ef28f4048d0015c231e1088e6273c 100644 --- a/hadrian/src/Hadrian/Builder.hs +++ b/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 [] diff --git a/hadrian/src/Oracles/Setting.hs b/hadrian/src/Oracles/Setting.hs index ae2facae9a8bd4dc4c72e8de5dfda27da39e441c..b20b0231734f5171aacd867e27baa4f11582a11e 100644 --- a/hadrian/src/Oracles/Setting.hs +++ b/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" diff --git a/hadrian/src/Packages.hs b/hadrian/src/Packages.hs index 108f1222ca6cdfc88b36a90eb465e29dd4bc3da3..3a16b679d34bf4ea711f734094aeb65f84b3ba33 100644 --- a/hadrian/src/Packages.hs +++ b/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'. diff --git a/hadrian/src/Rules/Generate.hs b/hadrian/src/Rules/Generate.hs index 7bc7b82c54b65efb33d9f11b1467a737cd0bae29..9185710b3c90b94e2505a6e13fcb100e1b8acfd3 100644 --- a/hadrian/src/Rules/Generate.hs +++ b/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) diff --git a/hadrian/src/Settings/Default.hs b/hadrian/src/Settings/Default.hs index f21521deb1cb0a839512712fd6869150a141c904..679a50f90021aa7518d986db551f9a3c28a7001d 100644 --- a/hadrian/src/Settings/Default.hs +++ b/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 ] ] diff --git a/m4/fp_settings.m4 b/m4/fp_settings.m4 index 832bbb9305a50cefa8a91377553242907d13e4a6..02fd987efc46996abe8d905655cdc0d4b53cad84 100644 --- a/m4/fp_settings.m4 +++ b/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) diff --git a/utils/touchy/Makefile b/utils/touchy/Makefile deleted file mode 100644 index c0eb696cc6e7c7147b281ee7f5a68f58fbf08b02..0000000000000000000000000000000000000000 --- a/utils/touchy/Makefile +++ /dev/null @@ -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/ - diff --git a/utils/touchy/touchy.c b/utils/touchy/touchy.c deleted file mode 100644 index dbcf71277c257629fd5a3fb0fa53f482dc89a3fa..0000000000000000000000000000000000000000 --- a/utils/touchy/touchy.c +++ /dev/null @@ -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 diff --git a/utils/touchy/touchy.cabal b/utils/touchy/touchy.cabal deleted file mode 100644 index 5c28c664fc74c5da42ddc27a8c5de17da5c2d9e7..0000000000000000000000000000000000000000 --- a/utils/touchy/touchy.cabal +++ /dev/null @@ -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