diff --git a/NEWS b/NEWS --- a/NEWS +++ b/NEWS @@ -1,3 +1,93 @@ +Darcs 2.4.1, 31 March 2010 + + * Important changes in Darcs 2.4.1 + + * darcs works again on Windows shared directories + * missing documentation and test files have been added to the tarball + * darcs will no longer give errors about a nonexistent file when compiled + with the wrong mmap + * moving files between directories can no longer break the directory index + * darcs handles the case that someone uses 'remove -r' on an + untracked directory + + * Bugs Fixed in Darcs 2.4.1 + + * 1750: uncover help text for 'darcs show pristine' + * 1753: restrict mmap to version used by hashed-storage + * 1754: fix issue458.sh on systems with xattrs + * 1756: moving files between directories breaks index + * 1757: add test files to distribution tarball + * 1765: refuse to remove non-tracked directories recursively + * 1767: send CRC erros to standard error + + +Darcs 2.4, 27 February 2010 + + * Important changes in Darcs 2.4 + + * Use fast index-based diffing everywhere (Petr) + * Interactive patch splitting (Ganesh) + * An 'optimize --upgrade' option to convert to hashed format in-place + (Eric) + * Hunk matching (Kamil Dworakowski, tat.wright) + * Progress reporting is no longer deceptive (Roman) + * A 'remove --recursive' option to remove a directory tree from revision + control (Roman) + * 'show files' accepts arguments to show a subset of tracked files (Luca) + * A '--remote-darcs' flag for pushing to a host where darcs isn't called + darcs + * Many miscellaneous Windows improvements (Salvatore, Petr and others) + * 'darcs send' now mentions the repository name in the email body (Joachim) + * Handle files with boring names in the repository correctly (Petr) + * Fix parsing of .authorspellings file (Tomáš) + * Various sane new command-line option names (Florent) + * Remove the '--checkpoint' option (Petr) + * Use external libraries for all UTF-8 handling (Eric, Reinier) + * Use the Haskell zlib package exclusively for compression (Petr) + + * Bugs Fixed in Darcs 2.4 + + * 183: do not sort changes --summary output + * 223: add --remote-darcs flag to specify name of remote darcs executable + * 291: provide (basic) interactive patch splitting + * 540: darcs remove --recursive + * 835: 'show files' with arguments + * 1122: get --complete should not offer to create a lazy repository + * 1216: list Match section in ToC + * 1224: refuse to convert a repo that's already in darcs-2 format + * 1300: logfile deleted on unsucessful record + * 1308: push should warn about unpulled patches before patch-selection + * 1336: sane error message on --last "" (empty string to numbers parser) + * 1362: mention repo name in mail send body + * 1377: getProgname for local darcs instances + * 1392: use parsec to parse .authorspelling + * 1424: darcs get wrongly reports "using lazy repository" if you ctrl-c + old-fashioned get + * 1447: different online help for send/apply --cc + * 1488: fix crash in whatsnew when invoked in non-tracked directory + * 1548: show contents requires at least one argument + * 1554: allow opt-out of -threaded (fix ARM builds) + * 1563: official thank-you page + * 1578: don't put newlines in the Haskeline prompts + * 1583: on darcs get, suggest upgrading source repo to hashed + * 1584: provide optimize --upgrade command + * 1588: add --skip-conflicts option + * 1594: define PREPROCHTML in makefile + * 1620: make amend leave a log file when it should + * 1636: hunk matching + * 1643: optimize --upgrade should do optimize + * 1652: suggest cabal update before cabal install + * 1659: make restrictBoring take recorded state into account + * 1677: create correct hashes for empty directories in index + * 1681: preserve log on amend failure + * 1709: fix short version of progress reporting + * 1712: correctly report number of patches to pull + * 1720: fix cabal haddock problem + * 1731: fix performance regression in check and repair + * 1741: fix --list-options when option has multiple names + * 1749: refuse to remove non-empty directories + + Darcs 2.3.1, 20 Sep 2009 * Important changes in Darcs 2.3.1 diff --git a/darcs.cabal b/darcs.cabal --- a/darcs.cabal +++ b/darcs.cabal @@ -1,5 +1,5 @@ Name: darcs -version: 2.4 +version: 2.4.1 License: GPL License-file: COPYING Author: David Roundy , @@ -48,7 +48,6 @@ -- documentation files src/best_practices.tex, src/building_darcs.tex, src/configuring_darcs.tex, src/features.tex, src/formats.tex, src/gpl.tex, src/switching.tex, src/darcs.tex - doc/manual/images.tex, doc/manual/bigimages.tex, doc/manual/patch-theory.tex, doc/darcs.css README, NEWS @@ -64,6 +63,7 @@ tests/network/*.sh tests/lib tests/example_binary.png + tests/README.test_maintainers.txt GNUmakefile @@ -126,6 +126,9 @@ src/maybe_relink.c src/umask.c src/Crypt/sha2.c + -- this module isn't exported by libdarcs, so not included in the tarball + -- if not mentioned + other-modules: Darcs.Test.Patch.Check extensions: CPP @@ -276,7 +279,6 @@ Darcs.SlurpDirectory Darcs.SlurpDirectory.Internal Darcs.Test - Darcs.Test.Patch.Check Darcs.TheCommands Darcs.URL Darcs.Utils @@ -323,7 +325,7 @@ html == 1.0.*, filepath == 1.1.*, haskeline >= 0.6.1 && < 0.7, - hashed-storage >= 0.4.7 && < 0.5 + hashed-storage == 0.4.11 if !os(windows) build-depends: unix >= 1.0 && < 2.5 @@ -369,7 +371,7 @@ buildable: False if flag(mmap) && !os(windows) - build-depends: mmap >= 0.2 + build-depends: mmap >= 0.2 && < 0.5 cpp-options: -DHAVE_MMAP build-depends: zlib >= 0.5.1.0 && < 0.6.0.0 @@ -453,7 +455,7 @@ html == 1.0.*, filepath == 1.1.*, haskeline >= 0.6.1 && < 0.7, - hashed-storage >= 0.4.4 && < 0.5 + hashed-storage == 0.4.11 if !os(windows) build-depends: unix >= 1.0 && < 2.5 @@ -491,7 +493,7 @@ buildable: False if flag(mmap) && !os(windows) - build-depends: mmap >= 0.2 + build-depends: mmap >= 0.2 && < 0.5 cpp-options: -DHAVE_MMAP build-depends: zlib >= 0.5.1.0 && < 0.6.0.0 @@ -539,6 +541,13 @@ src/maybe_relink.c src/umask.c src/Crypt/sha2.c + -- list all unit test modules not exported by libdarcs; otherwise Cabal won't + -- include them in the tarball + other-modules: Darcs.Test.Email + Darcs.Test.Patch.Check + Darcs.Test.Patch.QuickCheck + Darcs.Test.Patch.Test + Darcs.Test.Patch.Unit -- We need optimizations, regardless of what Hackage says ghc-options: -Wall -O2 -funbox-strict-fields @@ -591,7 +600,7 @@ random == 1.0.* if flag(mmap) && !os(windows) - build-depends: mmap >= 0.2 + build-depends: mmap >= 0.2 && < 0.5 cpp-options: -DHAVE_MMAP build-depends: zlib >= 0.5.1.0 && < 0.6.0.0 diff --git a/doc/manual/bigimages.tex b/doc/manual/bigimages.tex deleted file mode 100644 --- a/doc/manual/bigimages.tex +++ /dev/null @@ -1,605 +0,0 @@ -\batchmode - - -\documentclass{book} -\RequirePackage{ifthen} - - - - -\usepackage{verbatim} -\usepackage{html} -\usepackage{fancyvrb} - -% -\newenvironment{code}{\comment}{\endcomment} - - - - -\usepackage[dvips]{color} - - -\pagecolor[gray]{.7} - -\usepackage[latin1]{inputenc} - - - -\makeatletter - -\makeatletter -\count@=\the\catcode`\_ \catcode`\_=8 -\newenvironment{tex2html_wrap}{}{}% -\catcode`\<=12\catcode`\_=\count@ -\newcommand{\providedcommand}[1]{\expandafter\providecommand\csname #1\endcsname}% -\newcommand{\renewedcommand}[1]{\expandafter\providecommand\csname #1\endcsname{}% - \expandafter\renewcommand\csname #1\endcsname}% -\newcommand{\newedenvironment}[1]{\newenvironment{#1}{}{}\renewenvironment{#1}}% -\let\newedcommand\renewedcommand -\let\renewedenvironment\newedenvironment -\makeatother -\let\mathon=$ -\let\mathoff=$ -\ifx\AtBeginDocument\undefined \newcommand{\AtBeginDocument}[1]{}\fi -\newbox\sizebox -\setlength{\hoffset}{0pt}\setlength{\voffset}{0pt} -\addtolength{\textheight}{\footskip}\setlength{\footskip}{0pt} -\addtolength{\textheight}{\topmargin}\setlength{\topmargin}{0pt} -\addtolength{\textheight}{\headheight}\setlength{\headheight}{0pt} -\addtolength{\textheight}{\headsep}\setlength{\headsep}{0pt} -\setlength{\textwidth}{349pt} -\newwrite\lthtmlwrite -\makeatletter -\let\realnormalsize=\normalsize -\global\topskip=2sp -\def\preveqno{}\let\real@float=\@float \let\realend@float=\end@float -\def\@float{\let\@savefreelist\@freelist\real@float} -\def\liih@math{\ifmmode$\else\bad@math\fi} -\def\end@float{\realend@float\global\let\@freelist\@savefreelist} -\let\real@dbflt=\@dbflt \let\end@dblfloat=\end@float -\let\@largefloatcheck=\relax -\let\if@boxedmulticols=\iftrue -\def\@dbflt{\let\@savefreelist\@freelist\real@dbflt} -\def\adjustnormalsize{\def\normalsize{\mathsurround=0pt \realnormalsize - \parindent=0pt\abovedisplayskip=0pt\belowdisplayskip=0pt}% - \def\phantompar{\csname par\endcsname}\normalsize}% -\def\lthtmltypeout#1{{\let\protect\string \immediate\write\lthtmlwrite{#1}}}% -\newcommand\lthtmlhboxmathA{\adjustnormalsize\setbox\sizebox=\hbox\bgroup\kern.05em }% -\newcommand\lthtmlhboxmathB{\adjustnormalsize\setbox\sizebox=\hbox to\hsize\bgroup\hfill }% -\newcommand\lthtmlvboxmathA{\adjustnormalsize\setbox\sizebox=\vbox\bgroup % - \let\ifinner=\iffalse \let\)\liih@math }% -\newcommand\lthtmlboxmathZ{\@next\next\@currlist{}{\def\next{\voidb@x}}% - \expandafter\box\next\egroup}% -\newcommand\lthtmlmathtype[1]{\gdef\lthtmlmathenv{#1}}% -\newcommand\lthtmllogmath{\dimen0\ht\sizebox \advance\dimen0\dp\sizebox - \ifdim\dimen0>.95\vsize - \lthtmltypeout{% -*** image for \lthtmlmathenv\space is too tall at \the\dimen0, reducing to .95 vsize ***}% - \ht\sizebox.95\vsize \dp\sizebox\z@ \fi - \lthtmltypeout{l2hSize % -:\lthtmlmathenv:\the\ht\sizebox::\the\dp\sizebox::\the\wd\sizebox.\preveqno}}% -\newcommand\lthtmlfigureA[1]{\let\@savefreelist\@freelist - \lthtmlmathtype{#1}\lthtmlvboxmathA}% -\newcommand\lthtmlpictureA{\bgroup\catcode`\_=8 \lthtmlpictureB}% -\newcommand\lthtmlpictureB[1]{\lthtmlmathtype{#1}\egroup - \let\@savefreelist\@freelist \lthtmlhboxmathB}% -\newcommand\lthtmlpictureZ[1]{\hfill\lthtmlfigureZ}% -\newcommand\lthtmlfigureZ{\lthtmlboxmathZ\lthtmllogmath\copy\sizebox - \global\let\@freelist\@savefreelist}% -\newcommand\lthtmldisplayA{\bgroup\catcode`\_=8 \lthtmldisplayAi}% -\newcommand\lthtmldisplayAi[1]{\lthtmlmathtype{#1}\egroup\lthtmlvboxmathA}% -\newcommand\lthtmldisplayB[1]{\edef\preveqno{(\theequation)}% - \lthtmldisplayA{#1}\let\@eqnnum\relax}% -\newcommand\lthtmldisplayZ{\lthtmlboxmathZ\lthtmllogmath\lthtmlsetmath}% -\newcommand\lthtmlinlinemathA{\bgroup\catcode`\_=8 \lthtmlinlinemathB} -\newcommand\lthtmlinlinemathB[1]{\lthtmlmathtype{#1}\egroup\lthtmlhboxmathA - \vrule height1.5ex width0pt }% -\newcommand\lthtmlinlineA{\bgroup\catcode`\_=8 \lthtmlinlineB}% -\newcommand\lthtmlinlineB[1]{\lthtmlmathtype{#1}\egroup\lthtmlhboxmathA}% -\newcommand\lthtmlinlineZ{\egroup\expandafter\ifdim\dp\sizebox>0pt % - \expandafter\centerinlinemath\fi\lthtmllogmath\lthtmlsetinline} -\newcommand\lthtmlinlinemathZ{\egroup\expandafter\ifdim\dp\sizebox>0pt % - \expandafter\centerinlinemath\fi\lthtmllogmath\lthtmlsetmath} -\newcommand\lthtmlindisplaymathZ{\egroup % - \centerinlinemath\lthtmllogmath\lthtmlsetmath} -\def\lthtmlsetinline{\hbox{\vrule width.1em \vtop{\vbox{% - \kern.1em\copy\sizebox}\ifdim\dp\sizebox>0pt\kern.1em\else\kern.3pt\fi - \ifdim\hsize>\wd\sizebox \hrule depth1pt\fi}}} -\def\lthtmlsetmath{\hbox{\vrule width.1em\kern-.05em\vtop{\vbox{% - \kern.1em\kern0.8 pt\hbox{\hglue.17em\copy\sizebox\hglue0.8 pt}}\kern.3pt% - \ifdim\dp\sizebox>0pt\kern.1em\fi \kern0.8 pt% - \ifdim\hsize>\wd\sizebox \hrule depth1pt\fi}}} -\def\centerinlinemath{% - \dimen1=\ifdim\ht\sizebox<\dp\sizebox \dp\sizebox\else\ht\sizebox\fi - \advance\dimen1by.5pt \vrule width0pt height\dimen1 depth\dimen1 - \dp\sizebox=\dimen1\ht\sizebox=\dimen1\relax} - -\def\lthtmlcheckvsize{\ifdim\ht\sizebox<\vsize - \ifdim\wd\sizebox<\hsize\expandafter\hfill\fi \expandafter\vfill - \else\expandafter\vss\fi}% -\providecommand{\selectlanguage}[1]{}% -\makeatletter \tracingstats = 1 - - -\begin{document} -\pagestyle{empty}\thispagestyle{empty}\lthtmltypeout{}% -\lthtmltypeout{latex2htmlLength hsize=\the\hsize}\lthtmltypeout{}% -\lthtmltypeout{latex2htmlLength vsize=\the\vsize}\lthtmltypeout{}% -\lthtmltypeout{latex2htmlLength hoffset=\the\hoffset}\lthtmltypeout{}% -\lthtmltypeout{latex2htmlLength voffset=\the\voffset}\lthtmltypeout{}% -\lthtmltypeout{latex2htmlLength topmargin=\the\topmargin}\lthtmltypeout{}% -\lthtmltypeout{latex2htmlLength topskip=\the\topskip}\lthtmltypeout{}% -\lthtmltypeout{latex2htmlLength headheight=\the\headheight}\lthtmltypeout{}% -\lthtmltypeout{latex2htmlLength headsep=\the\headsep}\lthtmltypeout{}% -\lthtmltypeout{latex2htmlLength parskip=\the\parskip}\lthtmltypeout{}% -\lthtmltypeout{latex2htmlLength oddsidemargin=\the\oddsidemargin}\lthtmltypeout{}% -\makeatletter -\if@twoside\lthtmltypeout{latex2htmlLength evensidemargin=\the\evensidemargin}% -\else\lthtmltypeout{latex2htmlLength evensidemargin=\the\oddsidemargin}\fi% -\lthtmltypeout{}% -\makeatother -\setcounter{page}{1} -\onecolumn - -% !!! IMAGES START HERE !!! - -\stepcounter{chapter} -\stepcounter{paragraph} -\stepcounter{paragraph} -\stepcounter{paragraph} -\stepcounter{paragraph} -\stepcounter{section} -\stepcounter{paragraph} -\stepcounter{paragraph} -\stepcounter{paragraph} -\stepcounter{paragraph} -\stepcounter{paragraph} -\stepcounter{paragraph} -\stepcounter{paragraph} -\stepcounter{paragraph} -\stepcounter{paragraph} -\stepcounter{paragraph} -\stepcounter{paragraph} -\stepcounter{paragraph} -\stepcounter{paragraph} -\stepcounter{chapter} -\stepcounter{section} -\stepcounter{section} -\stepcounter{section} -\stepcounter{section} -\stepcounter{section} -\stepcounter{subsection} -\stepcounter{subsection} -\stepcounter{subsection} -\stepcounter{subsection} -\stepcounter{subsection} -\stepcounter{paragraph} -\stepcounter{paragraph} -\stepcounter{paragraph} -\stepcounter{paragraph} -{\newpage\clearpage -\lthtmlinlinemathA{tex2html_wrap_inline2771}% -$<$% -\lthtmlinlinemathZ -\lthtmlcheckvsize\clearpage} - -{\newpage\clearpage -\lthtmlinlinemathA{tex2html_wrap_inline2773}% -$>$% -\lthtmlinlinemathZ -\lthtmlcheckvsize\clearpage} - -\stepcounter{paragraph} -\stepcounter{chapter} -\stepcounter{paragraph} -\stepcounter{section} -\stepcounter{paragraph} -\stepcounter{paragraph} -\stepcounter{paragraph} -\stepcounter{paragraph} -\stepcounter{paragraph} -\stepcounter{paragraph} -\stepcounter{paragraph} -\stepcounter{paragraph} -\stepcounter{section} -\stepcounter{section} -\stepcounter{paragraph} -\stepcounter{paragraph} -\stepcounter{paragraph} -\stepcounter{paragraph} -\stepcounter{paragraph} -\stepcounter{section} -\stepcounter{paragraph} -\stepcounter{paragraph} -\stepcounter{paragraph} -\stepcounter{paragraph} -\stepcounter{paragraph} -\stepcounter{paragraph} -\stepcounter{paragraph} -\stepcounter{section} -\stepcounter{section} -\stepcounter{chapter} -\stepcounter{section} -\stepcounter{subsection} -\stepcounter{subsection} -\stepcounter{subsection} -\stepcounter{subsection} -{\newpage\clearpage -\lthtmlinlinemathA{tex2html_wrap_inline2775}% -$+$% -\lthtmlinlinemathZ -\lthtmlcheckvsize\clearpage} - -\stepcounter{section} -\stepcounter{subsection} -\stepcounter{subsection} -\stepcounter{subsection} -\stepcounter{subsection} -\stepcounter{subsection} -\stepcounter{subsection} -\stepcounter{section} -\stepcounter{section} -\stepcounter{section} -\stepcounter{section} -{\newpage\clearpage -\lthtmlinlinemathA{tex2html_wrap_inline2777}% -$R_{c}$% -\lthtmlinlinemathZ -\lthtmlcheckvsize\clearpage} - -{\newpage\clearpage -\lthtmlinlinemathA{tex2html_wrap_inline2779}% -$f_1$% -\lthtmlinlinemathZ -\lthtmlcheckvsize\clearpage} - -{\newpage\clearpage -\lthtmlinlinemathA{tex2html_wrap_inline2781}% -$R_c$% -\lthtmlinlinemathZ -\lthtmlcheckvsize\clearpage} - -{\newpage\clearpage -\lthtmlinlinemathA{tex2html_wrap_inline2783}% -$R_1$% -\lthtmlinlinemathZ -\lthtmlcheckvsize\clearpage} - -{\newpage\clearpage -\lthtmlinlinemathA{tex2html_wrap_inline2787}% -$f_2$% -\lthtmlinlinemathZ -\lthtmlcheckvsize\clearpage} - -{\newpage\clearpage -\lthtmlinlinemathA{tex2html_wrap_inline2795}% -$R_2$% -\lthtmlinlinemathZ -\lthtmlcheckvsize\clearpage} - -\stepcounter{subsection} -{\newpage\clearpage -\lthtmlinlinemathA{tex2html_wrap_inline2835}% -$R_p$% -\lthtmlinlinemathZ -\lthtmlcheckvsize\clearpage} - -{\newpage\clearpage -\lthtmlinlinemathA{tex2html_wrap_inline2839}% -$R_l$% -\lthtmlinlinemathZ -\lthtmlcheckvsize\clearpage} - -\stepcounter{chapter} -\stepcounter{chapter} -\stepcounter{paragraph} -\stepcounter{section} -\stepcounter{paragraph} -\stepcounter{subsection} -\stepcounter{paragraph} -\stepcounter{paragraph} -\stepcounter{paragraph} -\stepcounter{subsection} -\stepcounter{subsection} -\stepcounter{section} -\stepcounter{section} -\stepcounter{subsection} -\stepcounter{section} -\stepcounter{subsection} -\stepcounter{subsection} -\stepcounter{subsection} -\stepcounter{section} -\stepcounter{subsection} -\stepcounter{subsection} -\stepcounter{subsection} -\stepcounter{subsection} -{\newpage\clearpage -\lthtmlinlinemathA{tex2html_wrap_inline2841}% -$\backslash$% -\lthtmlinlinemathZ -\lthtmlcheckvsize\clearpage} - -\stepcounter{section} -\stepcounter{subsection} -\stepcounter{subsection} -{\newpage\clearpage -\lthtmlinlinemathA{tex2html_wrap_inline2847}% -$ R_1 \bigcup R_2 -\bigcup R_3 \ldots$% -\lthtmlinlinemathZ -\lthtmlcheckvsize\clearpage} - -{\newpage\clearpage -\lthtmlinlinemathA{tex2html_wrap_inline2849}% -$ R_1 \bigcap R_2 \bigcap R_3 \ldots$% -\lthtmlinlinemathZ -\lthtmlcheckvsize\clearpage} - -{\newpage\clearpage -\lthtmlinlinemathA{tex2html_wrap_inline2851}% -$ S -\backslash S \rightarrow \emptyset $% -\lthtmlinlinemathZ -\lthtmlcheckvsize\clearpage} - -{\newpage\clearpage -\lthtmlinlinemathA{tex2html_wrap_inline2853}% -$ R_1 -\backslash (R_2 \bigcup R_3 \bigcup \ldots$% -\lthtmlinlinemathZ -\lthtmlcheckvsize\clearpage} - -\stepcounter{subsection} -\stepcounter{subsection} -\stepcounter{subsection} -\stepcounter{section} -\stepcounter{subsection} -\stepcounter{subsection} -\stepcounter{subsection} -\stepcounter{subsubsection} -\stepcounter{subsubsection} -\stepcounter{subsubsection} -\stepcounter{subsubsection} -\stepcounter{subsubsection} -\stepcounter{section} -\stepcounter{subsection} -\stepcounter{subsection} -\stepcounter{subsection} -\stepcounter{subsection} -\stepcounter{section} -\stepcounter{subsection} -\stepcounter{subsection} -\stepcounter{subsection} - -% -\providecommand{\pullwarning}[1]{ -\textbf{WARNING:} #1 should not be run when there is a possibility -that another user may be pulling from the same repository. Attempting to do so -may cause repository corruption.}% - -\stepcounter{subsection} -\stepcounter{subsection} -\stepcounter{subsection} -\stepcounter{section} -\stepcounter{subsection} -\stepcounter{subsection} -\stepcounter{subsection} -\stepcounter{subsubsection} -\stepcounter{subsubsection} -\stepcounter{subsubsection} -\stepcounter{subsubsection} -\stepcounter{subsubsection} -\stepcounter{section} -\stepcounter{subsection} -\stepcounter{subsection} -\stepcounter{subsection} -\stepcounter{subsection} -\stepcounter{subsubsection} -\stepcounter{subsection} -\appendix -\stepcounter{section} -\stepcounter{paragraph} - - -\addtolength{\itemsep}{-0.5\baselineskip}% - -\stepcounter{paragraph} -\stepcounter{section} -\stepcounter{paragraph} - - -\addtolength{\itemsep}{-0.5\baselineskip}% - -\stepcounter{paragraph} -\stepcounter{chapter} -\stepcounter{section} -\stepcounter{section} -\stepcounter{chapter} - - -\newtheorem{thm}{Theorem}% - - - -\newtheorem{dfn}{Definition}% - -\stepcounter{section} -\stepcounter{section} -\stepcounter{section} -\stepcounter{subsection} -\stepcounter{subsection} -\stepcounter{section} -{\newpage\clearpage -\lthtmlinlinemathA{tex2html_wrap_inline2863}% -$P_1$% -\lthtmlinlinemathZ -\lthtmlcheckvsize\clearpage} - -{\newpage\clearpage -\lthtmlinlinemathA{tex2html_wrap_inline2865}% -$P_2$% -\lthtmlinlinemathZ -\lthtmlcheckvsize\clearpage} - -{\newpage\clearpage -\lthtmlinlinemathA{tex2html_wrap_inline2867}% -$P_2P_1$% -\lthtmlinlinemathZ -\lthtmlcheckvsize\clearpage} - -{\newpage\clearpage -\lthtmlinlinemathA{tex2html_wrap_inline2873}% -$P_1\parallel P_2$% -\lthtmlinlinemathZ -\lthtmlcheckvsize\clearpage} - -{\newpage\clearpage -\lthtmlinlinemathA{tex2html_wrap_inline2875}% -$P^{ -1}$% -\lthtmlinlinemathZ -\lthtmlcheckvsize\clearpage} - -{\newpage\clearpage -\lthtmlinlinemathA{tex2html_wrap_inline2877}% -$P$% -\lthtmlinlinemathZ -\lthtmlcheckvsize\clearpage} - -{\newpage\clearpage -\lthtmlinlinemathA{tex2html_wrap_inline2759}% -\( P^{ -1} P \)% -\lthtmlinlinemathZ -\lthtmlcheckvsize\clearpage} - -{\newpage\clearpage -\lthtmldisplayA{displaymath2763}% -\begin{displaymath} (P_2 P_1)^{ -1} = P_1^{ -1} P_2^{ -1}. \end{displaymath}% -\lthtmldisplayZ -\lthtmlcheckvsize\clearpage} - -\stepcounter{paragraph} -\stepcounter{paragraph} -\stepcounter{paragraph} -\stepcounter{paragraph} -\stepcounter{paragraph} -\stepcounter{paragraph} -\stepcounter{paragraph} -\stepcounter{paragraph} -\stepcounter{paragraph} -\stepcounter{paragraph} -\stepcounter{subsection} -\stepcounter{subsection} -{\newpage\clearpage -\lthtmlinlinemathA{tex2html_wrap_inline2881}% -$O(n)$% -\lthtmlinlinemathZ -\lthtmlcheckvsize\clearpage} - -\stepcounter{section} -\stepcounter{subsection} - -% -\providecommand{\commutex}{\longleftrightarrow}% - - -% -\providecommand{\commutes}{\longleftrightarrow}% - -{\newpage\clearpage -\lthtmldisplayA{displaymath2764}% -\begin{displaymath} P_2 P_1 \longleftrightarrow {P_1}' {P_2}'. \end{displaymath}% -\lthtmldisplayZ -\lthtmlcheckvsize\clearpage} - -{\newpage\clearpage -\lthtmlinlinemathA{tex2html_wrap_inline2887}% -$P_1'$% -\lthtmlinlinemathZ -\lthtmlcheckvsize\clearpage} - -{\newpage\clearpage -\lthtmlinlinemathA{tex2html_wrap_inline2893}% -$P_2'$% -\lthtmlinlinemathZ -\lthtmlcheckvsize\clearpage} - -{\newpage\clearpage -\lthtmlinlinemathA{tex2html_wrap_inline2897}% -$\longleftrightarrow $% -\lthtmlinlinemathZ -\lthtmlcheckvsize\clearpage} - -{\newpage\clearpage -\lthtmlinlinemathA{tex2html_wrap_inline2899}% -$==$% -\lthtmlinlinemathZ -\lthtmlcheckvsize\clearpage} - -{\newpage\clearpage -\lthtmlinlinemathA{tex2html_wrap_inline2901}% -$\ddot\frown$% -\lthtmlinlinemathZ -\lthtmlcheckvsize\clearpage} - -\stepcounter{paragraph} - -% -\providecommand{\merge}{\Longrightarrow}% - -{\newpage\clearpage -\lthtmlinlinemathA{tex2html_wrap_inline2760}% -\( \Longrightarrow \)% -\lthtmlinlinemathZ -\lthtmlcheckvsize\clearpage} - -{\newpage\clearpage -\lthtmldisplayA{displaymath2765}% -\begin{displaymath} P_2 \parallel P_1 \Longrightarrow {P_2}' P_1 \longleftrightarrow {P_1}' P_2. \end{displaymath}% -\lthtmldisplayZ -\lthtmlcheckvsize\clearpage} - -\stepcounter{subsection} -{\newpage\clearpage -\lthtmlinlinemathA{tex2html_wrap_inline2911}% -$ P_2' P_1 \longleftrightarrow P_1' P_2 $% -\lthtmlinlinemathZ -\lthtmlcheckvsize\clearpage} - -{\newpage\clearpage -\lthtmlinlinemathA{tex2html_wrap_inline2913}% -$ P_1'^{ -1} -P_2' \longleftrightarrow P_2 P_1^{ -1} $% -\lthtmlinlinemathZ -\lthtmlcheckvsize\clearpage} - -{\newpage\clearpage -\lthtmlinlinemathA{tex2html_wrap_inline2915}% -$P_1'^{ -1}$% -\lthtmlinlinemathZ -\lthtmlcheckvsize\clearpage} - -{\newpage\clearpage -\lthtmlinlinemathA{tex2html_wrap_inline2917}% -$P_1^{ -1}$% -\lthtmlinlinemathZ -\lthtmlcheckvsize\clearpage} - -{\newpage\clearpage -\lthtmldisplayA{displaymath2766}% -\begin{displaymath} -A^{ -1} C \longleftrightarrow C' A'^{ -1} -\end{displaymath}% -\lthtmldisplayZ -\lthtmlcheckvsize\clearpage} - -\stepcounter{section} -\stepcounter{section} -\stepcounter{paragraph} -\stepcounter{paragraph} -\stepcounter{chapter} -\stepcounter{chapter} -\addtocounter{enumi}{-1} -\stepcounter{section} - -\end{document} diff --git a/doc/manual/images.tex b/doc/manual/images.tex deleted file mode 100644 --- a/doc/manual/images.tex +++ /dev/null @@ -1,605 +0,0 @@ -\batchmode - - -\documentclass{book} -\RequirePackage{ifthen} - - - - -\usepackage{verbatim} -\usepackage{html} -\usepackage{fancyvrb} - -% -\newenvironment{code}{\comment}{\endcomment} - - - - -\usepackage[dvips]{color} - - -\pagecolor[gray]{.7} - -\usepackage[latin1]{inputenc} - - - -\makeatletter - -\makeatletter -\count@=\the\catcode`\_ \catcode`\_=8 -\newenvironment{tex2html_wrap}{}{}% -\catcode`\<=12\catcode`\_=\count@ -\newcommand{\providedcommand}[1]{\expandafter\providecommand\csname #1\endcsname}% -\newcommand{\renewedcommand}[1]{\expandafter\providecommand\csname #1\endcsname{}% - \expandafter\renewcommand\csname #1\endcsname}% -\newcommand{\newedenvironment}[1]{\newenvironment{#1}{}{}\renewenvironment{#1}}% -\let\newedcommand\renewedcommand -\let\renewedenvironment\newedenvironment -\makeatother -\let\mathon=$ -\let\mathoff=$ -\ifx\AtBeginDocument\undefined \newcommand{\AtBeginDocument}[1]{}\fi -\newbox\sizebox -\setlength{\hoffset}{0pt}\setlength{\voffset}{0pt} -\addtolength{\textheight}{\footskip}\setlength{\footskip}{0pt} -\addtolength{\textheight}{\topmargin}\setlength{\topmargin}{0pt} -\addtolength{\textheight}{\headheight}\setlength{\headheight}{0pt} -\addtolength{\textheight}{\headsep}\setlength{\headsep}{0pt} -\setlength{\textwidth}{349pt} -\newwrite\lthtmlwrite -\makeatletter -\let\realnormalsize=\normalsize -\global\topskip=2sp -\def\preveqno{}\let\real@float=\@float \let\realend@float=\end@float -\def\@float{\let\@savefreelist\@freelist\real@float} -\def\liih@math{\ifmmode$\else\bad@math\fi} -\def\end@float{\realend@float\global\let\@freelist\@savefreelist} -\let\real@dbflt=\@dbflt \let\end@dblfloat=\end@float -\let\@largefloatcheck=\relax -\let\if@boxedmulticols=\iftrue -\def\@dbflt{\let\@savefreelist\@freelist\real@dbflt} -\def\adjustnormalsize{\def\normalsize{\mathsurround=0pt \realnormalsize - \parindent=0pt\abovedisplayskip=0pt\belowdisplayskip=0pt}% - \def\phantompar{\csname par\endcsname}\normalsize}% -\def\lthtmltypeout#1{{\let\protect\string \immediate\write\lthtmlwrite{#1}}}% -\newcommand\lthtmlhboxmathA{\adjustnormalsize\setbox\sizebox=\hbox\bgroup\kern.05em }% -\newcommand\lthtmlhboxmathB{\adjustnormalsize\setbox\sizebox=\hbox to\hsize\bgroup\hfill }% -\newcommand\lthtmlvboxmathA{\adjustnormalsize\setbox\sizebox=\vbox\bgroup % - \let\ifinner=\iffalse \let\)\liih@math }% -\newcommand\lthtmlboxmathZ{\@next\next\@currlist{}{\def\next{\voidb@x}}% - \expandafter\box\next\egroup}% -\newcommand\lthtmlmathtype[1]{\gdef\lthtmlmathenv{#1}}% -\newcommand\lthtmllogmath{\dimen0\ht\sizebox \advance\dimen0\dp\sizebox - \ifdim\dimen0>.95\vsize - \lthtmltypeout{% -*** image for \lthtmlmathenv\space is too tall at \the\dimen0, reducing to .95 vsize ***}% - \ht\sizebox.95\vsize \dp\sizebox\z@ \fi - \lthtmltypeout{l2hSize % -:\lthtmlmathenv:\the\ht\sizebox::\the\dp\sizebox::\the\wd\sizebox.\preveqno}}% -\newcommand\lthtmlfigureA[1]{\let\@savefreelist\@freelist - \lthtmlmathtype{#1}\lthtmlvboxmathA}% -\newcommand\lthtmlpictureA{\bgroup\catcode`\_=8 \lthtmlpictureB}% -\newcommand\lthtmlpictureB[1]{\lthtmlmathtype{#1}\egroup - \let\@savefreelist\@freelist \lthtmlhboxmathB}% -\newcommand\lthtmlpictureZ[1]{\hfill\lthtmlfigureZ}% -\newcommand\lthtmlfigureZ{\lthtmlboxmathZ\lthtmllogmath\copy\sizebox - \global\let\@freelist\@savefreelist}% -\newcommand\lthtmldisplayA{\bgroup\catcode`\_=8 \lthtmldisplayAi}% -\newcommand\lthtmldisplayAi[1]{\lthtmlmathtype{#1}\egroup\lthtmlvboxmathA}% -\newcommand\lthtmldisplayB[1]{\edef\preveqno{(\theequation)}% - \lthtmldisplayA{#1}\let\@eqnnum\relax}% -\newcommand\lthtmldisplayZ{\lthtmlboxmathZ\lthtmllogmath\lthtmlsetmath}% -\newcommand\lthtmlinlinemathA{\bgroup\catcode`\_=8 \lthtmlinlinemathB} -\newcommand\lthtmlinlinemathB[1]{\lthtmlmathtype{#1}\egroup\lthtmlhboxmathA - \vrule height1.5ex width0pt }% -\newcommand\lthtmlinlineA{\bgroup\catcode`\_=8 \lthtmlinlineB}% -\newcommand\lthtmlinlineB[1]{\lthtmlmathtype{#1}\egroup\lthtmlhboxmathA}% -\newcommand\lthtmlinlineZ{\egroup\expandafter\ifdim\dp\sizebox>0pt % - \expandafter\centerinlinemath\fi\lthtmllogmath\lthtmlsetinline} -\newcommand\lthtmlinlinemathZ{\egroup\expandafter\ifdim\dp\sizebox>0pt % - \expandafter\centerinlinemath\fi\lthtmllogmath\lthtmlsetmath} -\newcommand\lthtmlindisplaymathZ{\egroup % - \centerinlinemath\lthtmllogmath\lthtmlsetmath} -\def\lthtmlsetinline{\hbox{\vrule width.1em \vtop{\vbox{% - \kern.1em\copy\sizebox}\ifdim\dp\sizebox>0pt\kern.1em\else\kern.3pt\fi - \ifdim\hsize>\wd\sizebox \hrule depth1pt\fi}}} -\def\lthtmlsetmath{\hbox{\vrule width.1em\kern-.05em\vtop{\vbox{% - \kern.1em\kern0.8 pt\hbox{\hglue.17em\copy\sizebox\hglue0.8 pt}}\kern.3pt% - \ifdim\dp\sizebox>0pt\kern.1em\fi \kern0.8 pt% - \ifdim\hsize>\wd\sizebox \hrule depth1pt\fi}}} -\def\centerinlinemath{% - \dimen1=\ifdim\ht\sizebox<\dp\sizebox \dp\sizebox\else\ht\sizebox\fi - \advance\dimen1by.5pt \vrule width0pt height\dimen1 depth\dimen1 - \dp\sizebox=\dimen1\ht\sizebox=\dimen1\relax} - -\def\lthtmlcheckvsize{\ifdim\ht\sizebox<\vsize - \ifdim\wd\sizebox<\hsize\expandafter\hfill\fi \expandafter\vfill - \else\expandafter\vss\fi}% -\providecommand{\selectlanguage}[1]{}% -\makeatletter \tracingstats = 1 - - -\begin{document} -\pagestyle{empty}\thispagestyle{empty}\lthtmltypeout{}% -\lthtmltypeout{latex2htmlLength hsize=\the\hsize}\lthtmltypeout{}% -\lthtmltypeout{latex2htmlLength vsize=\the\vsize}\lthtmltypeout{}% -\lthtmltypeout{latex2htmlLength hoffset=\the\hoffset}\lthtmltypeout{}% -\lthtmltypeout{latex2htmlLength voffset=\the\voffset}\lthtmltypeout{}% -\lthtmltypeout{latex2htmlLength topmargin=\the\topmargin}\lthtmltypeout{}% -\lthtmltypeout{latex2htmlLength topskip=\the\topskip}\lthtmltypeout{}% -\lthtmltypeout{latex2htmlLength headheight=\the\headheight}\lthtmltypeout{}% -\lthtmltypeout{latex2htmlLength headsep=\the\headsep}\lthtmltypeout{}% -\lthtmltypeout{latex2htmlLength parskip=\the\parskip}\lthtmltypeout{}% -\lthtmltypeout{latex2htmlLength oddsidemargin=\the\oddsidemargin}\lthtmltypeout{}% -\makeatletter -\if@twoside\lthtmltypeout{latex2htmlLength evensidemargin=\the\evensidemargin}% -\else\lthtmltypeout{latex2htmlLength evensidemargin=\the\oddsidemargin}\fi% -\lthtmltypeout{}% -\makeatother -\setcounter{page}{1} -\onecolumn - -% !!! IMAGES START HERE !!! - -\stepcounter{chapter} -\stepcounter{paragraph} -\stepcounter{paragraph} -\stepcounter{paragraph} -\stepcounter{paragraph} -\stepcounter{section} -\stepcounter{paragraph} -\stepcounter{paragraph} -\stepcounter{paragraph} -\stepcounter{paragraph} -\stepcounter{paragraph} -\stepcounter{paragraph} -\stepcounter{paragraph} -\stepcounter{paragraph} -\stepcounter{paragraph} -\stepcounter{paragraph} -\stepcounter{paragraph} -\stepcounter{paragraph} -\stepcounter{paragraph} -\stepcounter{chapter} -\stepcounter{section} -\stepcounter{section} -\stepcounter{section} -\stepcounter{section} -\stepcounter{section} -\stepcounter{subsection} -\stepcounter{subsection} -\stepcounter{subsection} -\stepcounter{subsection} -\stepcounter{subsection} -\stepcounter{paragraph} -\stepcounter{paragraph} -\stepcounter{paragraph} -\stepcounter{paragraph} -{\newpage\clearpage -\lthtmlinlinemathA{tex2html_wrap_inline2771}% -$<$% -\lthtmlinlinemathZ -\lthtmlcheckvsize\clearpage} - -{\newpage\clearpage -\lthtmlinlinemathA{tex2html_wrap_inline2773}% -$>$% -\lthtmlinlinemathZ -\lthtmlcheckvsize\clearpage} - -\stepcounter{paragraph} -\stepcounter{chapter} -\stepcounter{paragraph} -\stepcounter{section} -\stepcounter{paragraph} -\stepcounter{paragraph} -\stepcounter{paragraph} -\stepcounter{paragraph} -\stepcounter{paragraph} -\stepcounter{paragraph} -\stepcounter{paragraph} -\stepcounter{paragraph} -\stepcounter{section} -\stepcounter{section} -\stepcounter{paragraph} -\stepcounter{paragraph} -\stepcounter{paragraph} -\stepcounter{paragraph} -\stepcounter{paragraph} -\stepcounter{section} -\stepcounter{paragraph} -\stepcounter{paragraph} -\stepcounter{paragraph} -\stepcounter{paragraph} -\stepcounter{paragraph} -\stepcounter{paragraph} -\stepcounter{paragraph} -\stepcounter{section} -\stepcounter{section} -\stepcounter{chapter} -\stepcounter{section} -\stepcounter{subsection} -\stepcounter{subsection} -\stepcounter{subsection} -\stepcounter{subsection} -{\newpage\clearpage -\lthtmlinlinemathA{tex2html_wrap_inline2775}% -$+$% -\lthtmlinlinemathZ -\lthtmlcheckvsize\clearpage} - -\stepcounter{section} -\stepcounter{subsection} -\stepcounter{subsection} -\stepcounter{subsection} -\stepcounter{subsection} -\stepcounter{subsection} -\stepcounter{subsection} -\stepcounter{section} -\stepcounter{section} -\stepcounter{section} -\stepcounter{section} -{\newpage\clearpage -\lthtmlinlinemathA{tex2html_wrap_inline2777}% -$R_{c}$% -\lthtmlinlinemathZ -\lthtmlcheckvsize\clearpage} - -{\newpage\clearpage -\lthtmlinlinemathA{tex2html_wrap_inline2779}% -$f_1$% -\lthtmlinlinemathZ -\lthtmlcheckvsize\clearpage} - -{\newpage\clearpage -\lthtmlinlinemathA{tex2html_wrap_inline2781}% -$R_c$% -\lthtmlinlinemathZ -\lthtmlcheckvsize\clearpage} - -{\newpage\clearpage -\lthtmlinlinemathA{tex2html_wrap_inline2783}% -$R_1$% -\lthtmlinlinemathZ -\lthtmlcheckvsize\clearpage} - -{\newpage\clearpage -\lthtmlinlinemathA{tex2html_wrap_inline2787}% -$f_2$% -\lthtmlinlinemathZ -\lthtmlcheckvsize\clearpage} - -{\newpage\clearpage -\lthtmlinlinemathA{tex2html_wrap_inline2795}% -$R_2$% -\lthtmlinlinemathZ -\lthtmlcheckvsize\clearpage} - -\stepcounter{subsection} -{\newpage\clearpage -\lthtmlinlinemathA{tex2html_wrap_inline2835}% -$R_p$% -\lthtmlinlinemathZ -\lthtmlcheckvsize\clearpage} - -{\newpage\clearpage -\lthtmlinlinemathA{tex2html_wrap_inline2839}% -$R_l$% -\lthtmlinlinemathZ -\lthtmlcheckvsize\clearpage} - -\stepcounter{chapter} -\stepcounter{chapter} -\stepcounter{paragraph} -\stepcounter{section} -\stepcounter{paragraph} -\stepcounter{subsection} -\stepcounter{paragraph} -\stepcounter{paragraph} -\stepcounter{paragraph} -\stepcounter{subsection} -\stepcounter{subsection} -\stepcounter{section} -\stepcounter{section} -\stepcounter{subsection} -\stepcounter{section} -\stepcounter{subsection} -\stepcounter{subsection} -\stepcounter{subsection} -\stepcounter{section} -\stepcounter{subsection} -\stepcounter{subsection} -\stepcounter{subsection} -\stepcounter{subsection} -{\newpage\clearpage -\lthtmlinlinemathA{tex2html_wrap_inline2841}% -$\backslash$% -\lthtmlinlinemathZ -\lthtmlcheckvsize\clearpage} - -\stepcounter{section} -\stepcounter{subsection} -\stepcounter{subsection} -{\newpage\clearpage -\lthtmlinlinemathA{tex2html_wrap_inline2847}% -$ R_1 \bigcup R_2 -\bigcup R_3 \ldots$% -\lthtmlinlinemathZ -\lthtmlcheckvsize\clearpage} - -{\newpage\clearpage -\lthtmlinlinemathA{tex2html_wrap_inline2849}% -$ R_1 \bigcap R_2 \bigcap R_3 \ldots$% -\lthtmlinlinemathZ -\lthtmlcheckvsize\clearpage} - -{\newpage\clearpage -\lthtmlinlinemathA{tex2html_wrap_inline2851}% -$ S -\backslash S \rightarrow \emptyset $% -\lthtmlinlinemathZ -\lthtmlcheckvsize\clearpage} - -{\newpage\clearpage -\lthtmlinlinemathA{tex2html_wrap_inline2853}% -$ R_1 -\backslash (R_2 \bigcup R_3 \bigcup \ldots$% -\lthtmlinlinemathZ -\lthtmlcheckvsize\clearpage} - -\stepcounter{subsection} -\stepcounter{subsection} -\stepcounter{subsection} -\stepcounter{section} -\stepcounter{subsection} -\stepcounter{subsection} -\stepcounter{subsection} -\stepcounter{subsubsection} -\stepcounter{subsubsection} -\stepcounter{subsubsection} -\stepcounter{subsubsection} -\stepcounter{subsubsection} -\stepcounter{section} -\stepcounter{subsection} -\stepcounter{subsection} -\stepcounter{subsection} -\stepcounter{subsection} -\stepcounter{section} -\stepcounter{subsection} -\stepcounter{subsection} -\stepcounter{subsection} - -% -\providecommand{\pullwarning}[1]{ -\textbf{WARNING:} #1 should not be run when there is a possibility -that another user may be pulling from the same repository. Attempting to do so -may cause repository corruption.}% - -\stepcounter{subsection} -\stepcounter{subsection} -\stepcounter{subsection} -\stepcounter{section} -\stepcounter{subsection} -\stepcounter{subsection} -\stepcounter{subsection} -\stepcounter{subsubsection} -\stepcounter{subsubsection} -\stepcounter{subsubsection} -\stepcounter{subsubsection} -\stepcounter{subsubsection} -\stepcounter{section} -\stepcounter{subsection} -\stepcounter{subsection} -\stepcounter{subsection} -\stepcounter{subsection} -\stepcounter{subsubsection} -\stepcounter{subsection} -\appendix -\stepcounter{section} -\stepcounter{paragraph} - - -\addtolength{\itemsep}{-0.5\baselineskip}% - -\stepcounter{paragraph} -\stepcounter{section} -\stepcounter{paragraph} - - -\addtolength{\itemsep}{-0.5\baselineskip}% - -\stepcounter{paragraph} -\stepcounter{chapter} -\stepcounter{section} -\stepcounter{section} -\stepcounter{chapter} - - -\newtheorem{thm}{Theorem}% - - - -\newtheorem{dfn}{Definition}% - -\stepcounter{section} -\stepcounter{section} -\stepcounter{section} -\stepcounter{subsection} -\stepcounter{subsection} -\stepcounter{section} -{\newpage\clearpage -\lthtmlinlinemathA{tex2html_wrap_inline2863}% -$P_1$% -\lthtmlinlinemathZ -\lthtmlcheckvsize\clearpage} - -{\newpage\clearpage -\lthtmlinlinemathA{tex2html_wrap_inline2865}% -$P_2$% -\lthtmlinlinemathZ -\lthtmlcheckvsize\clearpage} - -{\newpage\clearpage -\lthtmlinlinemathA{tex2html_wrap_inline2867}% -$P_2P_1$% -\lthtmlinlinemathZ -\lthtmlcheckvsize\clearpage} - -{\newpage\clearpage -\lthtmlinlinemathA{tex2html_wrap_inline2873}% -$P_1\parallel P_2$% -\lthtmlinlinemathZ -\lthtmlcheckvsize\clearpage} - -{\newpage\clearpage -\lthtmlinlinemathA{tex2html_wrap_inline2875}% -$P^{ -1}$% -\lthtmlinlinemathZ -\lthtmlcheckvsize\clearpage} - -{\newpage\clearpage -\lthtmlinlinemathA{tex2html_wrap_inline2877}% -$P$% -\lthtmlinlinemathZ -\lthtmlcheckvsize\clearpage} - -{\newpage\clearpage -\lthtmlinlinemathA{tex2html_wrap_inline2759}% -\( P^{ -1} P \)% -\lthtmlinlinemathZ -\lthtmlcheckvsize\clearpage} - -{\newpage\clearpage -\lthtmldisplayA{displaymath2763}% -\begin{displaymath} (P_2 P_1)^{ -1} = P_1^{ -1} P_2^{ -1}. \end{displaymath}% -\lthtmldisplayZ -\lthtmlcheckvsize\clearpage} - -\stepcounter{paragraph} -\stepcounter{paragraph} -\stepcounter{paragraph} -\stepcounter{paragraph} -\stepcounter{paragraph} -\stepcounter{paragraph} -\stepcounter{paragraph} -\stepcounter{paragraph} -\stepcounter{paragraph} -\stepcounter{paragraph} -\stepcounter{subsection} -\stepcounter{subsection} -{\newpage\clearpage -\lthtmlinlinemathA{tex2html_wrap_inline2881}% -$O(n)$% -\lthtmlinlinemathZ -\lthtmlcheckvsize\clearpage} - -\stepcounter{section} -\stepcounter{subsection} - -% -\providecommand{\commutex}{\longleftrightarrow}% - - -% -\providecommand{\commutes}{\longleftrightarrow}% - -{\newpage\clearpage -\lthtmldisplayA{displaymath2764}% -\begin{displaymath} P_2 P_1 \longleftrightarrow {P_1}' {P_2}'. \end{displaymath}% -\lthtmldisplayZ -\lthtmlcheckvsize\clearpage} - -{\newpage\clearpage -\lthtmlinlinemathA{tex2html_wrap_inline2887}% -$P_1'$% -\lthtmlinlinemathZ -\lthtmlcheckvsize\clearpage} - -{\newpage\clearpage -\lthtmlinlinemathA{tex2html_wrap_inline2893}% -$P_2'$% -\lthtmlinlinemathZ -\lthtmlcheckvsize\clearpage} - -{\newpage\clearpage -\lthtmlinlinemathA{tex2html_wrap_inline2897}% -$\longleftrightarrow $% -\lthtmlinlinemathZ -\lthtmlcheckvsize\clearpage} - -{\newpage\clearpage -\lthtmlinlinemathA{tex2html_wrap_inline2899}% -$==$% -\lthtmlinlinemathZ -\lthtmlcheckvsize\clearpage} - -{\newpage\clearpage -\lthtmlinlinemathA{tex2html_wrap_inline2901}% -$\ddot\frown$% -\lthtmlinlinemathZ -\lthtmlcheckvsize\clearpage} - -\stepcounter{paragraph} - -% -\providecommand{\merge}{\Longrightarrow}% - -{\newpage\clearpage -\lthtmlinlinemathA{tex2html_wrap_inline2760}% -\( \Longrightarrow \)% -\lthtmlinlinemathZ -\lthtmlcheckvsize\clearpage} - -{\newpage\clearpage -\lthtmldisplayA{displaymath2765}% -\begin{displaymath} P_2 \parallel P_1 \Longrightarrow {P_2}' P_1 \longleftrightarrow {P_1}' P_2. \end{displaymath}% -\lthtmldisplayZ -\lthtmlcheckvsize\clearpage} - -\stepcounter{subsection} -{\newpage\clearpage -\lthtmlinlinemathA{tex2html_wrap_inline2911}% -$ P_2' P_1 \longleftrightarrow P_1' P_2 $% -\lthtmlinlinemathZ -\lthtmlcheckvsize\clearpage} - -{\newpage\clearpage -\lthtmlinlinemathA{tex2html_wrap_inline2913}% -$ P_1'^{ -1} -P_2' \longleftrightarrow P_2 P_1^{ -1} $% -\lthtmlinlinemathZ -\lthtmlcheckvsize\clearpage} - -{\newpage\clearpage -\lthtmlinlinemathA{tex2html_wrap_inline2915}% -$P_1'^{ -1}$% -\lthtmlinlinemathZ -\lthtmlcheckvsize\clearpage} - -{\newpage\clearpage -\lthtmlinlinemathA{tex2html_wrap_inline2917}% -$P_1^{ -1}$% -\lthtmlinlinemathZ -\lthtmlcheckvsize\clearpage} - -{\newpage\clearpage -\lthtmldisplayA{displaymath2766}% -\begin{displaymath} -A^{ -1} C \longleftrightarrow C' A'^{ -1} -\end{displaymath}% -\lthtmldisplayZ -\lthtmlcheckvsize\clearpage} - -\stepcounter{section} -\stepcounter{section} -\stepcounter{paragraph} -\stepcounter{paragraph} -\stepcounter{chapter} -\stepcounter{chapter} -\addtocounter{enumi}{-1} -\stepcounter{section} - -\end{document} diff --git a/doc/manual/patch-theory.tex b/doc/manual/patch-theory.tex deleted file mode 100644 --- a/doc/manual/patch-theory.tex +++ /dev/null @@ -1,79 +0,0 @@ -%% This file was automatically generated by preproc. -% Copyright (C) 2007 David Roundy -% -% This program is free software; you can redistribute it and/or modify -% it under the terms of the GNU General Public License as published by -% the Free Software Foundation; either version 2, or (at your option) -% any later version. -% -% This program is distributed in the hope that it will be useful, -% but WITHOUT ANY WARRANTY; without even the implied warranty of -% MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the -% GNU General Public License for more details. -% -% You should have received a copy of the GNU General Public License -% along with this program; see the file COPYING. If not, write to -% the Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor, -% Boston, MA 02110-1301, USA. - -\documentclass{article} -%\usepackage{color} - -\usepackage{verbatim} -\usepackage{hyperref} -\usepackage{fancyvrb} -\newenvironment{code}{\comment}{\endcomment} -% \newenvironment{code}{\color{blue}\verbatim}{\endverbatim} - -\newcommand{\commutes}{\longleftrightarrow} - -\begin{document} - - -\section{Patch properties} - -Darcs is built on a hierarchy of patch types. At the lowest level are -``primitive'' patches, and from these building blocks, a whole hierarchy of -patch types are built. Each of these patch types must support a number of -functions, which must obey a number of laws. - -\subsection{Properties of identity} - -\newtheorem{prp}{Property} - -\begin{prp}[Identity commutes trivially] - The identity patch must commute with any patch without modifying said patch. -\end{prp} - - -\begin{prp}[Inverse doesn't commute] - A patch and its inverse will always commute, unless that patch is an - identity patch (or an identity-like patch that has no effect). -\end{prp} - - -\subsection{Commute properties} - -\begin{prp}[Recommute] - $AB \commutes B'A'$ if and only if $B'A' \commutes AB$ -\end{prp} - - -\begin{prp}[Commute inverses] - $AB \commutes B'A'$ if and only if $B^{-1}A^{-1} \commutes A'^{-1}B'^{-1}$ -\end{prp} - - -\begin{prp}[Patch and inverse] - If $AB \commutes B'A'$ then $A^{-1}B' \commutes BA'^{-1}$ -\end{prp} - -This property is only true of primitive patches. - - -\begin{prp}[Permutivity] - (to be added...) -\end{prp} - - -\end{document} diff --git a/release/distributed-context b/release/distributed-context --- a/release/distributed-context +++ b/release/distributed-context @@ -1,1 +1,1 @@ -Just "\nContext:\n\n[TAG 2.4\nReinier Lamers **20100226180900\n Ignore-this: 36ce0456c214345f55a7bc5fc142e985\n] \n" +Just "\nContext:\n\n[TAG 2.4.1\nReinier Lamers **20100412161826\n Ignore-this: 17bcd98358f6da527cd14ab1a725f0b7\n] \n" diff --git a/src/Darcs/Commands.lhs b/src/Darcs/Commands.lhs --- a/src/Darcs/Commands.lhs +++ b/src/Darcs/Commands.lhs @@ -167,14 +167,16 @@ getSubcommands c@(SuperCommand {}) = commandSubCommands c getSubcommands _ = [] -commandAlias :: String -> DarcsCommand -> DarcsCommand -commandAlias n c = +commandAlias :: String -> Maybe DarcsCommand -> DarcsCommand -> DarcsCommand +commandAlias n msuper c = c { commandName = n - , commandDescription = "Alias for `darcs " ++ commandName c ++ "'." + , commandDescription = "Alias for `darcs " ++ cmdName ++ "'." , commandHelp = "The `darcs " ++ n ++ "' command is an alias for " ++ - "`darcs " ++ commandName c ++ "'.\n" ++ + "`darcs " ++ cmdName ++ "'.\n" ++ commandHelp c } + where + cmdName = unwords . map commandName . maybe id (:) msuper $ [ c ] commandStub :: String -> String -> String -> DarcsCommand -> DarcsCommand commandStub n h d c = diff --git a/src/Darcs/Commands/Changes.lhs b/src/Darcs/Commands/Changes.lhs --- a/src/Darcs/Commands/Changes.lhs +++ b/src/Darcs/Commands/Changes.lhs @@ -293,5 +293,5 @@ headRL NilRL = impossible log :: DarcsCommand -log = commandAlias "log" changes +log = commandAlias "log" Nothing changes \end{code} diff --git a/src/Darcs/Commands/GZCRCs.lhs b/src/Darcs/Commands/GZCRCs.lhs --- a/src/Darcs/Commands/GZCRCs.lhs +++ b/src/Darcs/Commands/GZCRCs.lhs @@ -38,6 +38,7 @@ import System.Directory ( getDirectoryContents, doesFileExist, doesDirectoryExist ) import System.Exit ( ExitCode(..), exitWith ) +import System.IO ( hPutStr, hPutStrLn, stderr ) import Data.IORef ( newIORef, readIORef, writeIORef ) import Darcs.Commands ( DarcsCommand(..), nodefaults ) @@ -110,12 +111,12 @@ files <- getCRCWarnings resetCRCWarnings when (not . null $ files) $ do - putStr . formatText $ + hPutStr stderr . formatText $ ["", "Warning: CRC errors found. These are probably harmless but should " ++ "be repaired. See 'darcs gzcrcs --help' for more information.", ""] - when verbose $ putStrLn $ unlines ("The following corrupt files were found:":files) + when verbose $ hPutStrLn stderr $ unlines ("The following corrupt files were found:":files) gzcrcs :: DarcsCommand gzcrcs = DarcsCommand {commandName = "gzcrcs", diff --git a/src/Darcs/Commands/Get.lhs b/src/Darcs/Commands/Get.lhs --- a/src/Darcs/Commands/Get.lhs +++ b/src/Darcs/Commands/Get.lhs @@ -132,7 +132,7 @@ getInventoryChoices]} clone :: DarcsCommand -clone = commandAlias "clone" get +clone = commandAlias "clone" Nothing get getCmd :: [DarcsFlag] -> [String] -> IO () getCmd opts [inrepodir, outname] = getCmd (NewRepo outname:opts) [inrepodir] diff --git a/src/Darcs/Commands/MarkConflicts.lhs b/src/Darcs/Commands/MarkConflicts.lhs --- a/src/Darcs/Commands/MarkConflicts.lhs +++ b/src/Darcs/Commands/MarkConflicts.lhs @@ -101,5 +101,5 @@ -- |resolve is an alias for mark-conflicts. resolve :: DarcsCommand -resolve = commandAlias "resolve" markconflicts +resolve = commandAlias "resolve" Nothing markconflicts \end{code} diff --git a/src/Darcs/Commands/Move.lhs b/src/Darcs/Commands/Move.lhs --- a/src/Darcs/Commands/Move.lhs +++ b/src/Darcs/Commands/Move.lhs @@ -178,7 +178,7 @@ | otherwise = return () mv :: DarcsCommand -mv = commandAlias "mv" move +mv = commandAlias "mv" Nothing move \end{code} diff --git a/src/Darcs/Commands/Remove.lhs b/src/Darcs/Commands/Remove.lhs --- a/src/Darcs/Commands/Remove.lhs +++ b/src/Darcs/Commands/Remove.lhs @@ -23,6 +23,7 @@ module Darcs.Commands.Remove ( remove, rm, unadd ) where import Control.Monad ( when ) +import Data.Maybe ( isJust ) import Darcs.Commands ( DarcsCommand(..), nodefaults, commandAlias, commandStub, putWarning @@ -47,7 +48,6 @@ import Darcs.Commands.Add( expandDirs ) import Printer ( text ) -import Debug.Trace #include "gadts.h" @@ -101,28 +101,38 @@ where mrp ftf recorded unrecorded (f:fs) = do let recorded' = modifyTree recorded f Nothing unrecorded' = modifyTree unrecorded f Nothing - Sealed rest <- mrp ftf recorded' unrecorded' fs - let f_fp = anchorPath "" f + f_fp = anchorPath "" f skipAndWarn reason = do putWarning opts . text $ "Can't remove " ++ f_fp ++ " (" ++ reason ++ ")" - return $ Sealed rest + return $ Nothing - case (find recorded f, find unrecorded f) of + local <- case (find recorded f, find unrecorded f) of (Just (SubTree _), Just (SubTree unrecordedChildren)) -> do if not $ null (list unrecordedChildren) then skipAndWarn "it is not empty" - else return . Sealed $ rmdir f_fp :>: rest + else return $ Just (rmdir f_fp :>: NilFL) (Just (File _), Just (File _)) -> - do diff <- treeDiff ftf unrecorded unrecorded' - return . Sealed $ diff +>+ rest + Just `fmap` treeDiff ftf unrecorded unrecorded' (Just (File _), _) -> - return . Sealed $ addfile f_fp :>: rmfile f_fp :>: rest + return $ Just (addfile f_fp :>: rmfile f_fp :>: NilFL) (Just (SubTree _), _) -> - return . Sealed $ adddir f_fp :>: rmdir f_fp :>: rest + return $ Just (adddir f_fp :>: rmdir f_fp :>: NilFL) (_, _) -> skipAndWarn "it is not tracked by darcs" + -- we can tell if the remove succeeded by looking if local is + -- empty. If the remove succeeded, we should pass on updated + -- recorded and unrecorded that reflect the removal + let nextRecorded | isJust local = recorded' + | otherwise = recorded + nextUnrecorded | isJust local = unrecorded' + | otherwise = unrecorded + Sealed rest <- mrp ftf nextRecorded nextUnrecorded fs + return . Sealed $ case local of + Just localFL -> (localFL +>+ rest) + Nothing -> rest + mrp _ _ _ [] = return (Sealed NilFL) rmDescription :: String @@ -140,7 +150,7 @@ rm = commandStub "rm" rmHelp rmDescription remove unadd :: DarcsCommand -unadd = commandAlias "unadd" remove +unadd = commandAlias "unadd" Nothing remove \end{code} diff --git a/src/Darcs/Commands/Show.lhs b/src/Darcs/Commands/Show.lhs --- a/src/Darcs/Commands/Show.lhs +++ b/src/Darcs/Commands/Show.lhs @@ -25,10 +25,10 @@ import Darcs.Commands.ShowAuthors ( showAuthors ) import Darcs.Commands.ShowBug ( showBug ) import Darcs.Commands.ShowContents ( showContents ) -import Darcs.Commands.ShowFiles ( showFiles, showManifest ) +import Darcs.Commands.ShowFiles ( showFiles, manifestCmd, toListManifest ) import Darcs.Commands.ShowTags ( showTags ) import Darcs.Commands.ShowRepo ( showRepo ) -import Darcs.Commands.ShowIndex ( showIndex, showPristine ) +import Darcs.Commands.ShowIndex ( showIndex, showPristineCmd ) import Darcs.Repository ( amInRepository ) showDescription :: String @@ -58,10 +58,27 @@ } query :: DarcsCommand -query = commandAlias "query" showCommand +query = commandAlias "query" Nothing showCommand list :: DarcsCommand -list = commandAlias "list" showCommand +list = commandAlias "list" Nothing showCommand + +-- unfortunately, aliases for sub-commands have to live in their parent command +-- to avoid an import cycle +showPristine :: DarcsCommand +showPristine = (commandAlias "pristine" (Just showCommand) showIndex) { + commandCommand = showPristineCmd, + commandDescription = "Dump contents of pristine cache.", + commandHelp = + "The `darcs show pristine' command lists all version-controlled files " ++ + "and directories along with the hashes of their pristine copies. " ++ + "For files, the fields correspond to file size, sha256 of the pristine " ++ + "file content and the filename." } + +showManifest :: DarcsCommand +showManifest = (commandAlias "manifest" (Just showCommand) showFiles) { + commandCommand = manifestCmd toListManifest +} \end{code} \subsection{darcs show} diff --git a/src/Darcs/Commands/ShowFiles.lhs b/src/Darcs/Commands/ShowFiles.lhs --- a/src/Darcs/Commands/ShowFiles.lhs +++ b/src/Darcs/Commands/ShowFiles.lhs @@ -20,10 +20,12 @@ {-# OPTIONS_GHC -cpp #-} {-# LANGUAGE CPP #-} #include "gadts.h" -module Darcs.Commands.ShowFiles ( showFiles, showManifest ) where +module Darcs.Commands.ShowFiles ( showFiles + , manifestCmd, toListManifest -- for alias + ) where import Darcs.Arguments ( DarcsFlag(..), workingRepoDir, files, directories, pending, nullFlag, matchOne ) -import Darcs.Commands ( DarcsCommand(..), nodefaults, commandAlias ) +import Darcs.Commands ( DarcsCommand(..), nodefaults ) import Darcs.Repository ( Repository, amInRepository, slurp_pending, slurp_recorded, withRepository ) import Darcs.Patch ( RepoPatch ) @@ -75,11 +77,6 @@ commandAdvancedOptions = [], commandBasicOptions = [files, directories, pending, nullFlag, matchOne, workingRepoDir] } - -showManifest :: DarcsCommand -showManifest = commandAlias "manifest" showFiles { - commandCommand = manifestCmd toListManifest -} toListFiles, toListManifest :: [DarcsFlag] -> Slurpy -> [FilePath] toListFiles opts = filesDirs (NoFiles `notElem` opts) (NoDirectories `notElem` opts) diff --git a/src/Darcs/Commands/ShowIndex.lhs b/src/Darcs/Commands/ShowIndex.lhs --- a/src/Darcs/Commands/ShowIndex.lhs +++ b/src/Darcs/Commands/ShowIndex.lhs @@ -25,10 +25,12 @@ {-# OPTIONS_GHC -cpp #-} {-# LANGUAGE CPP #-} #include "gadts.h" -module Darcs.Commands.ShowIndex ( showIndex, showPristine ) where +module Darcs.Commands.ShowIndex ( showIndex + , showPristineCmd -- for alias + ) where import Darcs.Arguments ( DarcsFlag(..), workingRepoDir, files, directories, nullFlag ) -import Darcs.Commands ( DarcsCommand(..), nodefaults, commandAlias ) +import Darcs.Commands ( DarcsCommand(..), nodefaults ) import Darcs.Repository ( amInRepository, withRepository, ($-), readIndex ) import Darcs.Repository.State ( readRecorded ) @@ -57,16 +59,6 @@ commandArgdefaults = nodefaults, commandAdvancedOptions = [], commandBasicOptions = [files, directories, nullFlag, workingRepoDir] } - -showPristine :: DarcsCommand -showPristine = commandAlias "pristine" showIndex { - commandCommand = showPristineCmd, - commandDescription = "Dump contents of pristine cache.", - commandHelp = - "The `darcs show pristine' command lists all version-controlled files " ++ - "and directories along with the hashes of their pristine copies. " ++ - "For files, the fields correspond to file size, sha256 of the pristine " ++ - "file content and the filename." } dump :: [DarcsFlag] -> Tree IO -> IO () dump opts tree = do diff --git a/src/Darcs/Commands/Unrecord.lhs b/src/Darcs/Commands/Unrecord.lhs --- a/src/Darcs/Commands/Unrecord.lhs +++ b/src/Darcs/Commands/Unrecord.lhs @@ -189,7 +189,7 @@ "will lose precious code by unpulling!\n" unpull :: DarcsCommand -unpull = (commandAlias "unpull" obliterate) +unpull = (commandAlias "unpull" Nothing obliterate) {commandHelp = unpullHelp, commandDescription = unpullDescription, commandCommand = unpullCmd} diff --git a/src/Darcs/Test/Email.hs b/src/Darcs/Test/Email.hs new file mode 100644 --- /dev/null +++ b/src/Darcs/Test/Email.hs @@ -0,0 +1,86 @@ +-- Copyright (C) 2002-2005,2007 David Roundy +-- Copyright (C) 2009 Reinier Lamers +-- +-- This program is free software; you can redistribute it and/or modify +-- it under the terms of the GNU General Public License as published by +-- the Free Software Foundation; either version 2, or (at your option) +-- any later version. +-- +-- This program is distributed in the hope that it will be useful, +-- but WITHOUT ANY WARRANTY; without even the implied warranty of +-- MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +-- GNU General Public License for more details. +-- +-- You should have received a copy of the GNU General Public License +-- along with this program; see the file COPYING. If not, write to +-- the Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor, +-- Boston, MA 02110-1301, USA. + +-- | This module contains unit tests of the code in 'Darcs.Email' +-- +-- These tests check whether the emails generated by darcs meet a few criteria. +-- We check for line length and non-ASCII characters. We apparently do not have +-- to check for CR-LF newlines because that's handled by sendmail. +module Darcs.Test.Email ( email_parsing, email_header_no_long_lines, + email_header_ascii_chars, email_header_lines_start, + email_header_no_empty_lines + ) where +import Data.Char ( isPrint ) +import qualified Data.ByteString as B ( length, unpack, null, head, filter, + cons, empty, foldr, ByteString ) +import qualified Data.ByteString.Char8 as BC ( unpack ) +import Test.Framework ( Test ) +import Test.Framework.Providers.QuickCheck2 ( testProperty ) +import Printer ( text, renderPS ) +import Darcs.Email ( make_email, read_email, formatHeader ) + +-- | Checks that darcs can read the emails it generates +email_parsing :: Test +email_parsing = testProperty "Checking that email can be parsed" $ \s -> + unlines ("":s++["", ""]) == + BC.unpack (read_email (renderPS + $ make_email "reponame" [] (Just (text "contents\n")) + (text $ unlines s) (Just "filename"))) + +-- | Check that formatHeader never creates lines longer than 78 characters +-- (excluding the carriage return and line feed) +email_header_no_long_lines :: Test +email_header_no_long_lines = + testProperty "Checking email header line length" $ \field value -> + let cleanField = clean_field_string field + in not $ any (>78) $ map B.length $ bs_lines $ formatHeader cleanField value + +-- Check that an email header does not contain non-ASCII characters +-- formatHeader doesn't escape field names, there is no such thing as non-ascii +-- field names afaik +email_header_ascii_chars :: Test +email_header_ascii_chars = + testProperty "Checking email for illegal characters" $ \field value -> + let cleanField = clean_field_string field + in not (any (>127) (B.unpack (formatHeader cleanField value))) + +-- Check that header the second and later lines of a header start with a space +email_header_lines_start :: Test +email_header_lines_start = + testProperty "Checking for spaces at start of folded email header lines" $ \field value -> + let headerLines = bs_lines (formatHeader cleanField value) + cleanField = clean_field_string field + in all (\l -> B.null l || B.head l == 32) (tail headerLines) + +-- Checks that there are no lines in email headers with only whitespace +email_header_no_empty_lines :: Test +email_header_no_empty_lines = + testProperty "Checking that there are no empty lines in email headers" $ \field value -> + let headerLines = bs_lines (formatHeader cleanField value) + cleanField = clean_field_string field + in all (not . B.null . B.filter (not . (`elem` [10, 32, 9]))) headerLines + +bs_lines :: B.ByteString -> [B.ByteString] +bs_lines = finalizeFold . B.foldr splitAtLines (B.empty, []) + where splitAtLines 10 (thisLine, prevLines) = (B.empty, thisLine:prevLines) + splitAtLines c (thisLine, prevLines) = (B.cons c thisLine, prevLines) + finalizeFold (lastLine, otherLines) = lastLine : otherLines + +clean_field_string :: String -> String +clean_field_string = filter (\c -> isPrint c && c < '\x80' && c /= ':') + diff --git a/src/Darcs/Test/Patch/QuickCheck.hs b/src/Darcs/Test/Patch/QuickCheck.hs new file mode 100644 --- /dev/null +++ b/src/Darcs/Test/Patch/QuickCheck.hs @@ -0,0 +1,782 @@ +{-# OPTIONS_GHC -fno-warn-deprecations -fno-warn-orphans -fglasgow-exts #-} +{-# LANGUAGE CPP, UndecidableInstances, ScopedTypeVariables #-} + +#include "gadts.h" +module Darcs.Test.Patch.QuickCheck ( WithStartState, RepoModel, Tree, +#ifndef GADT_WITNESSES + merge_examples, commute_examples, triple_examples, +#endif + prop_consistent_tree_flattenings, prop_fail, + prop_is_mergeable, + flattenOne, testConditional, + commutePairFromTree, mergePairFromTree, + commuteTripleFromTree, + commutePairFromTWFP, mergePairFromTWFP, getPairs, getTriples, + patchFromTree, + quickCheck, real_patch_loop_examples, shrink + ) where + +import Control.Arrow ( (***) ) +import Control.Monad ( liftM, replicateM, mplus, mzero ) +import qualified Data.ByteString.Char8 as BC (pack) +import qualified Data.ByteString as B (ByteString) +import Test.QuickCheck +import Test.Framework ( Test ) +import Test.Framework.Providers.QuickCheck2 ( testProperty ) +import Darcs.Witnesses.Sealed +import Darcs.Patch ( Patch ) +import Darcs.Witnesses.Ordered +import Darcs.Patch.Patchy (--showPatch, + Invert(..), Commute(..)) +import Darcs.Patch.Prim (Prim(..), Effect(..), FilePatchType(..), FromPrim(..), is_identity ) +import Darcs.Patch.Real ( RealPatch, prim2real ) +--import Darcs.ColorPrinter ( errorDoc ) +--import Darcs.ColorPrinter ( traceDoc ) +import Darcs.Witnesses.Show +--import Printer ( greenText, ($$) ) +import Darcs.Patch.FileName ( FileName, fp2fn ) + +#include "impossible.h" + + +#ifndef GADT_WITNESSES +instance Eq (a C(x y)) => Eq (Sealed2 a) where + (Sealed2 x) == (Sealed2 y) = x == y +#endif + +instance Show2 Patch where + show2 = show + +#ifndef GADT_WITNESSES +triple_examples :: (FromPrim p, Commute p, Invert p) => [p :> p :> p] +triple_examples = [commuteTripleFromTree id $ + WithStartState (RepoModel { rmFileName = fp2fn "./file", rmFileContents = [] }) + (ParTree + (SeqTree (FP (fp2fn "./file") (Hunk 0 [] [BC.pack "g"])) + (SeqTree (FP (fp2fn "./file") (Hunk 1 [] [BC.pack "j"])) + (SeqTree (FP (fp2fn "./file") (Hunk 0 [] [BC.pack "s"])) NilTree))) + (SeqTree (FP (fp2fn "./file") (Hunk 0 [] [BC.pack "e"])) NilTree)) + ,commuteTripleFromTree id $ + WithStartState (RepoModel { rmFileName = fp2fn "./file", + rmFileContents = [BC.pack "j"] }) + (ParTree + (SeqTree (FP (fp2fn "./file") (Hunk 0 [] [BC.pack "s"])) + (ParTree + (SeqTree (FP (fp2fn "./file") (Hunk 1 [BC.pack "j"] [])) NilTree) + (SeqTree (FP (fp2fn "./file") (Hunk 1 [BC.pack "j"] [])) NilTree))) + (SeqTree (FP (fp2fn "./file") (Hunk 0 [BC.pack "j"] [])) NilTree)) + ] + + +merge_examples :: (FromPrim p, Commute p, Invert p) => [p :\/: p] +merge_examples = map (mergePairFromCommutePair id) commute_examples + +commute_examples :: (FromPrim p, Commute p) => [p :> p] +commute_examples = [ + commutePairFromTWFP id $ + WithStartState (RepoModel { rmFileName = fp2fn "./file", rmFileContents = [] }) + (TWFP 3 + (ParTree + (SeqTree (FP (fp2fn "./file") (Hunk 0 [] [BC.pack "h"])) NilTree) + (SeqTree (FP (fp2fn "./file") (Hunk 0 [] [BC.pack "b"])) + (SeqTree (FP (fp2fn "./file") (Hunk 0 [] [BC.pack "f"])) + (SeqTree (FP (fp2fn "./file") (Hunk 0 [] [BC.pack "v"])) + (SeqTree (FP (fp2fn "./file") (Hunk 1 [BC.pack "f"] [])) NilTree)))))), + commutePairFromTWFP id $ + WithStartState + (RepoModel { rmFileName = fp2fn "./file", + rmFileContents = [BC.pack "f",BC.pack "s",BC.pack "d"] }) + (TWFP 3 + (ParTree + (SeqTree (FP (fp2fn "./file") (Hunk 2 [BC.pack "d"] [])) NilTree) + (ParTree + (SeqTree (FP (fp2fn "./file") (Hunk 0 [BC.pack "f"] [])) NilTree) + (SeqTree (FP (fp2fn "./file") (Hunk 0 [BC.pack "f"] [])) + (SeqTree (FP (fp2fn "./file") (Hunk 0 [BC.pack "s",BC.pack "d"] [])) + (SeqTree (FP (fp2fn "./file") (Hunk 0 [] [BC.pack "v"])) NilTree)))))), +{- commutePairFromTWFP id $ + WithStartState + (RepoModel { rmFileName = fp2fn "./file", + rmFileContents = [BC.pack "f",BC.pack "u", + BC.pack "s",BC.pack "d"] }) + (TWFP 5 + (ParTree + (SeqTree (FP (fp2fn "./file") (Hunk 4 [] [BC.pack "x"])) + (SeqTree (FP (fp2fn "./file") (Hunk 3 [BC.pack "d"] [])) NilTree)) + (ParTree + (SeqTree (FP (fp2fn "./file") (Hunk 0 [BC.pack "f",BC.pack "u"] [])) NilTree) + (SeqTree (FP (fp2fn "./file") (Hunk 0 [BC.pack "f"] [])) + (SeqTree (FP(fp2fn "./file") (Hunk 0 [BC.pack "u",BC.pack "s",BC.pack "d"] [])) + (SeqTree (FP (fp2fn "./file") (Hunk 0 [] [BC.pack "a"])) + (SeqTree (FP (fp2fn "./file") (Hunk 0 [BC.pack "a"] [])) NilTree))))))),-} + commutePairFromTree id $ + WithStartState (RepoModel { rmFileName = fp2fn "./file", + rmFileContents = [BC.pack "n",BC.pack "t",BC.pack "h"] }) + (ParTree + (SeqTree (FP (fp2fn "./file") (Hunk 0 [BC.pack "n",BC.pack "t",BC.pack "h"] [])) + NilTree) + (SeqTree (FP (fp2fn "./file") (Hunk 2 [BC.pack "h"] [])) + (SeqTree (FP (fp2fn "./file") (Hunk 0 [BC.pack "n"] [])) + (SeqTree (FP (fp2fn "./file") (Hunk 0 [BC.pack "t"] [])) NilTree)))), + commutePairFromTree id $ + WithStartState (RepoModel { rmFileName = fp2fn "./file", rmFileContents = [] }) + (ParTree + (SeqTree (FP (fp2fn "./file") (Hunk 0 [] [BC.pack "n"])) NilTree) + (SeqTree (FP (fp2fn "./file") (Hunk 0 [] [BC.pack "i"])) + (SeqTree (FP (fp2fn "./file") (Hunk 0 [] [BC.pack "i"])) NilTree))), + commutePairFromTree id $ + WithStartState (RepoModel { rmFileName = fp2fn "./file", rmFileContents = [] }) + (ParTree + (SeqTree (FP (fp2fn "./file") (Hunk 0 [] [BC.pack "c"])) + (ParTree + (SeqTree (FP (fp2fn "./file") (Hunk 0 [BC.pack "c"] [BC.pack "r"])) NilTree) + (SeqTree (FP (fp2fn "./file") (Hunk 0 [] [BC.pack "h"])) + (SeqTree (FP (fp2fn "./file") (Hunk 0 [] [BC.pack "d"])) NilTree)))) + (SeqTree (FP (fp2fn "./file") (Hunk 0 [] [BC.pack "f"])) NilTree)), + commutePairFromTWFP id $ + WithStartState (RepoModel { rmFileName = fp2fn "./file", rmFileContents = [] }) + (TWFP 1 + (ParTree + (ParTree + (SeqTree (FP (fp2fn "./file") (Hunk 0 [] [BC.pack "t"])) NilTree) + (SeqTree (FP (fp2fn "./file") (Hunk 0 [] [BC.pack "t"])) NilTree)) + (SeqTree (FP (fp2fn "./file") (Hunk 0 [] [BC.pack "f"])) NilTree))), + commutePairFromTWFP id $ + WithStartState (RepoModel { rmFileName = fp2fn "./file", + rmFileContents = [BC.pack "f",BC.pack " r", + BC.pack "c",BC.pack "v"] }) + (TWFP 4 + (ParTree + (SeqTree (FP (fp2fn "./file") (Hunk 2 [BC.pack "c",BC.pack "v"] [])) + (ParTree + (SeqTree (FP (fp2fn "./file") (Hunk 1 [BC.pack "r"] [])) + (SeqTree (FP (fp2fn "fi le") (Hunk 0 [BC.pack "f"] [])) NilTree)) + (SeqTree (FP (fp2fn "./file") (Hunk 0 [BC.pack "f",BC.pack "r"] [])) + (SeqTree (FP (fp2fn "./file") (Hunk 0 [] [BC.pack "y"])) NilTree)))) + (SeqTree (FP (fp2fn "./file") (Hunk 3 [BC.pack "v"] [])) NilTree))), + commutePairFromTree id $ + WithStartState (RepoModel { rmFileName = fp2fn "./file", rmFileContents = [] }) + (ParTree + (SeqTree (FP (fp2fn "./file") (Hunk 0 [] [BC.pack "z"])) NilTree) + (ParTree + (SeqTree (FP (fp2fn "./file") (Hunk 0 [] [BC.pack "f"])) NilTree) + (ParTree + (SeqTree (FP (fp2fn "./file") (Hunk 0 [] [BC.pack "r"])) NilTree) + (SeqTree (FP (fp2fn "./file") (Hunk 0 [] [BC.pack "d"])) NilTree)))) + , commutePairFromTree id $ + WithStartState (RepoModel { rmFileName = fp2fn "./file", + rmFileContents = [BC.pack "t",BC.pack "r", + BC.pack "h"] }) + (ParTree + (ParTree + (SeqTree (FP (fp2fn "./file") (Hunk 0 [BC.pack "t",BC.pack "r",BC.pack "h"] [])) + NilTree) + (SeqTree (FP (fp2fn "./file") (Hunk 0 [] [BC.pack "o"])) NilTree)) + (SeqTree (FP (fp2fn "./file") (Hunk 0 [BC.pack "t"] [])) + (SeqTree (FP (fp2fn "./file") (Hunk 1 [BC.pack "h"] [])) NilTree))) + , commutePairFromTWFP id $ + WithStartState (RepoModel { rmFileName = fp2fn "./file", rmFileContents = [] }) $ + TWFP 2 + (ParTree + (SeqTree (FP (fp2fn "./file") (Hunk 0 [] [BC.pack "h"])) NilTree) + (SeqTree (FP (fp2fn "./file") (Hunk 0 [] [BC.pack "y"])) + (SeqTree (FP (fp2fn "./file") (Hunk 1 [] [BC.pack "m"])) + (SeqTree (FP (fp2fn "./file") (Hunk 0 [] [BC.pack "v"])) NilTree)))) + , commutePairFromTree id $ + WithStartState (RepoModel {rmFileName = fp2fn "./file",rmFileContents = [] }) + (ParTree + (SeqTree (FP (fp2fn "./file") (Hunk 0 [] [BC.pack "p"])) + (SeqTree (FP (fp2fn "./file") (Hunk 0 [BC.pack "p"] [])) + (SeqTree (FP (fp2fn "./file") (Hunk 0 [] [BC.pack "c"])) NilTree))) + (SeqTree (FP (fp2fn "./file") (Hunk 0 [] [BC.pack "z"])) NilTree)) + , commutePairFromTree id $ + WithStartState (RepoModel { rmFileName = fp2fn "./file", rmFileContents = [] }) + (ParTree + (SeqTree (FP (fp2fn "./file") (Hunk 0 [] [BC.pack "j" ])) + (SeqTree (FP (fp2fn "./file") (Hunk 0 [BC.pack "j"] [])) NilTree)) + (SeqTree (FP (fp2fn "./file") (Hunk 0 [] [BC.pack "v"])) NilTree)) + , commutePairFromTree id $ + WithStartState (RepoModel { rmFileName = fp2fn "./file", rmFileContents = [] }) + (ParTree + (SeqTree (FP (fp2fn "./file") (Hunk 0 [] [BC.pack "v"])) NilTree) + (SeqTree (FP (fp2fn "./file") (Hunk 0 [] [BC.pack "j" ])) + (SeqTree (FP (fp2fn "./file") (Hunk 0 [BC.pack "j"] [])) NilTree))) + , commutePairFromTree id $ + WithStartState (RepoModel { rmFileName = fp2fn "./file", + rmFileContents = [BC.pack "x",BC.pack "c"] }) + (ParTree + (SeqTree (FP (fp2fn "./file") (Hunk 0 [] [BC.pack "h"])) + (ParTree + (SeqTree (FP (fp2fn "./file") (Hunk 2 [BC.pack "c"] [])) NilTree) + (SeqTree (FP (fp2fn "./file") (Hunk 1 [BC.pack "x"] [])) + (SeqTree (FP (fp2fn "./file") (Hunk 0 [] [BC.pack "j"])) NilTree)))) + (SeqTree (FP (fp2fn "./file") (Hunk 0 [] [BC.pack "l"])) NilTree)) + , commutePairFromTree id $ + WithStartState (RepoModel { rmFileName = fp2fn "./file", rmFileContents = [] }) + (ParTree + (SeqTree (FP (fp2fn "./file") (Hunk 0 [] (packStringLetters "s"))) NilTree) + (SeqTree (FP (fp2fn "./file") (Hunk 0 [] (packStringLetters "k"))) + (SeqTree (FP (fp2fn "./file") (Hunk 0 (packStringLetters "k") [])) + (SeqTree (FP (fp2fn "./file") (Hunk 0 [] (packStringLetters "m"))) + (SeqTree (FP (fp2fn "./file") (Hunk 0 (packStringLetters "m") [])) NilTree))))) + ] +#endif + +-- | Turns a condition and a test function into a conditional quickcheck +-- property that can be run by test-framework. +testConditional :: (Arbitrary p, Show p, Show q) => String -- ^ Test name + -> (p -> Bool) -- ^ Condition + -> (p -> Maybe q) -- ^ Test function + -> Test +testConditional name nottrivial t = testProperty name t' + where t' p = nottrivial p ==> case t p of + Nothing -> True + Just q -> error $ show q + +data RepoModel C(x) + = RepoModel { + rmFileName :: !FileName, + rmFileContents :: [B.ByteString] + } deriving (Eq) + +instance Show (RepoModel C(x)) where + showsPrec d rm = showParen (d > app_prec) $ + showString "RepoModel { rmFileName = " . showsPrec 0 (rmFileName rm) . + showString ", rmFileContents = " . showsPrec 0 (rmFileContents rm) . + showString " }" + +instance Show1 RepoModel where + showsPrec1 = showsPrec + +#ifdef GADT_WITNESSES +-- | The initial repository state, to be used as an argument to the @RepoModel@ +-- data type. +data InitRepoModel -- this ought to be defined somewhere central as the unique starting state +#endif + +-- | The initial repository model. The repository contains a single file named +-- @./file@, which is empty. +initRepoModel :: RepoModel C(InitRepoModel) +initRepoModel = RepoModel { rmFileName = fp2fn "./file", rmFileContents = [] } +rebuildRepoModel :: RepoModel C(x) -> RepoModel C(y) +rebuildRepoModel rm = RepoModel { rmFileName = rmFileName rm, rmFileContents = rmFileContents rm } + +-- | A combination of a patch and its final state. The state, in this module, is +-- typically represented by a 'RepoModel' value. The @px@ type is typically a +-- patch type applied to its pre-state, e.g. @Prim x@. +data WithEndState px s C(y) = WithEndState { wesPatch :: px C(y), _wesState :: s C(y) } + +-- | A type class to generate arbitrary values, threading a state through the +-- arbitrary calls. So this can be used to generate a patch that comes after +-- another patch. The post-state of the generated patch is hidden by the +-- 'Sealed'. +class ArbitraryState s p where + arbitraryState :: s C(x) -> Gen (Sealed (WithEndState (p C(x)) s)) + -- does a coarbitrary make sense? + +-- | Generate a patch to a certain state. +class ArbitraryStateIn s p where + arbitraryStateIn :: s C(x) -> Gen (p C(x)) + +instance ArbitraryState RepoModel Prim where + arbitraryState rm = oneof [arbitraryFP rm] + +instance Arbitrary (Sealed2 (FL Prim)) where + arbitrary = do Sealed2 ps1 <- liftM (unseal (seal2 . wesPatch)) $ arbitraryState initRepoModel + return $ Sealed2 $ mapFL_FL make_identity_identity ps1 + where make_identity_identity :: Prim C(x y) -> Prim C(x y) + make_identity_identity p | IsEq <- is_identity p = identity + | otherwise = p + +instance Arbitrary (Sealed2 (FL (WithState RepoModel Prim))) where + arbitrary = liftM (unseal (seal2 . wesPatch)) $ arbitraryState initRepoModel + +prop_consistent_tree_flattenings :: Sealed (WithStartState RepoModel (Tree Prim)) -> Bool +prop_consistent_tree_flattenings (Sealed (WithStartState start t)) + = fromJust $ + do Sealed (G2 flat) <- return $ flattenTree $ mapTree prim2real t + rms <- return $ map (applyPatch start) flat + return $ and $ zipWith assert_equal_fst (zip rms flat) (tail $ zip rms flat) + +assert_equal_fst :: (Eq a, Show a, Show b, Show c) => (a, b) -> (a, c) -> Bool +assert_equal_fst (x,bx) (y,by) + | x == y = True + | otherwise = error ("Not really equal:\n" ++ show x ++ "\nand\n" ++ show y + ++ "\ncoming from\n" ++ show bx ++ "\nand\n" ++ show by) + +-- WithState and prop_fail are handy for debugging arbitrary code +data WithState s p C(x y) = WithState (s C(x)) (p C(x y)) (s C(y)) + deriving Show + +data WithStartState s p C(x) = WithStartState (s C(x)) (p C(x)) + +instance (Show1 s, Show1 p) => Show (WithStartState s p C(x)) where + showsPrec d (WithStartState s p) = showParen (d > app_prec) $ showString "WithStartState " . + showsPrec1 (app_prec + 1) s . showString " " . + showsPrec1 (app_prec + 1) p + +instance (Show1 s, Show1 p) => Show1 (WithStartState s p) where + showsPrec1 = showsPrec + +prop_fail :: Int -> Tree Prim C(x) -> Bool +prop_fail n xs = sizeTree xs < n + +instance ArbitraryState s p => ArbitraryState s (WithState s p) where + arbitraryState rm = do xandrm' <- arbitraryState rm + flip unseal xandrm' $ \(WithEndState x rm') -> + return $ seal $ WithEndState (WithState rm x rm') rm' + +instance ArbitraryState s p => ArbitraryState s (FL p) where + arbitraryState rm1 = sized $ \n -> do k <- choose (0, n) + arbitraryList k rm1 + where arbitraryList :: FORALL(x) Int -> s C(x) -> Gen (Sealed (WithEndState (FL p C(x)) s)) + arbitraryList 0 rm = return $ seal $ WithEndState NilFL rm + arbitraryList (n+1) rm = do Sealed (WithEndState x rm') <- arbitraryState rm + Sealed (WithEndState xs rm'') <- arbitraryList n rm' + return $ seal $ WithEndState (x :>: xs) rm'' + arbitraryList _ _ = impossible + +data Tree p C(x) where + NilTree :: Tree p C(x) + SeqTree :: p C(x y) -> Tree p C(y) -> Tree p C(x) + ParTree :: Tree p C(x) -> Tree p C(x) -> Tree p C(x) + +mapTree :: (FORALL(y z) p C(y z) -> q C(y z)) -> Tree p C(x) -> Tree q C(x) +mapTree _ NilTree = NilTree +mapTree f (SeqTree p t) = SeqTree (f p) (mapTree f t) +mapTree f (ParTree t1 t2) = ParTree (mapTree f t1) (mapTree f t2) + +instance Show2 p => Show (Tree p C(x)) where + showsPrec _ NilTree = showString "NilTree" + showsPrec d (SeqTree a t) = showParen (d > app_prec) $ showString "SeqTree " . + showsPrec2 (app_prec + 1) a . showString " " . + showsPrec (app_prec + 1) t + showsPrec d (ParTree t1 t2) = showParen (d > app_prec) $ showString "ParTree " . + showsPrec (app_prec + 1) t1 . showString " " . + showsPrec (app_prec + 1) t2 + +instance Show2 p => Show1 (Tree p) where + showsPrec1 = showsPrec + +sizeTree :: Tree p C(x) -> Int +sizeTree NilTree = 0 +sizeTree (SeqTree _ t) = 1 + sizeTree t +sizeTree (ParTree t1 t2) = 1 + sizeTree t1 + sizeTree t2 + +-- newtype G1 l p C(x) = G1 { _unG1 :: l (p C(x)) } +newtype G2 l p C(x y) = G2 { unG2 :: l (p C(x y)) } + +flattenTree :: (Commute p) => Tree p C(z) -> Sealed (G2 [] (FL p) C(z)) +flattenTree NilTree = seal $ G2 $ return NilFL +flattenTree (SeqTree p t) = mapSeal (G2 . map (p :>:) . unG2) $ flattenTree t +flattenTree (ParTree t1 t2) = flip unseal (flattenTree t1) $ \gpss1 -> + flip unseal (flattenTree t2) $ \gpss2 -> + seal $ G2 $ + do ps1 <- unG2 gpss1 + ps2 <- unG2 gpss2 + ps2' :/\: ps1' <- return $ merge (ps1 :\/: ps2) + -- We can't prove that the existential type in the result + -- of merge will be the same for each pair of + -- ps1 and ps2. + map unsafeCoerceP [ps1 +>+ ps2', ps2 +>+ ps1'] + +instance ArbitraryState s p => ArbitraryStateIn s (Tree p) where + -- don't generate trees deeper than 5 with default QuickCheck size + arbitraryStateIn rm = sized $ \s -> arbitraryTree rm (s `div` 17) + +-- | Generate a tree of patches, bounded by the size @maxSize@. +arbitraryTree :: ArbitraryState s p => s C(x) -> Int -> Gen (Tree p C(x)) +arbitraryTree rm maxDepth + | maxDepth == 0 = return NilTree + | otherwise = frequency [(2, return NilTree) + ,(2, do Sealed (WithEndState p rm') <- arbitraryState rm + t <- arbitraryTree rm' maxDepth + return (SeqTree p t)) + ,(1, do t1 <- arbitraryTree rm (maxDepth - 1) + t2 <- arbitraryTree rm (maxDepth - 1) + return (ParTree t1 t2))] + + +shrinkWSSTree :: Sealed (WithStartState RepoModel (Tree Prim)) + -> [Sealed (WithStartState RepoModel (Tree Prim))] +shrinkWSSTree = unseal doShrinkWSSTree + where + doShrinkWSSTree wss@(WithStartState rm t) + = shrinkWSSTree' wss -- shrink the tree + `mplus` + do -- shrink the starting context + pos <- [0 .. length (rmFileContents rm) - 1] + let rmFileContents' = take pos (rmFileContents rm) ++ drop (pos+1) (rmFileContents rm) + t' = shrinkPosStart pos (canonizeTree t) + return $ seal $ WithStartState (rm { rmFileContents = rmFileContents' }) (canonizeTree t') + + +-- If we had a more general repo model, then Int would need to be more general too + +class ShrinkablePos p where + shrinkPos :: Int -> p C(x y) -> (p C(x y), Maybe Int) + shrinkPatch :: p C(x y) -> [(p C(x y), Maybe Int)] + nullPatch :: p C(x y) -> EqCheck C(x y) + +class ShrinkablePosStart p where + shrinkPosStart :: Int -> p C(x) -> p C(x) + +instance ShrinkablePos p => ShrinkablePosStart (Tree p) where + shrinkPosStart _ NilTree = NilTree + shrinkPosStart pos (SeqTree p t) + = let (p', mpos') = shrinkPos pos p + in case mpos' of + Nothing -> SeqTree p' t + Just pos' -> SeqTree p' (shrinkPosStart pos' t) + shrinkPosStart pos (ParTree t1 t2) = ParTree (shrinkPosStart pos t1) (shrinkPosStart pos t2) + +smartFP :: FileName -> FilePatchType C(x y) -> Prim C(x y) +smartFP _ (Hunk _ [] []) | avoidEmptyHunks = unsafeCoerceP Identity +smartFP fn filepatch = FP fn filepatch + +instance ShrinkablePos Prim where + shrinkPos pos (FP fn fp) = (smartFP fn *** id) (shrinkPos pos fp) + shrinkPos pos Identity = (Identity, Just pos) + shrinkPos _ _ = impossible + shrinkPatch (FP fn fp) = map (smartFP fn *** id) (shrinkPatch fp) + shrinkPatch Identity = [] + shrinkPatch _ = impossible + nullPatch (FP _ fp) = nullPatch fp + nullPatch Identity = IsEq + nullPatch _ = impossible + +avoidEmptyHunks :: Bool +avoidEmptyHunks = True + +instance ShrinkablePos FilePatchType where + shrinkPos pos (Hunk n old new) + | pos < n = (Hunk (n-1) old new, Just pos) + | pos >= n + length old = (Hunk n old new, Just (pos + length new - length old)) + | otherwise = (Hunk n (take pos' old ++ drop (pos'+1) old) new, Nothing) + where pos' = pos - n + shrinkPos _ _ = bug "foo1 in ShrinkablePos" + shrinkPatch (Hunk (n+1) [] []) = [(Hunk n [] [], Nothing)] + shrinkPatch (Hunk n old new) + = do i <- [0 .. length new - 1] + return (Hunk n old (take i new ++ drop (i+1) new), Just (n + i)) + shrinkPatch _ = bug "foo in ShrinkablePos" + nullPatch (Hunk _ [] []) = unsafeCoerceP IsEq -- is this safe? + nullPatch _ = NotEq + +shrinkWSSTree' + -- start a new line here because apparently ' confuses CPP.. + :: WithStartState RepoModel (Tree Prim) C(x) + -> [Sealed (WithStartState RepoModel (Tree Prim))] +shrinkWSSTree' (WithStartState _ NilTree) = [] +shrinkWSSTree' (WithStartState rm t@(SeqTree p t')) + = return (seal (WithStartState (applyPatch rm p) (canonizeTree t'))) + `mplus` + liftM (seal . WithStartState rm) (map canonizeTree $ shrinkTree t) +shrinkWSSTree' (WithStartState rm t@(ParTree _ _)) + = liftM (seal . WithStartState rm) (map canonizeTree $ shrinkTree t) + +-- canonize a tree, removing any dead branches +canonizeTree :: ShrinkablePos p => Tree p C(x) -> Tree p C(x) +canonizeTree NilTree = NilTree +canonizeTree (ParTree t1 t2) + | NilTree <- canonizeTree t1 = canonizeTree t2 + | NilTree <- canonizeTree t2 = canonizeTree t1 + | otherwise = ParTree (canonizeTree t1) (canonizeTree t2) +canonizeTree (SeqTree p t) | IsEq <- nullPatch p = canonizeTree t + | otherwise = SeqTree p (canonizeTree t) + +-- shrink the tree without changing the starting context +shrinkTree :: ShrinkablePos p => Tree p C(x) -> [Tree p C(x)] +shrinkTree NilTree = [] +shrinkTree (SeqTree p t) = do case nullPatch p of + IsEq -> return t + NotEq -> mzero + `mplus` + do (p', pos) <- shrinkPatch p + return (SeqTree p' (maybe id shrinkPosStart pos t)) + `mplus` + do t' <- shrinkTree t + return (SeqTree p t') +shrinkTree (ParTree t1 t2) = [t1, t2] + `mplus` + do t1' <- shrinkTree t1 + return (ParTree t1' t2) + `mplus` + do t2' <- shrinkTree t2 + return (ParTree t1 t2') + +instance Arbitrary (Sealed (WithStartState RepoModel (Tree Prim))) where + arbitrary = do Sealed (WithStartState rm tree) <- + liftM (seal . WithStartState initRepoModel) (arbitraryStateIn initRepoModel) + return $ Sealed $ WithStartState rm (canonizeTree tree) + shrink = shrinkWSSTree + +prop_is_mergeable :: forall p C(x) . (FromPrim p, Commute p) + => Sealed (WithStartState RepoModel (Tree Prim)) + -> Maybe (Tree p C(x)) +prop_is_mergeable (Sealed (WithStartState _ t)) + = case flattenOne t of + Sealed ps -> let _ = seal2 ps :: Sealed2 (FL p) + in case lengthFL ps of + _ -> Nothing + +flattenOne :: (FromPrim p, Commute p) => Tree Prim C(x) -> Sealed (FL p C(x)) +flattenOne NilTree = seal NilFL +flattenOne (SeqTree p t) = flip unseal (flattenOne t) $ \ps -> seal (fromPrim p :>: ps) +flattenOne (ParTree t1 t2) = + flip unseal (flattenOne t1) $ \ps1 -> + flip unseal (flattenOne t2) $ \ps2 -> + --traceDoc (greenText "flattening two parallel series: ps1" $$ showPatch ps1 $$ + -- greenText "ps2" $$ showPatch ps2) $ + case merge (ps1 :\/: ps2) of + ps2' :/\: _ -> seal (ps1 +>+ ps2') + +instance Arbitrary (Sealed2 (FL RealPatch)) where + arbitrary = do Sealed (WithStartState _ tree) <- arbitrary :: Gen (Sealed (WithStartState RepoModel (Tree Prim))) + return $ unseal seal2 (flattenOne tree) + +instance Arbitrary (Sealed2 RealPatch) where + arbitrary = do Sealed (WithStartState _ tree) <- arbitrary :: Gen (Sealed (WithStartState RepoModel (Tree Prim))) + case mapFL seal2 `unseal` flattenOne tree of + [] -> return $ seal2 $ fromPrim Identity + ps -> elements ps + +instance (Arbitrary (Sealed2 (FL p)), Commute p) => Arbitrary (Sealed2 (p :\/: p)) where + arbitrary = do Sealed2 (a :> b) <- arbitrary + case commute (a :> b) of + Just (b' :> _) -> return (seal2 (a :\/: b')) + Nothing -> arbitrary + +instance Arbitrary (Sealed2 (FL p)) => Arbitrary (Sealed2 (p :> p)) where + arbitrary = do Sealed2 ps <- arbitrary + let pairs = getPairs ps + case pairs of + [] -> arbitrary + _ -> elements pairs + +instance (Invert p, Arbitrary (Sealed2 (FL p))) => Arbitrary (Sealed2 (p :> p :> p)) where + arbitrary = do Sealed2 ps <- arbitrary + return $ last_triple ps + where last_triple :: FL p C(x y) -> Sealed2 (p :> p :> p) + last_triple NilFL = seal2 $ identity :> identity :> identity + last_triple (a :>: NilFL) = seal2 $ a :> invert a :> identity + last_triple (a :>: b :>: NilFL) = seal2 $ invert a :> a :> b + last_triple (a :>: b :>: c :>: NilFL) = seal2 $ a :> b :> c + last_triple (_ :>: xs) = last_triple xs + +data TreeWithFlattenPos p C(x) = TWFP Int (Tree p C(x)) + +commutePairFromTWFP :: (FromPrim p, Commute p) + => (FORALL (y z) (p :> p) C(y z) -> t) + -> (WithStartState RepoModel (TreeWithFlattenPos Prim) C(x) -> t) +commutePairFromTWFP handlePair (WithStartState _ (TWFP n t)) + = unseal2 handlePair $ + let xs = unseal getPairs (flattenOne t) + in if length xs > n && n >= 0 then xs!!n else seal2 (fromPrim Identity :> fromPrim Identity) + +commutePairFromTree :: (FromPrim p, Commute p) + => (FORALL (y z) (p :> p) C(y z) -> t) + -> (WithStartState RepoModel (Tree Prim) C(x) -> t) +commutePairFromTree handlePair (WithStartState _ t) + = unseal2 handlePair $ + case flattenOne t of + Sealed ps -> + let xs = --traceDoc (greenText "I'm flattening one to get:" $$ showPatch ps) $ + getPairs ps + in if null xs then seal2 (fromPrim Identity :> fromPrim Identity) else last xs + +commuteTripleFromTree :: (FromPrim p, Commute p) + => (FORALL (y z) (p :> p :> p) C(y z) -> t) + -> (WithStartState RepoModel (Tree Prim) C(x) -> t) +commuteTripleFromTree handle (WithStartState _ t) + = unseal2 handle $ + case flattenOne t of + Sealed ps -> + let xs = --traceDoc (greenText "I'm flattening one to get:" $$ showPatch ps) $ + getTriples ps + in if null xs + then seal2 (fromPrim Identity :> fromPrim Identity :> fromPrim Identity) + else last xs + +mergePairFromCommutePair :: (Commute p, Invert p) + => (FORALL (y z) (p :\/: p) C(y z) -> t) + -> (FORALL (y z) (p :> p) C(y z) -> t) +mergePairFromCommutePair handlePair (a :> b) + = case commute (a :> b) of + Just (b' :> _) -> handlePair (a :\/: b') + Nothing -> handlePair (b :\/: b) + +-- impredicativity problems mean we can't use (.) in the definitions below + +mergePairFromTWFP :: (FromPrim p, Commute p, Invert p) + => (FORALL (y z) (p :\/: p) C(y z) -> t) + -> (WithStartState RepoModel (TreeWithFlattenPos Prim) C(x) -> t) +mergePairFromTWFP x = commutePairFromTWFP (mergePairFromCommutePair x) + +mergePairFromTree :: (FromPrim p, Commute p, Invert p) + => (FORALL (y z) (p :\/: p) C(y z) -> t) + -> (WithStartState RepoModel (Tree Prim) C(x) -> t) +mergePairFromTree x = commutePairFromTree (mergePairFromCommutePair x) + +patchFromCommutePair :: (Commute p, Invert p) + => (FORALL (y z) p C(y z) -> t) + -> (FORALL (y z) (p :> p) C(y z) -> t) +patchFromCommutePair handle (_ :> b) = handle b + +patchFromTree :: (FromPrim p, Commute p, Invert p) + => (FORALL (y z) p C(y z) -> t) + -> (WithStartState RepoModel (Tree Prim) C(x) -> t) +patchFromTree x = commutePairFromTree (patchFromCommutePair x) + + +instance Show2 p => Show (TreeWithFlattenPos p C(x)) where + showsPrec d (TWFP n t) = showParen (d > app_prec) $ showString "TWFP " . + showsPrec (app_prec + 1) n . showString " " . + showsPrec1 (app_prec + 1) t + +instance Show1 (TreeWithFlattenPos Prim) where + show1 = show + +instance Arbitrary (Sealed (WithStartState RepoModel (TreeWithFlattenPos Prim))) where + arbitrary = do Sealed (WithStartState rm t) <- arbitrary + let num = unseal (length . getPairs) (flattenOneRP t) + if num == 0 then return $ Sealed $ WithStartState rm $ TWFP 0 NilTree + else do n <- choose (0, num - 1) + return $ Sealed $ WithStartState rm $ TWFP n t + where -- just used to get the length. In principle this should be independent of the patch type. + flattenOneRP :: Tree Prim C(x) -> Sealed (FL RealPatch C(x)) + flattenOneRP = flattenOne + shrink (Sealed (WithStartState rm (TWFP n t))) = + [Sealed (WithStartState rm' (TWFP n' t')) | Sealed (WithStartState rm' t') <- shrink (Sealed (WithStartState rm t)), + n' <- [0..n]] + + +getPairs :: FL p C(x y) -> [Sealed2 (p :> p)] +getPairs NilFL = [] +getPairs (_:>:NilFL) = [] +getPairs (a:>:b:>:c) = seal2 (a:>b) : getPairs (b:>:c) + +getTriples :: FL p C(x y) -> [Sealed2 (p :> p :> p)] +getTriples NilFL = [] +getTriples (_:>:NilFL) = [] +getTriples (_:>:_:>:NilFL) = [] +getTriples (a:>:b:>:c:>:d) = seal2 (a:>b:>c) : getTriples (b:>:c:>:d) + +arbitraryFP :: RepoModel C(x) -> Gen (Sealed (WithEndState (Prim C(x)) RepoModel)) +arbitraryFP rm + = do (fp, newcontents) <- arbitraryFilePatchType (rmFileContents rm) + return $ seal $ WithEndState (FP (rmFileName rm) fp) (rebuildRepoModel (rm { rmFileContents = newcontents })) + +-- Really [B.ByteString] should be parametrised by x y, and the result tuple sealed on y +arbitraryFilePatchType :: [B.ByteString] -> Gen (FilePatchType C(x y), [B.ByteString]) +arbitraryFilePatchType contents = oneof [arbitraryHunk contents] + +arbitraryHunk :: [B.ByteString] -> Gen (FilePatchType C(x y), [B.ByteString]) +arbitraryHunk contents + = sized $ \n -> + do start <- choose (0, min n (length contents)) + (removelen, _) + <- frequency $ zip (if start == length contents then [1, 13, 0, 0] else [1, 3, 5, 3]) + [return (0, 0) + ,do xa <- choose (0, n) + return (0, xa) + ,do xr <- choose (1, min n (length contents - start)) + return (xr, 0) + ,do xr <- choose (1, min n (length contents - start)) + xa <- choose (0, n) + return (xr, xa) + ] + addlen <- choose (0, n) + additems <- replicateM addlen (do c <- choose ('a', 'z') + return $ BC.pack [c]) + let newcontents = take start contents ++ additems ++ drop (start + removelen) contents + return (Hunk start (take removelen $ drop start $ contents) additems, newcontents) + +class Applyable p where + applyPatch :: RepoModel C(x) -> p C(x y) -> RepoModel C(y) + +instance Applyable p => Applyable (FL p) where + applyPatch rm NilFL = rm + applyPatch rm (p :>: ps) = applyPatch (applyPatch rm p) ps + +instance Applyable RealPatch where + applyPatch rm p = applyPatch rm (effect p) + +instance Applyable Prim where + applyPatch (rm@RepoModel { rmFileName = filename, rmFileContents = oldcontents }) (FP filename' fp) + | filename == filename' = rebuildRepoModel (rm { rmFileContents = applyFilePatchType oldcontents fp }) + applyPatch rm Identity = rm + applyPatch _ _ = bug "We haven't defined applyPatch on Prim for all patch types." + +applyFilePatchType :: [B.ByteString] -> FilePatchType C(x y) -> [B.ByteString] +applyFilePatchType oldcontents (Hunk n old new) + = if take (length old) (drop n oldcontents) == old + then take n oldcontents ++ new ++ drop (n + length old) oldcontents + else error "Bad patch context" +applyFilePatchType _ _ = bug "We haven't defined applyFilePatchType for all patch types." + +packStringLetters :: String -> [B.ByteString] +packStringLetters = map (BC.pack . (:[])) + +real_patch_loop_examples :: [Sealed (WithStartState RepoModel (Tree Prim))] +real_patch_loop_examples = + [Sealed (WithStartState (RepoModel { rmFileName = fx, rmFileContents = [] }) + $ canonizeTree + (ParTree + (SeqTree (FP fx (Hunk 0 [] (packStringLetters "pkotufogbvdabnmbzajvolwviqebieonxvcvuvigkfgybmqhzuaaurjspd"))) + (ParTree + (SeqTree (FP fx (Hunk 46 (packStringLetters "qhzu") (packStringLetters "zafybdcokyjskcgnvhkbzpysaafnjjhcstgrczplxsfwagmh"))) + (ParTree + (ParTree + NilTree + (ParTree + (ParTree + (ParTree + (SeqTree (FP fx (Hunk 14 (packStringLetters "mbzajvolwviqebieonxvcvuvigkfgyb") (packStringLetters "vujnxnhvybvpouyciaabszfmgssezlwwjgnethvrpnfrkubphzvdgymjjoacppqps"))) + (ParTree + NilTree + (ParTree + (SeqTree (FP fx (Hunk 39 (packStringLetters "ssezlwwjgnethvrpnfrkubphzvdgymjjoacppqpsmzafybdcokyjskcgnvhkbz") (packStringLetters "wnesidpccwoiqiichxaaejdsyrhrusqljlcoro"))) + (ParTree + (ParTree + (SeqTree (FP fx (Hunk 11 (packStringLetters "abnvujnxnhvybvpouyciaabszfmgwnesidpccwoiqii") (packStringLetters "czfdhqkipdstfjycqaxwnbxrihrufdeyneqiiiafwzlmg"))) NilTree) + NilTree) + NilTree)) + (SeqTree (FP fx (Hunk 24 [] (packStringLetters "dihgmsotezucqdgxczvcivijootyvhlwymbiueufnvpwpeukmskqllalfe"))) NilTree)))) + (SeqTree (FP fx (Hunk 55 (packStringLetters "yjskcgnvhkbzpysaafnjjhcstgrczplxsfwagmhaaurjsp") (packStringLetters "xldhrutyhcyaqeezwujiguawfyawjjqlirxshjddvq"))) NilTree)) + (SeqTree (FP fx (Hunk 19 [] (packStringLetters "ooygwiyogqrqnytixqtmvdxx"))) + (SeqTree (FP fx (Hunk 25 (packStringLetters "yogqrqnytixqtmvdxxvolwviqebieonxvcvuvigkfgybmzafybdcokyjskcgnvhkbz") (packStringLetters "akhsmlbkdxnvfoikmiatfbpzdrsyykkpoxvvddeaspzxe"))) + (SeqTree (FP fx (Hunk 38 [] (packStringLetters "ji"))) + (ParTree + NilTree + (ParTree + NilTree + (ParTree + (ParTree + NilTree + (SeqTree (FP fx (Hunk 25 (packStringLetters "akhsmlbkdxnvfjioikmiatfbpzdrsyykkpoxvvddeaspzxepysaafnjjhcstgrczplxs") (packStringLetters "onjbhddskcj"))) + (SeqTree (FP fx (Hunk 38 [] (packStringLetters "fyscunxxxjjtyqpfxeznhtwvlphmp"))) NilTree))) + (ParTree + NilTree + (SeqTree (FP fx (Hunk 43 [] (packStringLetters "xcchzwmzoezxkmkhcmesplnjpqriypshgiqklgdnbmmkldnydiy"))) + (ParTree + NilTree + (SeqTree (FP fx (Hunk 63 (packStringLetters "plnjpqriypshgiqklgdnbmmkldnydiymiatfbpzdrsyykkpoxvvddeaspzxepysaafn") (packStringLetters "anjlzfdqbjqbcplvqvkhwjtkigp"))) NilTree))))))))))) + (ParTree + NilTree + NilTree))) + NilTree)) + NilTree)) + (ParTree + NilTree + (SeqTree (FP fx (Hunk 0 [] (packStringLetters "ti"))) + (SeqTree (FP fx (Hunk 0 (packStringLetters "t") (packStringLetters "ybcop"))) + (SeqTree (FP fx (Hunk 1 [] (packStringLetters "dvlhgwqlpaeweerqrhnjtfolczbqbzoccnvdsyqiefqitrqneralf"))) + (SeqTree (FP fx (Hunk 14 [] (packStringLetters "yairbjphwtnaerccdlfewujvjvmjakbc"))) + (SeqTree (FP fx (Hunk 50 [] (packStringLetters "xayvfuwaiiogginufnhsrmktpmlbvxiakjwllddkiyofyfw"))) + (ParTree + NilTree + NilTree)))))))))] + +fx :: FileName +fx = fp2fn "./F" diff --git a/src/Darcs/Test/Patch/Test.hs b/src/Darcs/Test/Patch/Test.hs new file mode 100644 --- /dev/null +++ b/src/Darcs/Test/Patch/Test.hs @@ -0,0 +1,682 @@ +-- Copyright (C) 2002-2003,2007 David Roundy +-- +-- This program is free software; you can redistribute it and/or modify +-- it under the terms of the GNU General Public License as published by +-- the Free Software Foundation; either version 2, or (at your option) +-- any later version. +-- +-- This program is distributed in the hope that it will be useful, +-- but WITHOUT ANY WARRANTY; without even the implied warranty of +-- MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +-- GNU General Public License for more details. +-- +-- You should have received a copy of the GNU General Public License +-- along with this program; see the file COPYING. If not, write to +-- the Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor, +-- Boston, MA 02110-1301, USA. + +{-# OPTIONS_GHC -cpp -fno-warn-deprecations -fglasgow-exts -fno-warn-orphans #-} +{-# LANGUAGE CPP #-} + +#include "gadts.h" + +module Darcs.Test.Patch.Test + ( prop_read_show, + prop_inverse_composition, prop_commute_twice, + prop_inverse_valid, prop_other_inverse_valid, + prop_commute_equivalency, prop_commute_either_order, + prop_commute_either_way, prop_merge_is_commutable_and_correct, + prop_merge_is_swapable, prop_merge_valid, + prop_unravel_three_merge, prop_unravel_seq_merge, + prop_unravel_order_independent, + prop_simple_smart_merge_good_enough, + prop_elegant_merge_good_enough, + prop_patch_and_inverse_is_identity, + quickmerge, check_patch, check_a_patch, verbose_check_a_patch, + prop_resolve_conflicts_valid, + test_patch, prop_commute_inverse, + subcommutes_inverse, subcommutes_nontrivial_inverse, + subcommutes_failure, + join_patches + ) where + +import Prelude hiding ( pi ) +import System.IO.Unsafe ( unsafePerformIO ) +import Test.QuickCheck +import Control.Monad ( liftM, liftM2, liftM3, liftM4, replicateM ) + +import Darcs.Patch.Info ( PatchInfo, patchinfo ) +import Darcs.Test.Patch.Check ( PatchCheck, + check_move, remove_dir, create_dir, + is_valid, insert_line, file_empty, file_exists, + delete_line, modify_file, create_file, remove_file, + do_check, do_verbose_check, FileContents(..) + ) +import Darcs.Patch.RegChars ( regChars ) +import ByteStringUtils ( linesPS ) +import qualified Data.ByteString as B ( ByteString, null, concat ) +import qualified Data.ByteString.Char8 as BC ( break, pack ) +import Darcs.Patch.FileName ( fn2fp ) +import qualified Data.Map as M ( mapMaybe ) + +import Darcs.Patch.Patchy ( Commute ) +import Darcs.Patch ( addfile, adddir, move, showPatch, + hunk, tokreplace, joinPatches, binary, + changepref, isMerger, invert, commute, merge, + readPatch, resolveConflicts, + effect, fromPrims, + unravel, merger, elegantMerge ) +import Darcs.Patch.Core ( Patch(..) ) +import Darcs.Patch.Prim ( Prim(..), DirPatchType(..), FilePatchType(..), + CommuteFunction, Perhaps(..), + subcommutes ) +import Printer ( renderPS ) +import Darcs.Witnesses.Ordered +import Darcs.Witnesses.Sealed ( Sealed(Sealed), unsafeUnseal, unseal ) + +#include "impossible.h" + +instance Eq Patch where + x == y = IsEq == (x =\/= y) + +instance Eq Prim where + x == y = IsEq == (x =\/= y) + +instance (Commute a, MyEq a) => Eq (FL a) where + x == y = IsEq == (x =\/= y) + +instance Arbitrary Patch where + arbitrary = sized arbpatch +-- coarbitrary p = coarbitrary (show p) + +instance Arbitrary Prim where + arbitrary = onepatchgen +-- coarbitrary = impossible + +hunkgen :: Gen Prim +hunkgen = do + i <- frequency [(1,choose (0,5)),(1,choose (0,35)), + (2,return 0),(3,return 1),(2,return 2),(1,return 3)] + j <- frequency [(1,choose (0,5)),(1,choose (0,35)), + (2,return 0),(3,return 1),(2,return 2),(1,return 3)] + if i == 0 && j == 0 then hunkgen + else liftM4 hunk filepathgen linenumgen + (replicateM i filelinegen) + (replicateM j filelinegen) + +tokreplacegen :: Gen Prim +tokreplacegen = do + f <- filepathgen + o <- tokengen + n <- tokengen + if o == n + then return $ tokreplace f "A-Za-z" "old" "new" + else return $ tokreplace f "A-Za-z_" o n + +twofilegen :: (FilePath -> FilePath -> Prim) -> Gen Prim +twofilegen p = do + n1 <- filepathgen + n2 <- filepathgen + if n1 /= n2 && (check_a_patch $ fromPrims $ (p n1 n2 :>: NilFL)) + then return $ p n1 n2 + else twofilegen p + +chprefgen :: Gen Prim +chprefgen = do + f <- oneof [return "color", return "movie"] + o <- tokengen + n <- tokengen + if o == n then return $ changepref f "old" "new" + else return $ changepref f o n + +simplepatchgen :: Gen Prim +simplepatchgen = frequency [(1,liftM addfile filepathgen), + (1,liftM adddir filepathgen), + (1,liftM3 binary filepathgen arbitrary arbitrary), + (1,twofilegen move), + (1,tokreplacegen), + (1,chprefgen), + (7,hunkgen) + ] + +onepatchgen :: Gen Prim +onepatchgen = oneof [simplepatchgen, (invert) `fmap` simplepatchgen] + +norecursgen :: Int -> Gen Patch +norecursgen 0 = PP `fmap` onepatchgen +norecursgen n = oneof [PP `fmap` onepatchgen,flatcompgen n] + +arbpatch :: Int -> Gen Patch +arbpatch 0 = PP `fmap` onepatchgen +arbpatch n = frequency [(3,PP `fmap` onepatchgen), + -- (1,compgen n), + (2,flatcompgen n), + (0,raw_merge_gen n), + (0,mergegen n), + (1,PP `fmap` onepatchgen) + ] + +unempty :: Arbitrary a => Gen [a] +unempty = do + as <- arbitrary + case as of + [] -> unempty + _ -> return as + +join_patches :: [Patch] -> Patch +join_patches = joinPatches . unsafeFL + +raw_merge_gen :: Int -> Gen Patch +raw_merge_gen n = do p1 <- arbpatch len + p2 <- arbpatch len + if (check_a_patch $ join_patches [invert p1,p2]) && + (check_a_patch $ join_patches [invert p2,p1]) + then case merge (p2 :\/: p1) of + _ :/\: p2' -> return p2' + else raw_merge_gen n + where len = if n < 15 then n`div`3 else 3 + +mergegen :: Int -> Gen Patch +mergegen n = do + p1 <- norecursgen len + p2 <- norecursgen len + if (check_a_patch $ join_patches [invert p1,p2]) && + (check_a_patch $ join_patches [invert p2,p1]) + then case merge (p2:\/:p1) of + p1' :/\: p2' -> + if check_a_patch $ join_patches [p1,p2'] + then return $ join_patches [p1,p2'] + else return $ join_patches [PP $ addfile "Error_in_mergegen", + PP $ addfile "Error_in_mergegen", + p1,p2,p1',p2'] + else mergegen n + where len = if n < 15 then n`div`3 else 3 + +arbpi :: Gen PatchInfo +arbpi = do n <- unempty + a <- unempty + l <- unempty + d <- unempty + return $ unsafePerformIO $ patchinfo n d a l + +instance Arbitrary PatchInfo where + arbitrary = arbpi +-- coarbitrary pi = coarbitrary (show pi) + +instance Arbitrary B.ByteString where + arbitrary = liftM BC.pack arbitrary +-- coarbitrary ps = coarbitrary (unpackPS ps) + +{- +plistgen :: Int -> Int -> Gen [Patch] +plistgen s n + | n <= 0 = return [] + | otherwise = do + next <- arbpatch s + rest <- plistgen s (n-1) + return $ next : rest + +compgen :: Int -> Gen Patch +compgen n = do + size <- choose (0,n) + myp <- liftM join_patches $ plistgen size ((n+1) `div` (size+1)) +-- here I assume we only want to consider valid patches... + if check_a_patch myp + then return myp + else compgen n +-} + +flatlistgen :: Int -> Gen [Patch] +flatlistgen n = replicateM n (PP `fmap` onepatchgen) + +flatcompgen :: Int -> Gen Patch +flatcompgen n = do + myp <- liftM (join_patches . regularize_patches) $ flatlistgen n + if check_a_patch myp + then return myp + else flatcompgen n + +-- resize to size 25, that means we'll get line numbers no greater +-- than 1025 using QuickCheck 2.1 +linenumgen :: Gen Int +linenumgen = frequency [(1,return 1), (1,return 2), (1,return 3), + (3,liftM (\n->1+abs n) (resize 25 arbitrary)) ] + +tokengen :: Gen String +tokengen = oneof [return "hello", return "world", return "this", + return "is", return "a", return "silly", + return "token", return "test"] + +toklinegen :: Gen String +toklinegen = liftM unwords $ replicateM 3 tokengen + +filelinegen :: Gen B.ByteString +filelinegen = liftM BC.pack $ + frequency [(1,map fromSafeChar `fmap` arbitrary),(5,toklinegen), + (1,return ""), (1,return "{"), (1,return "}") ] + +filepathgen :: Gen String +filepathgen = liftM fixpath badfpgen + +fixpath :: String -> String +fixpath "" = "test" +fixpath p = fpth p + +fpth :: String -> String +fpth ('/':'/':cs) = fpth ('/':cs) +fpth (c:cs) = c : fpth cs +fpth [] = [] + +newtype SafeChar = SS Char +instance Arbitrary SafeChar where + arbitrary = oneof $ map (return . SS) (['a'..'z']++['A'..'Z']++['1'..'9']++"0") + +fromSafeChar :: SafeChar -> Char +fromSafeChar (SS s) = s + +badfpgen :: Gen String +badfpgen = frequency [(1,return "test"), (1,return "hello"), (1,return "world"), + (1,map fromSafeChar `fmap` arbitrary), + (1,liftM2 (\a b-> a++"/"++b) filepathgen filepathgen) ] + +{- +instance Arbitrary Char where + arbitrary = oneof $ map return + (['a'..'z']++['A'..'Z']++['1'..'9']++['0','~','.',',','-','/']) +-} +-- coarbitrary c = coarbitrary (ord c) + +check_patch :: Patch -> PatchCheck Bool +check_a_patch :: Patch -> Bool +check_a_patch p = do_check $ do check_patch p + check_patch $ invert p +verbose_check_a_patch :: Patch -> Bool +verbose_check_a_patch p = do_verbose_check $ do check_patch p + check_patch $ invert p + +check_patch p | isMerger p = do + check_patch $ fromPrims $ effect p +check_patch (Merger _ _ _ _) = impossible +check_patch (Regrem _ _ _ _) = impossible +check_patch (ComP NilFL) = is_valid +check_patch (ComP (p:>:ps)) = + check_patch p >> check_patch (ComP ps) +check_patch (PP Identity) = is_valid +check_patch (PP (Split NilFL)) = is_valid +check_patch (PP (Split (p:>:ps))) = + check_patch (PP p) >> check_patch (PP (Split ps)) + +check_patch (PP (FP f RmFile)) = remove_file $ fn2fp f +check_patch (PP (FP f AddFile)) = create_file $ fn2fp f +check_patch (PP (FP f (Hunk line old new))) = do + file_exists $ fn2fp f + mapM_ (delete_line (fn2fp f) line) old + mapM_ (insert_line (fn2fp f) line) (reverse new) + is_valid +check_patch (PP (FP f (TokReplace t old new))) = + modify_file (fn2fp f) (try_tok_possibly t old new) +-- note that the above isn't really a sure check, as it leaves PSomethings +-- and PNothings which may have contained new... +check_patch (PP (FP f (Binary o n))) = do + file_exists $ fn2fp f + mapM_ (delete_line (fn2fp f) 1) (linesPS o) + file_empty $ fn2fp f + mapM_ (insert_line (fn2fp f) 1) (reverse $ linesPS n) + is_valid + +check_patch (PP (DP d AddDir)) = create_dir $ fn2fp d +check_patch (PP (DP d RmDir)) = remove_dir $ fn2fp d + +check_patch (PP (Move f f')) = check_move (fn2fp f) (fn2fp f') +check_patch (PP (ChangePref _ _ _)) = return True + +regularize_patches :: [Patch] -> [Patch] +regularize_patches patches = rpint [] patches + where rpint ok_ps [] = ok_ps + rpint ok_ps (p:ps) = + if check_a_patch (join_patches $ p:ok_ps) + then rpint (p:ok_ps) ps + else rpint ok_ps ps + +prop_inverse_composition :: Patch -> Patch -> Bool +prop_inverse_composition p1 p2 = + invert (join_patches [p1,p2]) == join_patches [invert p2, invert p1] +prop_inverse_valid :: Patch -> Bool +prop_inverse_valid p1 = check_a_patch $ join_patches [invert p1,p1] +prop_other_inverse_valid :: Patch -> Bool +prop_other_inverse_valid p1 = check_a_patch $ join_patches [p1,invert p1] + +prop_commute_twice :: Patch -> Patch -> Property +prop_commute_twice p1 p2 = + (does_commute p1 p2) ==> (Just (p1:>p2) == (commute (p1:>p2) >>= commute)) +does_commute :: Patch -> Patch -> Bool +does_commute p1 p2 = + commute (p1:>p2) /= Nothing && (check_a_patch $ join_patches [p1,p2]) +prop_commute_equivalency :: Patch -> Patch -> Property +prop_commute_equivalency p1 p2 = + (does_commute p1 p2) ==> + case commute (p1:>p2) of + Just (p2':>p1') -> check_a_patch $ join_patches [p1,p2,invert p1',invert p2'] + _ -> impossible + +prop_commute_either_way :: Patch -> Patch -> Property +prop_commute_either_way p1 p2 = + does_commute p1 p2 ==> does_commute (invert p2) (invert p1) + +prop_commute_either_order :: Patch -> Patch -> Patch -> Property +prop_commute_either_order p1 p2 p3 = + check_a_patch (join_patches [p1,p2,p3]) && + does_commute p1 (join_patches [p2,p3]) && + does_commute p2 p3 ==> + case commute (p1:>p2) of + Nothing -> False + Just (p2':>p1') -> + case commute (p1':>p3) of + Nothing -> False + Just (p3':>_) -> + case commute (p2':>p3') of + Nothing -> False + Just (p3'' :> _) -> + case commute (p2:>p3) of + Nothing -> False + Just (p3'a:>_) -> + case commute (p1:>p3'a) of + Just (p3''a:>_) -> p3''a == p3'' + Nothing -> False + +prop_patch_and_inverse_is_identity :: Patch -> Patch -> Property +prop_patch_and_inverse_is_identity p1 p2 = + (check_a_patch $ join_patches [p1,p2]) && (commute (p1:>p2) /= Nothing) ==> + case commute (p1:>p2) of + Just (p2':>_) -> case commute (invert p1:>p2') of + Nothing -> True -- This is a subtle distinction. + Just (p2'':>_) -> p2'' == p2 + Nothing -> impossible + +quickmerge :: (Patch :\/: Patch) -> Patch +quickmerge (p1:\/:p2) = case merge (p1:\/:p2) of + _ :/\: p1' -> p1' + +prop_merge_is_commutable_and_correct :: Patch -> Patch -> Property +prop_merge_is_commutable_and_correct p1 p2 = + (check_a_patch $ join_patches [invert p1,p2]) ==> + case merge (p2:\/:p1) of + p1' :/\: p2' -> + case commute (p1:>p2') of + Nothing -> False + Just (p2'':>p1'') -> p2'' == p2 && p1' == p1'' +prop_merge_is_swapable :: Patch -> Patch -> Property +prop_merge_is_swapable p1 p2 = + (check_a_patch $ join_patches [invert p1,p2]) ==> + case merge (p2:\/:p1) of + p1' :/\: p2' -> + case merge (p1:\/:p2) of + p2''' :/\: p1''' -> p1' == p1''' && p2' == p2''' + +prop_merge_valid :: Patch -> Patch -> Property +prop_merge_valid p1 p2 = + (check_a_patch $ join_patches [invert p1,p2]) ==> + case merge (p2:\/:p1) of + _ :/\: p2' -> + check_a_patch $ join_patches [invert p1,p2,invert p2,p1,p2'] + +prop_simple_smart_merge_good_enough :: Patch -> Patch -> Property +prop_simple_smart_merge_good_enough p1 p2 = + (check_a_patch $ join_patches [invert p1,p2]) ==> + smart_merge (p2:\/:p1) == simple_smart_merge (p2:\/:p1) + +smart_merge :: (Patch :\/: Patch) -> Maybe (Patch :< Patch) +smart_merge (p1 :\/: p2) = + case simple_smart_merge (p1:\/:p2) of + Nothing -> Nothing + Just (p1'a: + case simple_smart_merge (p2 :\/: p1) of + Nothing -> Nothing + Just (x: + case commute (y:>x) of + Nothing -> Nothing + Just (p2b :> p1'b) -> + if p1'a == p1'b && p2a == p2b && p2a == p2 + then Just (p1'a :< p2) + else Nothing +simple_smart_merge :: (Patch :\/: Patch) -> Maybe (Patch :< Patch) +simple_smart_merge (p1 :\/: p2) = + case commute (invert p2 :> p1) of + Just (p1':>_) -> + case commute (p2:>p1') of + Just (p1o:>_) -> + if p1o == p1 then Just (p1' :< p2) + else Nothing + Nothing -> Nothing + Nothing -> Nothing + +prop_elegant_merge_good_enough :: Patch -> Patch -> Property +prop_elegant_merge_good_enough p1 p2 = + (check_a_patch $ join_patches [invert p1,p2]) ==> + (fst' `fmap` smart_merge (p2:\/:p1)) == + (snd'' `fmap` elegantMerge (p2:\/:p1)) + +fst' :: p :< p -> p +fst' (x:<_) = x + +snd'' :: q :/\: p -> p +snd'' (_:/\:x) = x + +instance Eq p => Eq (p :< p) where + (x: Eq (p :> p) where + (x:>y) == (x':>y') = x == x' && y == y' + +instance Show p => Show (p :< p) where + show (x :< y) = show x ++ " :< " ++ show y + +instance Show p => Show (p :> p) where + show (x :> y) = show x ++ " :> " ++ show y + +test_patch :: String +test_patch = test_str ++ test_note +tp1, tp2 :: Patch +tp1 = unsafeUnseal . fst . fromJust . readPatch $ BC.pack "\nmove ./test/test ./hello\n" +tp2 = unsafeUnseal . fst . fromJust . readPatch $ BC.pack "\nmove ./test ./hello\n" +tp1', tp2' :: Patch +tp2' = quickmerge (tp2:\/:tp1) +tp1' = quickmerge (tp1:\/:tp2) +test_note :: String +test_note = (if commute (tp1:>tp2') == Just (tp2:>tp1') + then "At least they commutex right.\n" + else "Argh! they don't even commutex right.\n") + ++(if check_a_patch $ tp2 + then "tp2 itself is valid!\n" + else "Oh my! tp2 isn't even valid!\n") + ++(if check_a_patch $ tp2' + then "tp2' itself is valid!\n" + else "Aaack! tp2' itself is invalid!\n") + ++(if check_a_patch $ join_patches [tp1, tp2'] + then "Valid merge tp2'!\n" + else "Bad merge tp2'!\n") + ++ (if check_a_patch $ join_patches [tp2, tp1'] + then "Valid merge tp1'!\n" + else "Bad merge tp1'!\n") + ++ (if check_a_patch $ join_patches [tp2,tp1',invert tp2',invert tp1] + then "Both agree!\n" + else "The two merges don't agree!\n") + ++ (if check_a_patch $ join_patches [invert tp2, tp1] + then "They should be mergable!\n" + else "Wait a minute, these guys can't be merged!\n") +tp :: Patch +tp = tp1' + +test_str :: String +test_str = "Patches are:\n"++(show tp) + ++(if check_a_patch tp + then "At least the patch itself is valid.\n" + else "The patch itself is bad!\n") + ++"commute of tp2 and tp1' is "++show (commute (tp2:>tp1'))++"\n" + ++"commute of tp1 and tp2' is "++show (commute (tp1:>tp2'))++"\n" + {-++ "\nSimply flattened, it is:\n" + ++ (show $ mapFL (joinPatches.flattenFL.merger_equivalent) $ flattenFL tp) + ++ "\n\nUnravelled, it gives:\n" ++ (show $ map unravel $ flatten tp) + ++ "\n\nUnwound, it gives:\n" ++ (show $ mapFL unwind $ flattenFL tp) + ++(if check_a_patch (join_patches$ reverse $ unwind tp) + then "Unwinding is valid.\n" + else "Bad unwinding!\n") + ++(if check_a_patch $ join_patches [tp,invert tp] + then "Inverse is valid.\n" + else "Bad inverse!\n") + ++(if check_a_patch $ join_patches [invert tp, tp] + then "Other inverse is valid.\n" + else "Bad other inverse!\n")-} + +-- | The conflict resolution code (glump) begins by "unravelling" the merger +-- into a set of sequences of patches. Each sequence of patches corresponds +-- to one non-conflicted patch that got merged together with the others. The +-- result of the unravelling of a series of merges must obviously be +-- independent of the order in which those merges are performed. This +-- unravelling code (which uses the unwind code mentioned above) uses probably +-- the second most complicated algorithm. Fortunately, if we can successfully +-- unravel the merger, almost any function of the unravelled merger satisfies +-- the two constraints mentioned above that the conflict resolution code must +-- satisfy. +prop_unravel_three_merge :: Patch -> Patch -> Patch -> Property +prop_unravel_three_merge p1 p2 p3 = + (check_a_patch $ join_patches [invert p1,p2,invert p2,p3]) ==> + (unravel $ merger "0.0" (merger "0.0" p2 p3) (merger "0.0" p2 p1)) == + (unravel $ merger "0.0" (merger "0.0" p1 p3) (merger "0.0" p1 p2)) + +prop_unravel_seq_merge :: Patch -> Patch -> Patch -> Property +prop_unravel_seq_merge p1 p2 p3 = + (check_a_patch $ join_patches [invert p1,p2,p3]) ==> + (unravel $ merger "0.0" p3 $ merger "0.0" p2 p1) == + (unravel $ merger "0.0" (merger "0.0" p2 p1) p3) + +prop_unravel_order_independent :: Patch -> Patch -> Property +prop_unravel_order_independent p1 p2 = + (check_a_patch $ join_patches [invert p1,p2]) ==> + (unravel $ merger "0.0" p2 p1) == (unravel $ merger "0.0" p1 p2) + +prop_resolve_conflicts_valid :: Patch -> Patch -> Property +prop_resolve_conflicts_valid p1 p2 = + (check_a_patch $ join_patches [invert p1,p2]) ==> + and $ map (check_a_patch.(\l-> join_patches [p,merge_list l])) + $ resolveConflicts p + where p = case merge (p1:\/:p2) of + _ :/\: p1' -> join_patches [p2,p1'] + +merge_list :: [Sealed (FL Prim C(x))] -> Patch +merge_list patches = fromPrims `unseal` doml NilFL patches + where doml mp (Sealed p:ps) = + case commute (invert p :> mp) of + Just (mp' :> _) -> doml (effect p +>+ effect mp') ps + Nothing -> doml mp ps -- This shouldn't happen for "good" resolutions. + doml mp [] = Sealed mp + +try_tok_possibly :: String -> String -> String + -> (Maybe FileContents) -> (Maybe FileContents) +try_tok_possibly t o n = liftM $ \contents -> + let lines' = M.mapMaybe (liftM B.concat + . try_tok_internal t (BC.pack o) (BC.pack n)) + (fc_lines contents) + in contents { fc_lines = lines' } + +try_tok_internal :: String -> B.ByteString -> B.ByteString + -> B.ByteString -> Maybe [B.ByteString] +try_tok_internal _ _ _ s | B.null s = Just [] +try_tok_internal t o n s = + case BC.break (regChars t) s of + (before,s') -> + case BC.break (not . regChars t) s' of + (tok,after) -> + case try_tok_internal t o n after of + Nothing -> Nothing + Just rest -> + if tok == o + then Just $ before : n : rest + else if tok == n + then Nothing + else Just $ before : tok : rest + +prop_read_show :: Patch -> Bool +prop_read_show p = case readPatch $ renderPS $ showPatch p of + Just (Sealed p',_) -> p' == p + Nothing -> False + +-- |In order for merges to work right with commuted patches, inverting a patch +-- past a patch and its inverse had golly well better give you the same patch +-- back again. +prop_commute_inverse :: Patch -> Patch -> Property +prop_commute_inverse p1 p2 = + does_commute p1 p2 ==> case commute (p1 :> p2) of + Nothing -> impossible + Just (_ :> p1') -> + case commute (p1' :> invert p2) of + Nothing -> False + Just (_ :> p1'') -> p1'' == p1 + +subcommutes_inverse :: [(String, Prim -> Prim -> Property)] +subcommutes_inverse = zip names (map prop_subcommute cs) + where (names, cs) = unzip subcommutes + prop_subcommute c p1 p2 = + does c p1 p2 ==> + case c (p2:< p1) of + Succeeded (p1': + case c (invert p2:< p1') of + Succeeded (p1'': p1'' == p1 && + case c (invert p1:< invert p2) of + Succeeded (ip2':< ip1') -> + case c (p2':< invert p1) of + Succeeded (ip1o':< p2o) -> + invert ip1' == p1' && invert ip2' == p2' && + ip1o' == ip1' && p2o == p2 && + p1'' == p1 && ip2x' == ip2' + _ -> False + _ -> False + _ -> False + _ -> False + +subcommutes_nontrivial_inverse :: [(String, Prim -> Prim -> Property)] +subcommutes_nontrivial_inverse = zip names (map prop_subcommute cs) + where (names, cs) = unzip subcommutes + prop_subcommute c p1 p2 = + nontrivial c p1 p2 ==> + case c (p2:< p1) of + Succeeded (p1': + case c (invert p2:< p1') of + Succeeded (p1'': p1'' == p1 && + case c (invert p1:< invert p2) of + Succeeded (ip2':< ip1') -> + case c (p2':< invert p1) of + Succeeded (ip1o':< p2o) -> + invert ip1' == p1' && invert ip2' == p2' && + ip1o' == ip1' && p2o == p2 && + p1'' == p1 && ip2x' == ip2' + _ -> False + _ -> False + _ -> False + _ -> False + +subcommutes_failure :: [(String, Prim -> Prim -> Property)] +subcommutes_failure = zip names (map prop cs) + where (names, cs) = unzip subcommutes + prop c p1 p2 = + does_fail c p1 p2 ==> case c (invert p1 :< invert p2) of + Failed -> True + _ -> False + +does_fail :: CommuteFunction -> Prim -> Prim -> Bool +does_fail c p1 p2 = + fails (c (p2: Prim -> Prim -> Bool +does c p1 p2 = + succeeds (c (p2: Prim -> Prim -> Bool +nontrivial c p1 p2 = + succeeds (c (p2:> return 0 + run_primitive_tests "prim join inverses" (\ (a:\/:_) -> join_inverses join a) mergeables, + testProperty "Checking prim join inverses using QuickCheck... " (isNothing . join_inverses join), + run_primitive_tests "prim inverse doesn't commute" (\ (a:\/:_) -> inverse_doesnt_commute a) mergeables, + -- The following fails because of setpref patches... + --,do putStr "Checking prim inverse doesn't commute using QuickCheck... " + -- simpleCheck (inverse_doesnt_commute :: Prim -> Maybe Doc) + run_primitive_tests "join commute" (join_commute join) prim_permutables, + testProperty "Checking prim join commute using QuickCheck... " (unseal2 (isNothing . join_commute join)), + run_primitive_tests "prim recommute" (recommute commute) $ map mergeable2commutable mergeables, + run_primitive_tests "prim patch and inverse commute" (patch_and_inverse_commute commute) $ map mergeable2commutable mergeables, + run_primitive_tests "prim inverses commute" (commute_inverses commute) $ map mergeable2commutable mergeables, + --,do putStr "Checking prim recommute using QuickCheck... " + -- simpleCheck (recommute + -- (commute :: Prim :> Prim + -- -> Maybe (Prim :> Prim))) + run_primitive_tests "FL prim recommute" (recommute commute) $ map mergeable2commutable mergeablesFL, + run_primitive_tests "FL prim patch and inverse commute" (patch_and_inverse_commute commute) $ map mergeable2commutable mergeablesFL, + run_primitive_tests "FL prim inverses commute" (commute_inverses commute) $ map mergeable2commutable mergeablesFL, + run_primitive_tests "fails" (commute_fails commute) ([] :: [Prim :> Prim]), + run_primitive_tests "read and show work on Prim" show_read prim_patches, + run_primitive_tests "read and show work on RealPatch" show_read real_patches, + testProperty "Checking that readPatch and showPatch work on RealPatch... " + (isNothing . (unseal $ patchFromTree $ (show_read :: RealPatch -> Maybe Doc))), + testProperty "Checking that readPatch and showPatch work on FL RealPatch... " + (isNothing . (unseal2 $ (show_read :: FL RealPatch -> Maybe Doc))), + run_primitive_tests "example flattenings work" + (\x -> if prop_consistent_tree_flattenings x + then Nothing + else Just $ redText "oops") + real_patch_loop_examples, + testProperty "Checking that tree flattenings are consistent... " prop_consistent_tree_flattenings, + testProperty "Checking with quickcheck that real patches are consistent... " + (isNothing . (unseal $ patchFromTree $ is_consistent)), + run_primitive_tests "real merge input consistent" (merge_arguments_consistent is_consistent) real_mergeables, + run_primitive_tests "real merge input is forward" (merge_arguments_consistent is_forward) real_mergeables, + run_primitive_tests "real merge output is forward" (merge_consistent is_forward) real_mergeables, + run_primitive_tests "real merge output consistent" (merge_consistent is_consistent) real_mergeables, + run_primitive_tests "real merge either way" merge_either_way real_mergeables, + run_primitive_tests "real merge and commute" merge_commute real_mergeables, + + run_primitive_tests "real recommute" (recommute commute) real_commutables, + run_primitive_tests "real inverses commute" (commute_inverses commute) real_commutables, + run_primitive_tests "real permutivity" (permutivity commute) $ filter (not_duplicatestriple) real_triples, + run_primitive_tests "real partial permutivity" (partial_permutivity commute) $ filter (not_duplicatestriple) real_triples, + + testProperty "Checking we can do merges using QuickCheck" + (isNothing . (prop_is_mergeable :: + Sealed (WithStartState RepoModel (Tree Prim)) + -> Maybe (Tree RealPatch C(x)))), + testProperty "Checking recommute using QuickCheck Tree generator" + (isNothing. (unseal $ commutePairFromTree $ + (recommute + (commute :: RealPatch :> RealPatch + -> Maybe (RealPatch :> RealPatch))))), + testProperty "Checking recommute using QuickCheck TWFP generator" + (isNothing . (unseal $ commutePairFromTWFP $ + (recommute + (commute :: RealPatch :> RealPatch + -> Maybe (RealPatch :> RealPatch))))), + testConditional "Checking nontrivial recommute" + (unseal $ commutePairFromTree $ nontrivial_reals) + (unseal $ commutePairFromTree $ + (recommute + (commute :: RealPatch :> RealPatch + -> Maybe (RealPatch :> RealPatch)))), + testConditional "Checking nontrivial recommute using TWFP" + (unseal $ commutePairFromTWFP $ nontrivial_reals) + (unseal $ commutePairFromTWFP $ + (recommute + (commute :: RealPatch :> RealPatch + -> Maybe (RealPatch :> RealPatch)))), + + testProperty "Checking inverses commute using QuickCheck Tree generator" + (isNothing . (unseal $ commutePairFromTree $ + (commute_inverses + (commute :: RealPatch :> RealPatch + -> Maybe (RealPatch :> RealPatch))))), + testProperty "Checking inverses commute using QuickCheck TWFP generator" + (isNothing . (unseal $ commutePairFromTWFP $ + (commute_inverses + (commute :: RealPatch :> RealPatch + -> Maybe (RealPatch :> RealPatch))))), + testConditional "Checking nontrivial inverses commute" + (unseal $ commutePairFromTree $ nontrivial_reals) + (unseal $ commutePairFromTree $ + (commute_inverses + (commute :: RealPatch :> RealPatch + -> Maybe (RealPatch :> RealPatch)))), + testConditional "Checking nontrivial inverses commute using TWFP" + (unseal $ commutePairFromTWFP $ nontrivial_reals) + (unseal $ commutePairFromTWFP $ + (commute_inverses + (commute :: RealPatch :> RealPatch + -> Maybe (RealPatch :> RealPatch)))), + + testProperty "Checking merge either way using QuickCheck TWFP generator" + (isNothing . (unseal $ mergePairFromTWFP $ + (merge_either_way :: RealPatch :\/: RealPatch -> Maybe Doc))), + testProperty "Checking merge either way using QuickCheck Tree generator" + (isNothing . (unseal $ mergePairFromTree $ + (merge_either_way :: RealPatch :\/: RealPatch -> Maybe Doc))), + testConditional "Checking nontrivial merge either way" + (unseal $ mergePairFromTree $ nontrivial_merge_reals) + (unseal $ mergePairFromTree $ + (merge_either_way :: RealPatch :\/: RealPatch -> Maybe Doc)), + testConditional "Checking nontrivial merge either way using TWFP" + (unseal $ mergePairFromTWFP $ nontrivial_merge_reals) + (unseal $ mergePairFromTWFP $ + (merge_either_way :: RealPatch :\/: RealPatch -> Maybe Doc)), + + testConditional "Checking permutivity" + (unseal $ commuteTripleFromTree not_duplicatestriple) + (unseal $ commuteTripleFromTree $ permutivity + (commute :: RealPatch :> RealPatch -> Maybe (RealPatch :> RealPatch))), + testConditional "Checking partial permutivity" + (unseal $ commuteTripleFromTree not_duplicatestriple) + (unseal $ commuteTripleFromTree $ partial_permutivity + (commute :: RealPatch :> RealPatch -> Maybe (RealPatch :> RealPatch))), + testConditional "Checking nontrivial permutivity" + (unseal $ commuteTripleFromTree + (\t -> nontrivial_triple t && not_duplicatestriple t)) + (unseal $ commuteTripleFromTree $ + (permutivity + (commute :: RealPatch :> RealPatch + -> Maybe (RealPatch :> RealPatch)))) + ] + +not_duplicatestriple :: RealPatch :> RealPatch :> RealPatch -> Bool +not_duplicatestriple (a :> b :> c) = not $ any is_duplicate [a,b,c] + +--not_duplicates_pair :: RealPatch :> RealPatch -> Bool +--not_duplicates_pair (a :> b) = not $ any is_duplicate [a,b] + +nontrivial_triple :: RealPatch :> RealPatch :> RealPatch -> Bool +nontrivial_triple (a :> b :> c) = + case commute (a :> b) of + Nothing -> False + Just (b' :> a') -> + case commute (a' :> c) of + Nothing -> False + Just (c'' :> a'') -> + case commute (b :> c) of + Nothing -> False + Just (c' :> b'') -> (not (a `unsafeCompare` a') || not (b `unsafeCompare` b')) && + (not (c' `unsafeCompare` c) || not (b'' `unsafeCompare` b)) && + (not (c'' `unsafeCompare` c) || not (a'' `unsafeCompare` a')) + +nontrivial_reals :: RealPatch :> RealPatch -> Bool +nontrivial_reals = nontrivial_commute + +nontrivial_commute :: Patchy p => p :> p -> Bool +nontrivial_commute (x :> y) = case commute (x :> y) of + Just (y' :> x') -> not (y' `unsafeCompare` y) || + not (x' `unsafeCompare` x) + Nothing -> False + +nontrivial_merge_reals :: RealPatch :\/: RealPatch -> Bool +nontrivial_merge_reals = nontrivial_merge + +nontrivial_merge :: Patchy p => p :\/: p -> Bool +nontrivial_merge (x :\/: y) = case merge (x :\/: y) of + y' :/\: x' -> not (y' `unsafeCompare` y) || + not (x' `unsafeCompare` x) + +-- | Run a test function on a set of data, using HUnit. The test function should +-- return @Nothing@ upon success and a @Just x@ upon failure. +run_primitive_tests :: (Show a, Show b) => String -- ^ The test name + -> (a -> Maybe b) -- ^ The test function + -> [a] -- ^ The test data + -> Test +run_primitive_tests name test datas = testCase name (assertBool assertName res) + where assertName = "Boolean assertion for \"" ++ name ++ "\"" + res = and $ map (isNothing . test) datas + +quickhunk :: Int -> String -> String -> Prim +quickhunk l o n = hunk "test" l (map (\c -> BC.pack [c]) o) + (map (\c -> BC.pack [c]) n) + +prim_permutables :: [Prim :> Prim :> Prim] +prim_permutables = + [quickhunk 0 "e" "bo" :> quickhunk 3 "" "x" :> quickhunk 2 "f" "qljo"] + +mergeables :: [Prim :\/: Prim] +mergeables = [quickhunk 1 "a" "b" :\/: quickhunk 1 "a" "c", + quickhunk 1 "a" "b" :\/: quickhunk 3 "z" "c", + quickhunk 0 "" "a" :\/: quickhunk 1 "" "b", + quickhunk 0 "a" "" :\/: quickhunk 1 "" "b", + quickhunk 0 "a" "" :\/: quickhunk 1 "b" "", + quickhunk 0 "" "a" :\/: quickhunk 1 "b" "" + ] + +mergeablesFL :: [FL Prim :\/: FL Prim] +mergeablesFL = map (\ (x:\/:y) -> (x :>: NilFL) :\/: (y :>: NilFL)) mergeables ++ + [] -- [(quickhunk 1 "a" "b" :>: quickhunk 3 "z" "c" :>: NilFL) + -- :\/: (quickhunk 1 "a" "z" :>: NilFL), + -- (quickhunk 1 "a" "b" :>: quickhunk 1 "b" "c" :>: NilFL) + -- :\/: (quickhunk 1 "a" "z" :>: NilFL)] + +mergeable2commutable :: Invert p => p :\/: p -> p :> p +mergeable2commutable (x :\/: y) = invert x :> y + +prim_patches :: [Prim] +prim_patches = concatMap mergeable2patches mergeables + where mergeable2patches (x:\/:y) = [x,y] + +real_patches :: [RealPatch] +real_patches = concatMap commutable2patches real_commutables + where commutable2patches (x:>y) = [x,y] + +real_triples :: [RealPatch :> RealPatch :> RealPatch] +real_triples = [ob' :> oa2 :> a2'', + oa' :> oa2 :> a2''] ++ triple_examples + ++ map unsafeUnseal2 (concatMap getTriples realFLs) + where oa = prim2real $ quickhunk 1 "o" "aa" + oa2 = oa + a2 = prim2real $ quickhunk 2 "a34" "2xx" + ob = prim2real $ quickhunk 1 "o" "bb" + ob' :/\: oa' = merge (oa :\/: ob) + a2' :/\: _ = merge (ob' :\/: a2) + a2'' :/\: _ = merge (oa2 :\/: a2') + +realFLs :: [FL RealPatch] +realFLs = [oa :>: invert oa :>: oa :>: invert oa :>: ps +>+ oa :>: invert oa :>: NilFL] + where oa = prim2real $ quickhunk 1 "o" "a" + ps :/\: _ = merge (oa :>: invert oa :>: NilFL :\/: oa :>: invert oa :>: NilFL) + +real_commutables :: [RealPatch :> RealPatch] +real_commutables = commute_examples ++ map mergeable2commutable real_mergeables++ + [invert oa :> ob'] ++ map unsafeUnseal2 (concatMap getPairs realFLs) + where oa = prim2real $ quickhunk 1 "o" "a" + ob = prim2real $ quickhunk 1 "o" "b" + _ :/\: ob' = mergeFL (ob :\/: oa :>: invert oa :>: NilFL) + +real_mergeables :: [RealPatch :\/: RealPatch] +real_mergeables = map (\ (x :\/: y) -> prim2real x :\/: prim2real y) mergeables + ++ real_igloo_mergeables + ++ real_quickcheck_mergeables + ++ merge_examples + ++ catMaybes (map pair2m (concatMap getPairs realFLs)) + ++ [(oa :\/: od), + (oa :\/: a2'), + (ob' :\/: od''), + (oe :\/: od), + (of' :\/: oe'), + (ob' :\/: oe'), + (oa :\/: oe'), + (ob' :\/: oc'), + (b2' :\/: oc'''), + (ob' :\/: a2), + (b2' :\/: og'''), + (oc''' :\/: og'''), + (oc'' :\/: og''), + (ob'' :\/: og''), + (ob'' :\/: oc''), + (oc' :\/: od'')] + where oa = prim2real $ quickhunk 1 "o" "aa" + a2 = prim2real $ quickhunk 2 "a34" "2xx" + og = prim2real $ quickhunk 3 "4" "g" + ob = prim2real $ quickhunk 1 "o" "bb" + b2 = prim2real $ quickhunk 2 "b" "2" + oc = prim2real $ quickhunk 1 "o" "cc" + od = prim2real $ quickhunk 7 "x" "d" + oe = prim2real $ quickhunk 7 "x" "e" + pf = prim2real $ quickhunk 7 "x" "f" + od'' = prim2real $ quickhunk 8 "x" "d" + ob' :>: b2' :>: NilFL :/\: _ = mergeFL (oa :\/: ob :>: b2 :>: NilFL) + a2' :/\: _ = merge (ob' :\/: a2) + ob'' :/\: _ = merge (a2 :\/: ob') + og' :/\: _ = merge (oa :\/: og) + og'' :/\: _ = merge (a2 :\/: og') + og''' :/\: _ = merge (ob' :\/: og') + oc' :/\: _ = merge (oa :\/: oc) + oc'' :/\: _ = merge (a2 :\/: oc) + oc''' :/\: _ = merge (ob' :\/: oc') + oe' :/\: _ = merge (od :\/: oe) + of' :/\: _ = merge (od :\/: pf) + pair2m :: Sealed2 (RealPatch :> RealPatch) + -> Maybe (RealPatch :\/: RealPatch) + pair2m (Sealed2 (xx :> y)) = do y' :> _ <- commute (xx :> y) + return (xx :\/: y') + +real_igloo_mergeables :: [RealPatch :\/: RealPatch] +real_igloo_mergeables = [(a :\/: b), + (b :\/: c), + (a :\/: c), + (x :\/: a), + (y :\/: b), + (z :\/: c), + (x' :\/: y'), + (z' :\/: y'), + (x' :\/: z'), + (a :\/: a)] + where a = prim2real $ quickhunk 1 "1" "A" + b = prim2real $ quickhunk 2 "2" "B" + c = prim2real $ quickhunk 3 "3" "C" + x = prim2real $ quickhunk 1 "1BC" "xbc" + y = prim2real $ quickhunk 1 "A2C" "ayc" + z = prim2real $ quickhunk 1 "AB3" "abz" + x' :/\: _ = merge (a :\/: x) + y' :/\: _ = merge (b :\/: y) + z' :/\: _ = merge (c :\/: z) + +real_quickcheck_mergeables :: [RealPatch :\/: RealPatch] +real_quickcheck_mergeables = [-- invert k1 :\/: n1 + --, invert k2 :\/: n2 + hb :\/: k + , b' :\/: b' + , n' :\/: n' + , b :\/: d + , k' :\/: k' + , k3 :\/: k3 + ] ++ catMaybes (map pair2m pairs) + where hb = prim2real $ quickhunk 0 "" "hb" + k = prim2real $ quickhunk 0 "" "k" + n = prim2real $ quickhunk 0 "" "n" + b = prim2real $ quickhunk 1 "b" "" + d = prim2real $ quickhunk 2 "" "d" + d':/\:_ = merge (b :\/: d) + --k1 :>: n1 :>: NilFL :/\: _ = mergeFL (hb :\/: k :>: n :>: NilFL) + --k2 :>: n2 :>: NilFL :/\: _ = + -- merge (hb :>: b :>: NilFL :\/: k :>: n :>: NilFL) + k' :>: n' :>: NilFL :/\: _ :>: b' :>: _ = merge (hb :>: b :>: d' :>: NilFL :\/: k :>: n :>: NilFL) + pairs = getPairs (hb :>: b :>: d' :>: k' :>: n' :>: NilFL) + pair2m :: Sealed2 (RealPatch :> RealPatch) + -> Maybe (RealPatch :\/: RealPatch) + pair2m (Sealed2 (xx :> y)) = do y' :> _ <- commute (xx :> y) + return (xx :\/: y') + + i = prim2real $ quickhunk 0 "" "i" + x = prim2real $ quickhunk 0 "" "x" + xi = prim2real $ quickhunk 0 "xi" "" + d3 :/\: _ = merge (xi :\/: d) + _ :/\: k3 = mergeFL (k :\/: i :>: x :>: xi :>: d3 :>: NilFL) + +commute_fails :: (MyEq p, Patchy p) => (p :> p -> Maybe (p :> p)) -> p :> p + -> Maybe Doc +commute_fails c (x :> y) = do y' :> x' <- c (x :> y) + return $ redText "x" $$ showPatch x $$ + redText ":> y" $$ showPatch y $$ + redText "y'" $$ showPatch y' $$ + redText ":> x'" $$ showPatch x' diff --git a/tests/README.test_maintainers.txt b/tests/README.test_maintainers.txt new file mode 100644 --- /dev/null +++ b/tests/README.test_maintainers.txt @@ -0,0 +1,100 @@ + +The following is provided as a reference for those interested in understanding +how the test suite works, and how to add and maintain tests. + +Overview of types of tests +========================== + +Darcs has tests in two formats. Unit tests that directly test Haskell +functions are written in Haskell and live in modules under src/Darcs/Test. +Functional tests that test the darcs binary are written in Shell and live in +tests/. + +Haskell tests +-------------------------- + +These are QuickCheck and HUnit tests primarily testing the Darcs core. The +Haskell modules containing these tests are under Darcs.Test in the module +hierarchy. They are called from src/unit.lhs using the test-framework package +from Hackage. + +More about the Haskell tests can be found on http://wiki.darcs.net/UnitTests. + +Shell tests +--------------------------- + +Shell tests are useful because they are easy to create from a copy/paste +of actual shell commands executed. They are considered successful if no +bad exit codes are returned from the commands in the script. If the name of the +script file starts with 'failing-' however, the script is expected to return +a bad exit code. If such a script returns a bad exit code, this will not be +treated as a test suite failure. This is useful to document bugs and to-do +items. + +How to run tests +============================= + +To build the unit tests, pass the "-ftest" flag to "cabal configure" and then +do "cabal build". To run them, do "dist/build/unit/unit". They take a while. +Output like "[OK]" and "[OK, passed 100 tests]" is good. Output like +"Arguments exhausted after 33 tests" is a shortage of QuickCheck test +cases, not a test failure. + +"runghc Setup.lhs test" causes all the functional tests in "tests/" to be run +against repositories in the old, hashed, and darcs2 formats. + +Because "runghc Setup.lhs test" can take a long time to run, it's useful to run +fewer tests at once. To help with that, 'runghc Setup.lhs test' accepts +arguments to run only a specific group of test scripts, or only named test +scripts: + + runghc Setup.lhs test tests # all tests, excluding bugs or network tests + runghc Setup.lhs test bugs # all bugs (the 'failing-' scripts) + runghc Setup.lhs test network # the network tests + + # and this one runs tests/issue279_get_extra.sh and tests/repair_corrupt.sh + runghc Setup.lhs test issue279_get_extra repair-corrupt + +Tips for writing (and reading) tests +==================================== + +- Avoid including a repo format type to "darcs init" + This insures that all three repo formats will be tested. + However, if you know that the test only passes under some + repo formats, *do* explicitly include a format option to "darcs init". + + +Tips for writing tests +---------------------- + +- Copy an existing test, which will already have the following properties: + +- Simply call darcs using "darcs" as you would in the shell. It is the + responsibility of the test harness to ensure that the darcs we are + testing is first in the path. + +- Always use Bash explicitly - this improves the portability of our tests. + +- Always add this near the top of the script: + + set -ev + + The "v" causes the contents of the script to be printed as part of the run, + which is helpful for debugging. The "e" causes the script to exit as soon as + there is an error. + +- Try to avoid defining functions where possible. This makes them + harder to run and generally harder to use. There are certainly cases + where it is appropriate to define a function, but please do not do + this just to avoid a little duplication. + +- Also try to be careful using certain utilities; 'yes' is prohibited since + it can cause infinite loops on Mac OS X; 'find' can be very useful, but + options and behavior can differ from GNU find to the BSD finds to Solaris's + find and so on. In general, stick to POSIX flags and functionality. + +- There is a utility script intended for factoring out common calls and + functions, called 'lib'. It can be invoked by adding a line like '. lib' to + your shell script. lib provides 'set -ev', a common definition of 'not', and + 'abort_windows' for use in scripts which shouldn't run under Windows. + You don't have to use lib if you don't want to, or if it causes problems. diff --git a/tests/failing-issue1645-ignore-symlinks.sh b/tests/failing-issue1645-ignore-symlinks.sh deleted file mode 100644 --- a/tests/failing-issue1645-ignore-symlinks.sh +++ /dev/null @@ -1,35 +0,0 @@ -#!/usr/bin/env bash -## Test for issue1645 - whatsnew -l should not consider symlinks to be -## "real" files in the working tree. -## -## Copyright (C) 2009 Trent W. Buck -## -## Permission is hereby granted, free of charge, to any person -## obtaining a copy of this software and associated documentation -## files (the "Software"), to deal in the Software without -## restriction, including without limitation the rights to use, copy, -## modify, merge, publish, distribute, sublicense, and/or sell copies -## of the Software, and to permit persons to whom the Software is -## furnished to do so, subject to the following conditions: -## -## The above copyright notice and this permission notice shall be -## included in all copies or substantial portions of the Software. -## -## THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, -## EXPRESS OR IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF -## MERCHANTABILITY, FITNESS FOR A PARTICULAR PURPOSE AND -## NONINFRINGEMENT. IN NO EVENT SHALL THE AUTHORS OR COPYRIGHT HOLDERS -## BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER LIABILITY, WHETHER IN AN -## ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM, OUT OF OR IN -## CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN THE -## SOFTWARE. - -. ../tests/lib # Load some portability helpers. -rm -rf R f # Another script may have left a mess. -darcs init --repo R # Create our test repos. - -cd R -echo 'Example content.' > ../f # a file outside the repo -ln -s ../f # a symlink to same inside the repo -darcs whatsnew -l >log -fgrep 'No changes!' log # Darcs shouldn't report any changes. diff --git a/tests/issue1645-ignore-symlinks-case-fold.sh b/tests/issue1645-ignore-symlinks-case-fold.sh new file mode 100644 --- /dev/null +++ b/tests/issue1645-ignore-symlinks-case-fold.sh @@ -0,0 +1,73 @@ +#!/usr/bin/env bash +## Test for issue1645 - Since Darcs does not version-contol symlinks, +## it should not follow them, ESPECIALLY symlinks to directories +## outside the repository. All these tests are passed with darcs-2.2 +## +## See path_resolution(7) and symlink(7) for more info, especially +## the former. +## +## This only covers the case-folding test cases. +## See also the issue1645-ignore-symlinks for the main test +## +## Copyright (C) 2010 Trent W. Buck, Dmitry Astapov +## +## Permission is hereby granted, free of charge, to any person +## obtaining a copy of this software and associated documentation +## files (the "Software"), to deal in the Software without +## restriction, including without limitation the rights to use, copy, +## modify, merge, publish, distribute, sublicense, and/or sell copies +## of the Software, and to permit persons to whom the Software is +## furnished to do so, subject to the following conditions: +## +## The above copyright notice and this permission notice shall be +## included in all copies or substantial portions of the Software. +## +## THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, +## EXPRESS OR IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF +## MERCHANTABILITY, FITNESS FOR A PARTICULAR PURPOSE AND +## NONINFRINGEMENT. IN NO EVENT SHALL THE AUTHORS OR COPYRIGHT HOLDERS +## BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER LIABILITY, WHETHER IN AN +## ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM, OUT OF OR IN +## CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN THE +## SOFTWARE. + +. lib # Load some portability helpers. +rm -rf R S # Another script may have left a mess. +darcs init --repo R # Create our test repos. +darcs init --repo S + +add_to_boring() { + echo "$1" >> _darcs/prefs/boring +} + +## These are the simple does-the-wrong-thing errors. +cd R +touch log +add_to_boring '^log$' + +unset pwd # Since this test is pretty much linux-specific, hspwd.hs is not needed + +# Skip the case-folding tests on systems that don't support it +touch cs-test +ln -s cs-test cs-Test || exit 200 + +rm cs-test cs-Test # move file and symlink out of the way for real tests + +# Case 15: case-folding link to non-recorded file +touch non-recorded-file2 +ln -s ./non-recorded-file2 ./Non-Recorded-File2 +ln -s "`pwd`"/non-recorded-file2 ./Non-ReCoRdEd-File2 +darcs w -l >log 2>&1 # should report only "non-recorded-file" +darcs rec -alm "added ./non-recorded-file2" >>log 2>&1 # should add only file, not symlink +darcs changes -s --patch="added ./non-recorded-file2" >>log 2>&1 # should report only file, not symlink +cat log +not grep -vE "(^ *$|^\+|[0-9]:[0-9][0-9]:[0-9]|./non-recorded-file2)" log +rm Non-Recorded-File2 ./Non-ReCoRdEd-File2 + +# Case 16: case-folding link to recorded file +ln -s ./recorded-file ./Recorded-File +ln -s "`pwd`"/recorded-file ./ReCorded-File +not darcs w -l >log 2>&1 # expecting "No changes!" +darcs rec -alm "should not happen" >>log 2>&1 # expecting "No changes!" as well +not grep -vE "(^ *$|^\+|No changes!)" log +rm Recorded-File ReCorded-File diff --git a/tests/issue1645-ignore-symlinks.sh b/tests/issue1645-ignore-symlinks.sh new file mode 100644 --- /dev/null +++ b/tests/issue1645-ignore-symlinks.sh @@ -0,0 +1,173 @@ +#!/usr/bin/env bash +## Test for issue1645 - Since Darcs does not version-contol symlinks, +## it should not follow them, ESPECIALLY symlinks to directories +## outside the repository. All these tests are passed with darcs-2.2 +## +## See path_resolution(7) and symlink(7) for more info, especially +## the former. +## +## There's a second section to this test for systems that support +## case-folding. See issue1645-ignore-symlinks-case-fold.sh +## +## Copyright (C) 2010 Trent W. Buck, Dmitry Astapov +## +## Permission is hereby granted, free of charge, to any person +## obtaining a copy of this software and associated documentation +## files (the "Software"), to deal in the Software without +## restriction, including without limitation the rights to use, copy, +## modify, merge, publish, distribute, sublicense, and/or sell copies +## of the Software, and to permit persons to whom the Software is +## furnished to do so, subject to the following conditions: +## +## The above copyright notice and this permission notice shall be +## included in all copies or substantial portions of the Software. +## +## THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, +## EXPRESS OR IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF +## MERCHANTABILITY, FITNESS FOR A PARTICULAR PURPOSE AND +## NONINFRINGEMENT. IN NO EVENT SHALL THE AUTHORS OR COPYRIGHT HOLDERS +## BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER LIABILITY, WHETHER IN AN +## ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM, OUT OF OR IN +## CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN THE +## SOFTWARE. + +. lib # Load some portability helpers. +rm -rf R S # Another script may have left a mess. +darcs init --repo R # Create our test repos. +darcs init --repo S + +darcs --version + +add_to_boring() { + echo "$1" >> _darcs/prefs/boring +} + +## These are the simple does-the-wrong-thing errors. +cd R +touch log +add_to_boring '^log$' + +unset pwd # Since this test is pretty much linux-specific, hspwd.hs is not needed + +# Case 1: looping symlink to non-recorded non-boring dir +mkdir non-recorded-dir +ln -s ../non-recorded-dir ./non-recorded-dir/loop # relative symlink +ln -s "`pwd`"/non-recorded-dir ./non-recorded-dir/loop2 # absolute symlink +darcs w -l >log 2>&1 # should not loop +darcs rec -alm "added ./non-recorded-dir" >>log 2>&1 # should not loop +darcs changes -s --patch="added ./non-recorded-dir" >>log 2>&1 # should report only dir, not symlink +not grep -vE "(^ *$|^\+|[0-9]:[0-9][0-9]:[0-9]|./non-recorded-dir)" log + +# Case 2: looping symlink to recorded dir +mkdir recorded-dir +darcs add recorded-dir +darcs rec -am "added recorded-dir" +ln -s ../recorded-dir ./recorded-dir/loop # relative symlink +ln -s "`pwd`"/recorded-dir ./recorded-dir/loop2 # absolute symlink +not darcs w -l >log 2>&1 # expecting "No changes!" +darcs rec -alm "should not happen" >>log 2>&1 # expecting "No changes!" as well +not grep -vE "(^ *$|^\+|No changes!)" log + +# Case 3: looping symlink to boring dir +mkdir boring-dir +add_to_boring '^boring-dir$' +ln -s ../boring-dir ./boring-dir/loop +ln -s "`pwd`"/boting-dir ./boring-dir/loop2 +not darcs w -l >log 2>&1 # expecting "No changes!" +darcs rec -alm "should not happen" >>log 2>&1 # expecting "No changes!" as well +not grep -vE "(^ *$|^\+|No changes!)" log + +# Case 4: non-looping symlink to non-recorded non-boring dir +mkdir non-recorded-dir2 +ln -s ./non-recorded-dir2 link +ln -s "`pwd`"/non-recorded-dir2 ./link2 +darcs w -l >log 2>&1 # should report only "non-recorded-dir2" +darcs rec -alm "added ./non-recorded-dir2" >>log 2>&1 # should add only dir, not symlink +darcs changes -s --patch="added ./non-recorded-dir2" >>log 2>&1 # should report only dir, not symlink +not grep -vE "(^ *$|^\+|[0-9]:[0-9][0-9]:[0-9]|./non-recorded-dir2)" log +rm link link2 + +# Case 5: non-looping symlink to recorded dir +ln -s ./recorded-dir ./link +ln -s "`pwd`"/recorded-dir ./link2 +not darcs w -l >log 2>&1 # expecting "No changes!" +darcs rec -alm "should not happen" >>log 2>&1 # expecting "No changes!" as well +not grep -vE "(^ *$|^\+|No changes!)" log +rm link link2 + +# Case 6: non-looping symlink to boring dir +ln -s ./boring-dir ./link +ln -s "`pwd`"/boring-dir ./link2 +not darcs w -l >log 2>&1 # expecting "No changes!" +darcs rec -alm "should not happen" >>log 2>&1 # expecting "No changes!" as well +not grep -vE "(^ *$|^\+|No changes!)" log +rm link link2 + +# Case 7: symlink pointing outside the repo +ln -s ../S link +(cd ..; ln -s "`pwd`"/S ./R/link2) +not darcs w -l >log 2>&1 # expecting "No changes!" +darcs rec -alm "should not happen" >>log 2>&1 # expecting "No changes!" as well +not grep -vE "(^ *$|^\+|No changes!)" log +rm link link2 + +# Case 8: symlink to non-recorded non-boring file +touch non-recorded-file +ln -s ./non-recorded-file ./link +ln -s "`pwd`"/non-recorded-file ./link2 +darcs w -l >log 2>&1 # should report only "non-recorded-file" +darcs rec -alm "added ./non-recorded-file" >>log 2>&1 # should add only file, not symlink +darcs changes -s --patch="added ./non-recorded-file" >>log 2>&1 # should report only file, not symlink +not grep -vE "(^ *$|^\+|[0-9]:[0-9][0-9]:[0-9]|./non-recorded-file)" log +rm link link2 + +# Case 9: symlink to recorded file +echo "some content" > recorded-file +darcs add recorded-file +darcs rec -am "added recorded-file" recorded-file +ln -s ./recorded-file ./link +ln -s "`pwd`"/recorded-file ./link2 +not darcs w -l >log 2>&1 # expecting "No changes!" +darcs rec -alm "should not happen" >>log 2>&1 # expecting "No changes!" as well +not grep -vE "(^ *$|^\+|No changes!)" log +rm link link2 + +# Case 10: symlink to boring file +ln -s ./log ./link +ln -s "`pwd`"/log ./link2 +not darcs w -l >log 2>&1 # expecting "No changes!" +darcs rec -alm "should not happen" >>log 2>&1 # expecting "No changes!" as well +not grep -vE "(^ *$|^\+|No changes!)" log +rm link link2 + +# Case 11: dangling symlink +ln -s /completely/bogus/path ./link +ln -s ../../../../not/exist ./link2 +not darcs w -l >log 2>&1 # expecting "No changes!" +darcs rec -alm "should not happen" >>log 2>&1 # expecting "No changes!" as well +not grep -vE "(^ *$|^\+|No changes!)" log +rm link link2 + +# Case 12: self-referencing link +ln -s l l +ln -s "`pwd`"/l2 ./l2 +not darcs w -l >log 2>&1 # expecting "No changes!" +darcs rec -alm "should not happen" >>log 2>&1 # expecting "No changes!" as well +not grep -vE "(^ *$|^\+|No changes!)" log +rm l l2 + +# Case 13: link to device file outside the repo +ln -s /dev/zero l +not darcs w -l >log 2>&1 # expecting "No changes!" +darcs rec -alm "should not happen" >>log 2>&1 # expecting "No changes!" as well +not grep -vE "(^ *$|^\+|No changes!)" log +rm l + +# Case 14: link to fifo +mkfifo f +ln -s f l +ln -s "`pwd`"/f ./l2 +not darcs w -l >log 2>&1 # expecting "No changes!" +darcs rec -alm "should not happen" >>log 2>&1 # expecting "No changes!" as well +not grep -vE "(^ *$|^\+|No changes!)" log +rm f l l2 diff --git a/tests/issue1765_recursive-remove-on-root.sh b/tests/issue1765_recursive-remove-on-root.sh new file mode 100644 --- /dev/null +++ b/tests/issue1765_recursive-remove-on-root.sh @@ -0,0 +1,36 @@ +#!/usr/bin/env bash +## Test for issueNNNN - +## +## Copyright (C) YEAR AUTHOR +## +## Permission is hereby granted, free of charge, to any person +## obtaining a copy of this software and associated documentation +## files (the "Software"), to deal in the Software without +## restriction, including without limitation the rights to use, copy, +## modify, merge, publish, distribute, sublicense, and/or sell copies +## of the Software, and to permit persons to whom the Software is +## furnished to do so, subject to the following conditions: +## +## The above copyright notice and this permission notice shall be +## included in all copies or substantial portions of the Software. +## +## THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, +## EXPRESS OR IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF +## MERCHANTABILITY, FITNESS FOR A PARTICULAR PURPOSE AND +## NONINFRINGEMENT. IN NO EVENT SHALL THE AUTHORS OR COPYRIGHT HOLDERS +## BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER LIABILITY, WHETHER IN AN +## ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM, OUT OF OR IN +## CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN THE +## SOFTWARE. + +. lib # Load some portability helpers. +rm -rf R S # Another script may have left a mess. +darcs init --repo R # Create our test repos. +darcs init --repo S + +cd R +mkdir d e # Change the working tree. +echo 'Example content.' > d/f +darcs record -lam 'Add d/f and e.' +darcs remove * -r diff --git a/tests/issue458.sh b/tests/issue458.sh --- a/tests/issue458.sh +++ b/tests/issue458.sh @@ -20,7 +20,8 @@ darcs record --repodir repo1 -lam x x umask 077 # DENY ALL access to group, all darcs get --set-scripts-executable repo1 repo2 -ls -l repo2/x | cut -f 1 -d\ > mode +# remove trailing-dot for xattr +ls -l repo2/x | cut -f 1 -d\ | sed -e "s/\.$//" > mode echo -rwx------ > desired-mode diff -u desired-mode mode