X-Git-Url: http://git.megacz.com/?p=ghc-base.git;a=blobdiff_plain;f=System%2FIO.hs;h=29996d4d730025a816835fe6076167e88963f0fe;hp=f2b9090c4f157b062dada31e8929efa5f35e2d6c;hb=33a57fb5a398b4ac78061732eb3e506aa5c0fb60;hpb=1251923c1e38fb76ce139d2a2fe6a6230abf2d56 diff --git a/System/IO.hs b/System/IO.hs index f2b9090..29996d4 100644 --- a/System/IO.hs +++ b/System/IO.hs @@ -421,7 +421,7 @@ hSetBinaryMode _ _ = return () -- The created file isn\'t deleted automatically, so you need to delete it manually. openTempFile :: FilePath -- ^ Directory in which to create the file -> String -- ^ File name template. If the template is \"foo.ext\" then - -- the create file will be \"fooXXX.ext\" where XXX is some + -- the created file will be \"fooXXX.ext\" where XXX is some -- random number. -> IO (FilePath, Handle) openTempFile tmp_dir template = openTempFile' "openTempFile" tmp_dir template False @@ -438,9 +438,19 @@ openTempFile' loc tmp_dir template binary = do -- We split off the last extension, so we can use .foo.ext files -- for temporary files (hidden on Unix OSes). Unfortunately we're -- below filepath in the hierarchy here. - (prefix,suffix) = case break (== '.') $ reverse template of - (rev_suffix, rev_prefix) -> - (reverse rev_prefix, reverse rev_suffix) + (prefix,suffix) = + case break (== '.') $ reverse template of + -- First case: template contains no '.'s. Just re-reverse it. + (rev_suffix, "") -> (reverse rev_suffix, "") + -- Second case: template contains at least one '.'. Strip the + -- dot from the prefix and prepend it to the suffix (if we don't + -- do this, the unique number will get added after the '.' and + -- thus be part of the extension, which is wrong.) + (rev_suffix, '.':rest) -> (reverse rest, '.':reverse rev_suffix) + -- Otherwise, something is wrong, because (break (== '.')) should + -- always return a pair with either the empty string or a string + -- beginning with '.' as the second component. + _ -> error "bug in System.IO.openTempFile" oflags1 = rw_flags .|. o_EXCL