[darcs-users] [patch258] Bug fix: treat filenames in darcs-2 patc... (and 1 more)

Reinier Lamers bugs at darcs.net
Sun Jun 13 19:09:31 UTC 2010


Reinier Lamers <tux_rocker at reinier.de> added the comment:

Hi all,

Here's a review of patch 258. Before pushing it, I'd like to know if it's 
intentional that all tests that the bundle adds pass, even when I apply only 
the new tests.

>[Bug fix: treat filenames in darcs-2 patches as raw bytes.
>Eric Kow <kowey at darcs.net>**20100602110817
> Ignore-this: d283d32e56eb92ca2e7e9959d625eb48
> (instead of trying to decode from UTF-8)
>] hunk ./src/Darcs/Patch/Non.hs 70
>
> readNon :: (ReadPatch p, ParserM m) => m (Maybe (Non p C(x)))
> readNon = do Just (Sealed ps) <- readPatch' False
>-             peekfor ":" (do Just (Sealed p) <- readPatch' False
>+             peekfor ":" (do Just (Sealed p) <- readPrim NewFormat
>                              return $ Just $ Non ps p)
>                          (return Nothing)
>

Here we make sure that when reading a "Non", which is a kind of patch in the 
darcs-2 patch handling code, we use the new format. Because Non's only occur 
in darcs-2 patches, and darcs-2 patches should always be written with the new 
format, this is correct.

>hunk ./src/Darcs/Patch/Patchy.hs 203
>
> {-# INLINE bracketedFL #-}
> bracketedFL :: (ReadPatch p, ParserM m) =>
>-               Word8 -> Word8 -> m (Maybe (Sealed (FL p C(x))))
>-bracketedFL pre post =
>+               m (Maybe (Sealed p C(x))) -> Word8 -> Word8 -> m (Maybe
> (Sealed (FL p C(x)))) +bracketedFL parser pre post =
>     peekforw pre bfl (return Nothing)
>hunk ./src/Darcs/Patch/Patchy.hs 206
>-        where bfl :: (ReadPatch p, ParserM m) => m (Maybe (Sealed (FL p
> C(x)))) -              bfl = peekforw post (return $ Just $ Sealed NilFL)
>-                                  (do Just (Sealed p) <- readPatch' False
>+        where bfl = peekforw post (return $ Just $ Sealed NilFL)
>+                                  (do Just (Sealed p) <- parser
>                                       Just (Sealed ps) <- bfl
>                                       return $ Just $ Sealed (p:>:ps))
>

Here bracketedFL is parameterised with respect to the code that parses the 
string between 'pre' and 'post'.

>hunk ./src/Darcs/Patch/Read.hs 85
>
> instance ReadPatch Patch where
>  readPatch' want_eof
>-   = do mps <- bracketedFL (fromIntegral $ fromEnum '{') (fromIntegral $
> fromEnum '}')
> +   = do mps <- bracketedFL (readPatch' False) (fromIntegral
> $ fromEnum '{') (fromIntegral $ fromEnum '}')
>          case mps of
>           Just (Sealed ps) -> return $ Just $ Sealed $ ComP ps
>           Nothing -> do s <- peekInput

Use the old format for 'Patch', which is the old-fashioned patch type.

>hunk ./src/Darcs/Patch/Real.hs 746
>                  --let tracePeek x = do y <- peekInput
>                  --                     traceDoc (greenText x $$ greenText
> (show $ BC.unpack y)) return () i <- readNons
>-                 Just (Sealed ps) <- bracketedFL (fromIntegral $ fromEnum
> '[') (fromIntegral $ fromEnum ']')
> +                Just (Sealed ps) <- bracketedFL (readPrim NewFormat) 
(fromIntegral $ fromEnum '[') (fromIntegral $ fromEnum ']')
>
>                  Just p <- readNon
>                  return $ Just $ Sealed $ Conflictor i (unsafeCoerceP ps) p

Use the new format when reading conflictors using the ReadPatch instance for 
RealPatch (which is the darcs-2 patch type afaik).

>hunk ./src/Darcs/Patch/Real.hs 753
>           Just "rotcilfnoc" ->
>               do work myLex
>                  i <- readNons
>-                 Just (Sealed ps) <- bracketedFL (fromIntegral $ fromEnum
> '[') (fromIntegral $ fromEnum ']')
> +                 Just (Sealed ps) <-
> bracketedFL (readPrim NewFormat) (fromIntegral $ fromEnum '[')
> (fromIntegral $ fromEnum ']') Just p <- readNon
>                  return $ Just $ Sealed $ InvConflictor i ps p
>           _ -> do mp <- readPrim NewFormat

And also use the new format when reading inverse conflictors using the 
ReadPatch instance for RealPatch.

>[Extend issue1763 test to be more aggressive.
>Eric Kow <kowey at darcs.net>**20100602111219
> Ignore-this: 6ea29905c8c4accf4d3ca4c1748f4469
>] hunk ./tests/issue1763-pull-fails-on-non-ascii-filenames.sh 29
> ## SOFTWARE.
>
> . lib
>-rm -rf R S
>+rm -rf R
> darcs init --repo R
>hunk ./tests/issue1763-pull-fails-on-non-ascii-filenames.sh 31
>-darcs init --repo S
>
> # Set up a repo with 3 patches to a non-ASCII-named file
> cd R
>hunk ./tests/issue1763-pull-fails-on-non-ascii-filenames.sh 39
> darcs record -a -m "Add"
> echo hi >> kitöltés.lisp
> darcs record -a -m "First edit"
>+cd ..
>+
>+rm -rf S S2 S3
>+darcs get R S
>+darcs get R S2
>+darcs get R S3
>+
>+cd R
> echo hi >> kitöltés.lisp
> darcs record -a -m "Second edit"
>hunk ./tests/issue1763-pull-fails-on-non-ascii-filenames.sh 49
>+cd ..
>
> # From another repo, pull the first two, edit, pull the third to get a
> # conflict, pull again to get the crash
>hunk ./tests/issue1763-pull-fails-on-non-ascii-filenames.sh 53
>-cd ../S
>-echo yyn | darcs pull --interactive ../R
>+cd S
> echo hello >> kitöltés.lisp
> darcs record -a -m "My edit"
> darcs pull -a ../R
>hunk ./tests/issue1763-pull-fails-on-non-ascii-filenames.sh 58
> darcs pull -a ../R
>+cd ..
>
>hunk ./tests/issue1763-pull-fails-on-non-ascii-filenames.sh 60
>+# duplicates
>+cd S2
>+echo hi >> kitöltés.lisp
>+darcs record -a -m "My duplicate edit"
>+darcs pull -a ../R
>+darcs pull -a ../R
>+cd ..
>+
>+# nons
>+cd S3
>+echo hello >> kitöltés.lisp
>+darcs record -a -m "My conflicting edit"
>+echo hello >> kitöltés.lisp
>+touch non-kitöltés.lisp
>+darcs add non-kitöltés.lisp
>+darcs record -a -m "My continuation of the conflict"
>+darcs pull -a ../R
>+darcs pull -a ../R
>+cd ..

Add 3 more scenarios. I don't understand what the third one wants to check. It 
has a conflicting edit and then records something unrelated to a file named 
non-kitöltés.lisp. Is that when Non's arise?

What's more, all 3 tests succeed for me even when the other 2 patches have not 
been applied! Is that intentional?

>[Bug fix: inverse conflictors should also use raw bytes for filenames.
>Eric Kow <kowey at darcs.net>**20100602112801
> Ignore-this: e66332fcf70600acea05b9c495a7afe5
>] hunk ./src/Darcs/Patch/Real.hs 723
>         blueText "rotcilfnoc" <+> showNons i <+> blueText "[]" $$ showNon p
>     showPatch (InvConflictor i cs p) =
>         blueText "rotcilfnoc" <+> showNons i <+> blueText "[" $$
>-        showPatch cs $$
>+        showPrimFL NewFormat cs $$
>         blueText "]" $$
>         showNon p
>     showContextPatch (Normal p) = showContextPatch p

Also write inverse conflictors in the new format. Before, conflictors where 
written in the new format and inverse coflictors in the old format :-S.

Reinier

__________________________________
Darcs bug tracker <bugs at darcs.net>
<http://bugs.darcs.net/patch258>
__________________________________


More information about the darcs-users mailing list