Compare commits
No commits in common. "08d7a9f7aff5d0dbd0fa72709d9f1b82bf3323e8" and "51e303a7980ee863cd2e2bb169fd8cfbc1903571" have entirely different histories.
08d7a9f7af
...
51e303a798
36 changed files with 9984 additions and 3207 deletions
|
@ -1 +0,0 @@
|
|||
repo_token: xl1m2EiKjG4YlJQ0KjTTBNDRcAFD0lCVt
|
|
@ -1,6 +0,0 @@
|
|||
((cperl-mode . ((dumb-jump-force-searcher . rg)
|
||||
(cperl-indent-level . 4)
|
||||
(cperl-close-paren-offset . -4)
|
||||
(cperl-indent-subs-specially . nil)
|
||||
(indent-tabs-mode . nil)
|
||||
(eval . (auto-fill-mode -1)))))
|
|
@ -1,2 +0,0 @@
|
|||
+bin/*.in
|
||||
+lib/*.pm.in
|
80
.github/workflows/test.yml
vendored
80
.github/workflows/test.yml
vendored
|
@ -1,80 +0,0 @@
|
|||
# This file is part of GNU Stow.
|
||||
#
|
||||
# GNU Stow 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 3 of the License, or
|
||||
# (at your option) any later version.
|
||||
#
|
||||
# GNU Stow 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. If not, see https://www.gnu.org/licenses/.
|
||||
|
||||
name: Test suite
|
||||
|
||||
on:
|
||||
push:
|
||||
branches: [master]
|
||||
|
||||
pull_request:
|
||||
branches: [master]
|
||||
types: [opened, synchronize, reopened, ready_for_review]
|
||||
|
||||
jobs:
|
||||
# call-simple-perl-test:
|
||||
# uses: perl-actions/github-workflows/.github/workflows/simple-perltester-workflow.yml@main
|
||||
# with:
|
||||
# since-perl: 5.14
|
||||
|
||||
test:
|
||||
name: Perl ${{ matrix.perl-version }}
|
||||
runs-on: ubuntu-latest
|
||||
|
||||
strategy:
|
||||
matrix:
|
||||
perl-version:
|
||||
- '5.38'
|
||||
- '5.36'
|
||||
- '5.34'
|
||||
- '5.32'
|
||||
- '5.30'
|
||||
|
||||
container:
|
||||
# This Docker image should avoid the need to run:
|
||||
#
|
||||
# cpanm -n Devel::Cover::Report::Coveralls
|
||||
image: perldocker/perl-tester:${{ matrix.perl-version }}
|
||||
|
||||
steps:
|
||||
- run: apt-get update && apt-get install -y sudo texinfo texlive
|
||||
|
||||
- name: Checkout code
|
||||
uses: actions/checkout@v2
|
||||
|
||||
# - uses: awalsh128/cache-apt-pkgs-action@latest
|
||||
# with:
|
||||
# debug: true
|
||||
# packages: texinfo texlive
|
||||
# version: 1.0
|
||||
|
||||
- run: autoreconf --install
|
||||
- name: ./configure && make
|
||||
run: |
|
||||
eval `perl -V:siteprefix`
|
||||
# Note: this will complain Test::Output isn't yet installed:
|
||||
./configure --prefix=$siteprefix && make
|
||||
|
||||
# but that's OK because we install it here:
|
||||
make cpanm
|
||||
|
||||
#- name: Run tests
|
||||
# run: make test
|
||||
|
||||
- run: make distcheck
|
||||
- run: perl Build.PL
|
||||
- run: ./Build build
|
||||
- run: cover -test -report coveralls
|
||||
- run: ./Build distcheck
|
3
.gitignore
vendored
3
.gitignore
vendored
|
@ -9,8 +9,7 @@
|
|||
/bin/stow
|
||||
/doc/stow.info
|
||||
/doc/version.texi
|
||||
/playground/
|
||||
tmp-testing-trees*/
|
||||
tmp-testing-trees/
|
||||
_build/
|
||||
autom4te.cache/
|
||||
blib/
|
||||
|
|
4
AUTHORS
4
AUTHORS
|
@ -1,7 +1,3 @@
|
|||
This file documents the high-level history of Stow, and some of its
|
||||
major contributors. See also the THANKS file for a more complete list
|
||||
of contributors.
|
||||
|
||||
Stow was originally written by Bob Glickstein <bobg+stow@zanshin.com>,
|
||||
Zanshin Software, Inc.
|
||||
|
||||
|
|
123
CONTRIBUTING.md
123
CONTRIBUTING.md
|
@ -1,123 +0,0 @@
|
|||
Contributing to GNU Stow
|
||||
========================
|
||||
|
||||
Development of Stow, and GNU in general, is a volunteer effort, and
|
||||
you can contribute. If you'd like to get involved, it's a good idea to join
|
||||
the [stow-devel](https://lists.gnu.org/mailman/listinfo/stow-devel)
|
||||
mailing list.
|
||||
|
||||
Bug reporting
|
||||
-------------
|
||||
|
||||
Please follow the procedure described in [the "Reporting Bugs"
|
||||
section](https://www.gnu.org/software/stow/manual/html_node/Reporting-Bugs.html#Reporting-Bugs)
|
||||
of [the manual](README.md#documentation).
|
||||
|
||||
Development
|
||||
-----------
|
||||
|
||||
For [development sources](https://savannah.gnu.org/git/?group=stow)
|
||||
and other information, please see the [Stow project
|
||||
page](http://savannah.gnu.org/projects/stow/) at
|
||||
[savannah.gnu.org](http://savannah.gnu.org).
|
||||
|
||||
There is also a
|
||||
[stow-devel](https://lists.gnu.org/mailman/listinfo/stow-devel)
|
||||
mailing list (see [Mailing lists](README.md#mailing-lists)).
|
||||
|
||||
Please be aware that all program source files (excluding the test
|
||||
suite) end in `.in`, and are pre-processed by `Makefile` into
|
||||
corresponding files with that prefix stripped before execution. So if
|
||||
you want to test any modifications to the source, make sure that you
|
||||
change the `.in` files and then run `make` to regenerate the
|
||||
pre-processed versions before doing any testing. To avoid forgetting
|
||||
(which can potentially waste a lot of time debugging the wrong code),
|
||||
you can automatically run `make` in an infinite loop every second via:
|
||||
|
||||
make watch
|
||||
|
||||
(You could even use fancier approaches like
|
||||
[`inotifywait(1)`](https://www.man7.org/linux/man-pages/man1/inotifywait.1.html)
|
||||
or [Guard](https://guardgem.org/). But those are probably overkill in
|
||||
this case where the simple `while` loop is plenty good enough.)
|
||||
|
||||
Testing
|
||||
~~~~~~~
|
||||
|
||||
The test suite can be found in the [`t/`](t/) subdirectory. You can
|
||||
run the test suite via:
|
||||
|
||||
make check
|
||||
|
||||
Tests can be run individually as follows. First you have to ensure
|
||||
that the `t/`, `bin/`, and `lib/` directories are on Perl's search path.
|
||||
Assuming that you run all tests from the root of the repository tree,
|
||||
this will do the job:
|
||||
|
||||
export PERL5LIB=t:bin:lib
|
||||
|
||||
(Not all tests require all of these, but it's safer to include all of
|
||||
them.)
|
||||
|
||||
Secondly, be aware that if you want to test modifications to the
|
||||
source files, you will need to run `make watch`, or `make` before each
|
||||
test run as explained above.
|
||||
|
||||
Now running an individual test is as simple as:
|
||||
|
||||
perl t/chkstow.t
|
||||
|
||||
or with a given debugging verbosity corresponding to the `-v` / `--verbose`
|
||||
command-line option:
|
||||
|
||||
TEST_VERBOSE=4 perl t/chkstow.t
|
||||
|
||||
The [`prove(1)` test runner](https://perldoc.perl.org/prove) is another
|
||||
good alternative which provides several handy extra features. Invocation
|
||||
is very similar, e.g.:
|
||||
|
||||
prove t/stow.t
|
||||
|
||||
or to run the whole suite:
|
||||
|
||||
prove
|
||||
|
||||
However currently there is an issue where this interferes with
|
||||
`TEST_VERBOSE`.
|
||||
|
||||
If you want to create test files for experimentation, it is
|
||||
recommended to put them in a subdirectory called `playground/` since
|
||||
this will be automatically ignored by git and the build process,
|
||||
avoiding any undesirable complications.
|
||||
|
||||
Test coverage
|
||||
~~~~~~~~~~~~~
|
||||
|
||||
To view test coverage reports, first ensure that
|
||||
[`Devel::Cover`](https://metacpan.org/dist/Devel-Cover) is installed.
|
||||
Then type `make coverage`. The last lines of the output should
|
||||
include something like:
|
||||
|
||||
HTML output written to /home/user/path/to/stow/cover_db/coverage.html
|
||||
|
||||
which you can open in a web browser to view the report.
|
||||
|
||||
Translating Stow
|
||||
----------------
|
||||
|
||||
Stow is not currently multi-lingual, but patches would be very
|
||||
gratefully accepted. Please e-mail
|
||||
[stow-devel](https://lists.gnu.org/mailman/listinfo/stow-devel) if you
|
||||
intend to work on this.
|
||||
|
||||
Maintainers
|
||||
-----------
|
||||
|
||||
Stow is currently being maintained by Adam Spiers. Please use [the
|
||||
mailing lists](README.md#mailing-lists).
|
||||
|
||||
Helping the GNU project
|
||||
-----------------------
|
||||
|
||||
For more general information, please read [How to help
|
||||
GNU](https://www.gnu.org/help/).
|
5
MANIFEST
5
MANIFEST
|
@ -3,7 +3,6 @@ aclocal.m4
|
|||
automake/install-sh
|
||||
automake/mdate-sh
|
||||
automake/missing
|
||||
automake/texinfo.tex
|
||||
bin/chkstow
|
||||
bin/chkstow.in
|
||||
bin/stow
|
||||
|
@ -12,7 +11,6 @@ Build.PL
|
|||
ChangeLog
|
||||
configure
|
||||
configure.ac
|
||||
CONTRIBUTING.md
|
||||
COPYING
|
||||
default-ignore-list
|
||||
doc/ChangeLog.OLD
|
||||
|
@ -21,6 +19,7 @@ doc/manual.pdf
|
|||
doc/stow.8
|
||||
doc/stow.info
|
||||
doc/stow.texi
|
||||
doc/texinfo.tex
|
||||
doc/version.texi
|
||||
INSTALL.md
|
||||
lib/Stow.pm
|
||||
|
@ -44,12 +43,12 @@ t/find_stowed_path.t
|
|||
t/foldable.t
|
||||
t/ignore.t
|
||||
t/join_paths.t
|
||||
t/link_dest_within_stow_dir.t
|
||||
t/parent.t
|
||||
t/stow.t
|
||||
t/rc_options.t
|
||||
t/testutil.pm
|
||||
t/unstow.t
|
||||
t/unstow_orig.t
|
||||
tools/get-version
|
||||
THANKS
|
||||
TODO
|
||||
|
|
|
@ -83,14 +83,7 @@
|
|||
^doc/HOWTO-RELEASE$
|
||||
|
||||
# Avoid test files
|
||||
tmp-testing-trees*
|
||||
^.coveralls.yml
|
||||
^.github/workflows/
|
||||
^.travis.yml
|
||||
tmp-testing-trees
|
||||
.travis.yml
|
||||
^docker/
|
||||
^[a-zA-Z]*-docker.sh
|
||||
^playground/
|
||||
|
||||
# Avoid development config
|
||||
^.dir-locals.el
|
||||
^.dumbjump
|
||||
|
|
10
META.json
10
META.json
|
@ -4,7 +4,7 @@
|
|||
"unknown"
|
||||
],
|
||||
"dynamic_config" : 1,
|
||||
"generated_by" : "Module::Build version 0.4234",
|
||||
"generated_by" : "Module::Build version 0.4224",
|
||||
"license" : [
|
||||
"gpl_1"
|
||||
],
|
||||
|
@ -37,11 +37,11 @@
|
|||
"provides" : {
|
||||
"Stow" : {
|
||||
"file" : "lib/Stow.pm",
|
||||
"version" : "v2.4.0"
|
||||
"version" : "v2.3.2-fixbug56727"
|
||||
},
|
||||
"Stow::Util" : {
|
||||
"file" : "lib/Stow/Util.pm",
|
||||
"version" : "v2.4.0"
|
||||
"version" : "v2.3.2-fixbug56727"
|
||||
}
|
||||
},
|
||||
"release_status" : "stable",
|
||||
|
@ -55,6 +55,6 @@
|
|||
"url" : "git://git.savannah.gnu.org/stow.git"
|
||||
}
|
||||
},
|
||||
"version" : "v2.4.0",
|
||||
"x_serialization_backend" : "JSON::PP version 4.16"
|
||||
"version" : "v2.3.2-fixbug56727",
|
||||
"x_serialization_backend" : "JSON::PP version 4.00"
|
||||
}
|
||||
|
|
8
META.yml
8
META.yml
|
@ -9,7 +9,7 @@ build_requires:
|
|||
configure_requires:
|
||||
Module::Build: '0'
|
||||
dynamic_config: 1
|
||||
generated_by: 'Module::Build version 0.4234, CPAN::Meta::Converter version 2.150010'
|
||||
generated_by: 'Module::Build version 0.4224, CPAN::Meta::Converter version 2.150010'
|
||||
license: gpl
|
||||
meta-spec:
|
||||
url: http://module-build.sourceforge.net/META-spec-v1.4.html
|
||||
|
@ -18,10 +18,10 @@ name: Stow
|
|||
provides:
|
||||
Stow:
|
||||
file: lib/Stow.pm
|
||||
version: v2.4.0
|
||||
version: v2.3.2-fixbug56727
|
||||
Stow::Util:
|
||||
file: lib/Stow/Util.pm
|
||||
version: v2.4.0
|
||||
version: v2.3.2-fixbug56727
|
||||
requires:
|
||||
Carp: '0'
|
||||
IO::File: '0'
|
||||
|
@ -30,5 +30,5 @@ resources:
|
|||
homepage: https://savannah.gnu.org/projects/stow
|
||||
license: http://www.gnu.org/licenses/gpl-2.0.html
|
||||
repository: git://git.savannah.gnu.org/stow.git
|
||||
version: v2.4.0
|
||||
version: v2.3.2-fixbug56727
|
||||
x_serialization_backend: 'CPAN::Meta::YAML version 0.018'
|
||||
|
|
48
Makefile.am
48
Makefile.am
|
@ -32,26 +32,26 @@ pmstowdir = $(pmdir)/Stow
|
|||
pm_DATA = lib/Stow.pm
|
||||
pmstow_DATA = lib/Stow/Util.pm
|
||||
|
||||
TEXINFO_TEX = doc/texinfo.tex
|
||||
export TEXI2DVI_BUILD_MODE = clean
|
||||
AM_MAKEINFOFLAGS = -I $(srcdir)
|
||||
|
||||
# We require this -I parameter to ensure that the include of the
|
||||
# default ignore list in the manual works correctly, even when the
|
||||
# manual is being built via make distcheck from a different directory.
|
||||
# Unfortunately this is the only way to do it:
|
||||
# default ignore list in the manual works. Unfortunately this is
|
||||
# the only way to do it:
|
||||
#
|
||||
# https://lists.gnu.org/archive/html/bug-automake/2008-09/msg00040.html
|
||||
# http://article.gmane.org/gmane.comp.sysutils.automake.bugs/4334/match=passing+parameters
|
||||
#
|
||||
# even though it annoyingly produces a warning with the -Wall option
|
||||
# to AM_INIT_AUTOMAKE which has to be silenced via -Wno-override.
|
||||
TEXI2DVI = texi2dvi $(AM_MAKEINFOFLAGS)
|
||||
|
||||
doc_deps = $(info_TEXINFOS) doc/version.texi
|
||||
|
||||
DEFAULT_IGNORE_LIST = $(srcdir)/default-ignore-list
|
||||
|
||||
doc_deps = $(info_TEXINFOS) doc/version.texi $(DEFAULT_IGNORE_LIST)
|
||||
|
||||
TESTS_DIR = $(srcdir)/t
|
||||
TESTS_OUT = tmp-testing-trees tmp-testing-trees-compat
|
||||
TESTS_OUT = tmp-testing-trees
|
||||
TESTS_ENVIRONMENT = $(PERL) -Ibin -Ilib -I$(TESTS_DIR)
|
||||
|
||||
# This is a kind of hack; TESTS needs to be set to ensure that the
|
||||
|
@ -77,7 +77,7 @@ check_DATA = $(TESTS_OUT)
|
|||
# Note that automake's `check' rule cannot be overridden
|
||||
# for some weird reason:
|
||||
#
|
||||
# https://lists.gnu.org/archive/html/automake/2011-09/msg00029.html
|
||||
# http://thread.gmane.org/gmane.comp.sysutils.automake.general/13040/focus=13041
|
||||
#
|
||||
# so we override check-TESTS instead which is where the real work is
|
||||
# done anyway. Unfortunately this produces a warning with the -Wall
|
||||
|
@ -87,10 +87,6 @@ check-TESTS:
|
|||
dir=$(TESTS_DIR); \
|
||||
$(TESTS_ENVIRONMENT) -MTest::Harness -e 'runtests(@ARGV)' "$${dir#./}"/*.t
|
||||
|
||||
coverage:
|
||||
PERL5OPT=-MDevel::Cover $(MAKE) check-TESTS
|
||||
cover
|
||||
|
||||
$(TESTS_OUT):
|
||||
mkdir -p $@
|
||||
|
||||
|
@ -99,6 +95,7 @@ EXTRA_DIST = \
|
|||
bin/stow.in bin/chkstow.in lib/Stow.pm.in lib/Stow/Util.pm.in \
|
||||
doc/manual-split \
|
||||
$(TESTS) t/testutil.pm \
|
||||
$(TEXINFO_TEX) \
|
||||
$(DEFAULT_IGNORE_LIST) \
|
||||
$(CPAN_FILES)
|
||||
CLEANFILES = $(bin_SCRIPTS) $(pm_DATA) $(pmstow_DATA)
|
||||
|
@ -196,7 +193,7 @@ doc/stow.8: bin/stow.in Makefile.am
|
|||
#
|
||||
# If it were not for a troublesome dependency on doc/$(am__dirstamp):
|
||||
#
|
||||
# https://lists.gnu.org/archive/html/automake/2011-11/msg00107.html
|
||||
# http://article.gmane.org/gmane.comp.sysutils.automake.general/13192
|
||||
#
|
||||
# we could have achieved this using the built-in rules combined with
|
||||
# install-data-hook to rename from stow.pdf to manual.pdf etc. on
|
||||
|
@ -305,28 +302,3 @@ ChangeLog: doc/ChangeLog.OLD
|
|||
else \
|
||||
echo "Not in a git repository; can't update ChangeLog."; \
|
||||
fi
|
||||
|
||||
# Watch for changes, and if any rebuilds are required, also do a
|
||||
# make install.
|
||||
#
|
||||
# If we solved https://github.com/aspiers/stow/issues/84, we could
|
||||
# probably ditch this:
|
||||
watch:
|
||||
@echo "Watching for changes to program source files ..."
|
||||
@while true; do \
|
||||
if $(MAKE) 2>&1 | \
|
||||
grep -vE 'make\[[1-9]\]: (Entering|Leaving) directory ' | \
|
||||
grep -v 'Nothing to be done'; \
|
||||
then \
|
||||
echo; \
|
||||
echo "-----------------------------------------------------"; \
|
||||
echo "make found things to rebuild; doing $(MAKE) install ..."; \
|
||||
echo; \
|
||||
$(MAKE) install; \
|
||||
echo; \
|
||||
echo ">>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>"; \
|
||||
echo; \
|
||||
fi; \
|
||||
sleep 1; \
|
||||
done 2>&1 | \
|
||||
grep -vE 'make\[[1-9]\]: (Entering|Leaving) directory '
|
||||
|
|
82
NEWS
82
NEWS
|
@ -1,81 +1,5 @@
|
|||
News file for Stow.
|
||||
|
||||
* Changes in version 2.4.0
|
||||
|
||||
*** --dotfiles now works with directories
|
||||
|
||||
A long-standing bug preventing the --dotfiles option from working
|
||||
correctly with directories has been fixed.
|
||||
|
||||
It should also works in combination with the --compat option.
|
||||
|
||||
*** Eliminated a spurious warning on unstowing
|
||||
|
||||
2.3.1 introduced a benign but annoying warning when unstowing
|
||||
in certain circumstances. It looked like:
|
||||
|
||||
BUG in find_stowed_path? Absolute/relative mismatch between Stow dir X and path Y
|
||||
|
||||
This was caused by erroneous logic, and has now been fixed.
|
||||
|
||||
*** Unstowing logic has been improved in other cases
|
||||
|
||||
Several other improvements have been made internally to the
|
||||
unstowing logic. These changes should all be either invisible
|
||||
(except for changes to debug output) or improvements, but if you
|
||||
encounter any unexpected behaviour, please report it as directed
|
||||
in the manual.
|
||||
|
||||
*** Improved debug output
|
||||
|
||||
Extra output resulting from use of the -v / --verbose flag
|
||||
now appears in a more logical and understandable way.
|
||||
|
||||
*** Janitorial tasks
|
||||
|
||||
Users are not substantially affected by these changes.
|
||||
|
||||
***** Added some more information from the web page to the README
|
||||
|
||||
***** Made some improvements to the documentation
|
||||
|
||||
***** Improve readability of source code
|
||||
|
||||
Quite a few extra details have been added in comments to clarify
|
||||
how the code works. Many variable names have also been
|
||||
improved. The comments of many Stow class methods have been
|
||||
converted into Perl POD format.
|
||||
|
||||
***** Added a =CONTRIBUTING.md= file
|
||||
|
||||
***** Add a =watch= target to =Makefile=
|
||||
|
||||
=make watch= provides easy continual pre-processing during
|
||||
development, which reduces the risk of debugging the wrong code.
|
||||
|
||||
***** Removed texinfo.tex from the distribution
|
||||
|
||||
This eliminates existing and future bit-rot.
|
||||
|
||||
***** Updated aclocal.m4 from 1.15.1 to 1.16.5
|
||||
|
||||
This mostly just updates copyright notices to 2021, and URLs to https.
|
||||
|
||||
***** Replace broken gmane links with links to lists.gnu.org
|
||||
|
||||
[[https://lars.ingebrigtsen.no/2020/01/06/whatever-happened-to-news-gmane-org/][gmane has been dead for quite a while.]]
|
||||
|
||||
***** Improve support for navigating / editing source via emacs
|
||||
|
||||
******* Support source navigation in emacs via [[https://github.com/jacktasia/dumb-jump][dumb-jump]].
|
||||
|
||||
******* Configure cperl-mode to match existing coding style.
|
||||
|
||||
*** Various maintainer tweaks
|
||||
|
||||
Further improved the release process and its documentation in
|
||||
various minor ways.
|
||||
|
||||
* Changes in version 2.3.1
|
||||
|
||||
*** Remove dependencies on Hash::Merge and Clone::Choose
|
||||
|
@ -214,7 +138,6 @@ News file for Stow.
|
|||
consistency.
|
||||
|
||||
- INSTALL.md now also documents how to build directly from git.
|
||||
|
||||
*** Fixes for bugs, tests, and other technical debt
|
||||
|
||||
***** Add Docker files for convenient testing across multiple Perl versions
|
||||
|
@ -312,7 +235,7 @@ due to Stow::Util missing $VERSION.
|
|||
stow directory path being calculated as
|
||||
../../../usr/home/user/local/stow relative to the target.
|
||||
|
||||
See https://lists.gnu.org/archive/html/bug-stow/2013-04/msg00000.html for details.
|
||||
See http://article.gmane.org/gmane.comp.gnu.stow.bugs/8820 for details.
|
||||
|
||||
*** Fix stowing of relative links when --no-folding is used.
|
||||
|
||||
|
@ -353,7 +276,7 @@ due to Stow::Util missing $VERSION.
|
|||
|
||||
Thanks to Gabriele Balducci for reporting this problem:
|
||||
|
||||
https://lists.gnu.org/archive/html/help-stow/2014-09/msg00000.html
|
||||
http://thread.gmane.org/gmane.comp.gnu.stow.general/6676
|
||||
|
||||
*** Internal code cleanups
|
||||
|
||||
|
@ -663,5 +586,4 @@ due to Stow::Util missing $VERSION.
|
|||
org-export-with-toc: nil
|
||||
org-export-with-author: nil
|
||||
org-toc-odd-levels-only: t
|
||||
org-blank-before-new-entry: ((heading . auto) (plain-list-item . auto))
|
||||
End:
|
||||
|
|
62
README.md
62
README.md
|
@ -60,56 +60,6 @@ You can get the latest information about Stow from the home page:
|
|||
|
||||
http://www.gnu.org/software/stow/
|
||||
|
||||
Installation
|
||||
------------
|
||||
|
||||
See [`INSTALL.md`](INSTALL.md) for installation instructions.
|
||||
|
||||
Documentation
|
||||
-------------
|
||||
|
||||
Documentation for Stow is available
|
||||
[online](https://www.gnu.org/software/stow/manual/), as is
|
||||
[documentation for most GNU
|
||||
software](https://www.gnu.org/software/manual/). Once you have Stow
|
||||
installed, you may also find more information about Stow by running
|
||||
`info stow` or `man stow`, or by looking at `/usr/share/doc/stow/`,
|
||||
`/usr/local/doc/stow/`, or similar directories on your system. A
|
||||
brief summary is available by running `stow --help`.
|
||||
|
||||
Mailing lists
|
||||
-------------
|
||||
|
||||
Stow has the following mailing lists:
|
||||
|
||||
- [help-stow](https://lists.gnu.org/mailman/listinfo/help-stow) is for
|
||||
general user help and discussion.
|
||||
- [stow-devel](https://lists.gnu.org/mailman/listinfo/stow-devel) is
|
||||
used to discuss most aspects of Stow, including development and
|
||||
enhancement requests.
|
||||
- [bug-stow](https://lists.gnu.org/mailman/listinfo/bug-stow) is for
|
||||
bug reports.
|
||||
|
||||
Announcements about Stow are posted to
|
||||
[info-stow](http://lists.gnu.org/mailman/listinfo/info-stow) and also,
|
||||
as with most other GNU software, to
|
||||
[info-gnu](http://lists.gnu.org/mailman/listinfo/info-gnu)
|
||||
([archive](http://lists.gnu.org/archive/html/info-gnu/)).
|
||||
|
||||
Security reports that should not be made immediately public can be
|
||||
sent directly to the maintainer. If there is no response to an urgent
|
||||
issue, you can escalate to the general
|
||||
[security](http://lists.gnu.org/mailman/listinfo/security) mailing
|
||||
list for advice.
|
||||
|
||||
The Savannah project also has a [mailing
|
||||
lists](https://savannah.gnu.org/mail/?group=stow) page.
|
||||
|
||||
Getting involved
|
||||
----------------
|
||||
|
||||
Please see the [`CONTRIBUTING.md` file](CONTRIBUTING.md).
|
||||
|
||||
License
|
||||
-------
|
||||
|
||||
|
@ -121,6 +71,18 @@ are permitted in any medium without royalty provided the copyright
|
|||
notice and this notice are preserved. This file is offered as-is,
|
||||
without any warranty.
|
||||
|
||||
Installation
|
||||
------------
|
||||
|
||||
See [`INSTALL.md`](INSTALL.md) for installation instructions.
|
||||
|
||||
Feedback
|
||||
--------
|
||||
|
||||
Please do send comments, questions, and constructive criticism. The
|
||||
mailing lists and any other communication channels are detailed on the
|
||||
above home page.
|
||||
|
||||
Brief history and authorship
|
||||
----------------------------
|
||||
|
||||
|
|
2
TODO
2
TODO
|
@ -4,7 +4,7 @@
|
|||
install-info, amongst other things:
|
||||
|
||||
*** http://unix.stackexchange.com/questions/73426/dealing-with-gnu-stow-conflicts
|
||||
*** https://lists.gnu.org/archive/html/help-stow/2013-04/msg00016.html
|
||||
*** http://article.gmane.org/gmane.comp.gnu.stow.general/6661
|
||||
|
||||
* Get permission for next documentation release to be under FDL 1.3
|
||||
|
||||
|
|
4
aclocal.m4
vendored
4
aclocal.m4
vendored
|
@ -14,8 +14,8 @@
|
|||
m4_ifndef([AC_CONFIG_MACRO_DIRS], [m4_defun([_AM_CONFIG_MACRO_DIRS], [])m4_defun([AC_CONFIG_MACRO_DIRS], [_AM_CONFIG_MACRO_DIRS($@)])])
|
||||
m4_ifndef([AC_AUTOCONF_VERSION],
|
||||
[m4_copy([m4_PACKAGE_VERSION], [AC_AUTOCONF_VERSION])])dnl
|
||||
m4_if(m4_defn([AC_AUTOCONF_VERSION]), [2.72],,
|
||||
[m4_warning([this file was generated for autoconf 2.72.
|
||||
m4_if(m4_defn([AC_AUTOCONF_VERSION]), [2.71],,
|
||||
[m4_warning([this file was generated for autoconf 2.71.
|
||||
You have another version of autoconf. It may work, but is not guaranteed to.
|
||||
If you have problems, you may need to regenerate the build system entirely.
|
||||
To do so, use the procedure documented by the package, typically 'autoreconf'.])])
|
||||
|
|
1
automake/.gitignore
vendored
1
automake/.gitignore
vendored
|
@ -2,4 +2,3 @@ install-sh
|
|||
missing
|
||||
mdate-sh
|
||||
test-driver
|
||||
texinfo.tex
|
||||
|
|
|
@ -123,5 +123,6 @@ sub list {
|
|||
|
||||
# Local variables:
|
||||
# mode: perl
|
||||
# cperl-indent-level: 4
|
||||
# End:
|
||||
# vim: ft=perl
|
||||
|
|
|
@ -474,6 +474,7 @@ sub main {
|
|||
my ($options, $pkgs_to_unstow, $pkgs_to_stow) = process_options();
|
||||
|
||||
my $stow = new Stow(%$options);
|
||||
# current dir is now the target directory
|
||||
|
||||
$stow->plan_unstow(@$pkgs_to_unstow);
|
||||
$stow->plan_stow (@$pkgs_to_stow);
|
||||
|
@ -848,5 +849,6 @@ sub version {
|
|||
|
||||
# Local variables:
|
||||
# mode: perl
|
||||
# cperl-indent-level: 4
|
||||
# end:
|
||||
# vim: ft=perl
|
||||
|
|
|
@ -15,11 +15,11 @@ dnl along with this program. If not, see https://www.gnu.org/licenses/.
|
|||
|
||||
dnl Process this file with Autoconf to produce configure dnl
|
||||
|
||||
AC_INIT([stow], [2.4.0], [bug-stow@gnu.org])
|
||||
AC_INIT([stow], [2.3.2-fixbug56727], [bug-stow@gnu.org])
|
||||
AC_PREREQ([2.61])
|
||||
AC_CONFIG_AUX_DIR([automake])
|
||||
# Unfortunately we have to disable warnings for overrides, because we
|
||||
# need to override the built-in `check-TESTS' rule and also the TEXI2DVI
|
||||
# need to override the built-in `check' rule and also the TEXI2DVI
|
||||
# variable.
|
||||
AM_INIT_AUTOMAKE([-Wall -Werror -Wno-override dist-bzip2 foreign])
|
||||
AC_PROG_INSTALL
|
||||
|
|
|
@ -13,7 +13,6 @@ _darcs
|
|||
|
||||
\.git
|
||||
\.gitignore
|
||||
\.gitmodules
|
||||
|
||||
.+~ # emacs backup files
|
||||
\#.*\# # emacs autosave files
|
||||
|
|
|
@ -21,16 +21,17 @@ Release procedure
|
|||
|
||||
version=$( tools/get-version ) && echo $version
|
||||
|
||||
- Ensure NEWS contains the latest changes. If necessary, commit
|
||||
- Ensure NEWS contains the latest changes, and that any new
|
||||
contributors have been added to THANKS. If necessary, commit
|
||||
any additions:
|
||||
|
||||
git commit -m "Prepare NEWS for $version release"
|
||||
git commit -m "Prepare NEWS and THANKS for $version release"
|
||||
|
||||
- Check CPAN distribution will work via Module::Build:
|
||||
|
||||
- Start from a clean slate:
|
||||
|
||||
make maintainer-clean
|
||||
make distclean
|
||||
autoreconf -iv
|
||||
|
||||
- Generate stow, chkstow, and lib/Stow.pm via:
|
||||
|
|
182
doc/stow.texi
182
doc/stow.texi
|
@ -19,13 +19,13 @@ This manual describes GNU Stow version @value{VERSION}
|
|||
|
||||
Software and documentation is copyrighted by the following:
|
||||
|
||||
@copyright{} 1993, 1994, 1995, 1996 Bob Glickstein @email{bobg+stow@@zanshin.com}
|
||||
@copyright{} 1993, 1994, 1995, 1996 Bob Glickstein <bobg+stow@@zanshin.com>
|
||||
@*
|
||||
@copyright{} 2000, 2001 Guillaume Morin @email{gmorin@@gnu.org}
|
||||
@copyright{} 2000, 2001 Guillaume Morin <gmorin@@gnu.org>
|
||||
@*
|
||||
@copyright{} 2007 Kahlil (Kal) Hodgson @email{kahlil@@internode.on.net}
|
||||
@copyright{} 2007 Kahlil (Kal) Hodgson <kahlil@@internode.on.net>
|
||||
@*
|
||||
@copyright{} 2011 Adam Spiers @email{stow@@adamspiers.org}
|
||||
@copyright{} 2011 Adam Spiers <stow@@adamspiers.org>
|
||||
|
||||
@quotation
|
||||
Permission is granted to make and distribute verbatim copies of this
|
||||
|
@ -99,7 +99,7 @@ appear to be installed in a single directory tree.
|
|||
* Multiple Stow Directories:: Further segregating software.
|
||||
* Target Maintenance:: Cleaning up mistakes.
|
||||
* Resource Files:: Setting default command line options.
|
||||
* Compile-time vs. Install-time:: Faking out `make install'.
|
||||
* Compile-time vs Install-time:: Faking out `make install'.
|
||||
* Bootstrapping:: When stow and perl are not yet stowed.
|
||||
* Reporting Bugs:: How, what, where, and when to report.
|
||||
* Known Bugs:: Don't report any of these.
|
||||
|
@ -220,12 +220,9 @@ to be installed in a particular directory structure --- e.g., with
|
|||
|
||||
@cindex target directory
|
||||
A @dfn{target directory} is the root of a tree in which one or more
|
||||
packages wish to @emph{appear} to be installed. @file{/usr/local} is a
|
||||
common choice for this, but by no means the only such location. Another
|
||||
common choice is @file{~} (i.e.@: the user's @code{$HOME} directory) in
|
||||
the case where Stow is being used to manage the user's configuration
|
||||
(``dotfiles'') and other files in their @code{$HOME}. The examples in
|
||||
this manual will use @file{/usr/local} as the target directory.
|
||||
packages wish to @emph{appear} to be installed. A common, but by no
|
||||
means the only such location is @file{/usr/local}. The examples in this
|
||||
manual will use @file{/usr/local} as the target directory.
|
||||
|
||||
@cindex stow directory
|
||||
A @dfn{stow directory} is the root of a tree containing separate
|
||||
|
@ -243,11 +240,6 @@ installation image for Perl includes: a @file{bin} directory containing
|
|||
containing Texinfo documentation; a @file{lib/perl} directory containing
|
||||
Perl libraries; and a @file{man/man1} directory containing man pages.
|
||||
|
||||
@quotation Note
|
||||
This is a @emph{pre-}installation image which exists even before Stow
|
||||
has installed any symlinks into the target directory which point to it.
|
||||
@end quotation
|
||||
|
||||
@cindex package directory
|
||||
@cindex package name
|
||||
A @dfn{package directory} is the root of a tree containing the
|
||||
|
@ -263,68 +255,15 @@ target directory, @file{/usr/local/stow} is the stow directory,
|
|||
@file{/usr/local/stow/perl} is the package directory, and
|
||||
@file{bin/perl} within is part of the installation image.
|
||||
|
||||
@anchor{symlink}
|
||||
@cindex symlink
|
||||
@cindex symlink source
|
||||
@cindex symlink destination
|
||||
@cindex relative symlink
|
||||
@cindex absolute symlink
|
||||
A @dfn{symlink} is a symbolic link, i.e.@: an entry on the filesystem
|
||||
whose path is sometimes called the @dfn{symlink source}, which points to
|
||||
another location on the filesystem called the @dfn{symlink destination}.
|
||||
There is no guarantee that the destination actually exists.
|
||||
|
||||
In general, symlinks can be @dfn{relative} or @dfn{absolute}. A symlink
|
||||
is absolute when the destination names a full path; that is, one
|
||||
starting from @file{/}. A symlink is relative when the destination
|
||||
names a relative path; that is, one not starting from @file{/}. The
|
||||
destination of a relative symlink is computed starting from the
|
||||
symlink's own directory, i.e.@: the directory containing the symlink
|
||||
source.
|
||||
|
||||
@quotation Note
|
||||
Stow only creates symlinks within the target directory which point to
|
||||
locations @emph{outside} the target directory and inside the stow
|
||||
directory.
|
||||
|
||||
Consequently, we avoid referring to symlink destinations as symlink
|
||||
@emph{targets}, since this would result in the word ``target'' having
|
||||
two different meanings:
|
||||
|
||||
@enumerate
|
||||
|
||||
@item
|
||||
the target directory, i.e.@: the directory into which Stow targets
|
||||
installation, where symlinks are managed by Stow, and
|
||||
|
||||
@item
|
||||
the destinations of those symlinks.
|
||||
|
||||
@end enumerate
|
||||
|
||||
If we did not avoid the second meaning of ``target'', then it would lead
|
||||
to confusing language, such as describing Stow as installing symlinks
|
||||
into the target directory which point to targets @emph{outside} the
|
||||
target directory.
|
||||
|
||||
Similarly, the word ``source'' can have two different meanings in this
|
||||
context:
|
||||
|
||||
@enumerate
|
||||
|
||||
@item
|
||||
the installation image, or some of its contents, and
|
||||
|
||||
@item
|
||||
the location of symlinks (the ``source'' of the link, vs.@: its
|
||||
destination).
|
||||
|
||||
@end enumerate
|
||||
|
||||
Therefore it should also be avoided, or at least care taken to ensure
|
||||
that the meaning is not ambiguous.
|
||||
|
||||
@end quotation
|
||||
A @dfn{symlink} is a symbolic link. A symlink can be @dfn{relative} or
|
||||
@dfn{absolute}. An absolute symlink names a full path; that is, one
|
||||
starting from @file{/}. A relative symlink names a relative path; that
|
||||
is, one not starting from @file{/}. The target of a relative symlink is
|
||||
computed starting from the symlink's own directory. Stow only
|
||||
creates relative symlinks.
|
||||
|
||||
@c ===========================================================================
|
||||
@node Invoking Stow, Ignore Lists, Terminology, Top
|
||||
|
@ -444,7 +383,7 @@ refolding (@pxref{tree refolding}). If a new subdirectory is
|
|||
encountered whilst stowing a new package, the subdirectory is created
|
||||
within the target, and its contents are symlinked, rather than just
|
||||
creating a symlink for the directory. If removal of symlinks whilst
|
||||
unstowing a package causes a subtree to be foldable (i.e.@: only
|
||||
unstowing a package causes a subtree to be foldable (i.e. only
|
||||
containing symlinks to a single package), that subtree will not be
|
||||
removed and replaced with a symlink.
|
||||
|
||||
|
@ -489,15 +428,13 @@ doing. Verbosity levels are from 0 to 5; 0 is the default. Using
|
|||
|
||||
@item -p
|
||||
@itemx --compat
|
||||
Scan the whole target tree when unstowing. By default, only directories
|
||||
specified in the @dfn{installation image} are scanned during an unstow
|
||||
operation. Previously Stow scanned the whole tree, which can be
|
||||
prohibitive if your target tree is very large, but on the other hand has
|
||||
the advantage of unstowing previously stowed links which are no longer
|
||||
present in the installation image and therefore orphaned. This option
|
||||
restores the legacy behaviour; however, the @option{--badlinks} option
|
||||
to the @command{chkstow} utility may be a better way of ensuring that
|
||||
your installation does not have any dangling symlinks (@pxref{Target
|
||||
Scan the whole target tree when unstowing. By default, only
|
||||
directories specified in the @dfn{installation image} are scanned
|
||||
during an unstow operation. Scanning the whole tree can be
|
||||
prohibitive if your target tree is very large. This option restores
|
||||
the legacy behaviour; however, the @option{--badlinks} option to the
|
||||
@command{chkstow} utility may be a better way of ensuring that your
|
||||
installation does not have any dangling symlinks (@pxref{Target
|
||||
Maintenance}).
|
||||
|
||||
@item -V
|
||||
|
@ -876,7 +813,7 @@ This is much faster and cleaner than performing two separate
|
|||
invocations of stow, because redundant folding/unfolding operations
|
||||
can be factored out. In addition, all the operations are calculated
|
||||
and merged before being executed (@pxref{Deferred Operation}), so the
|
||||
amount of time in which GNU Emacs is unavailable is minimised.
|
||||
amount of of time in which GNU Emacs is unavailable is minimised.
|
||||
|
||||
You can mix and match any number of actions, for example,
|
||||
|
||||
|
@ -956,7 +893,7 @@ directory.
|
|||
@end table
|
||||
|
||||
@c ===========================================================================
|
||||
@node Resource Files, Compile-time vs. Install-time, Target Maintenance, Top
|
||||
@node Resource Files, Compile-time vs Install-time, Target Maintenance, Top
|
||||
@chapter Resource Files
|
||||
@cindex resource files
|
||||
@cindex configuration files
|
||||
|
@ -1023,8 +960,8 @@ resource files. This is also true of any package names given in the
|
|||
resource file.
|
||||
|
||||
@c ===========================================================================
|
||||
@node Compile-time vs. Install-time, Bootstrapping, Resource Files, Top
|
||||
@chapter Compile-time vs. Install-time
|
||||
@node Compile-time vs Install-time, Bootstrapping, Resource Files, Top
|
||||
@chapter Compile-time vs Install-time
|
||||
|
||||
Software whose installation is managed with Stow needs to be installed
|
||||
in one place (the package directory, e.g. @file{/usr/local/stow/perl})
|
||||
|
@ -1106,7 +1043,7 @@ following sections.
|
|||
@end menu
|
||||
|
||||
@c ---------------------------------------------------------------------------
|
||||
@node GNU Emacs, Other FSF Software, Compile-time vs. Install-time, Compile-time vs. Install-time
|
||||
@node GNU Emacs, Other FSF Software, Compile-time vs Install-time, Compile-time vs Install-time
|
||||
@section GNU Emacs
|
||||
|
||||
Although the Free Software Foundation has many enlightened practices
|
||||
|
@ -1139,7 +1076,7 @@ make do-install prefix=/usr/local/stow/emacs
|
|||
@end example
|
||||
|
||||
@c ---------------------------------------------------------------------------
|
||||
@node Other FSF Software, Cygnus Software, GNU Emacs, Compile-time vs. Install-time
|
||||
@node Other FSF Software, Cygnus Software, GNU Emacs, Compile-time vs Install-time
|
||||
@section Other FSF Software
|
||||
|
||||
The Free Software Foundation, the organization behind the GNU project,
|
||||
|
@ -1160,7 +1097,7 @@ and @samp{make install} steps to work correctly without needing to
|
|||
``fool'' the build process.
|
||||
|
||||
@c ---------------------------------------------------------------------------
|
||||
@node Cygnus Software, Perl and Perl 5 Modules, Other FSF Software, Compile-time vs. Install-time
|
||||
@node Cygnus Software, Perl and Perl 5 Modules, Other FSF Software, Compile-time vs Install-time
|
||||
@section Cygnus Software
|
||||
|
||||
Cygnus is a commercial supplier and supporter of GNU software. It has
|
||||
|
@ -1189,7 +1126,7 @@ is recompiling files. Usually it will work just fine; otherwise,
|
|||
install manually.
|
||||
|
||||
@c ---------------------------------------------------------------------------
|
||||
@node Perl and Perl 5 Modules, , Cygnus Software, Compile-time vs. Install-time
|
||||
@node Perl and Perl 5 Modules, , Cygnus Software, Compile-time vs Install-time
|
||||
@section Perl and Perl 5 Modules
|
||||
|
||||
Perl 4.036 allows you to specify different locations for installation
|
||||
|
@ -1292,7 +1229,7 @@ find cpan.* \( -name .exists -o -name perllocal.pod \) -print | \
|
|||
|
||||
|
||||
@c ---------------------------------------------------------------------------
|
||||
@node Bootstrapping, Reporting Bugs, Compile-time vs. Install-time, Top
|
||||
@node Bootstrapping, Reporting Bugs, Compile-time vs Install-time, Top
|
||||
@chapter Bootstrapping
|
||||
|
||||
Suppose you have a stow directory all set up and ready to go:
|
||||
|
@ -1327,32 +1264,9 @@ perl/bin/perl stow/bin/stow -vv *
|
|||
@node Reporting Bugs, Known Bugs, Bootstrapping, Top
|
||||
@chapter Reporting Bugs
|
||||
|
||||
You can report bugs to the current maintainers in one of three ways:
|
||||
|
||||
@enumerate
|
||||
@item
|
||||
Send e-mail to @email{bug-stow@@gnu.org}.
|
||||
|
||||
@item
|
||||
File an issue in @uref{https://savannah.gnu.org/bugs/?group=stow,
|
||||
the Savannah bug tracker}.
|
||||
|
||||
@item
|
||||
File an issue in
|
||||
@uref{https://github.com/aspiers/stow/issues/, the GitHub project}.
|
||||
@end enumerate
|
||||
|
||||
While GitHub is arguably the most convenient of these three options, it
|
||||
@uref{https://www.gnu.org/software/repo-criteria-evaluation.html#GitHub,
|
||||
is not the most ethical or freedom-preserving way to host software
|
||||
projects}. Therefore the GitHub project may be
|
||||
@uref{https://github.com/aspiers/stow/issues/43, moved to a more ethical
|
||||
hosting service} in the future.
|
||||
|
||||
Before reporting a bug, it is recommended to check whether it is already
|
||||
known, so please first @pxref{Known Bugs}.
|
||||
|
||||
When reporting a new bug, please include:
|
||||
Please send bug reports to the current maintainers by electronic
|
||||
mail. The address to use is @samp{<bug-stow@@gnu.org>}. Please
|
||||
include:
|
||||
|
||||
@itemize @bullet
|
||||
@item
|
||||
|
@ -1373,13 +1287,12 @@ the precise command you gave;
|
|||
|
||||
@item
|
||||
the output from the command (preferably verbose output, obtained by
|
||||
adding @samp{--verbose=5} to the Stow command line).
|
||||
adding @samp{--verbose=3} to the Stow command line).
|
||||
@end itemize
|
||||
|
||||
If you are really keen, consider developing a minimal test case and
|
||||
creating a new test. See the @file{t/} directory in the source for lots
|
||||
of examples, and the @file{CONTRIBUTING.md} file for a guide on how to
|
||||
contribute.
|
||||
creating a new test. See the @file{t/} directory in the source for
|
||||
lots of examples.
|
||||
|
||||
Before reporting a bug, please read the manual carefully, especially
|
||||
@ref{Known Bugs}, to see whether you're encountering
|
||||
|
@ -1390,22 +1303,13 @@ something that doesn't need reporting.
|
|||
@node Known Bugs, GNU General Public License, Reporting Bugs, Top
|
||||
@chapter Known Bugs
|
||||
|
||||
Known bugs can be found in the following locations:
|
||||
There are no known bugs in Stow version @value{VERSION}!
|
||||
If you think you have found one, please @pxref{Reporting Bugs}.
|
||||
|
||||
@itemize
|
||||
@item
|
||||
@uref{https://github.com/aspiers/stow/issues/, the GitHub issue tracker}
|
||||
|
||||
@item
|
||||
@uref{https://savannah.gnu.org/bugs/?group=stow, the Savannah bug
|
||||
tracker}
|
||||
|
||||
@item
|
||||
the @uref{https://lists.gnu.org/archive/html/bug-stow/, bug-stow list
|
||||
archives}
|
||||
@end itemize
|
||||
|
||||
If you think you have found a new bug, please @pxref{Reporting Bugs}.
|
||||
@c @itemize @bullet
|
||||
@c @item
|
||||
@c Put known bugs here
|
||||
@c @end itemize
|
||||
|
||||
@c ===========================================================================
|
||||
@node GNU General Public License, Index, Known Bugs, Top
|
||||
|
|
7482
doc/texinfo.tex
Normal file
7482
doc/texinfo.tex
Normal file
File diff suppressed because it is too large
Load diff
|
@ -16,9 +16,10 @@
|
|||
# Build docker image: `docker build -t stowtest`
|
||||
# Run tests: (from stow src directory)
|
||||
# `docker run --rm -it -v $(pwd):$(pwd) -w $(pwd) stowtest`
|
||||
FROM debian:bookworm
|
||||
RUN DEBIAN_FRONTEND=noninteractive apt-get update -qq
|
||||
FROM debian:jessie
|
||||
RUN printf "deb http://archive.debian.org/debian/ jessie main\ndeb-src http://archive.debian.org/debian/ jessie main\ndeb http://security.debian.org jessie/updates main\ndeb-src http://security.debian.org jessie/updates main" > /etc/apt/sources.list
|
||||
RUN DEBIAN_FRONTEND=noninteractive \
|
||||
apt-get update -qq && \
|
||||
apt-get install -y -q \
|
||||
autoconf \
|
||||
bzip2 \
|
||||
|
|
2073
lib/Stow.pm.in
2073
lib/Stow.pm.in
File diff suppressed because it is too large
Load diff
|
@ -32,14 +32,12 @@ Supporting utility routines for L<Stow>.
|
|||
use strict;
|
||||
use warnings;
|
||||
|
||||
use File::Spec;
|
||||
use POSIX qw(getcwd);
|
||||
|
||||
use base qw(Exporter);
|
||||
our @EXPORT_OK = qw(
|
||||
error debug set_debug_level set_test_mode
|
||||
join_paths parent canon_path restore_cwd
|
||||
adjust_dotfile unadjust_dotfile
|
||||
join_paths parent canon_path restore_cwd adjust_dotfile
|
||||
);
|
||||
|
||||
our $ProgramName = 'stow';
|
||||
|
@ -95,7 +93,7 @@ sub set_test_mode {
|
|||
}
|
||||
}
|
||||
|
||||
=head2 debug($level[, $indent_level], $msg)
|
||||
=head2 debug($level, $msg)
|
||||
|
||||
Logs to STDERR based on C<$debug_level> setting. C<$level> is the
|
||||
minimum verbosity level required to output C<$msg>. All output is to
|
||||
|
@ -127,18 +125,13 @@ overriding, fixing invalid links
|
|||
=cut
|
||||
|
||||
sub debug {
|
||||
my $level = shift;
|
||||
my $indent_level;
|
||||
# Maintain backwards-compatibility in case anyone's relying on this.
|
||||
$indent_level = $_[0] =~ /^\d+$/ ? shift : 0;
|
||||
my $msg = shift;
|
||||
my ($level, $msg) = @_;
|
||||
if ($debug_level >= $level) {
|
||||
my $indent = ' ' x $indent_level;
|
||||
if ($test_mode) {
|
||||
print "# $indent$msg\n";
|
||||
print "# $msg\n";
|
||||
}
|
||||
else {
|
||||
warn "$indent$msg\n";
|
||||
warn "$msg\n";
|
||||
}
|
||||
}
|
||||
}
|
||||
|
@ -149,53 +142,29 @@ sub debug {
|
|||
# Parameters: path1, path2, ... => paths
|
||||
# Returns : concatenation of given paths
|
||||
# Throws : n/a
|
||||
# Comments : Factors out some redundant path elements:
|
||||
# : '//' => '/', and 'a/b/../c' => 'a/c'. We need this function
|
||||
# : with this behaviour, even though b could be a symlink to
|
||||
# : elsewhere, as noted in the perldoc for File::Spec->canonpath().
|
||||
# : This behaviour is deliberately different to
|
||||
# : Stow::Util::canon_path(), because the way join_paths() is used
|
||||
# : relies on this. Firstly, there is no guarantee that the paths
|
||||
# : exist, so a filesystem check is inappropriate.
|
||||
# :
|
||||
# : For example, it's used to determine the path from the target
|
||||
# : directory to a symlink destination. So if a symlink
|
||||
# : path/to/target/a/b/c points to ../../../stow/pkg/a/b/c,
|
||||
# : then joining path/to/target/a/b with ../../../stow/pkg/a/b/c
|
||||
# : yields path/to/stow/pkg/a/b/c, and it's crucial that the
|
||||
# : path/to/stow prefix matches a recognisable stow directory.
|
||||
# Comments : factors out redundant path elements:
|
||||
# : '//' => '/' and 'a/b/../c' => 'a/c'
|
||||
#============================================================================
|
||||
sub join_paths {
|
||||
my @paths = @_;
|
||||
|
||||
debug(5, 5, "| Joining: @paths");
|
||||
my $result = '';
|
||||
for my $part (@paths) {
|
||||
next if ! length $part; # probably shouldn't happen?
|
||||
$part = File::Spec->canonpath($part);
|
||||
# weed out empty components and concatenate
|
||||
my $result = join '/', grep {! /\A\z/} @paths;
|
||||
|
||||
if (substr($part, 0, 1) eq '/') {
|
||||
$result = $part; # absolute path, so ignore all previous parts
|
||||
# factor out back references and remove redundant /'s)
|
||||
my @result = ();
|
||||
PART:
|
||||
for my $part (split m{/+}, $result) {
|
||||
next PART if $part eq '.';
|
||||
if (@result && $part eq '..' && $result[-1] ne '..') {
|
||||
pop @result;
|
||||
}
|
||||
else {
|
||||
$result .= '/' if length $result && $result ne '/';
|
||||
$result .= $part;
|
||||
push @result, $part;
|
||||
}
|
||||
debug(7, 6, "| Join now: $result");
|
||||
}
|
||||
debug(6, 5, "| Joined: $result");
|
||||
|
||||
# Need this to remove any initial ./
|
||||
$result = File::Spec->canonpath($result);
|
||||
|
||||
# remove foo/..
|
||||
1 while $result =~ s,(^|/)(?!\.\.)[^/]+/\.\.(/|$),$1,;
|
||||
debug(6, 5, "| After .. removal: $result");
|
||||
|
||||
$result = File::Spec->canonpath($result);
|
||||
debug(5, 5, "| Final join: $result");
|
||||
|
||||
return $result;
|
||||
return join '/', @result;
|
||||
}
|
||||
|
||||
#===== METHOD ===============================================================
|
||||
|
@ -212,7 +181,7 @@ sub parent {
|
|||
my $path = join '/', @_;
|
||||
my @elts = split m{/+}, $path;
|
||||
pop @elts;
|
||||
return join '/', @elts;
|
||||
return join '/', @elts;
|
||||
}
|
||||
|
||||
#===== METHOD ===============================================================
|
||||
|
@ -240,17 +209,17 @@ sub restore_cwd {
|
|||
}
|
||||
|
||||
sub adjust_dotfile {
|
||||
my ($pkg_node) = @_;
|
||||
(my $adjusted = $pkg_node) =~ s/^dot-([^.])/.$1/;
|
||||
return $adjusted;
|
||||
}
|
||||
my ($target) = @_;
|
||||
|
||||
# Needed when unstowing with --compat and --dotfiles
|
||||
sub unadjust_dotfile {
|
||||
my ($target_node) = @_;
|
||||
return $target_node if $target_node =~ /^\.\.?$/;
|
||||
(my $adjusted = $target_node) =~ s/^\./dot-/;
|
||||
return $adjusted;
|
||||
my @result = ();
|
||||
for my $part (split m{/+}, $target) {
|
||||
if (($part ne "dot-") && ($part ne "dot-.")) {
|
||||
$part =~ s/^dot-/./;
|
||||
}
|
||||
push @result, $part;
|
||||
}
|
||||
|
||||
return join '/', @result;
|
||||
}
|
||||
|
||||
=head1 BUGS
|
||||
|
@ -263,5 +232,6 @@ sub unadjust_dotfile {
|
|||
|
||||
# Local variables:
|
||||
# mode: perl
|
||||
# cperl-indent-level: 4
|
||||
# end:
|
||||
# vim: ft=perl
|
||||
|
|
|
@ -22,11 +22,10 @@
|
|||
use strict;
|
||||
use warnings;
|
||||
|
||||
use Test::More tests => 4;
|
||||
use Test::More tests => 6;
|
||||
use English qw(-no_match_vars);
|
||||
|
||||
use testutil;
|
||||
use Stow::Util;
|
||||
|
||||
init_test_dirs();
|
||||
cd("$TEST_DIR/target");
|
||||
|
@ -35,64 +34,48 @@ my $stow;
|
|||
|
||||
# Note that each of the following tests use a distinct set of files
|
||||
|
||||
subtest('nothing to clean in a simple tree' => sub {
|
||||
plan tests => 1;
|
||||
#
|
||||
# nothing to clean in a simple tree
|
||||
#
|
||||
|
||||
make_path('../stow/pkg1/bin1');
|
||||
make_file('../stow/pkg1/bin1/file1');
|
||||
make_link('bin1', '../stow/pkg1/bin1');
|
||||
|
||||
$stow = new_Stow();
|
||||
$stow->cleanup_invalid_links('./');
|
||||
is(
|
||||
scalar($stow->get_tasks), 0
|
||||
=> 'nothing to clean'
|
||||
);
|
||||
});
|
||||
make_path('../stow/pkg1/bin1');
|
||||
make_file('../stow/pkg1/bin1/file1');
|
||||
make_link('bin1', '../stow/pkg1/bin1');
|
||||
|
||||
subtest('cleanup an orphaned owned link in a simple tree' => sub {
|
||||
plan tests => 3;
|
||||
$stow = new_Stow();
|
||||
$stow->cleanup_invalid_links('./');
|
||||
is(
|
||||
scalar($stow->get_tasks), 0
|
||||
=> 'nothing to clean'
|
||||
);
|
||||
|
||||
make_path('bin2');
|
||||
make_path('../stow/pkg2/bin2');
|
||||
make_file('../stow/pkg2/bin2/file2a');
|
||||
make_link('bin2/file2a', '../../stow/pkg2/bin2/file2a');
|
||||
make_invalid_link('bin2/file2b', '../../stow/pkg2/bin2/file2b');
|
||||
#
|
||||
# cleanup a bad link in a simple tree
|
||||
#
|
||||
make_path('bin2');
|
||||
make_path('../stow/pkg2/bin2');
|
||||
make_file('../stow/pkg2/bin2/file2a');
|
||||
make_link('bin2/file2a', '../../stow/pkg2/bin2/file2a');
|
||||
make_invalid_link('bin2/file2b', '../../stow/pkg2/bin2/file2b');
|
||||
|
||||
$stow = new_Stow();
|
||||
$stow->cleanup_invalid_links('bin2');
|
||||
is($stow->get_conflict_count, 0, 'no conflicts cleaning up bad link');
|
||||
is(scalar($stow->get_tasks), 1, 'one task cleaning up bad link');
|
||||
is($stow->link_task_action('bin2/file2b'), 'remove', 'removal task for bad link');
|
||||
});
|
||||
$stow = new_Stow();
|
||||
$stow->cleanup_invalid_links('bin2');
|
||||
is($stow->get_conflict_count, 0, 'no conflicts cleaning up bad link');
|
||||
is(scalar($stow->get_tasks), 1, 'one task cleaning up bad link');
|
||||
is($stow->link_task_action('bin2/file2b'), 'remove', 'removal task for bad link');
|
||||
|
||||
subtest("don't cleanup a bad link not owned by stow" => sub {
|
||||
plan tests => 2;
|
||||
#
|
||||
# dont cleanup a bad link not owned by stow
|
||||
#
|
||||
|
||||
make_path('bin3');
|
||||
make_path('../stow/pkg3/bin3');
|
||||
make_file('../stow/pkg3/bin3/file3a');
|
||||
make_link('bin3/file3a', '../../stow/pkg3/bin3/file3a');
|
||||
make_invalid_link('bin3/file3b', '../../empty');
|
||||
make_path('bin3');
|
||||
make_path('../stow/pkg3/bin3');
|
||||
make_file('../stow/pkg3/bin3/file3a');
|
||||
make_link('bin3/file3a', '../../stow/pkg3/bin3/file3a');
|
||||
make_invalid_link('bin3/file3b', '../../empty');
|
||||
|
||||
$stow = new_Stow();
|
||||
$stow->cleanup_invalid_links('bin3');
|
||||
is($stow->get_conflict_count, 0, 'no conflicts cleaning up bad link not owned by stow');
|
||||
is(scalar($stow->get_tasks), 0, 'no tasks cleaning up bad link not owned by stow');
|
||||
});
|
||||
|
||||
subtest("don't cleanup a valid link in the target not owned by stow" => sub {
|
||||
plan tests => 2;
|
||||
|
||||
make_path('bin4');
|
||||
make_path('../stow/pkg4/bin4');
|
||||
make_file('../stow/pkg4/bin4/file3a');
|
||||
make_link('bin4/file3a', '../../stow/pkg4/bin4/file3a');
|
||||
make_file("unowned");
|
||||
make_link('bin4/file3b', '../unowned');
|
||||
|
||||
$stow = new_Stow();
|
||||
$stow->cleanup_invalid_links('bin4');
|
||||
is($stow->get_conflict_count, 0, 'no conflicts cleaning up bad link not owned by stow');
|
||||
is(scalar($stow->get_tasks), 0, 'no tasks cleaning up bad link not owned by stow');
|
||||
});
|
||||
$stow = new_Stow();
|
||||
$stow->cleanup_invalid_links('bin3');
|
||||
is($stow->get_conflict_count, 0, 'no conflicts cleaning up bad link not owned by stow');
|
||||
is(scalar($stow->get_tasks), 0, 'no tasks cleaning up bad link not owned by stow');
|
||||
|
|
322
t/dotfiles.t
322
t/dotfiles.t
|
@ -22,214 +22,190 @@
|
|||
use strict;
|
||||
use warnings;
|
||||
|
||||
use Test::More tests => 12;
|
||||
use testutil;
|
||||
|
||||
use Test::More tests => 10;
|
||||
use English qw(-no_match_vars);
|
||||
|
||||
use Stow::Util qw(adjust_dotfile unadjust_dotfile);
|
||||
use testutil;
|
||||
|
||||
init_test_dirs();
|
||||
cd("$TEST_DIR/target");
|
||||
|
||||
subtest('adjust_dotfile()', sub {
|
||||
plan tests => 4;
|
||||
my @TESTS = (
|
||||
['file'],
|
||||
['dot-'],
|
||||
['dot-.'],
|
||||
['dot-file', '.file'],
|
||||
);
|
||||
for my $test (@TESTS) {
|
||||
my ($input, $expected) = @$test;
|
||||
$expected ||= $input;
|
||||
is(adjust_dotfile($input), $expected);
|
||||
}
|
||||
});
|
||||
|
||||
subtest('unadjust_dotfile()', sub {
|
||||
plan tests => 4;
|
||||
my @TESTS = (
|
||||
['file'],
|
||||
['.'],
|
||||
['..'],
|
||||
['.file', 'dot-file'],
|
||||
);
|
||||
for my $test (@TESTS) {
|
||||
my ($input, $expected) = @$test;
|
||||
$expected ||= $input;
|
||||
is(unadjust_dotfile($input), $expected);
|
||||
}
|
||||
});
|
||||
|
||||
my $stow;
|
||||
|
||||
subtest("stow dot-foo as .foo", sub {
|
||||
plan tests => 1;
|
||||
$stow = new_Stow(dir => '../stow', dotfiles => 1);
|
||||
make_path('../stow/dotfiles');
|
||||
make_file('../stow/dotfiles/dot-foo');
|
||||
#
|
||||
# process a dotfile marked with 'dot' prefix
|
||||
#
|
||||
|
||||
$stow->plan_stow('dotfiles');
|
||||
$stow->process_tasks();
|
||||
is(
|
||||
readlink('.foo'),
|
||||
'../stow/dotfiles/dot-foo',
|
||||
=> 'processed dotfile'
|
||||
);
|
||||
});
|
||||
$stow = new_Stow(dir => '../stow', dotfiles => 1);
|
||||
|
||||
subtest("stow dot-foo as dot-foo without --dotfile enabled", sub {
|
||||
plan tests => 1;
|
||||
$stow = new_Stow(dir => '../stow', dotfiles => 0);
|
||||
make_path('../stow/dotfiles');
|
||||
make_file('../stow/dotfiles/dot-foo');
|
||||
make_path('../stow/dotfiles');
|
||||
make_file('../stow/dotfiles/dot-foo');
|
||||
|
||||
$stow->plan_stow('dotfiles');
|
||||
$stow->process_tasks();
|
||||
is(
|
||||
readlink('dot-foo'),
|
||||
'../stow/dotfiles/dot-foo',
|
||||
=> 'unprocessed dotfile'
|
||||
);
|
||||
});
|
||||
$stow->plan_stow('dotfiles');
|
||||
$stow->process_tasks();
|
||||
is(
|
||||
readlink('.foo'),
|
||||
'../stow/dotfiles/dot-foo',
|
||||
=> 'processed dotfile'
|
||||
);
|
||||
|
||||
subtest("stow dot-emacs dir as .emacs", sub {
|
||||
plan tests => 1;
|
||||
$stow = new_Stow(dir => '../stow', dotfiles => 1);
|
||||
#
|
||||
# ensure that turning off dotfile processing links files as usual
|
||||
#
|
||||
|
||||
make_path('../stow/dotfiles/dot-emacs');
|
||||
make_file('../stow/dotfiles/dot-emacs/init.el');
|
||||
$stow = new_Stow(dir => '../stow', dotfiles => 0);
|
||||
|
||||
$stow->plan_stow('dotfiles');
|
||||
$stow->process_tasks();
|
||||
is(
|
||||
readlink('.emacs'),
|
||||
'../stow/dotfiles/dot-emacs',
|
||||
=> 'processed dotfile dir'
|
||||
);
|
||||
});
|
||||
make_path('../stow/dotfiles');
|
||||
make_file('../stow/dotfiles/dot-foo');
|
||||
|
||||
subtest("stow dir marked with 'dot' prefix when directory exists in target", sub {
|
||||
plan tests => 1;
|
||||
$stow = new_Stow(dir => '../stow', dotfiles => 1);
|
||||
$stow->plan_stow('dotfiles');
|
||||
$stow->process_tasks();
|
||||
is(
|
||||
readlink('dot-foo'),
|
||||
'../stow/dotfiles/dot-foo',
|
||||
=> 'unprocessed dotfile'
|
||||
);
|
||||
|
||||
make_path('../stow/dotfiles/dot-emacs.d');
|
||||
make_file('../stow/dotfiles/dot-emacs.d/init.el');
|
||||
make_path('.emacs.d');
|
||||
|
||||
$stow->plan_stow('dotfiles');
|
||||
$stow->process_tasks();
|
||||
is(
|
||||
readlink('.emacs.d/init.el'),
|
||||
'../../stow/dotfiles/dot-emacs.d/init.el',
|
||||
=> 'processed dotfile dir when dir exists (1 level)'
|
||||
);
|
||||
});
|
||||
#
|
||||
# process folder marked with 'dot' prefix
|
||||
#
|
||||
|
||||
subtest("stow dir marked with 'dot' prefix when directory exists in target (2 levels)", sub {
|
||||
plan tests => 1;
|
||||
$stow = new_Stow(dir => '../stow', dotfiles => 1);
|
||||
$stow = new_Stow(dir => '../stow', dotfiles => 1);
|
||||
|
||||
make_path('../stow/dotfiles/dot-emacs.d/dot-emacs.d');
|
||||
make_file('../stow/dotfiles/dot-emacs.d/dot-emacs.d/init.el');
|
||||
make_path('.emacs.d');
|
||||
make_path('../stow/dotfiles/dot-emacs');
|
||||
make_file('../stow/dotfiles/dot-emacs/init.el');
|
||||
|
||||
$stow->plan_stow('dotfiles');
|
||||
$stow->process_tasks();
|
||||
is(
|
||||
readlink('.emacs.d/.emacs.d'),
|
||||
'../../stow/dotfiles/dot-emacs.d/dot-emacs.d',
|
||||
=> 'processed dotfile dir exists (2 levels)'
|
||||
);
|
||||
});
|
||||
$stow->plan_stow('dotfiles');
|
||||
$stow->process_tasks();
|
||||
is(
|
||||
readlink('.emacs'),
|
||||
'../stow/dotfiles/dot-emacs',
|
||||
=> 'processed dotfile folder'
|
||||
);
|
||||
|
||||
subtest("stow dir marked with 'dot' prefix when directory exists in target", sub {
|
||||
plan tests => 1;
|
||||
$stow = new_Stow(dir => '../stow', dotfiles => 1);
|
||||
#
|
||||
# process folder marked with 'dot' prefix
|
||||
# when directory exists is target
|
||||
#
|
||||
|
||||
make_path('../stow/dotfiles/dot-one/dot-two');
|
||||
make_file('../stow/dotfiles/dot-one/dot-two/three');
|
||||
make_path('.one/.two');
|
||||
$stow = new_Stow(dir => '../stow', dotfiles => 1);
|
||||
|
||||
$stow->plan_stow('dotfiles');
|
||||
$stow->process_tasks();
|
||||
is(
|
||||
readlink('./.one/.two/three'),
|
||||
'../../../stow/dotfiles/dot-one/dot-two/three',
|
||||
=> 'processed dotfile 2 dir exists (2 levels)'
|
||||
);
|
||||
make_path('../stow/dotfiles/dot-emacs.d');
|
||||
make_file('../stow/dotfiles/dot-emacs.d/init.el');
|
||||
make_path('.emacs.d');
|
||||
|
||||
});
|
||||
$stow->plan_stow('dotfiles');
|
||||
$stow->process_tasks();
|
||||
is(
|
||||
readlink('.emacs.d/init.el'),
|
||||
'../../stow/dotfiles/dot-emacs.d/init.el',
|
||||
=> 'processed dotfile folder when folder exists (1 level)'
|
||||
);
|
||||
|
||||
subtest("dot-. should not have that part expanded.", sub {
|
||||
plan tests => 2;
|
||||
$stow = new_Stow(dir => '../stow', dotfiles => 1);
|
||||
#
|
||||
# process folder marked with 'dot' prefix
|
||||
# when directory exists is target (2 levels)
|
||||
#
|
||||
|
||||
make_path('../stow/dotfiles');
|
||||
make_file('../stow/dotfiles/dot-');
|
||||
$stow = new_Stow(dir => '../stow', dotfiles => 1);
|
||||
|
||||
make_path('../stow/dotfiles/dot-.');
|
||||
make_file('../stow/dotfiles/dot-./foo');
|
||||
make_path('../stow/dotfiles/dot-emacs.d/dot-emacs.d');
|
||||
make_file('../stow/dotfiles/dot-emacs.d/dot-emacs.d/init.el');
|
||||
make_path('.emacs.d');
|
||||
|
||||
$stow->plan_stow('dotfiles');
|
||||
$stow->process_tasks();
|
||||
is(
|
||||
readlink('dot-'),
|
||||
'../stow/dotfiles/dot-',
|
||||
=> 'processed dotfile'
|
||||
);
|
||||
is(
|
||||
readlink('dot-.'),
|
||||
'../stow/dotfiles/dot-.',
|
||||
=> 'unprocessed dotfile'
|
||||
);
|
||||
});
|
||||
$stow->plan_stow('dotfiles');
|
||||
$stow->process_tasks();
|
||||
is(
|
||||
readlink('.emacs.d/.emacs.d'),
|
||||
'../../stow/dotfiles/dot-emacs.d/dot-emacs.d',
|
||||
=> 'processed dotfile folder exists (2 levels)'
|
||||
);
|
||||
|
||||
subtest("unstow .bar from dot-bar", sub {
|
||||
plan tests => 3;
|
||||
$stow = new_Stow(dir => '../stow', dotfiles => 1);
|
||||
#
|
||||
# process folder marked with 'dot' prefix
|
||||
# when directory exists is target
|
||||
#
|
||||
|
||||
make_path('../stow/dotfiles');
|
||||
make_file('../stow/dotfiles/dot-bar');
|
||||
make_link('.bar', '../stow/dotfiles/dot-bar');
|
||||
$stow = new_Stow(dir => '../stow', dotfiles => 1);
|
||||
|
||||
$stow->plan_unstow('dotfiles');
|
||||
$stow->process_tasks();
|
||||
is($stow->get_conflict_count, 0);
|
||||
ok(-f '../stow/dotfiles/dot-bar', 'package file untouched');
|
||||
ok(! -e '.bar' => '.bar was unstowed');
|
||||
});
|
||||
make_path('../stow/dotfiles/dot-one/dot-two');
|
||||
make_file('../stow/dotfiles/dot-one/dot-two/three');
|
||||
make_path('.one/.two');
|
||||
|
||||
subtest("unstow dot-emacs.d/init.el when .emacs.d/init.el in target", sub {
|
||||
plan tests => 4;
|
||||
$stow = new_Stow(dir => '../stow', dotfiles => 1);
|
||||
$stow->plan_stow('dotfiles');
|
||||
$stow->process_tasks();
|
||||
is(
|
||||
readlink('./.one/.two/three'),
|
||||
'../../../stow/dotfiles/dot-one/dot-two/three',
|
||||
=> 'processed dotfile 2 folder exists (2 levels)'
|
||||
);
|
||||
|
||||
make_path('../stow/dotfiles/dot-emacs.d');
|
||||
make_file('../stow/dotfiles/dot-emacs.d/init.el');
|
||||
make_path('.emacs.d');
|
||||
make_link('.emacs.d/init.el', '../../stow/dotfiles/dot-emacs.d/init.el');
|
||||
|
||||
$stow->plan_unstow('dotfiles');
|
||||
$stow->process_tasks();
|
||||
is($stow->get_conflict_count, 0);
|
||||
ok(-f '../stow/dotfiles/dot-emacs.d/init.el');
|
||||
ok(! -e '.emacs.d/init.el', '.emacs.d/init.el unstowed');
|
||||
ok(-d '.emacs.d/' => '.emacs.d left behind');
|
||||
});
|
||||
#
|
||||
# corner case: paths that have a part in them that's just "$DOT_PREFIX" or
|
||||
# "$DOT_PREFIX." should not have that part expanded.
|
||||
#
|
||||
|
||||
subtest("unstow dot-emacs.d/init.el in --compat mode", sub {
|
||||
plan tests => 4;
|
||||
$stow = new_compat_Stow(dir => '../stow', dotfiles => 1);
|
||||
$stow = new_Stow(dir => '../stow', dotfiles => 1);
|
||||
|
||||
make_path('../stow/dotfiles/dot-emacs.d');
|
||||
make_file('../stow/dotfiles/dot-emacs.d/init.el');
|
||||
make_path('.emacs.d');
|
||||
make_link('.emacs.d/init.el', '../../stow/dotfiles/dot-emacs.d/init.el');
|
||||
make_path('../stow/dotfiles');
|
||||
make_file('../stow/dotfiles/dot-');
|
||||
|
||||
$stow->plan_unstow('dotfiles');
|
||||
$stow->process_tasks();
|
||||
is($stow->get_conflict_count, 0);
|
||||
ok(-f '../stow/dotfiles/dot-emacs.d/init.el');
|
||||
ok(! -e '.emacs.d/init.el', '.emacs.d/init.el unstowed');
|
||||
ok(-d '.emacs.d/' => '.emacs.d left behind');
|
||||
});
|
||||
make_path('../stow/dotfiles/dot-.');
|
||||
make_file('../stow/dotfiles/dot-./foo');
|
||||
|
||||
$stow->plan_stow('dotfiles');
|
||||
$stow->process_tasks();
|
||||
is(
|
||||
readlink('dot-'),
|
||||
'../stow/dotfiles/dot-',
|
||||
=> 'processed dotfile'
|
||||
);
|
||||
is(
|
||||
readlink('dot-.'),
|
||||
'../stow/dotfiles/dot-.',
|
||||
=> 'unprocessed dotfile'
|
||||
);
|
||||
|
||||
#
|
||||
# simple unstow scenario
|
||||
#
|
||||
|
||||
$stow = new_Stow(dir => '../stow', dotfiles => 1);
|
||||
|
||||
make_path('../stow/dotfiles');
|
||||
make_file('../stow/dotfiles/dot-bar');
|
||||
make_link('.bar', '../stow/dotfiles/dot-bar');
|
||||
|
||||
$stow->plan_unstow('dotfiles');
|
||||
$stow->process_tasks();
|
||||
ok(
|
||||
$stow->get_conflict_count == 0 &&
|
||||
-f '../stow/dotfiles/dot-bar' && ! -e '.bar'
|
||||
=> 'unstow a simple dotfile'
|
||||
);
|
||||
|
||||
#
|
||||
# unstow process folder marked with 'dot' prefix
|
||||
# when directory exists is target
|
||||
#
|
||||
|
||||
$stow = new_Stow(dir => '../stow', dotfiles => 1);
|
||||
|
||||
make_path('../stow/dotfiles/dot-emacs.d');
|
||||
make_file('../stow/dotfiles/dot-emacs.d/init.el');
|
||||
make_path('.emacs.d');
|
||||
make_link('.emacs.d/init.el', '../../stow/dotfiles/dot-emacs.d/init.el');
|
||||
|
||||
$stow->plan_unstow('dotfiles');
|
||||
$stow->process_tasks();
|
||||
ok(
|
||||
$stow->get_conflict_count == 0 &&
|
||||
-f '../stow/dotfiles/dot-emacs.d/init.el' &&
|
||||
! -e '.emacs.d/init.el' &&
|
||||
-d '.emacs.d/'
|
||||
=> 'unstow dotfile folder when folder already exists'
|
||||
);
|
||||
|
|
|
@ -16,133 +16,65 @@
|
|||
# along with this program. If not, see https://www.gnu.org/licenses/.
|
||||
|
||||
#
|
||||
# Testing Stow:: find_stowed_path()
|
||||
# Testing find_stowed_path()
|
||||
#
|
||||
|
||||
use strict;
|
||||
use warnings;
|
||||
|
||||
use Test::More tests => 10;
|
||||
use Test::More tests => 18;
|
||||
|
||||
use testutil;
|
||||
use Stow::Util qw(set_debug_level);
|
||||
|
||||
init_test_dirs();
|
||||
|
||||
subtest("find link to a stowed path with relative target" => sub {
|
||||
plan tests => 3;
|
||||
my $stow = new_Stow(dir => "$TEST_DIR/stow");
|
||||
#set_debug_level(4);
|
||||
|
||||
# This is a relative path, unlike $ABS_TEST_DIR below.
|
||||
my $target = "$TEST_DIR/target";
|
||||
my ($path, $stow_path, $package) =
|
||||
$stow->find_stowed_path("$TEST_DIR/target/a/b/c", "../../../stow/a/b/c");
|
||||
is($path, "$TEST_DIR/stow/a/b/c", "path");
|
||||
is($stow_path, "$TEST_DIR/stow", "stow path");
|
||||
is($package, "a", "package");
|
||||
|
||||
my $stow = new_Stow(dir => "$TEST_DIR/stow", target => $target);
|
||||
my ($path, $stow_path, $package) =
|
||||
$stow->find_stowed_path("a/b/c", "../../../stow/a/b/c");
|
||||
is($path, "../stow/a/b/c", "path");
|
||||
is($stow_path, "../stow", "stow path");
|
||||
is($package, "a", "package");
|
||||
});
|
||||
cd("$TEST_DIR/target");
|
||||
$stow->set_stow_dir("../stow");
|
||||
($path, $stow_path, $package) =
|
||||
$stow->find_stowed_path("a/b/c", "../../../stow/a/b/c");
|
||||
is($path, "../stow/a/b/c", "path from target directory");
|
||||
is($stow_path, "../stow", "stow path from target directory");
|
||||
is($package, "a", "from target directory");
|
||||
|
||||
my $stow = new_Stow(dir => "$ABS_TEST_DIR/stow", target => "$ABS_TEST_DIR/target");
|
||||
make_path("stow");
|
||||
cd("../..");
|
||||
$stow->set_stow_dir("$TEST_DIR/target/stow");
|
||||
|
||||
# Required by creation of stow2 and stow2/.stow below
|
||||
cd("$ABS_TEST_DIR/target");
|
||||
($path, $stow_path, $package) =
|
||||
$stow->find_stowed_path("$TEST_DIR/target/a/b/c", "../../stow/a/b/c");
|
||||
is($path, "$TEST_DIR/target/stow/a/b/c", "path");
|
||||
is($stow_path, "$TEST_DIR/target/stow", "stow path");
|
||||
is($package, "a", "stow is subdir of target directory");
|
||||
|
||||
subtest("find link to a stowed path" => sub {
|
||||
plan tests => 3;
|
||||
my ($path, $stow_path, $package) =
|
||||
$stow->find_stowed_path("a/b/c", "../../../stow/a/b/c");
|
||||
is($path, "../stow/a/b/c", "path from target directory");
|
||||
is($stow_path, "../stow", "stow path from target directory");
|
||||
is($package, "a", "from target directory");
|
||||
});
|
||||
($path, $stow_path, $package) =
|
||||
$stow->find_stowed_path("$TEST_DIR/target/a/b/c", "../../empty");
|
||||
is($path, "", "empty path");
|
||||
is($stow_path, "", "empty stow path");
|
||||
is($package, "", "target is not stowed");
|
||||
|
||||
subtest("find link to alien path not owned by Stow" => sub {
|
||||
plan tests => 3;
|
||||
my ($path, $stow_path, $package) =
|
||||
$stow->find_stowed_path("a/b/c", "../../alien");
|
||||
is($path, "", "alien is not stowed, so path is empty");
|
||||
is($stow_path, "", "alien, so stow path is empty");
|
||||
is($package, "", "alien is not stowed in any package");
|
||||
});
|
||||
make_path("$TEST_DIR/target/stow2");
|
||||
make_file("$TEST_DIR/target/stow2/.stow");
|
||||
|
||||
# Make a second stow directory within the target directory, so that we
|
||||
# can check that links to package files within that stow directory are
|
||||
# detected correctly.
|
||||
make_path("stow2");
|
||||
($path, $stow_path, $package) =
|
||||
$stow->find_stowed_path("$TEST_DIR/target/a/b/c","../../stow2/a/b/c");
|
||||
is($path, "$TEST_DIR/target/stow2/a/b/c", "path");
|
||||
is($stow_path, "$TEST_DIR/target/stow2", "stow path");
|
||||
is($package, "a", "detect alternate stow directory");
|
||||
|
||||
# However this second stow directory is still "alien" to stow until we
|
||||
# put a .stow file in it. So first test a symlink pointing to a path
|
||||
# within this second stow directory
|
||||
subtest("second stow dir still alien without .stow" => sub {
|
||||
plan tests => 3;
|
||||
my ($path, $stow_path, $package) =
|
||||
$stow->find_stowed_path("a/b/c", "../../stow2/a/b/c");
|
||||
is($path, "", "stow2 not a stow dir yet, so path is empty");
|
||||
is($stow_path, "", "stow2 not a stow dir yet so stow path is empty");
|
||||
is($package, "", "not stowed in any recognised package yet");
|
||||
});
|
||||
|
||||
# Now make stow2 a secondary stow directory and test that
|
||||
make_file("stow2/.stow");
|
||||
|
||||
subtest(".stow makes second stow dir owned by Stow" => sub {
|
||||
plan tests => 3;
|
||||
my ($path, $stow_path, $package) =
|
||||
$stow->find_stowed_path("a/b/c", "../../stow2/a/b/c");
|
||||
is($path, "stow2/a/b/c", "path");
|
||||
is($stow_path, "stow2", "stow path");
|
||||
is($package, "a", "detect alternate stow directory");
|
||||
});
|
||||
|
||||
subtest("relative symlink pointing to target dir" => sub {
|
||||
plan tests => 3;
|
||||
my ($path, $stow_path, $package) =
|
||||
$stow->find_stowed_path("a/b/c", "../../..");
|
||||
# Technically the target dir is not owned by Stow, since
|
||||
# Stow won't touch the target dir itself, only its contents.
|
||||
is($path, "", "path");
|
||||
is($stow_path, "", "stow path");
|
||||
is($package, "", "corner case - link points to target dir");
|
||||
});
|
||||
|
||||
subtest("relative symlink pointing to parent of target dir" => sub {
|
||||
plan tests => 3;
|
||||
my ($path, $stow_path, $package) =
|
||||
$stow->find_stowed_path("a/b/c", "../../../..");
|
||||
is($path, "", "path");
|
||||
is($stow_path, "", "stow path");
|
||||
is($package, "", "corner case - link points to parent of target dir");
|
||||
});
|
||||
|
||||
subtest("unowned symlink pointing to absolute path inside target" => sub {
|
||||
plan tests => 3;
|
||||
my ($path, $stow_path, $package) =
|
||||
$stow->find_stowed_path("a/b/c", "$ABS_TEST_DIR/target/d");
|
||||
is($path, "", "path");
|
||||
is($stow_path, "", "stow path");
|
||||
is($package, "", "symlink unowned by Stow points to absolute path outside target directory");
|
||||
});
|
||||
|
||||
subtest("unowned symlink pointing to absolute path outside target" => sub {
|
||||
plan tests => 3;
|
||||
my ($path, $stow_path, $package) =
|
||||
$stow->find_stowed_path("a/b/c", "/dev/null");
|
||||
is($path, "", "path");
|
||||
is($stow_path, "", "stow path");
|
||||
is($package, "", "symlink unowned by Stow points to absolute path outside target directory");
|
||||
});
|
||||
|
||||
# Now make stow2 the primary stow directory and test that it still
|
||||
# works when the stow directory is under the target directory
|
||||
$stow->set_stow_dir("$ABS_TEST_DIR/target/stow2");
|
||||
|
||||
subtest("stow2 becomes the primary stow directory" => sub {
|
||||
plan tests => 3;
|
||||
|
||||
my ($path, $stow_path, $package) =
|
||||
$stow->find_stowed_path("a/b/c", "../../stow2/a/b/c");
|
||||
is($path, "stow2/a/b/c", "path in stow2");
|
||||
is($stow_path, "stow2", "stow path for stow2");
|
||||
is($package, "a", "stow2 is subdir of target directory");
|
||||
});
|
||||
# Possible corner case with rogue symlink pointing to ancestor of
|
||||
# stow dir.
|
||||
($path, $stow_path, $package) =
|
||||
$stow->find_stowed_path("$TEST_DIR/target/a/b/c","../../..");
|
||||
is($path, "", "path");
|
||||
is($stow_path, "", "stow path");
|
||||
is($package, "", "corner case - link points to ancestor of stow dir");
|
||||
|
|
117
t/join_paths.t
117
t/join_paths.t
|
@ -22,40 +22,91 @@
|
|||
use strict;
|
||||
use warnings;
|
||||
|
||||
use Stow::Util qw(join_paths set_debug_level);
|
||||
use Stow::Util qw(join_paths);
|
||||
|
||||
#set_debug_level(4);
|
||||
use Test::More tests => 14;
|
||||
|
||||
use Test::More tests => 22;
|
||||
|
||||
my @TESTS = (
|
||||
[['a/b/c', 'd/e/f'], 'a/b/c/d/e/f' => 'simple'],
|
||||
[['a/b/c', '/d/e/f'], '/d/e/f' => 'relative then absolute'],
|
||||
[['/a/b/c', 'd/e/f'], '/a/b/c/d/e/f' => 'absolute then relative'],
|
||||
[['/a/b/c', '/d/e/f'], '/d/e/f' => 'two absolutes'],
|
||||
[['/a/b/c/', '/d/e/f/'], '/d/e/f' => 'two absolutes with trailing /'],
|
||||
[['///a/b///c//', '/d///////e/f'], '/d/e/f' => "multiple /'s, absolute"],
|
||||
[['///a/b///c//', 'd///////e/f'], '/a/b/c/d/e/f' => "multiple /'s, relative"],
|
||||
[['', 'a/b/c'], 'a/b/c' => 'first empty'],
|
||||
[['a/b/c', ''], 'a/b/c' => 'second empty'],
|
||||
[['/', 'a/b/c'], '/a/b/c' => 'first is /'],
|
||||
[['a/b/c', '/'], '/' => 'second is /'],
|
||||
[['../a1/b1/../c1/', 'a2/../b2/e2'], '../a1/c1/b2/e2' => 'relative with ../'],
|
||||
[['../a1/b1/../c1/', '/a2/../b2/e2'], '/b2/e2' => 'absolute with ../'],
|
||||
[['../a1/../../c1', 'a2/../../'], '../..' => 'lots of ../'],
|
||||
[['./', '../a2'], '../a2' => 'drop any "./"'],
|
||||
[['./a1', '../../a2'], '../a2' => 'drop any "./foo"'],
|
||||
[['a/b/c', '.'], 'a/b/c' => '. on RHS'],
|
||||
[['a/b/c', '.', 'd/e'], 'a/b/c/d/e' => '. in middle'],
|
||||
[['0', 'a/b'], '0/a/b' => '0 at start'],
|
||||
[['/0', 'a/b'], '/0/a/b' => '/0 at start'],
|
||||
[['a/b/c', '0', 'd/e'], 'a/b/c/0/d/e' => '0 in middle'],
|
||||
[['a/b', '0'], 'a/b/0' => '0 at end'],
|
||||
is(
|
||||
join_paths('a/b/c', 'd/e/f'),
|
||||
'a/b/c/d/e/f'
|
||||
=> 'simple'
|
||||
);
|
||||
|
||||
for my $test (@TESTS) {
|
||||
my ($inputs, $expected, $scenario) = @$test;
|
||||
my $got = join_paths(@$inputs);
|
||||
my $descr = "$scenario: in=[" . join(', ', map "'$_'", @$inputs) . "] exp=[$expected] got=[$got]";
|
||||
is($got, $expected, $descr);
|
||||
}
|
||||
is(
|
||||
join_paths('/a/b/c', '/d/e/f'),
|
||||
'/a/b/c/d/e/f'
|
||||
=> 'leading /'
|
||||
);
|
||||
|
||||
is(
|
||||
join_paths('/a/b/c/', '/d/e/f/'),
|
||||
'/a/b/c/d/e/f'
|
||||
=> 'trailing /'
|
||||
);
|
||||
|
||||
is(
|
||||
join_paths('///a/b///c//', '/d///////e/f'),
|
||||
'/a/b/c/d/e/f'
|
||||
=> 'mltiple /\'s'
|
||||
);
|
||||
|
||||
is(
|
||||
join_paths('', 'a/b/c'),
|
||||
'a/b/c'
|
||||
=> 'first empty'
|
||||
);
|
||||
|
||||
is(
|
||||
join_paths('a/b/c', ''),
|
||||
'a/b/c'
|
||||
=> 'second empty'
|
||||
);
|
||||
|
||||
is(
|
||||
join_paths('/', 'a/b/c'),
|
||||
'/a/b/c'
|
||||
=> 'first is /'
|
||||
);
|
||||
|
||||
is(
|
||||
join_paths('a/b/c', '/'),
|
||||
'a/b/c'
|
||||
=> 'second is /'
|
||||
);
|
||||
|
||||
is(
|
||||
join_paths('///a/b///c//', '/d///////e/f'),
|
||||
'/a/b/c/d/e/f'
|
||||
=> 'multiple /\'s'
|
||||
);
|
||||
|
||||
|
||||
is(
|
||||
join_paths('../a1/b1/../c1/', '/a2/../b2/e2'),
|
||||
'../a1/c1/b2/e2'
|
||||
=> 'simple deref ".."'
|
||||
);
|
||||
|
||||
is(
|
||||
join_paths('../a1/b1/../c1/d1/e1', '../a2/../b2/c2/d2/../e2'),
|
||||
'../a1/c1/d1/b2/c2/e2'
|
||||
=> 'complex deref ".."'
|
||||
);
|
||||
|
||||
is(
|
||||
join_paths('../a1/../../c1', 'a2/../../'),
|
||||
'../..'
|
||||
=> 'too many ".."'
|
||||
);
|
||||
|
||||
is(
|
||||
join_paths('./a1', '../../a2'),
|
||||
'../a2'
|
||||
=> 'drop any "./"'
|
||||
);
|
||||
|
||||
is(
|
||||
join_paths('a/b/c', '.'),
|
||||
'a/b/c'
|
||||
=> '. on RHS'
|
||||
);
|
||||
|
|
|
@ -1,88 +0,0 @@
|
|||
#!/usr/bin/perl
|
||||
#
|
||||
# This file is part of GNU Stow.
|
||||
#
|
||||
# GNU Stow 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 3 of the License, or
|
||||
# (at your option) any later version.
|
||||
#
|
||||
# GNU Stow 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. If not, see https://www.gnu.org/licenses/.
|
||||
|
||||
#
|
||||
# Testing Stow::link_dest_within_stow_dir()
|
||||
#
|
||||
|
||||
use strict;
|
||||
use warnings;
|
||||
|
||||
use Test::More tests => 6;
|
||||
|
||||
use testutil;
|
||||
use Stow::Util;
|
||||
|
||||
init_test_dirs();
|
||||
|
||||
# This is a relative path, unlike $ABS_TEST_DIR below.
|
||||
my $stow = new_Stow(dir => "$TEST_DIR/stow",
|
||||
target => "$TEST_DIR/target");
|
||||
|
||||
subtest("relative stow dir, link to top-level package file" => sub {
|
||||
plan tests => 2;
|
||||
my ($package, $path) =
|
||||
$stow->link_dest_within_stow_dir("../stow/pkg/dir/file");
|
||||
is($package, "pkg", "package");
|
||||
is($path, "dir/file", "path");
|
||||
});
|
||||
|
||||
subtest("relative stow dir, link to second-level package file" => sub {
|
||||
plan tests => 2;
|
||||
my ($package, $path) =
|
||||
$stow->link_dest_within_stow_dir("../stow/pkg/dir/subdir/file");
|
||||
is($package, "pkg", "package");
|
||||
is($path, "dir/subdir/file", "path");
|
||||
});
|
||||
|
||||
# This is an absolute path, unlike $TEST_DIR above.
|
||||
$stow = new_Stow(dir => "$ABS_TEST_DIR/stow",
|
||||
target => "$ABS_TEST_DIR/target");
|
||||
|
||||
subtest("relative stow dir, link to second-level package file" => sub {
|
||||
plan tests => 2;
|
||||
my ($package, $path) =
|
||||
$stow->link_dest_within_stow_dir("../stow/pkg/dir/file");
|
||||
is($package, "pkg", "package");
|
||||
is($path, "dir/file", "path");
|
||||
});
|
||||
|
||||
subtest("absolute stow dir, link to top-level package file" => sub {
|
||||
plan tests => 2;
|
||||
my ($package, $path) =
|
||||
$stow->link_dest_within_stow_dir("../stow/pkg/dir/subdir/file");
|
||||
is($package, "pkg", "package");
|
||||
is($path, "dir/subdir/file", "path");
|
||||
});
|
||||
|
||||
# Links with destination in the target are not pointing within
|
||||
# the stow dir, so they're not owned by stow.
|
||||
subtest("link to path in target" => sub {
|
||||
plan tests => 2;
|
||||
my ($package, $path) =
|
||||
$stow->link_dest_within_stow_dir("./alien");
|
||||
is($path, "", "alien is in target, so path is empty");
|
||||
is($package, "", "alien is in target, so package is empty");
|
||||
});
|
||||
|
||||
subtest("link to path outside target and stow dir" => sub {
|
||||
plan tests => 2;
|
||||
my ($package, $path) =
|
||||
$stow->link_dest_within_stow_dir("../alien");
|
||||
is($path, "", "alien is outside, so path is empty");
|
||||
is($package, "", "alien is outside, so package is empty");
|
||||
});
|
895
t/stow.t
895
t/stow.t
|
@ -22,7 +22,7 @@
|
|||
use strict;
|
||||
use warnings;
|
||||
|
||||
use Test::More tests => 22;
|
||||
use Test::More tests => 118;
|
||||
use Test::Output;
|
||||
use English qw(-no_match_vars);
|
||||
|
||||
|
@ -37,535 +37,520 @@ my %conflicts;
|
|||
|
||||
# Note that each of the following tests use a distinct set of files
|
||||
|
||||
subtest('stow a simple tree minimally', sub {
|
||||
plan tests => 2;
|
||||
my $stow = new_Stow(dir => '../stow');
|
||||
#
|
||||
# stow a simple tree minimally
|
||||
#
|
||||
$stow = new_Stow(dir => '../stow');
|
||||
|
||||
make_path('../stow/pkg1/bin1');
|
||||
make_file('../stow/pkg1/bin1/file1');
|
||||
make_path('../stow/pkg1/bin1');
|
||||
make_file('../stow/pkg1/bin1/file1');
|
||||
|
||||
$stow->plan_stow('pkg1');
|
||||
$stow->process_tasks();
|
||||
is_deeply([ $stow->get_conflicts ], [], 'no conflicts with minimal stow');
|
||||
is(
|
||||
readlink('bin1'),
|
||||
'../stow/pkg1/bin1',
|
||||
=> 'minimal stow of a simple tree'
|
||||
);
|
||||
});
|
||||
$stow->plan_stow('pkg1');
|
||||
$stow->process_tasks();
|
||||
is_deeply([ $stow->get_conflicts ], [], 'no conflicts with minimal stow');
|
||||
is(
|
||||
readlink('bin1'),
|
||||
'../stow/pkg1/bin1',
|
||||
=> 'minimal stow of a simple tree'
|
||||
);
|
||||
|
||||
subtest('stow a simple tree into an existing directory', sub {
|
||||
plan tests => 1;
|
||||
my $stow = new_Stow();
|
||||
#
|
||||
# stow a simple tree into an existing directory
|
||||
#
|
||||
$stow = new_Stow();
|
||||
|
||||
make_path('../stow/pkg2/lib2');
|
||||
make_file('../stow/pkg2/lib2/file2');
|
||||
make_path('lib2');
|
||||
make_path('../stow/pkg2/lib2');
|
||||
make_file('../stow/pkg2/lib2/file2');
|
||||
make_path('lib2');
|
||||
|
||||
$stow->plan_stow('pkg2');
|
||||
$stow->process_tasks();
|
||||
is(
|
||||
readlink('lib2/file2'),
|
||||
'../../stow/pkg2/lib2/file2',
|
||||
=> 'stow simple tree to existing directory'
|
||||
);
|
||||
});
|
||||
$stow->plan_stow('pkg2');
|
||||
$stow->process_tasks();
|
||||
is(
|
||||
readlink('lib2/file2'),
|
||||
'../../stow/pkg2/lib2/file2',
|
||||
=> 'stow simple tree to existing directory'
|
||||
);
|
||||
|
||||
subtest('unfold existing tree', sub {
|
||||
plan tests => 3;
|
||||
my $stow = new_Stow();
|
||||
#
|
||||
# unfold existing tree
|
||||
#
|
||||
$stow = new_Stow();
|
||||
|
||||
make_path('../stow/pkg3a/bin3');
|
||||
make_file('../stow/pkg3a/bin3/file3a');
|
||||
make_link('bin3' => '../stow/pkg3a/bin3'); # emulate stow
|
||||
make_path('../stow/pkg3a/bin3');
|
||||
make_file('../stow/pkg3a/bin3/file3a');
|
||||
make_link('bin3' => '../stow/pkg3a/bin3'); # emulate stow
|
||||
|
||||
make_path('../stow/pkg3b/bin3');
|
||||
make_file('../stow/pkg3b/bin3/file3b');
|
||||
make_path('../stow/pkg3b/bin3');
|
||||
make_file('../stow/pkg3b/bin3/file3b');
|
||||
|
||||
$stow->plan_stow('pkg3b');
|
||||
$stow->process_tasks();
|
||||
ok(-d 'bin3');
|
||||
is(readlink('bin3/file3a'), '../../stow/pkg3a/bin3/file3a');
|
||||
is(readlink('bin3/file3b'), '../../stow/pkg3b/bin3/file3b'
|
||||
=> 'target already has 1 stowed package');
|
||||
});
|
||||
$stow->plan_stow('pkg3b');
|
||||
$stow->process_tasks();
|
||||
ok(
|
||||
-d 'bin3' &&
|
||||
readlink('bin3/file3a') eq '../../stow/pkg3a/bin3/file3a' &&
|
||||
readlink('bin3/file3b') eq '../../stow/pkg3b/bin3/file3b'
|
||||
=> 'target already has 1 stowed package'
|
||||
);
|
||||
|
||||
subtest("Package dir 'bin4' conflicts with existing non-dir so can't unfold", sub {
|
||||
plan tests => 2;
|
||||
my $stow = new_Stow();
|
||||
#
|
||||
# Link to a new dir 'bin4' conflicts with existing non-dir so can't
|
||||
# unfold
|
||||
#
|
||||
$stow = new_Stow();
|
||||
|
||||
make_file('bin4'); # this is a file but named like a directory
|
||||
make_path('../stow/pkg4/bin4');
|
||||
make_file('../stow/pkg4/bin4/file4');
|
||||
make_file('bin4'); # this is a file but named like a directory
|
||||
make_path('../stow/pkg4/bin4');
|
||||
make_file('../stow/pkg4/bin4/file4');
|
||||
|
||||
$stow->plan_stow('pkg4');
|
||||
%conflicts = $stow->get_conflicts();
|
||||
is($stow->get_conflict_count, 1);
|
||||
$stow->plan_stow('pkg4');
|
||||
%conflicts = $stow->get_conflicts();
|
||||
ok(
|
||||
$stow->get_conflict_count == 1 &&
|
||||
$conflicts{stow}{pkg4}[0] =~
|
||||
qr/existing target is neither a link nor a directory/
|
||||
=> 'link to new dir bin4 conflicts with existing non-directory'
|
||||
);
|
||||
|
||||
#
|
||||
# Link to a new dir 'bin4a' conflicts with existing non-dir so can't
|
||||
# unfold even with --adopt
|
||||
#
|
||||
#$stow = new_Stow(adopt => 1);
|
||||
$stow = new_Stow();
|
||||
|
||||
make_file('bin4a'); # this is a file but named like a directory
|
||||
make_path('../stow/pkg4a/bin4a');
|
||||
make_file('../stow/pkg4a/bin4a/file4a');
|
||||
|
||||
$stow->plan_stow('pkg4a');
|
||||
%conflicts = $stow->get_conflicts();
|
||||
ok(
|
||||
$stow->get_conflict_count == 1 &&
|
||||
$conflicts{stow}{pkg4a}[0] =~
|
||||
qr/existing target is neither a link nor a directory/
|
||||
=> 'link to new dir bin4a conflicts with existing non-directory'
|
||||
);
|
||||
|
||||
#
|
||||
# Link to files 'file4b' and 'bin4b' conflict with existing files
|
||||
# without --adopt
|
||||
#
|
||||
$stow = new_Stow();
|
||||
|
||||
# Populate target
|
||||
make_file('file4b', 'file4b - version originally in target');
|
||||
make_path ('bin4b');
|
||||
make_file('bin4b/file4b', 'bin4b/file4b - version originally in target');
|
||||
|
||||
# Populate
|
||||
make_path ('../stow/pkg4b/bin4b');
|
||||
make_file('../stow/pkg4b/file4b', 'file4b - version originally in stow package');
|
||||
make_file('../stow/pkg4b/bin4b/file4b', 'bin4b/file4b - version originally in stow package');
|
||||
|
||||
$stow->plan_stow('pkg4b');
|
||||
%conflicts = $stow->get_conflicts();
|
||||
is($stow->get_conflict_count, 2 => 'conflict per file');
|
||||
for my $i (0, 1) {
|
||||
like(
|
||||
$conflicts{stow}{pkg4}[0],
|
||||
qr!cannot stow ../stow/pkg4/bin4 over existing target bin4 since neither a link nor a directory and --adopt not specified!
|
||||
=> 'link to new dir bin4 conflicts with existing non-directory'
|
||||
$conflicts{stow}{pkg4b}[$i],
|
||||
qr/existing target is neither a link nor a directory/
|
||||
=> 'link to file4b conflicts with existing non-directory'
|
||||
);
|
||||
});
|
||||
}
|
||||
|
||||
subtest("Package dir 'bin4a' conflicts with existing non-dir " .
|
||||
"so can't unfold even with --adopt", sub {
|
||||
plan tests => 2;
|
||||
my $stow = new_Stow(adopt => 1);
|
||||
#
|
||||
# Link to files 'file4b' and 'bin4b' do not conflict with existing
|
||||
# files when --adopt is given
|
||||
#
|
||||
$stow = new_Stow(adopt => 1);
|
||||
|
||||
make_file('bin4a'); # this is a file but named like a directory
|
||||
make_path('../stow/pkg4a/bin4a');
|
||||
make_file('../stow/pkg4a/bin4a/file4a');
|
||||
# Populate target
|
||||
make_file('file4c', "file4c - version originally in target\n");
|
||||
make_path ('bin4c');
|
||||
make_file('bin4c/file4c', "bin4c/file4c - version originally in target\n");
|
||||
|
||||
$stow->plan_stow('pkg4a');
|
||||
%conflicts = $stow->get_conflicts();
|
||||
is($stow->get_conflict_count, 1);
|
||||
like(
|
||||
$conflicts{stow}{pkg4a}[0],
|
||||
qr!cannot stow directory ../stow/pkg4a/bin4a over existing non-directory target bin4a!
|
||||
=> 'link to new dir bin4a conflicts with existing non-directory'
|
||||
);
|
||||
});
|
||||
# Populate
|
||||
make_path ('../stow/pkg4c/bin4c');
|
||||
make_file('../stow/pkg4c/file4c', "file4c - version originally in stow package\n");
|
||||
make_file('../stow/pkg4c/bin4c/file4c', "bin4c/file4c - version originally in stow package\n");
|
||||
|
||||
subtest("Package files 'file4b' and 'bin4b' conflict with existing files", sub {
|
||||
plan tests => 3;
|
||||
my $stow = new_Stow();
|
||||
|
||||
# Populate target
|
||||
make_file('file4b', 'file4b - version originally in target');
|
||||
make_path('bin4b');
|
||||
make_file('bin4b/file4b', 'bin4b/file4b - version originally in target');
|
||||
|
||||
# Populate stow package
|
||||
make_path('../stow/pkg4b');
|
||||
make_file('../stow/pkg4b/file4b', 'file4b - version originally in stow package');
|
||||
make_path('../stow/pkg4b/bin4b');
|
||||
make_file('../stow/pkg4b/bin4b/file4b', 'bin4b/file4b - version originally in stow package');
|
||||
|
||||
$stow->plan_stow('pkg4b');
|
||||
%conflicts = $stow->get_conflicts();
|
||||
is($stow->get_conflict_count, 2 => 'conflict per file');
|
||||
for my $i (0, 1) {
|
||||
my $target = $i ? 'file4b' : 'bin4b/file4b';
|
||||
like(
|
||||
$conflicts{stow}{pkg4b}[$i],
|
||||
qr,cannot stow ../stow/pkg4b/$target over existing target $target since neither a link nor a directory and --adopt not specified,
|
||||
=> 'link to file4b conflicts with existing non-directory'
|
||||
);
|
||||
}
|
||||
});
|
||||
|
||||
subtest("Package files 'file4d' conflicts with existing directories", sub {
|
||||
plan tests => 3;
|
||||
my $stow = new_Stow();
|
||||
|
||||
# Populate target
|
||||
make_path('file4d'); # this is a directory but named like a file to create the conflict
|
||||
make_path('bin4d/file4d'); # same here
|
||||
|
||||
# Populate stow package
|
||||
make_path('../stow/pkg4d');
|
||||
make_file('../stow/pkg4d/file4d', 'file4d - version originally in stow package');
|
||||
make_path('../stow/pkg4d/bin4d');
|
||||
make_file('../stow/pkg4d/bin4d/file4d', 'bin4d/file4d - version originally in stow package');
|
||||
|
||||
$stow->plan_stow('pkg4d');
|
||||
%conflicts = $stow->get_conflicts();
|
||||
is($stow->get_conflict_count, 2 => 'conflict per file');
|
||||
for my $i (0, 1) {
|
||||
my $target = $i ? 'file4d' : 'bin4d/file4d';
|
||||
like(
|
||||
$conflicts{stow}{pkg4d}[$i],
|
||||
qr!cannot stow non-directory ../stow/pkg4d/$target over existing directory target $target!
|
||||
=> 'link to file4d conflicts with existing non-directory'
|
||||
);
|
||||
}
|
||||
});
|
||||
|
||||
subtest("Package files 'file4c' and 'bin4c' can adopt existing versions", sub {
|
||||
plan tests => 8;
|
||||
my $stow = new_Stow(adopt => 1);
|
||||
|
||||
# Populate target
|
||||
make_file('file4c', "file4c - version originally in target\n");
|
||||
make_path ('bin4c');
|
||||
make_file('bin4c/file4c', "bin4c/file4c - version originally in target\n");
|
||||
|
||||
# Populate stow package
|
||||
make_path('../stow/pkg4c');
|
||||
make_file('../stow/pkg4c/file4c', "file4c - version originally in stow package\n");
|
||||
make_path ('../stow/pkg4c/bin4c');
|
||||
make_file('../stow/pkg4c/bin4c/file4c', "bin4c/file4c - version originally in stow package\n");
|
||||
|
||||
$stow->plan_stow('pkg4c');
|
||||
is($stow->get_conflict_count, 0 => 'no conflicts with --adopt');
|
||||
is($stow->get_tasks, 4 => 'two tasks per file');
|
||||
$stow->process_tasks();
|
||||
for my $file ('file4c', 'bin4c/file4c') {
|
||||
ok(-l $file, "$file turned into a symlink");
|
||||
is(
|
||||
readlink $file,
|
||||
(index($file, '/') == -1 ? '' : '../' )
|
||||
. "../stow/pkg4c/$file" => "$file points to right place"
|
||||
);
|
||||
is(cat_file($file), "$file - version originally in target\n" => "$file has right contents");
|
||||
}
|
||||
|
||||
});
|
||||
|
||||
subtest("Target already exists but is not owned by stow", sub {
|
||||
plan tests => 1;
|
||||
my $stow = new_Stow();
|
||||
|
||||
make_path('bin5');
|
||||
make_invalid_link('bin5/file5','../../empty');
|
||||
make_path('../stow/pkg5/bin5/file5');
|
||||
|
||||
$stow->plan_stow('pkg5');
|
||||
%conflicts = $stow->get_conflicts();
|
||||
like(
|
||||
$conflicts{stow}{pkg5}[-1],
|
||||
qr/not owned by stow/
|
||||
=> 'target already exists but is not owned by stow'
|
||||
);
|
||||
});
|
||||
|
||||
subtest("Replace existing but invalid target", sub {
|
||||
plan tests => 1;
|
||||
my $stow = new_Stow();
|
||||
|
||||
make_invalid_link('file6','../stow/path-does-not-exist');
|
||||
make_path('../stow/pkg6');
|
||||
make_file('../stow/pkg6/file6');
|
||||
|
||||
$stow->plan_stow('pkg6');
|
||||
$stow->process_tasks();
|
||||
$stow->plan_stow('pkg4c');
|
||||
is($stow->get_conflict_count, 0 => 'no conflicts with --adopt');
|
||||
is($stow->get_tasks, 4 => 'two tasks per file');
|
||||
$stow->process_tasks();
|
||||
for my $file ('file4c', 'bin4c/file4c') {
|
||||
ok(-l $file, "$file turned into a symlink");
|
||||
is(
|
||||
readlink('file6'),
|
||||
'../stow/pkg6/file6'
|
||||
=> 'replace existing but invalid target'
|
||||
readlink $file,
|
||||
(index($file, '/') == -1 ? '' : '../' )
|
||||
. "../stow/pkg4c/$file" => "$file points to right place"
|
||||
);
|
||||
});
|
||||
is(cat_file($file), "$file - version originally in target\n" => "$file has right contents");
|
||||
}
|
||||
|
||||
subtest("Target already exists, is owned by stow, but points to a non-directory", sub {
|
||||
plan tests => 1;
|
||||
my $stow = new_Stow();
|
||||
#set_debug_level(4);
|
||||
|
||||
make_path('bin7');
|
||||
make_path('../stow/pkg7a/bin7');
|
||||
make_file('../stow/pkg7a/bin7/node7');
|
||||
make_link('bin7/node7','../../stow/pkg7a/bin7/node7');
|
||||
make_path('../stow/pkg7b/bin7/node7');
|
||||
make_file('../stow/pkg7b/bin7/node7/file7');
|
||||
#
|
||||
# Target already exists but is not owned by stow
|
||||
#
|
||||
$stow = new_Stow();
|
||||
|
||||
$stow->plan_stow('pkg7b');
|
||||
%conflicts = $stow->get_conflicts();
|
||||
like(
|
||||
$conflicts{stow}{pkg7b}[-1],
|
||||
qr/existing target is stowed to a different package/
|
||||
=> 'link to new dir conflicts with existing stowed non-directory'
|
||||
);
|
||||
});
|
||||
make_path('bin5');
|
||||
make_invalid_link('bin5/file5','../../empty');
|
||||
make_path('../stow/pkg5/bin5/file5');
|
||||
|
||||
subtest("stowing directories named 0", sub {
|
||||
plan tests => 4;
|
||||
my $stow = new_Stow();
|
||||
$stow->plan_stow('pkg5');
|
||||
%conflicts = $stow->get_conflicts();
|
||||
like(
|
||||
$conflicts{stow}{pkg5}[-1],
|
||||
qr/not owned by stow/
|
||||
=> 'target already exists but is not owned by stow'
|
||||
);
|
||||
|
||||
make_path('../stow/pkg8a/0');
|
||||
make_file('../stow/pkg8a/0/file8a');
|
||||
make_link('0' => '../stow/pkg8a/0'); # emulate stow
|
||||
#
|
||||
# Replace existing but invalid target
|
||||
#
|
||||
$stow = new_Stow();
|
||||
|
||||
make_path('../stow/pkg8b/0');
|
||||
make_file('../stow/pkg8b/0/file8b');
|
||||
make_invalid_link('file6','../stow/path-does-not-exist');
|
||||
make_path('../stow/pkg6');
|
||||
make_file('../stow/pkg6/file6');
|
||||
|
||||
$stow->plan_stow('pkg8b');
|
||||
$stow->process_tasks();
|
||||
is($stow->get_conflict_count, 0);
|
||||
ok(-d '0');
|
||||
is(readlink('0/file8a'), '../../stow/pkg8a/0/file8a');
|
||||
is(readlink('0/file8b'), '../../stow/pkg8b/0/file8b'
|
||||
=> 'stowing directories named 0'
|
||||
);
|
||||
});
|
||||
$stow->plan_stow('pkg6');
|
||||
$stow->process_tasks();
|
||||
is(
|
||||
readlink('file6'),
|
||||
'../stow/pkg6/file6'
|
||||
=> 'replace existing but invalid target'
|
||||
);
|
||||
|
||||
subtest("overriding already stowed documentation", sub {
|
||||
plan tests => 2;
|
||||
my $stow = new_Stow(override => ['man9', 'info9']);
|
||||
#
|
||||
# Target already exists, is owned by stow, but points to a non-directory
|
||||
# (can't unfold)
|
||||
#
|
||||
$stow = new_Stow();
|
||||
#set_debug_level(4);
|
||||
|
||||
make_path('../stow/pkg9a/man9/man1');
|
||||
make_file('../stow/pkg9a/man9/man1/file9.1');
|
||||
make_path('man9/man1');
|
||||
make_link('man9/man1/file9.1' => '../../../stow/pkg9a/man9/man1/file9.1'); # emulate stow
|
||||
make_path('bin7');
|
||||
make_path('../stow/pkg7a/bin7');
|
||||
make_file('../stow/pkg7a/bin7/node7');
|
||||
make_link('bin7/node7','../../stow/pkg7a/bin7/node7');
|
||||
make_path('../stow/pkg7b/bin7/node7');
|
||||
make_file('../stow/pkg7b/bin7/node7/file7');
|
||||
|
||||
make_path('../stow/pkg9b/man9/man1');
|
||||
make_file('../stow/pkg9b/man9/man1/file9.1');
|
||||
$stow->plan_stow('pkg7b');
|
||||
%conflicts = $stow->get_conflicts();
|
||||
like(
|
||||
$conflicts{stow}{pkg7b}[-1],
|
||||
qr/existing target is stowed to a different package/
|
||||
=> 'link to new dir conflicts with existing stowed non-directory'
|
||||
);
|
||||
|
||||
$stow->plan_stow('pkg9b');
|
||||
$stow->process_tasks();
|
||||
is($stow->get_conflict_count, 0);
|
||||
is(readlink('man9/man1/file9.1'), '../../../stow/pkg9b/man9/man1/file9.1'
|
||||
=> 'overriding existing documentation files'
|
||||
);
|
||||
});
|
||||
#
|
||||
# stowing directories named 0
|
||||
#
|
||||
$stow = new_Stow();
|
||||
|
||||
subtest("deferring to already stowed documentation", sub {
|
||||
plan tests => 3;
|
||||
my $stow = new_Stow(defer => ['man10', 'info10']);
|
||||
make_path('../stow/pkg8a/0');
|
||||
make_file('../stow/pkg8a/0/file8a');
|
||||
make_link('0' => '../stow/pkg8a/0'); # emulate stow
|
||||
|
||||
make_path('../stow/pkg10a/man10/man1');
|
||||
make_file('../stow/pkg10a/man10/man1/file10.1');
|
||||
make_path('man10/man1');
|
||||
make_link('man10/man1/file10.1' => '../../../stow/pkg10a/man10/man1/file10.1'); # emulate stow
|
||||
make_path('../stow/pkg8b/0');
|
||||
make_file('../stow/pkg8b/0/file8b');
|
||||
|
||||
make_path('../stow/pkg10b/man10/man1');
|
||||
make_file('../stow/pkg10b/man10/man1/file10.1');
|
||||
$stow->plan_stow('pkg8b');
|
||||
$stow->process_tasks();
|
||||
ok(
|
||||
$stow->get_conflict_count == 0 &&
|
||||
-d '0' &&
|
||||
readlink('0/file8a') eq '../../stow/pkg8a/0/file8a' &&
|
||||
readlink('0/file8b') eq '../../stow/pkg8b/0/file8b'
|
||||
=> 'stowing directories named 0'
|
||||
);
|
||||
|
||||
$stow->plan_stow('pkg10b');
|
||||
is($stow->get_tasks, 0, 'no tasks to process');
|
||||
is($stow->get_conflict_count, 0);
|
||||
is(readlink('man10/man1/file10.1'), '../../../stow/pkg10a/man10/man1/file10.1'
|
||||
=> 'defer to existing documentation files'
|
||||
);
|
||||
});
|
||||
#
|
||||
# overriding already stowed documentation
|
||||
#
|
||||
$stow = new_Stow(override => ['man9', 'info9']);
|
||||
|
||||
subtest("Ignore temp files", sub {
|
||||
plan tests => 4;
|
||||
my $stow = new_Stow(ignore => ['~', '\.#.*']);
|
||||
make_path('../stow/pkg9a/man9/man1');
|
||||
make_file('../stow/pkg9a/man9/man1/file9.1');
|
||||
make_path('man9/man1');
|
||||
make_link('man9/man1/file9.1' => '../../../stow/pkg9a/man9/man1/file9.1'); # emulate stow
|
||||
|
||||
make_path('../stow/pkg11/man11/man1');
|
||||
make_file('../stow/pkg11/man11/man1/file11.1');
|
||||
make_file('../stow/pkg11/man11/man1/file11.1~');
|
||||
make_file('../stow/pkg11/man11/man1/.#file11.1');
|
||||
make_path('man11/man1');
|
||||
make_path('../stow/pkg9b/man9/man1');
|
||||
make_file('../stow/pkg9b/man9/man1/file9.1');
|
||||
|
||||
$stow->plan_stow('pkg11');
|
||||
$stow->process_tasks();
|
||||
is($stow->get_conflict_count, 0);
|
||||
is(readlink('man11/man1/file11.1'), '../../../stow/pkg11/man11/man1/file11.1');
|
||||
ok(!-e 'man11/man1/file11.1~');
|
||||
ok(!-e 'man11/man1/.#file11.1'
|
||||
=> 'ignore temp files'
|
||||
);
|
||||
});
|
||||
$stow->plan_stow('pkg9b');
|
||||
$stow->process_tasks();
|
||||
ok(
|
||||
$stow->get_conflict_count == 0 &&
|
||||
readlink('man9/man1/file9.1') eq '../../../stow/pkg9b/man9/man1/file9.1'
|
||||
=> 'overriding existing documentation files'
|
||||
);
|
||||
|
||||
subtest("stowing links library files", sub {
|
||||
plan tests => 3;
|
||||
my $stow = new_Stow();
|
||||
#
|
||||
# deferring to already stowed documentation
|
||||
#
|
||||
$stow = new_Stow(defer => ['man10', 'info10']);
|
||||
|
||||
make_path('../stow/pkg12/lib12/');
|
||||
make_file('../stow/pkg12/lib12/lib.so.1');
|
||||
make_link('../stow/pkg12/lib12/lib.so', 'lib.so.1');
|
||||
make_path('../stow/pkg10a/man10/man1');
|
||||
make_file('../stow/pkg10a/man10/man1/file10.1');
|
||||
make_path('man10/man1');
|
||||
make_link('man10/man1/file10.1' => '../../../stow/pkg10a/man10/man1/file10.1'); # emulate stow
|
||||
|
||||
make_path('lib12/');
|
||||
make_path('../stow/pkg10b/man10/man1');
|
||||
make_file('../stow/pkg10b/man10/man1/file10.1');
|
||||
|
||||
$stow->plan_stow('pkg12');
|
||||
$stow->process_tasks();
|
||||
is($stow->get_conflict_count, 0);
|
||||
is(readlink('lib12/lib.so.1'), '../../stow/pkg12/lib12/lib.so.1');
|
||||
is(readlink('lib12/lib.so'), '../../stow/pkg12/lib12/lib.so'
|
||||
=> 'stow links to libraries'
|
||||
);
|
||||
});
|
||||
$stow->plan_stow('pkg10b');
|
||||
is($stow->get_tasks, 0, 'no tasks to process');
|
||||
ok(
|
||||
$stow->get_conflict_count == 0 &&
|
||||
readlink('man10/man1/file10.1') eq '../../../stow/pkg10a/man10/man1/file10.1'
|
||||
=> 'defer to existing documentation files'
|
||||
);
|
||||
|
||||
subtest("unfolding to stow links to library files", sub {
|
||||
plan tests => 5;
|
||||
my $stow = new_Stow();
|
||||
#
|
||||
# Ignore temp files
|
||||
#
|
||||
$stow = new_Stow(ignore => ['~', '\.#.*']);
|
||||
|
||||
make_path('../stow/pkg13a/lib13/');
|
||||
make_file('../stow/pkg13a/lib13/liba.so.1');
|
||||
make_link('../stow/pkg13a/lib13/liba.so', 'liba.so.1');
|
||||
make_link('lib13','../stow/pkg13a/lib13');
|
||||
make_path('../stow/pkg11/man11/man1');
|
||||
make_file('../stow/pkg11/man11/man1/file11.1');
|
||||
make_file('../stow/pkg11/man11/man1/file11.1~');
|
||||
make_file('../stow/pkg11/man11/man1/.#file11.1');
|
||||
make_path('man11/man1');
|
||||
|
||||
make_path('../stow/pkg13b/lib13/');
|
||||
make_file('../stow/pkg13b/lib13/libb.so.1');
|
||||
make_link('../stow/pkg13b/lib13/libb.so', 'libb.so.1');
|
||||
$stow->plan_stow('pkg11');
|
||||
$stow->process_tasks();
|
||||
ok(
|
||||
$stow->get_conflict_count == 0 &&
|
||||
readlink('man11/man1/file11.1') eq '../../../stow/pkg11/man11/man1/file11.1' &&
|
||||
!-e 'man11/man1/file11.1~' &&
|
||||
!-e 'man11/man1/.#file11.1'
|
||||
=> 'ignore temp files'
|
||||
);
|
||||
|
||||
$stow->plan_stow('pkg13b');
|
||||
$stow->process_tasks();
|
||||
is($stow->get_conflict_count, 0);
|
||||
is(readlink('lib13/liba.so.1'), '../../stow/pkg13a/lib13/liba.so.1');
|
||||
is(readlink('lib13/liba.so' ), '../../stow/pkg13a/lib13/liba.so');
|
||||
is(readlink('lib13/libb.so.1'), '../../stow/pkg13b/lib13/libb.so.1');
|
||||
is(readlink('lib13/libb.so' ), '../../stow/pkg13b/lib13/libb.so'
|
||||
=> 'unfolding to stow links to libraries'
|
||||
);
|
||||
});
|
||||
#
|
||||
# stowing links library files
|
||||
#
|
||||
$stow = new_Stow();
|
||||
|
||||
subtest("stowing to stow dir should fail", sub {
|
||||
plan tests => 4;
|
||||
make_path('stow');
|
||||
$stow = new_Stow(dir => 'stow');
|
||||
make_path('../stow/pkg12/lib12/');
|
||||
make_file('../stow/pkg12/lib12/lib.so.1');
|
||||
make_link('../stow/pkg12/lib12/lib.so', 'lib.so.1');
|
||||
|
||||
make_path('stow/pkg14/stow/pkg15');
|
||||
make_file('stow/pkg14/stow/pkg15/node15');
|
||||
make_path('lib12/');
|
||||
|
||||
stderr_like(
|
||||
sub { $stow->plan_stow('pkg14'); },
|
||||
qr/WARNING: skipping target which was current stow directory stow/,
|
||||
"stowing to stow dir should give warning"
|
||||
);
|
||||
$stow->plan_stow('pkg12');
|
||||
$stow->process_tasks();
|
||||
ok(
|
||||
$stow->get_conflict_count == 0 &&
|
||||
readlink('lib12/lib.so.1') eq '../../stow/pkg12/lib12/lib.so.1' &&
|
||||
readlink('lib12/lib.so' ) eq '../../stow/pkg12/lib12/lib.so'
|
||||
=> 'stow links to libraries'
|
||||
);
|
||||
|
||||
is($stow->get_tasks, 0, 'no tasks to process');
|
||||
is($stow->get_conflict_count, 0);
|
||||
ok(
|
||||
! -l 'stow/pkg15'
|
||||
=> "stowing to stow dir should fail"
|
||||
);
|
||||
});
|
||||
#
|
||||
# unfolding to stow links to library files
|
||||
#
|
||||
$stow = new_Stow();
|
||||
|
||||
subtest("stow a simple tree minimally when cwd isn't target", sub {
|
||||
plan tests => 2;
|
||||
cd('../..');
|
||||
$stow = new_Stow(dir => "$TEST_DIR/stow", target => "$TEST_DIR/target");
|
||||
make_path('../stow/pkg13a/lib13/');
|
||||
make_file('../stow/pkg13a/lib13/liba.so.1');
|
||||
make_link('../stow/pkg13a/lib13/liba.so', 'liba.so.1');
|
||||
make_link('lib13','../stow/pkg13a/lib13');
|
||||
|
||||
make_path("$TEST_DIR/stow/pkg16/bin16");
|
||||
make_file("$TEST_DIR/stow/pkg16/bin16/file16");
|
||||
make_path('../stow/pkg13b/lib13/');
|
||||
make_file('../stow/pkg13b/lib13/libb.so.1');
|
||||
make_link('../stow/pkg13b/lib13/libb.so', 'libb.so.1');
|
||||
|
||||
$stow->plan_stow('pkg16');
|
||||
$stow->process_tasks();
|
||||
is_deeply([ $stow->get_conflicts ], [], 'no conflicts with minimal stow');
|
||||
is(
|
||||
readlink("$TEST_DIR/target/bin16"),
|
||||
'../stow/pkg16/bin16',
|
||||
=> "minimal stow of a simple tree when cwd isn't target"
|
||||
);
|
||||
});
|
||||
$stow->plan_stow('pkg13b');
|
||||
$stow->process_tasks();
|
||||
ok(
|
||||
$stow->get_conflict_count == 0 &&
|
||||
readlink('lib13/liba.so.1') eq '../../stow/pkg13a/lib13/liba.so.1' &&
|
||||
readlink('lib13/liba.so' ) eq '../../stow/pkg13a/lib13/liba.so' &&
|
||||
readlink('lib13/libb.so.1') eq '../../stow/pkg13b/lib13/libb.so.1' &&
|
||||
readlink('lib13/libb.so' ) eq '../../stow/pkg13b/lib13/libb.so'
|
||||
=> 'unfolding to stow links to libraries'
|
||||
);
|
||||
|
||||
subtest("stow a simple tree minimally to absolute stow dir when cwd isn't", sub {
|
||||
plan tests => 2;
|
||||
my $stow = new_Stow(dir => canon_path("$TEST_DIR/stow"),
|
||||
target => "$TEST_DIR/target");
|
||||
#
|
||||
# stowing to stow dir should fail
|
||||
#
|
||||
make_path('stow');
|
||||
$stow = new_Stow(dir => 'stow');
|
||||
|
||||
make_path("$TEST_DIR/stow/pkg17/bin17");
|
||||
make_file("$TEST_DIR/stow/pkg17/bin17/file17");
|
||||
make_path('stow/pkg14/stow/pkg15');
|
||||
make_file('stow/pkg14/stow/pkg15/node15');
|
||||
|
||||
$stow->plan_stow('pkg17');
|
||||
$stow->process_tasks();
|
||||
is_deeply([ $stow->get_conflicts ], [], 'no conflicts with minimal stow');
|
||||
is(
|
||||
readlink("$TEST_DIR/target/bin17"),
|
||||
'../stow/pkg17/bin17',
|
||||
=> "minimal stow of a simple tree with absolute stow dir"
|
||||
);
|
||||
});
|
||||
capture_stderr();
|
||||
$stow->plan_stow('pkg14');
|
||||
is($stow->get_tasks, 0, 'no tasks to process');
|
||||
ok(
|
||||
$stow->get_conflict_count == 0 &&
|
||||
! -l 'stow/pkg15'
|
||||
=> "stowing to stow dir should fail"
|
||||
);
|
||||
like($stderr,
|
||||
qr/WARNING: skipping target which was current stow directory stow/
|
||||
=> "stowing to stow dir should give warning");
|
||||
uncapture_stderr();
|
||||
|
||||
subtest("stow a simple tree minimally with absolute stow AND target dirs when", sub {
|
||||
plan tests => 2;
|
||||
my $stow = new_Stow(dir => canon_path("$TEST_DIR/stow"),
|
||||
target => canon_path("$TEST_DIR/target"));
|
||||
#
|
||||
# stow a simple tree minimally when cwd isn't target
|
||||
#
|
||||
cd('../..');
|
||||
$stow = new_Stow(dir => "$TEST_DIR/stow", target => "$TEST_DIR/target");
|
||||
|
||||
make_path("$TEST_DIR/stow/pkg18/bin18");
|
||||
make_file("$TEST_DIR/stow/pkg18/bin18/file18");
|
||||
make_path("$TEST_DIR/stow/pkg16/bin16");
|
||||
make_file("$TEST_DIR/stow/pkg16/bin16/file16");
|
||||
|
||||
$stow->plan_stow('pkg18');
|
||||
$stow->process_tasks();
|
||||
is_deeply([ $stow->get_conflicts ], [], 'no conflicts with minimal stow');
|
||||
is(
|
||||
readlink("$TEST_DIR/target/bin18"),
|
||||
'../stow/pkg18/bin18',
|
||||
=> "minimal stow of a simple tree with absolute stow and target dirs"
|
||||
);
|
||||
});
|
||||
$stow->plan_stow('pkg16');
|
||||
$stow->process_tasks();
|
||||
is_deeply([ $stow->get_conflicts ], [], 'no conflicts with minimal stow');
|
||||
is(
|
||||
readlink("$TEST_DIR/target/bin16"),
|
||||
'../stow/pkg16/bin16',
|
||||
=> "minimal stow of a simple tree when cwd isn't target"
|
||||
);
|
||||
|
||||
subtest("stow a tree with no-folding enabled", sub {
|
||||
plan tests => 82;
|
||||
# folded directories should be split open (unfolded) where
|
||||
# (and only where) necessary
|
||||
#
|
||||
cd("$TEST_DIR/target");
|
||||
#
|
||||
# stow a simple tree minimally to absolute stow dir when cwd isn't
|
||||
# target
|
||||
#
|
||||
$stow = new_Stow(dir => canon_path("$TEST_DIR/stow"),
|
||||
target => "$TEST_DIR/target");
|
||||
|
||||
sub create_pkg {
|
||||
my ($id, $pkg) = @_;
|
||||
make_path("$TEST_DIR/stow/pkg17/bin17");
|
||||
make_file("$TEST_DIR/stow/pkg17/bin17/file17");
|
||||
|
||||
my $stow_pkg = "../stow/$id-$pkg";
|
||||
make_path ($stow_pkg);
|
||||
make_file("$stow_pkg/$id-file-$pkg");
|
||||
$stow->plan_stow('pkg17');
|
||||
$stow->process_tasks();
|
||||
is_deeply([ $stow->get_conflicts ], [], 'no conflicts with minimal stow');
|
||||
is(
|
||||
readlink("$TEST_DIR/target/bin17"),
|
||||
'../stow/pkg17/bin17',
|
||||
=> "minimal stow of a simple tree with absolute stow dir"
|
||||
);
|
||||
|
||||
# create a shallow hierarchy specific to this package which isn't
|
||||
# yet stowed
|
||||
make_path ("$stow_pkg/$id-$pkg-only-new");
|
||||
make_file("$stow_pkg/$id-$pkg-only-new/$id-file-$pkg");
|
||||
#
|
||||
# stow a simple tree minimally with absolute stow AND target dirs when
|
||||
# cwd isn't target
|
||||
#
|
||||
$stow = new_Stow(dir => canon_path("$TEST_DIR/stow"),
|
||||
target => canon_path("$TEST_DIR/target"));
|
||||
|
||||
# create a deeper hierarchy specific to this package which isn't
|
||||
# yet stowed
|
||||
make_path ("$stow_pkg/$id-$pkg-only-new2/subdir");
|
||||
make_file("$stow_pkg/$id-$pkg-only-new2/subdir/$id-file-$pkg");
|
||||
make_link("$stow_pkg/$id-$pkg-only-new2/current", "subdir");
|
||||
make_path("$TEST_DIR/stow/pkg18/bin18");
|
||||
make_file("$TEST_DIR/stow/pkg18/bin18/file18");
|
||||
|
||||
# create a hierarchy specific to this package which is already
|
||||
# stowed via a folded tree
|
||||
make_path ("$stow_pkg/$id-$pkg-only-old");
|
||||
make_link("$id-$pkg-only-old", "$stow_pkg/$id-$pkg-only-old");
|
||||
make_file("$stow_pkg/$id-$pkg-only-old/$id-file-$pkg");
|
||||
$stow->plan_stow('pkg18');
|
||||
$stow->process_tasks();
|
||||
is_deeply([ $stow->get_conflicts ], [], 'no conflicts with minimal stow');
|
||||
is(
|
||||
readlink("$TEST_DIR/target/bin18"),
|
||||
'../stow/pkg18/bin18',
|
||||
=> "minimal stow of a simple tree with absolute stow and target dirs"
|
||||
);
|
||||
|
||||
# create a shared hierarchy which this package uses
|
||||
make_path ("$stow_pkg/$id-shared");
|
||||
make_file("$stow_pkg/$id-shared/$id-file-$pkg");
|
||||
#
|
||||
# stow a tree with no-folding enabled -
|
||||
# no new folded directories should be created, and existing
|
||||
# folded directories should be split open (unfolded) where
|
||||
# (and only where) necessary
|
||||
#
|
||||
cd("$TEST_DIR/target");
|
||||
|
||||
# create a partially shared hierarchy which this package uses
|
||||
make_path ("$stow_pkg/$id-shared2/subdir-$pkg");
|
||||
make_file("$stow_pkg/$id-shared2/$id-file-$pkg");
|
||||
make_file("$stow_pkg/$id-shared2/subdir-$pkg/$id-file-$pkg");
|
||||
}
|
||||
sub create_pkg {
|
||||
my ($id, $pkg) = @_;
|
||||
|
||||
foreach my $pkg (qw{a b}) {
|
||||
create_pkg('no-folding', $pkg);
|
||||
}
|
||||
my $stow_pkg = "../stow/$id-$pkg";
|
||||
make_path ($stow_pkg);
|
||||
make_file("$stow_pkg/$id-file-$pkg");
|
||||
|
||||
$stow = new_Stow('no-folding' => 1);
|
||||
$stow->plan_stow('no-folding-a');
|
||||
is_deeply([ $stow->get_conflicts ], [] => 'no conflicts with --no-folding');
|
||||
my @tasks = $stow->get_tasks;
|
||||
use Data::Dumper;
|
||||
is(scalar(@tasks), 13 => "6 dirs, 7 links") || warn Dumper(\@tasks);
|
||||
$stow->process_tasks();
|
||||
# create a shallow hierarchy specific to this package which isn't
|
||||
# yet stowed
|
||||
make_path ("$stow_pkg/$id-$pkg-only-new");
|
||||
make_file("$stow_pkg/$id-$pkg-only-new/$id-file-$pkg");
|
||||
|
||||
sub check_no_folding {
|
||||
my ($pkg) = @_;
|
||||
my $stow_pkg = "../stow/no-folding-$pkg";
|
||||
is_link("no-folding-file-$pkg", "$stow_pkg/no-folding-file-$pkg");
|
||||
# create a deeper hierarchy specific to this package which isn't
|
||||
# yet stowed
|
||||
make_path ("$stow_pkg/$id-$pkg-only-new2/subdir");
|
||||
make_file("$stow_pkg/$id-$pkg-only-new2/subdir/$id-file-$pkg");
|
||||
make_link("$stow_pkg/$id-$pkg-only-new2/current", "subdir");
|
||||
|
||||
# check existing folded tree is untouched
|
||||
is_link("no-folding-$pkg-only-old", "$stow_pkg/no-folding-$pkg-only-old");
|
||||
# create a hierarchy specific to this package which is already
|
||||
# stowed via a folded tree
|
||||
make_path ("$stow_pkg/$id-$pkg-only-old");
|
||||
make_link("$id-$pkg-only-old", "$stow_pkg/$id-$pkg-only-old");
|
||||
make_file("$stow_pkg/$id-$pkg-only-old/$id-file-$pkg");
|
||||
|
||||
# check newly stowed shallow tree is not folded
|
||||
is_dir_not_symlink("no-folding-$pkg-only-new");
|
||||
is_link("no-folding-$pkg-only-new/no-folding-file-$pkg",
|
||||
"../$stow_pkg/no-folding-$pkg-only-new/no-folding-file-$pkg");
|
||||
# create a shared hierarchy which this package uses
|
||||
make_path ("$stow_pkg/$id-shared");
|
||||
make_file("$stow_pkg/$id-shared/$id-file-$pkg");
|
||||
|
||||
# check newly stowed deeper tree is not folded
|
||||
is_dir_not_symlink("no-folding-$pkg-only-new2");
|
||||
is_dir_not_symlink("no-folding-$pkg-only-new2/subdir");
|
||||
is_link("no-folding-$pkg-only-new2/subdir/no-folding-file-$pkg",
|
||||
"../../$stow_pkg/no-folding-$pkg-only-new2/subdir/no-folding-file-$pkg");
|
||||
is_link("no-folding-$pkg-only-new2/current",
|
||||
"../$stow_pkg/no-folding-$pkg-only-new2/current");
|
||||
# create a partially shared hierarchy which this package uses
|
||||
make_path ("$stow_pkg/$id-shared2/subdir-$pkg");
|
||||
make_file("$stow_pkg/$id-shared2/$id-file-$pkg");
|
||||
make_file("$stow_pkg/$id-shared2/subdir-$pkg/$id-file-$pkg");
|
||||
}
|
||||
|
||||
# check shared tree is not folded. first time round this will be
|
||||
# newly stowed.
|
||||
is_dir_not_symlink('no-folding-shared');
|
||||
is_link("no-folding-shared/no-folding-file-$pkg",
|
||||
"../$stow_pkg/no-folding-shared/no-folding-file-$pkg");
|
||||
foreach my $pkg (qw{a b}) {
|
||||
create_pkg('no-folding', $pkg);
|
||||
}
|
||||
|
||||
# check partially shared tree is not folded. first time round this
|
||||
# will be newly stowed.
|
||||
is_dir_not_symlink('no-folding-shared2');
|
||||
is_link("no-folding-shared2/no-folding-file-$pkg",
|
||||
"../$stow_pkg/no-folding-shared2/no-folding-file-$pkg");
|
||||
is_link("no-folding-shared2/no-folding-file-$pkg",
|
||||
"../$stow_pkg/no-folding-shared2/no-folding-file-$pkg");
|
||||
}
|
||||
$stow = new_Stow('no-folding' => 1);
|
||||
$stow->plan_stow('no-folding-a');
|
||||
is_deeply([ $stow->get_conflicts ], [] => 'no conflicts with --no-folding');
|
||||
my @tasks = $stow->get_tasks;
|
||||
use Data::Dumper;
|
||||
is(scalar(@tasks), 13 => "6 dirs, 7 links") || warn Dumper(\@tasks);
|
||||
$stow->process_tasks();
|
||||
|
||||
check_no_folding('a');
|
||||
sub check_no_folding {
|
||||
my ($pkg) = @_;
|
||||
my $stow_pkg = "../stow/no-folding-$pkg";
|
||||
is_link("no-folding-file-$pkg", "$stow_pkg/no-folding-file-$pkg");
|
||||
|
||||
$stow = new_Stow('no-folding' => 1);
|
||||
$stow->plan_stow('no-folding-b');
|
||||
is_deeply([ $stow->get_conflicts ], [] => 'no conflicts with --no-folding');
|
||||
@tasks = $stow->get_tasks;
|
||||
is(scalar(@tasks), 11 => '4 dirs, 7 links') || warn Dumper(\@tasks);
|
||||
$stow->process_tasks();
|
||||
# check existing folded tree is untouched
|
||||
is_link("no-folding-$pkg-only-old", "$stow_pkg/no-folding-$pkg-only-old");
|
||||
|
||||
check_no_folding('a');
|
||||
check_no_folding('b');
|
||||
});
|
||||
# check newly stowed shallow tree is not folded
|
||||
is_dir_not_symlink("no-folding-$pkg-only-new");
|
||||
is_link("no-folding-$pkg-only-new/no-folding-file-$pkg",
|
||||
"../$stow_pkg/no-folding-$pkg-only-new/no-folding-file-$pkg");
|
||||
|
||||
# check newly stowed deeper tree is not folded
|
||||
is_dir_not_symlink("no-folding-$pkg-only-new2");
|
||||
is_dir_not_symlink("no-folding-$pkg-only-new2/subdir");
|
||||
is_link("no-folding-$pkg-only-new2/subdir/no-folding-file-$pkg",
|
||||
"../../$stow_pkg/no-folding-$pkg-only-new2/subdir/no-folding-file-$pkg");
|
||||
is_link("no-folding-$pkg-only-new2/current",
|
||||
"../$stow_pkg/no-folding-$pkg-only-new2/current");
|
||||
|
||||
# check shared tree is not folded. first time round this will be
|
||||
# newly stowed.
|
||||
is_dir_not_symlink('no-folding-shared');
|
||||
is_link("no-folding-shared/no-folding-file-$pkg",
|
||||
"../$stow_pkg/no-folding-shared/no-folding-file-$pkg");
|
||||
|
||||
# check partially shared tree is not folded. first time round this
|
||||
# will be newly stowed.
|
||||
is_dir_not_symlink('no-folding-shared2');
|
||||
is_link("no-folding-shared2/no-folding-file-$pkg",
|
||||
"../$stow_pkg/no-folding-shared2/no-folding-file-$pkg");
|
||||
is_link("no-folding-shared2/no-folding-file-$pkg",
|
||||
"../$stow_pkg/no-folding-shared2/no-folding-file-$pkg");
|
||||
}
|
||||
|
||||
check_no_folding('a');
|
||||
|
||||
$stow = new_Stow('no-folding' => 1);
|
||||
$stow->plan_stow('no-folding-b');
|
||||
is_deeply([ $stow->get_conflicts ], [] => 'no conflicts with --no-folding');
|
||||
@tasks = $stow->get_tasks;
|
||||
is(scalar(@tasks), 11 => '4 dirs, 7 links') || warn Dumper(\@tasks);
|
||||
$stow->process_tasks();
|
||||
|
||||
check_no_folding('a');
|
||||
check_no_folding('b');
|
||||
|
|
|
@ -24,10 +24,11 @@ package testutil;
|
|||
use strict;
|
||||
use warnings;
|
||||
|
||||
use Carp qw(confess croak);
|
||||
use Carp qw(croak);
|
||||
use File::Basename;
|
||||
use File::Path qw(make_path remove_tree);
|
||||
use File::Spec;
|
||||
use IO::Scalar;
|
||||
use Test::More;
|
||||
|
||||
use Stow;
|
||||
|
@ -37,6 +38,7 @@ use base qw(Exporter);
|
|||
our @EXPORT = qw(
|
||||
$ABS_TEST_DIR
|
||||
$TEST_DIR
|
||||
$stderr
|
||||
init_test_dirs
|
||||
cd
|
||||
new_Stow new_compat_Stow
|
||||
|
@ -44,41 +46,45 @@ our @EXPORT = qw(
|
|||
remove_dir remove_file remove_link
|
||||
cat_file
|
||||
is_link is_dir_not_symlink is_nonexistent_path
|
||||
capture_stderr uncapture_stderr
|
||||
);
|
||||
|
||||
our $TEST_DIR = 'tmp-testing-trees';
|
||||
our $ABS_TEST_DIR = File::Spec->rel2abs('tmp-testing-trees');
|
||||
|
||||
sub init_test_dirs {
|
||||
my $test_dir = shift || $TEST_DIR;
|
||||
my $abs_test_dir = File::Spec->rel2abs($test_dir);
|
||||
our $stderr;
|
||||
my $tied_err;
|
||||
|
||||
sub capture_stderr {
|
||||
undef $stderr;
|
||||
$tied_err = tie *STDERR, 'IO::Scalar', \$stderr;
|
||||
}
|
||||
|
||||
sub uncapture_stderr {
|
||||
undef $tied_err;
|
||||
untie *STDERR;
|
||||
}
|
||||
|
||||
sub init_test_dirs {
|
||||
# Create a run_from/ subdirectory for tests which want to run
|
||||
# from a separate directory outside the Stow directory or
|
||||
# target directory.
|
||||
for my $dir ("target", "stow", "run_from") {
|
||||
my $path = "$test_dir/$dir";
|
||||
my $path = "$TEST_DIR/$dir";
|
||||
-d $path and remove_tree($path);
|
||||
make_path($path);
|
||||
}
|
||||
|
||||
# Don't let user's ~/.stow-global-ignore affect test results
|
||||
$ENV{HOME} = $abs_test_dir;
|
||||
return $abs_test_dir;
|
||||
$ENV{HOME} = $ABS_TEST_DIR;
|
||||
}
|
||||
|
||||
sub new_Stow {
|
||||
my %opts = @_;
|
||||
# These default paths assume that execution will be triggered from
|
||||
# within the target directory.
|
||||
$opts{dir} ||= '../stow';
|
||||
$opts{target} ||= '.';
|
||||
$opts{test_mode} = 1;
|
||||
my $stow = eval { new Stow(%opts) };
|
||||
if ($@) {
|
||||
confess "Error while trying to instantiate new Stow(%opts): $@";
|
||||
}
|
||||
return $stow;
|
||||
return new Stow(%opts);
|
||||
}
|
||||
|
||||
sub new_compat_Stow {
|
||||
|
@ -90,28 +96,28 @@ sub new_compat_Stow {
|
|||
#===== SUBROUTINE ===========================================================
|
||||
# Name : make_link()
|
||||
# Purpose : safely create a link
|
||||
# Parameters: $link_src => path to the link
|
||||
# : $link_dest => where the new link should point
|
||||
# : $invalid => true iff $link_dest refers to non-existent file
|
||||
# Parameters: $target => path to the link
|
||||
# : $source => where the new link should point
|
||||
# : $invalid => true iff $source refers to non-existent file
|
||||
# Returns : n/a
|
||||
# Throws : fatal error if the link can not be safely created
|
||||
# Comments : checks for existing nodes
|
||||
#============================================================================
|
||||
sub make_link {
|
||||
my ($link_src, $link_dest, $invalid) = @_;
|
||||
my ($target, $source, $invalid) = @_;
|
||||
|
||||
if (-l $link_src) {
|
||||
my $old_source = readlink join('/', parent($link_src), $link_dest)
|
||||
or croak "$link_src is already a link but could not read link $link_src/$link_dest";
|
||||
if ($old_source ne $link_dest) {
|
||||
croak "$link_src already exists but points elsewhere\n";
|
||||
if (-l $target) {
|
||||
my $old_source = readlink join('/', parent($target), $source)
|
||||
or die "$target is already a link but could not read link $target/$source";
|
||||
if ($old_source ne $source) {
|
||||
die "$target already exists but points elsewhere\n";
|
||||
}
|
||||
}
|
||||
croak "$link_src already exists and is not a link\n" if -e $link_src;
|
||||
my $abs_target = File::Spec->rel2abs($link_src);
|
||||
my $link_src_container = dirname($abs_target);
|
||||
my $abs_source = File::Spec->rel2abs($link_dest, $link_src_container);
|
||||
#warn "t $link_src c $link_src_container as $abs_source";
|
||||
die "$target already exists and is not a link\n" if -e $target;
|
||||
my $abs_target = File::Spec->rel2abs($target);
|
||||
my $target_container = dirname($abs_target);
|
||||
my $abs_source = File::Spec->rel2abs($source, $target_container);
|
||||
#warn "t $target c $target_container as $abs_source";
|
||||
if (-e $abs_source) {
|
||||
croak "Won't make invalid link pointing to existing $abs_target"
|
||||
if $invalid;
|
||||
|
@ -120,8 +126,8 @@ sub make_link {
|
|||
croak "Won't make link pointing to non-existent $abs_target"
|
||||
unless $invalid;
|
||||
}
|
||||
symlink $link_dest, $link_src
|
||||
or croak "could not create link $link_src => $link_dest ($!)\n";
|
||||
symlink $source, $target
|
||||
or die "could not create link $target => $source ($!)\n";
|
||||
}
|
||||
|
||||
#===== SUBROUTINE ===========================================================
|
||||
|
@ -151,11 +157,11 @@ sub make_file {
|
|||
my ($path, $contents) = @_;
|
||||
|
||||
if (-e $path and ! -f $path) {
|
||||
croak "a non-file already exists at $path\n";
|
||||
die "a non-file already exists at $path\n";
|
||||
}
|
||||
|
||||
open my $FILE ,'>', $path
|
||||
or croak "could not create file: $path ($!)\n";
|
||||
or die "could not create file: $path ($!)\n";
|
||||
print $FILE $contents if defined $contents;
|
||||
close $FILE;
|
||||
}
|
||||
|
@ -172,9 +178,9 @@ sub make_file {
|
|||
sub remove_link {
|
||||
my ($path) = @_;
|
||||
if (not -l $path) {
|
||||
croak qq(remove_link() called with a non-link: $path);
|
||||
die qq(remove_link() called with a non-link: $path);
|
||||
}
|
||||
unlink $path or croak "could not remove link: $path ($!)\n";
|
||||
unlink $path or die "could not remove link: $path ($!)\n";
|
||||
return;
|
||||
}
|
||||
|
||||
|
@ -189,9 +195,9 @@ sub remove_link {
|
|||
sub remove_file {
|
||||
my ($path) = @_;
|
||||
if (-z $path) {
|
||||
croak "file at $path is non-empty\n";
|
||||
die "file at $path is non-empty\n";
|
||||
}
|
||||
unlink $path or croak "could not remove empty file: $path ($!)\n";
|
||||
unlink $path or die "could not remove empty file: $path ($!)\n";
|
||||
return;
|
||||
}
|
||||
|
||||
|
@ -207,10 +213,10 @@ sub remove_dir {
|
|||
my ($dir) = @_;
|
||||
|
||||
if (not -d $dir) {
|
||||
croak "$dir is not a directory";
|
||||
die "$dir is not a directory";
|
||||
}
|
||||
|
||||
opendir my $DIR, $dir or croak "cannot read directory: $dir ($!)\n";
|
||||
opendir my $DIR, $dir or die "cannot read directory: $dir ($!)\n";
|
||||
my @listing = readdir $DIR;
|
||||
closedir $DIR;
|
||||
|
||||
|
@ -221,16 +227,16 @@ sub remove_dir {
|
|||
|
||||
my $path = "$dir/$node";
|
||||
if (-l $path or (-f $path and -z $path) or $node eq $Stow::LOCAL_IGNORE_FILE) {
|
||||
unlink $path or croak "cannot unlink $path ($!)\n";
|
||||
unlink $path or die "cannot unlink $path ($!)\n";
|
||||
}
|
||||
elsif (-d "$path") {
|
||||
remove_dir($path);
|
||||
}
|
||||
else {
|
||||
croak "$path is not a link, directory, or empty file\n";
|
||||
die "$path is not a link, directory, or empty file\n";
|
||||
}
|
||||
}
|
||||
rmdir $dir or croak "cannot rmdir $dir ($!)\n";
|
||||
rmdir $dir or die "cannot rmdir $dir ($!)\n";
|
||||
|
||||
return;
|
||||
}
|
||||
|
@ -245,7 +251,7 @@ sub remove_dir {
|
|||
#============================================================================
|
||||
sub cd {
|
||||
my ($dir) = @_;
|
||||
chdir $dir or croak "Failed to chdir($dir): $!\n";
|
||||
chdir $dir or die "Failed to chdir($dir): $!\n";
|
||||
}
|
||||
|
||||
#===== SUBROUTINE ===========================================================
|
||||
|
@ -258,7 +264,7 @@ sub cd {
|
|||
#============================================================================
|
||||
sub cat_file {
|
||||
my ($file) = @_;
|
||||
open F, $file or croak "Failed to open($file): $!\n";
|
||||
open F, $file or die "Failed to open($file): $!\n";
|
||||
my $contents = join '', <F>;
|
||||
close(F);
|
||||
return $contents;
|
||||
|
@ -303,5 +309,6 @@ sub is_nonexistent_path {
|
|||
|
||||
# Local variables:
|
||||
# mode: perl
|
||||
# cperl-indent-level: 4
|
||||
# end:
|
||||
# vim: ft=perl
|
||||
|
|
727
t/unstow.t
727
t/unstow.t
|
@ -22,528 +22,429 @@
|
|||
use strict;
|
||||
use warnings;
|
||||
|
||||
use File::Spec qw(make_path);
|
||||
use POSIX qw(getcwd);
|
||||
use Test::More tests => 35;
|
||||
use Test::More tests => 39;
|
||||
use Test::Output;
|
||||
use English qw(-no_match_vars);
|
||||
|
||||
use testutil;
|
||||
use Stow::Util qw(canon_path);
|
||||
|
||||
my $repo = getcwd();
|
||||
init_test_dirs();
|
||||
cd("$TEST_DIR/target");
|
||||
|
||||
init_test_dirs($TEST_DIR);
|
||||
# Note that each of the following tests use a distinct set of files
|
||||
|
||||
our $COMPAT_TEST_DIR = "${TEST_DIR}-compat";
|
||||
our $COMPAT_ABS_TEST_DIR = init_test_dirs($COMPAT_TEST_DIR);
|
||||
my $stow;
|
||||
my %conflicts;
|
||||
|
||||
sub init_stow2 {
|
||||
make_path('stow2'); # make our alternate stow dir a subdir of target
|
||||
make_file('stow2/.stow');
|
||||
}
|
||||
|
||||
sub create_unowned_files {
|
||||
# Make things harder for Stow to figure out, by adding
|
||||
# a bunch of alien files unrelated to Stow.
|
||||
my @UNOWNED_DIRS = ('unowned-dir', '.unowned-dir', 'dot-unowned-dir');
|
||||
for my $dir ('.', @UNOWNED_DIRS) {
|
||||
for my $subdir ('.', @UNOWNED_DIRS) {
|
||||
make_path("$dir/$subdir");
|
||||
make_file("$dir/$subdir/unowned");
|
||||
make_file("$dir/$subdir/.unowned");
|
||||
make_file("$dir/$subdir/dot-unowned");
|
||||
}
|
||||
}
|
||||
}
|
||||
|
||||
# Run a subtest twice, with compat off then on, in parallel test trees.
|
||||
#
|
||||
# Params: $name[, $setup], $test_code
|
||||
# unstow a simple tree minimally
|
||||
#
|
||||
$stow = new_Stow();
|
||||
|
||||
make_path('../stow/pkg1/bin1');
|
||||
make_file('../stow/pkg1/bin1/file1');
|
||||
make_link('bin1', '../stow/pkg1/bin1');
|
||||
|
||||
$stow->plan_unstow('pkg1');
|
||||
$stow->process_tasks();
|
||||
ok(
|
||||
$stow->get_conflict_count == 0 &&
|
||||
-f '../stow/pkg1/bin1/file1' && ! -e 'bin1'
|
||||
=> 'unstow a simple tree'
|
||||
);
|
||||
|
||||
#
|
||||
# $setup is an optional ref to an options hash to pass into the new
|
||||
# Stow() constructor, or a ref to a sub which performs setup before
|
||||
# the constructor gets called and then returns that options hash.
|
||||
sub subtests {
|
||||
my $name = shift;
|
||||
my $setup = @_ == 2 ? shift : {};
|
||||
my $code = shift;
|
||||
# unstow a simple tree from an existing directory
|
||||
#
|
||||
$stow = new_Stow();
|
||||
|
||||
$ENV{HOME} = $ABS_TEST_DIR;
|
||||
cd($repo);
|
||||
cd("$TEST_DIR/target");
|
||||
create_unowned_files();
|
||||
# cd first to allow setup to cd somewhere else.
|
||||
my $opts = ref($setup) eq 'HASH' ? $setup : $setup->($TEST_DIR);
|
||||
subtest($name, sub {
|
||||
make_path($opts->{dir}) if $opts->{dir};
|
||||
my $stow = new_Stow(%$opts);
|
||||
$code->($stow, $TEST_DIR);
|
||||
});
|
||||
make_path('lib2');
|
||||
make_path('../stow/pkg2/lib2');
|
||||
make_file('../stow/pkg2/lib2/file2');
|
||||
make_link('lib2/file2', '../../stow/pkg2/lib2/file2');
|
||||
$stow->plan_unstow('pkg2');
|
||||
$stow->process_tasks();
|
||||
ok(
|
||||
$stow->get_conflict_count == 0 &&
|
||||
-f '../stow/pkg2/lib2/file2' && -d 'lib2'
|
||||
=> 'unstow simple tree from a pre-existing directory'
|
||||
);
|
||||
|
||||
$ENV{HOME} = $COMPAT_ABS_TEST_DIR;
|
||||
cd($repo);
|
||||
cd("$COMPAT_TEST_DIR/target");
|
||||
create_unowned_files();
|
||||
# cd first to allow setup to cd somewhere else.
|
||||
$opts = ref $setup eq 'HASH' ? $setup : $setup->($COMPAT_TEST_DIR);
|
||||
subtest("$name (compat mode)", sub {
|
||||
make_path($opts->{dir}) if $opts->{dir};
|
||||
my $stow = new_compat_Stow(%$opts);
|
||||
$code->($stow, $COMPAT_TEST_DIR);
|
||||
});
|
||||
}
|
||||
#
|
||||
# fold tree after unstowing
|
||||
#
|
||||
$stow = new_Stow();
|
||||
|
||||
sub plan_tests {
|
||||
my ($stow, $count) = @_;
|
||||
plan tests => $stow->{compat} ? $count + 2 : $count;
|
||||
}
|
||||
make_path('bin3');
|
||||
|
||||
subtests("unstow a simple tree minimally", sub {
|
||||
my ($stow) = @_;
|
||||
plan tests => 3;
|
||||
make_path('../stow/pkg3a/bin3');
|
||||
make_file('../stow/pkg3a/bin3/file3a');
|
||||
make_link('bin3/file3a' => '../../stow/pkg3a/bin3/file3a'); # emulate stow
|
||||
|
||||
make_path('../stow/pkg1/bin1');
|
||||
make_file('../stow/pkg1/bin1/file1');
|
||||
make_link('bin1', '../stow/pkg1/bin1');
|
||||
make_path('../stow/pkg3b/bin3');
|
||||
make_file('../stow/pkg3b/bin3/file3b');
|
||||
make_link('bin3/file3b' => '../../stow/pkg3b/bin3/file3b'); # emulate stow
|
||||
$stow->plan_unstow('pkg3b');
|
||||
$stow->process_tasks();
|
||||
ok(
|
||||
$stow->get_conflict_count == 0 &&
|
||||
-l 'bin3' &&
|
||||
readlink('bin3') eq '../stow/pkg3a/bin3'
|
||||
=> 'fold tree after unstowing'
|
||||
);
|
||||
|
||||
$stow->plan_unstow('pkg1');
|
||||
$stow->process_tasks();
|
||||
is($stow->get_conflict_count, 0, 'conflict count');
|
||||
ok(-f '../stow/pkg1/bin1/file1');
|
||||
ok(! -e 'bin1' => 'unstow a simple tree');
|
||||
});
|
||||
#
|
||||
# existing link is owned by stow but is invalid so it gets removed anyway
|
||||
#
|
||||
$stow = new_Stow();
|
||||
|
||||
subtests("unstow a simple tree from an existing directory", sub {
|
||||
my ($stow) = @_;
|
||||
plan tests => 3;
|
||||
make_path('bin4');
|
||||
make_path('../stow/pkg4/bin4');
|
||||
make_file('../stow/pkg4/bin4/file4');
|
||||
make_invalid_link('bin4/file4', '../../stow/pkg4/bin4/does-not-exist');
|
||||
|
||||
make_path('lib2');
|
||||
make_path('../stow/pkg2/lib2');
|
||||
make_file('../stow/pkg2/lib2/file2');
|
||||
make_link('lib2/file2', '../../stow/pkg2/lib2/file2');
|
||||
$stow->plan_unstow('pkg2');
|
||||
$stow->process_tasks();
|
||||
is($stow->get_conflict_count, 0, 'conflict count');
|
||||
ok(-f '../stow/pkg2/lib2/file2');
|
||||
ok(-d 'lib2'
|
||||
=> 'unstow simple tree from a pre-existing directory'
|
||||
);
|
||||
});
|
||||
$stow->plan_unstow('pkg4');
|
||||
$stow->process_tasks();
|
||||
ok(
|
||||
$stow->get_conflict_count == 0 &&
|
||||
! -e 'bin4/file4'
|
||||
=> q(remove invalid link owned by stow)
|
||||
);
|
||||
|
||||
subtests("fold tree after unstowing", sub {
|
||||
my ($stow) = @_;
|
||||
plan tests => 3;
|
||||
#
|
||||
# Existing link is not owned by stow
|
||||
#
|
||||
$stow = new_Stow();
|
||||
|
||||
make_path('bin3');
|
||||
make_path('../stow/pkg5/bin5');
|
||||
make_invalid_link('bin5', '../not-stow');
|
||||
|
||||
make_path('../stow/pkg3a/bin3');
|
||||
make_file('../stow/pkg3a/bin3/file3a');
|
||||
make_link('bin3/file3a' => '../../stow/pkg3a/bin3/file3a'); # emulate stow
|
||||
$stow->plan_unstow('pkg5');
|
||||
%conflicts = $stow->get_conflicts;
|
||||
like(
|
||||
$conflicts{unstow}{pkg5}[-1],
|
||||
qr(existing target is not owned by stow)
|
||||
=> q(existing link not owned by stow)
|
||||
);
|
||||
|
||||
make_path('../stow/pkg3b/bin3');
|
||||
make_file('../stow/pkg3b/bin3/file3b');
|
||||
make_link('bin3/file3b' => '../../stow/pkg3b/bin3/file3b'); # emulate stow
|
||||
$stow->plan_unstow('pkg3b');
|
||||
$stow->process_tasks();
|
||||
is($stow->get_conflict_count, 0, 'conflict count');
|
||||
ok(-l 'bin3');
|
||||
is(readlink('bin3'), '../stow/pkg3a/bin3'
|
||||
=> 'fold tree after unstowing'
|
||||
);
|
||||
});
|
||||
#
|
||||
# Target already exists, is owned by stow, but points to a different package
|
||||
#
|
||||
$stow = new_Stow();
|
||||
|
||||
subtests("existing link is owned by stow but is invalid so it gets removed anyway", sub {
|
||||
my ($stow) = @_;
|
||||
plan tests => 2;
|
||||
make_path('bin6');
|
||||
make_path('../stow/pkg6a/bin6');
|
||||
make_file('../stow/pkg6a/bin6/file6');
|
||||
make_link('bin6/file6', '../../stow/pkg6a/bin6/file6');
|
||||
|
||||
make_path('bin4');
|
||||
make_path('../stow/pkg4/bin4');
|
||||
make_file('../stow/pkg4/bin4/file4');
|
||||
make_invalid_link('bin4/file4', '../../stow/pkg4/bin4/does-not-exist');
|
||||
make_path('../stow/pkg6b/bin6');
|
||||
make_file('../stow/pkg6b/bin6/file6');
|
||||
|
||||
$stow->plan_unstow('pkg4');
|
||||
$stow->process_tasks();
|
||||
is($stow->get_conflict_count, 0, 'conflict count');
|
||||
ok(! -e 'bin4/file4'
|
||||
=> q(remove invalid link owned by stow)
|
||||
);
|
||||
});
|
||||
$stow->plan_unstow('pkg6b');
|
||||
ok(
|
||||
$stow->get_conflict_count == 0 &&
|
||||
-l 'bin6/file6' &&
|
||||
readlink('bin6/file6') eq '../../stow/pkg6a/bin6/file6'
|
||||
=> q(ignore existing link that points to a different package)
|
||||
);
|
||||
|
||||
subtests("Existing invalid link is not owned by stow", sub {
|
||||
my ($stow) = @_;
|
||||
plan tests => 3;
|
||||
#
|
||||
# Don't unlink anything under the stow directory
|
||||
#
|
||||
make_path('stow'); # make out stow dir a subdir of target
|
||||
$stow = new_Stow(dir => 'stow');
|
||||
|
||||
make_path('../stow/pkg5/bin5');
|
||||
make_invalid_link('bin5', '../not-stow');
|
||||
# emulate stowing into ourself (bizarre corner case or accident)
|
||||
make_path('stow/pkg7a/stow/pkg7b');
|
||||
make_file('stow/pkg7a/stow/pkg7b/file7b');
|
||||
make_link('stow/pkg7b', '../stow/pkg7a/stow/pkg7b');
|
||||
|
||||
$stow->plan_unstow('pkg5');
|
||||
is($stow->get_conflict_count, 0, 'conflict count');
|
||||
ok(-l 'bin5', 'invalid link not removed');
|
||||
is(readlink('bin5'), '../not-stow' => "invalid link not changed");
|
||||
});
|
||||
$stow->plan_unstow('pkg7b');
|
||||
is($stow->get_tasks, 0, 'no tasks to process when unstowing pkg7b');
|
||||
ok(
|
||||
$stow->get_conflict_count == 0 &&
|
||||
-l 'stow/pkg7b' &&
|
||||
readlink('stow/pkg7b') eq '../stow/pkg7a/stow/pkg7b'
|
||||
=> q(don't unlink any nodes under the stow directory)
|
||||
);
|
||||
|
||||
subtests("Target already exists, is owned by stow, but points to a different package", sub {
|
||||
my ($stow) = @_;
|
||||
plan tests => 3;
|
||||
|
||||
make_path('bin6');
|
||||
make_path('../stow/pkg6a/bin6');
|
||||
make_file('../stow/pkg6a/bin6/file6');
|
||||
make_link('bin6/file6', '../../stow/pkg6a/bin6/file6');
|
||||
#
|
||||
# Don't unlink any nodes under another stow directory
|
||||
#
|
||||
$stow = new_Stow(dir => 'stow');
|
||||
|
||||
make_path('../stow/pkg6b/bin6');
|
||||
make_file('../stow/pkg6b/bin6/file6');
|
||||
make_path('stow2'); # make our alternate stow dir a subdir of target
|
||||
make_file('stow2/.stow');
|
||||
|
||||
$stow->plan_unstow('pkg6b');
|
||||
is($stow->get_conflict_count, 0, 'conflict count');
|
||||
ok(-l 'bin6/file6');
|
||||
is(
|
||||
readlink('bin6/file6'),
|
||||
'../../stow/pkg6a/bin6/file6'
|
||||
=> q(ignore existing link that points to a different package)
|
||||
);
|
||||
});
|
||||
# emulate stowing into ourself (bizarre corner case or accident)
|
||||
make_path('stow/pkg8a/stow2/pkg8b');
|
||||
make_file('stow/pkg8a/stow2/pkg8b/file8b');
|
||||
make_link('stow2/pkg8b', '../stow/pkg8a/stow2/pkg8b');
|
||||
|
||||
subtests("Don't unlink anything under the stow directory",
|
||||
sub {
|
||||
make_path('stow');
|
||||
return { dir => 'stow' };
|
||||
# target dir defaults to parent of stow, which is target directory
|
||||
},
|
||||
sub {
|
||||
plan tests => 5;
|
||||
my ($stow) = @_;
|
||||
capture_stderr();
|
||||
$stow->plan_unstow('pkg8a');
|
||||
is($stow->get_tasks, 0, 'no tasks to process when unstowing pkg8a');
|
||||
ok(
|
||||
$stow->get_conflict_count == 0 &&
|
||||
-l 'stow2/pkg8b' &&
|
||||
readlink('stow2/pkg8b') eq '../stow/pkg8a/stow2/pkg8b'
|
||||
=> q(don't unlink any nodes under another stow directory)
|
||||
);
|
||||
like($stderr,
|
||||
qr/WARNING: skipping protected directory stow2/
|
||||
=> "unstowing from ourself should skip stow");
|
||||
uncapture_stderr();
|
||||
|
||||
# Emulate stowing into ourself (bizarre corner case or accident):
|
||||
make_path('stow/pkg7a/stow/pkg7b');
|
||||
make_file('stow/pkg7a/stow/pkg7b/file7b');
|
||||
# Make a package be a link to a package of the same name inside another package.
|
||||
make_link('stow/pkg7b', '../stow/pkg7a/stow/pkg7b');
|
||||
#
|
||||
# overriding already stowed documentation
|
||||
#
|
||||
$stow = new_Stow(override => ['man9', 'info9']);
|
||||
make_file('stow/.stow');
|
||||
|
||||
stderr_like(
|
||||
sub { $stow->plan_unstow('pkg7b'); },
|
||||
$stow->{compat} ? qr/WARNING: skipping target which was current stow directory stow/ : qr//
|
||||
=> "warn when unstowing from ourself"
|
||||
);
|
||||
is($stow->get_tasks, 0, 'no tasks to process when unstowing pkg7b');
|
||||
is($stow->get_conflict_count, 0, 'conflict count');
|
||||
ok(-l 'stow/pkg7b');
|
||||
is(
|
||||
readlink('stow/pkg7b'),
|
||||
'../stow/pkg7a/stow/pkg7b'
|
||||
=> q(don't unlink any nodes under the stow directory)
|
||||
);
|
||||
});
|
||||
make_path('../stow/pkg9a/man9/man1');
|
||||
make_file('../stow/pkg9a/man9/man1/file9.1');
|
||||
make_path('man9/man1');
|
||||
make_link('man9/man1/file9.1' => '../../../stow/pkg9a/man9/man1/file9.1'); # emulate stow
|
||||
|
||||
subtests("Don't unlink any nodes under another stow directory",
|
||||
sub {
|
||||
make_path('stow');
|
||||
return { dir => 'stow' };
|
||||
},
|
||||
sub {
|
||||
my ($stow) = @_;
|
||||
plan tests => 5;
|
||||
make_path('../stow/pkg9b/man9/man1');
|
||||
make_file('../stow/pkg9b/man9/man1/file9.1');
|
||||
$stow->plan_unstow('pkg9b');
|
||||
$stow->process_tasks();
|
||||
ok(
|
||||
$stow->get_conflict_count == 0 &&
|
||||
!-l 'man9/man1/file9.1'
|
||||
=> 'overriding existing documentation files'
|
||||
);
|
||||
|
||||
init_stow2();
|
||||
# emulate stowing into ourself (bizarre corner case or accident)
|
||||
make_path('stow/pkg8a/stow2/pkg8b');
|
||||
make_file('stow/pkg8a/stow2/pkg8b/file8b');
|
||||
make_link('stow2/pkg8b', '../stow/pkg8a/stow2/pkg8b');
|
||||
#
|
||||
# deferring to already stowed documentation
|
||||
#
|
||||
$stow = new_Stow(defer => ['man10', 'info10']);
|
||||
|
||||
stderr_like(
|
||||
sub { $stow->plan_unstow('pkg8a'); },
|
||||
qr/WARNING: skipping marked Stow directory stow2/
|
||||
=> "warn when skipping unstowing"
|
||||
);
|
||||
is($stow->get_tasks, 0, 'no tasks to process when unstowing pkg8a');
|
||||
is($stow->get_conflict_count, 0, 'conflict count');
|
||||
ok(-l 'stow2/pkg8b');
|
||||
is(
|
||||
readlink('stow2/pkg8b'),
|
||||
'../stow/pkg8a/stow2/pkg8b'
|
||||
=> q(don't unlink any nodes under another stow directory)
|
||||
);
|
||||
});
|
||||
make_path('../stow/pkg10a/man10/man1');
|
||||
make_file('../stow/pkg10a/man10/man1/file10a.1');
|
||||
make_path('man10/man1');
|
||||
make_link('man10/man1/file10a.1' => '../../../stow/pkg10a/man10/man1/file10a.1');
|
||||
|
||||
# This will be used by subsequent tests
|
||||
sub check_protected_dirs_skipped {
|
||||
my ($stderr) = @_;
|
||||
for my $dir (qw{stow stow2}) {
|
||||
like($stderr,
|
||||
qr/WARNING: skipping marked Stow directory $dir/
|
||||
=> "warn when skipping marked directory $dir");
|
||||
}
|
||||
}
|
||||
# need this to block folding
|
||||
make_path('../stow/pkg10b/man10/man1');
|
||||
make_file('../stow/pkg10b/man10/man1/file10b.1');
|
||||
make_link('man10/man1/file10b.1' => '../../../stow/pkg10b/man10/man1/file10b.1');
|
||||
|
||||
subtests("overriding already stowed documentation",
|
||||
{override => ['man9', 'info9']},
|
||||
sub {
|
||||
my ($stow) = @_;
|
||||
plan_tests($stow, 2);
|
||||
|
||||
make_file('stow/.stow');
|
||||
init_stow2();
|
||||
make_path('../stow/pkg9a/man9/man1');
|
||||
make_file('../stow/pkg9a/man9/man1/file9.1');
|
||||
make_path('man9/man1');
|
||||
make_link('man9/man1/file9.1' => '../../../stow/pkg9a/man9/man1/file9.1'); # emulate stow
|
||||
make_path('../stow/pkg10c/man10/man1');
|
||||
make_file('../stow/pkg10c/man10/man1/file10a.1');
|
||||
$stow->plan_unstow('pkg10c');
|
||||
is($stow->get_tasks, 0, 'no tasks to process when unstowing pkg10c');
|
||||
ok(
|
||||
$stow->get_conflict_count == 0 &&
|
||||
readlink('man10/man1/file10a.1') eq '../../../stow/pkg10a/man10/man1/file10a.1'
|
||||
=> 'defer to existing documentation files'
|
||||
);
|
||||
|
||||
make_path('../stow/pkg9b/man9/man1');
|
||||
make_file('../stow/pkg9b/man9/man1/file9.1');
|
||||
my $stderr = stderr_from { $stow->plan_unstow('pkg9b') };
|
||||
check_protected_dirs_skipped($stderr) if $stow->{compat};
|
||||
$stow->process_tasks();
|
||||
is($stow->get_conflict_count, 0, 'conflict count');
|
||||
ok(!-l 'man9/man1/file9.1'
|
||||
=> 'overriding existing documentation files'
|
||||
);
|
||||
});
|
||||
#
|
||||
# Ignore temp files
|
||||
#
|
||||
$stow = new_Stow(ignore => ['~', '\.#.*']);
|
||||
|
||||
subtests("deferring to already stowed documentation",
|
||||
{defer => ['man10', 'info10']},
|
||||
sub {
|
||||
my ($stow) = @_;
|
||||
plan_tests($stow, 3);
|
||||
make_path('../stow/pkg12/man12/man1');
|
||||
make_file('../stow/pkg12/man12/man1/file12.1');
|
||||
make_file('../stow/pkg12/man12/man1/file12.1~');
|
||||
make_file('../stow/pkg12/man12/man1/.#file12.1');
|
||||
make_path('man12/man1');
|
||||
make_link('man12/man1/file12.1' => '../../../stow/pkg12/man12/man1/file12.1');
|
||||
|
||||
init_stow2();
|
||||
make_path('../stow/pkg10a/man10/man1');
|
||||
make_file('../stow/pkg10a/man10/man1/file10a.1');
|
||||
make_path('man10/man1');
|
||||
make_link('man10/man1/file10a.1' => '../../../stow/pkg10a/man10/man1/file10a.1');
|
||||
$stow->plan_unstow('pkg12');
|
||||
$stow->process_tasks();
|
||||
ok(
|
||||
$stow->get_conflict_count == 0 &&
|
||||
!-e 'man12/man1/file12.1'
|
||||
=> 'ignore temp files'
|
||||
);
|
||||
|
||||
# need this to block folding
|
||||
make_path('../stow/pkg10b/man10/man1');
|
||||
make_file('../stow/pkg10b/man10/man1/file10b.1');
|
||||
make_link('man10/man1/file10b.1' => '../../../stow/pkg10b/man10/man1/file10b.1');
|
||||
#
|
||||
# Unstow an already unstowed package
|
||||
#
|
||||
$stow = new_Stow();
|
||||
$stow->plan_unstow('pkg12');
|
||||
is($stow->get_tasks, 0, 'no tasks to process when unstowing pkg12');
|
||||
ok(
|
||||
$stow->get_conflict_count == 0
|
||||
=> 'unstow already unstowed package pkg12'
|
||||
);
|
||||
|
||||
make_path('../stow/pkg10c/man10/man1');
|
||||
make_file('../stow/pkg10c/man10/man1/file10a.1');
|
||||
my $stderr = stderr_from { $stow->plan_unstow('pkg10c') };
|
||||
check_protected_dirs_skipped($stderr) if $stow->{compat};
|
||||
is($stow->get_tasks, 0, 'no tasks to process when unstowing pkg10c');
|
||||
is($stow->get_conflict_count, 0, 'conflict count');
|
||||
is(
|
||||
readlink('man10/man1/file10a.1'),
|
||||
'../../../stow/pkg10a/man10/man1/file10a.1'
|
||||
=> 'defer to existing documentation files'
|
||||
);
|
||||
});
|
||||
#
|
||||
# Unstow a never stowed package
|
||||
#
|
||||
|
||||
subtests("Ignore temp files",
|
||||
{ignore => ['~', '\.#.*']},
|
||||
sub {
|
||||
my ($stow) = @_;
|
||||
plan_tests($stow, 2);
|
||||
eval { remove_dir("$TEST_DIR/target"); };
|
||||
mkdir("$TEST_DIR/target");
|
||||
|
||||
init_stow2();
|
||||
make_path('../stow/pkg12/man12/man1');
|
||||
make_file('../stow/pkg12/man12/man1/file12.1');
|
||||
make_file('../stow/pkg12/man12/man1/file12.1~');
|
||||
make_file('../stow/pkg12/man12/man1/.#file12.1');
|
||||
make_path('man12/man1');
|
||||
make_link('man12/man1/file12.1' => '../../../stow/pkg12/man12/man1/file12.1');
|
||||
$stow = new_Stow();
|
||||
$stow->plan_unstow('pkg12');
|
||||
is($stow->get_tasks, 0, 'no tasks to process when unstowing pkg12 which was never stowed');
|
||||
ok(
|
||||
$stow->get_conflict_count == 0
|
||||
=> 'unstow never stowed package pkg12'
|
||||
);
|
||||
|
||||
my $stderr = stderr_from { $stow->plan_unstow('pkg12') };
|
||||
check_protected_dirs_skipped($stderr) if $stow->{compat};
|
||||
$stow->process_tasks();
|
||||
is($stow->get_conflict_count, 0, 'conflict count');
|
||||
ok(! -e 'man12/man1/file12.1' => 'man12/man1/file12.1 was unstowed');
|
||||
});
|
||||
#
|
||||
# Unstowing when target contains a real file shouldn't be an issue.
|
||||
#
|
||||
make_file('man12/man1/file12.1');
|
||||
|
||||
subtests("Unstow an already unstowed package", sub {
|
||||
my ($stow) = @_;
|
||||
plan_tests($stow, 2);
|
||||
$stow = new_Stow();
|
||||
$stow->plan_unstow('pkg12');
|
||||
is($stow->get_tasks, 0, 'no tasks to process when unstowing pkg12 for third time');
|
||||
%conflicts = $stow->get_conflicts;
|
||||
ok(
|
||||
$stow->get_conflict_count == 1 &&
|
||||
$conflicts{unstow}{pkg12}[0]
|
||||
=~ m!existing target is neither a link nor a directory: man12/man1/file12\.1!
|
||||
=> 'unstow pkg12 for third time'
|
||||
);
|
||||
|
||||
my $stderr = stderr_from { $stow->plan_unstow('pkg12') };
|
||||
check_protected_dirs_skipped($stderr) if $stow->{compat};
|
||||
is($stow->get_tasks, 0, 'no tasks to process when unstowing pkg12');
|
||||
is($stow->get_conflict_count, 0, 'conflict count');
|
||||
});
|
||||
#
|
||||
# unstow a simple tree minimally when cwd isn't target
|
||||
#
|
||||
cd('../..');
|
||||
$stow = new_Stow(dir => "$TEST_DIR/stow", target => "$TEST_DIR/target");
|
||||
|
||||
subtests("Unstow a never stowed package", sub {
|
||||
my ($stow) = @_;
|
||||
plan tests => 2;
|
||||
make_path("$TEST_DIR/stow/pkg13/bin13");
|
||||
make_file("$TEST_DIR/stow/pkg13/bin13/file13");
|
||||
make_link("$TEST_DIR/target/bin13", '../stow/pkg13/bin13');
|
||||
|
||||
eval { remove_dir($stow->{target}); };
|
||||
mkdir($stow->{target});
|
||||
$stow->plan_unstow('pkg13');
|
||||
$stow->process_tasks();
|
||||
ok(
|
||||
$stow->get_conflict_count == 0 &&
|
||||
-f "$TEST_DIR/stow/pkg13/bin13/file13" && ! -e "$TEST_DIR/target/bin13"
|
||||
=> 'unstow a simple tree'
|
||||
);
|
||||
|
||||
$stow->plan_unstow('pkg12');
|
||||
is($stow->get_tasks, 0, 'no tasks to process when unstowing pkg12 which was never stowed');
|
||||
is($stow->get_conflict_count, 0, 'conflict count');
|
||||
});
|
||||
#
|
||||
# unstow a simple tree minimally with absolute stow dir when cwd isn't
|
||||
# target
|
||||
#
|
||||
$stow = new_Stow(dir => canon_path("$TEST_DIR/stow"),
|
||||
target => "$TEST_DIR/target");
|
||||
|
||||
subtests("Unstowing when target contains real files shouldn't be an issue", sub {
|
||||
my ($stow) = @_;
|
||||
plan tests => 4;
|
||||
make_path("$TEST_DIR/stow/pkg14/bin14");
|
||||
make_file("$TEST_DIR/stow/pkg14/bin14/file14");
|
||||
make_link("$TEST_DIR/target/bin14", '../stow/pkg14/bin14');
|
||||
|
||||
# Test both a file which do / don't overlap with the package
|
||||
make_path('man12/man1');
|
||||
make_file('man12/man1/alien');
|
||||
make_file('man12/man1/file12.1');
|
||||
$stow->plan_unstow('pkg14');
|
||||
$stow->process_tasks();
|
||||
ok(
|
||||
$stow->get_conflict_count == 0 &&
|
||||
-f "$TEST_DIR/stow/pkg14/bin14/file14" && ! -e "$TEST_DIR/target/bin14"
|
||||
=> 'unstow a simple tree with absolute stow dir'
|
||||
);
|
||||
|
||||
$stow->plan_unstow('pkg12');
|
||||
is($stow->get_tasks, 0, 'no tasks to process when unstowing pkg12 for third time');
|
||||
is($stow->get_conflict_count, 0, 'conflict count');
|
||||
ok(-f 'man12/man1/alien', 'alien untouched');
|
||||
ok(-f 'man12/man1/file12.1', 'file overlapping with pkg untouched');
|
||||
});
|
||||
#
|
||||
# unstow a simple tree minimally with absolute stow AND target dirs
|
||||
# when cwd isn't target
|
||||
#
|
||||
$stow = new_Stow(dir => canon_path("$TEST_DIR/stow"),
|
||||
target => canon_path("$TEST_DIR/target"));
|
||||
|
||||
subtests("unstow a simple tree minimally when cwd isn't target",
|
||||
sub {
|
||||
my $test_dir = shift;
|
||||
cd($repo);
|
||||
return {
|
||||
dir => "$test_dir/stow",
|
||||
target => "$test_dir/target"
|
||||
}
|
||||
},
|
||||
sub {
|
||||
my ($stow, $test_dir) = @_;
|
||||
plan tests => 3;
|
||||
make_path("$TEST_DIR/stow/pkg15/bin15");
|
||||
make_file("$TEST_DIR/stow/pkg15/bin15/file15");
|
||||
make_link("$TEST_DIR/target/bin15", '../stow/pkg15/bin15');
|
||||
|
||||
make_path("$test_dir/stow/pkg13/bin13");
|
||||
make_file("$test_dir/stow/pkg13/bin13/file13");
|
||||
make_link("$test_dir/target/bin13", '../stow/pkg13/bin13');
|
||||
$stow->plan_unstow('pkg15');
|
||||
$stow->process_tasks();
|
||||
ok(
|
||||
$stow->get_conflict_count == 0 &&
|
||||
-f "$TEST_DIR/stow/pkg15/bin15/file15" && ! -e "$TEST_DIR/target/bin15"
|
||||
=> 'unstow a simple tree with absolute stow and target dirs'
|
||||
);
|
||||
|
||||
$stow->plan_unstow('pkg13');
|
||||
$stow->process_tasks();
|
||||
is($stow->get_conflict_count, 0, 'conflict count');
|
||||
ok(-f "$test_dir/stow/pkg13/bin13/file13", 'package file untouched');
|
||||
ok(! -e "$test_dir/target/bin13" => 'bin13/ unstowed');
|
||||
});
|
||||
|
||||
subtests("unstow a simple tree minimally with absolute stow dir when cwd isn't target",
|
||||
sub {
|
||||
my $test_dir = shift;
|
||||
cd($repo);
|
||||
return {
|
||||
dir => canon_path("$test_dir/stow"),
|
||||
target => "$test_dir/target"
|
||||
};
|
||||
},
|
||||
sub {
|
||||
plan tests => 3;
|
||||
my ($stow, $test_dir) = @_;
|
||||
|
||||
make_path("$test_dir/stow/pkg14/bin14");
|
||||
make_file("$test_dir/stow/pkg14/bin14/file14");
|
||||
make_link("$test_dir/target/bin14", '../stow/pkg14/bin14');
|
||||
|
||||
$stow->plan_unstow('pkg14');
|
||||
$stow->process_tasks();
|
||||
is($stow->get_conflict_count, 0, 'conflict count');
|
||||
ok(-f "$test_dir/stow/pkg14/bin14/file14");
|
||||
ok(! -e "$test_dir/target/bin14"
|
||||
=> 'unstow a simple tree with absolute stow dir'
|
||||
);
|
||||
});
|
||||
|
||||
subtests("unstow a simple tree minimally with absolute stow AND target dirs when cwd isn't target",
|
||||
sub {
|
||||
my $test_dir = shift;
|
||||
cd($repo);
|
||||
return {
|
||||
dir => canon_path("$test_dir/stow"),
|
||||
target => canon_path("$test_dir/target")
|
||||
};
|
||||
},
|
||||
sub {
|
||||
my ($stow, $test_dir) = @_;
|
||||
plan tests => 3;
|
||||
|
||||
make_path("$test_dir/stow/pkg15/bin15");
|
||||
make_file("$test_dir/stow/pkg15/bin15/file15");
|
||||
make_link("$test_dir/target/bin15", '../stow/pkg15/bin15');
|
||||
|
||||
$stow->plan_unstow('pkg15');
|
||||
$stow->process_tasks();
|
||||
is($stow->get_conflict_count, 0, 'conflict count');
|
||||
ok(-f "$test_dir/stow/pkg15/bin15/file15");
|
||||
ok(! -e "$test_dir/target/bin15"
|
||||
=> 'unstow a simple tree with absolute stow and target dirs'
|
||||
);
|
||||
});
|
||||
#
|
||||
# unstow a tree with no-folding enabled -
|
||||
# no refolding should take place
|
||||
#
|
||||
cd("$TEST_DIR/target");
|
||||
|
||||
sub create_and_stow_pkg {
|
||||
my ($id, $pkg) = @_;
|
||||
|
||||
my $stow_pkg = "../stow/$id-$pkg";
|
||||
make_path($stow_pkg);
|
||||
make_path ($stow_pkg);
|
||||
make_file("$stow_pkg/$id-file-$pkg");
|
||||
|
||||
# create a shallow hierarchy specific to this package and stow
|
||||
# via folding
|
||||
make_path("$stow_pkg/$id-$pkg-only-folded");
|
||||
make_path ("$stow_pkg/$id-$pkg-only-folded");
|
||||
make_file("$stow_pkg/$id-$pkg-only-folded/file-$pkg");
|
||||
make_link("$id-$pkg-only-folded", "$stow_pkg/$id-$pkg-only-folded");
|
||||
|
||||
# create a deeper hierarchy specific to this package and stow
|
||||
# via folding
|
||||
make_path("$stow_pkg/$id-$pkg-only-folded2/subdir");
|
||||
make_path ("$stow_pkg/$id-$pkg-only-folded2/subdir");
|
||||
make_file("$stow_pkg/$id-$pkg-only-folded2/subdir/file-$pkg");
|
||||
make_link("$id-$pkg-only-folded2",
|
||||
"$stow_pkg/$id-$pkg-only-folded2");
|
||||
|
||||
# create a shallow hierarchy specific to this package and stow
|
||||
# without folding
|
||||
make_path("$stow_pkg/$id-$pkg-only-unfolded");
|
||||
make_path ("$stow_pkg/$id-$pkg-only-unfolded");
|
||||
make_file("$stow_pkg/$id-$pkg-only-unfolded/file-$pkg");
|
||||
make_path("$id-$pkg-only-unfolded");
|
||||
make_path ("$id-$pkg-only-unfolded");
|
||||
make_link("$id-$pkg-only-unfolded/file-$pkg",
|
||||
"../$stow_pkg/$id-$pkg-only-unfolded/file-$pkg");
|
||||
|
||||
# create a deeper hierarchy specific to this package and stow
|
||||
# without folding
|
||||
make_path("$stow_pkg/$id-$pkg-only-unfolded2/subdir");
|
||||
make_path ("$stow_pkg/$id-$pkg-only-unfolded2/subdir");
|
||||
make_file("$stow_pkg/$id-$pkg-only-unfolded2/subdir/file-$pkg");
|
||||
make_path("$id-$pkg-only-unfolded2/subdir");
|
||||
make_path ("$id-$pkg-only-unfolded2/subdir");
|
||||
make_link("$id-$pkg-only-unfolded2/subdir/file-$pkg",
|
||||
"../../$stow_pkg/$id-$pkg-only-unfolded2/subdir/file-$pkg");
|
||||
|
||||
# create a shallow shared hierarchy which this package uses, and stow
|
||||
# its contents without folding
|
||||
make_path("$stow_pkg/$id-shared");
|
||||
make_path ("$stow_pkg/$id-shared");
|
||||
make_file("$stow_pkg/$id-shared/file-$pkg");
|
||||
make_path("$id-shared");
|
||||
make_path ("$id-shared");
|
||||
make_link("$id-shared/file-$pkg",
|
||||
"../$stow_pkg/$id-shared/file-$pkg");
|
||||
|
||||
# create a deeper shared hierarchy which this package uses, and stow
|
||||
# its contents without folding
|
||||
make_path("$stow_pkg/$id-shared2/subdir");
|
||||
make_path ("$stow_pkg/$id-shared2/subdir");
|
||||
make_file("$stow_pkg/$id-shared2/file-$pkg");
|
||||
make_file("$stow_pkg/$id-shared2/subdir/file-$pkg");
|
||||
make_path("$id-shared2/subdir");
|
||||
make_path ("$id-shared2/subdir");
|
||||
make_link("$id-shared2/file-$pkg",
|
||||
"../$stow_pkg/$id-shared2/file-$pkg");
|
||||
make_link("$id-shared2/subdir/file-$pkg",
|
||||
"../../$stow_pkg/$id-shared2/subdir/file-$pkg");
|
||||
}
|
||||
|
||||
subtest("unstow a tree with no-folding enabled - no refolding should take place", sub {
|
||||
cd("$TEST_DIR/target");
|
||||
plan tests => 15;
|
||||
foreach my $pkg (qw{a b}) {
|
||||
create_and_stow_pkg('no-folding', $pkg);
|
||||
}
|
||||
|
||||
foreach my $pkg (qw{a b}) {
|
||||
create_and_stow_pkg('no-folding', $pkg);
|
||||
}
|
||||
$stow = new_Stow('no-folding' => 1);
|
||||
$stow->plan_unstow('no-folding-b');
|
||||
is_deeply([ $stow->get_conflicts ], [] => 'no conflicts with --no-folding');
|
||||
use Data::Dumper;
|
||||
#warn Dumper($stow->get_tasks);
|
||||
|
||||
my $stow = new_Stow('no-folding' => 1);
|
||||
$stow->plan_unstow('no-folding-b');
|
||||
is_deeply([ $stow->get_conflicts ], [] => 'no conflicts with --no-folding');
|
||||
$stow->process_tasks();
|
||||
|
||||
$stow->process_tasks();
|
||||
is_nonexistent_path('no-folding-b-only-folded');
|
||||
is_nonexistent_path('no-folding-b-only-folded2');
|
||||
is_nonexistent_path('no-folding-b-only-unfolded/file-b');
|
||||
is_nonexistent_path('no-folding-b-only-unfolded2/subdir/file-b');
|
||||
is_dir_not_symlink('no-folding-shared');
|
||||
is_dir_not_symlink('no-folding-shared2');
|
||||
is_dir_not_symlink('no-folding-shared2/subdir');
|
||||
|
||||
is_nonexistent_path('no-folding-b-only-folded');
|
||||
is_nonexistent_path('no-folding-b-only-folded2');
|
||||
is_nonexistent_path('no-folding-b-only-unfolded/file-b');
|
||||
is_nonexistent_path('no-folding-b-only-unfolded2/subdir/file-b');
|
||||
is_dir_not_symlink('no-folding-shared');
|
||||
is_dir_not_symlink('no-folding-shared2');
|
||||
is_dir_not_symlink('no-folding-shared2/subdir');
|
||||
});
|
||||
|
||||
# subtests("Test cleaning up subdirs with --paranoid option", sub {
|
||||
# TODO
|
||||
# });
|
||||
# Todo
|
||||
#
|
||||
# Test cleaning up subdirs with --paranoid option
|
||||
|
|
403
t/unstow_orig.t
Executable file
403
t/unstow_orig.t
Executable file
|
@ -0,0 +1,403 @@
|
|||
#!/usr/bin/perl
|
||||
#
|
||||
# This file is part of GNU Stow.
|
||||
#
|
||||
# GNU Stow 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 3 of the License, or
|
||||
# (at your option) any later version.
|
||||
#
|
||||
# GNU Stow 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. If not, see https://www.gnu.org/licenses/.
|
||||
|
||||
#
|
||||
# Test unstowing packages in compat mode
|
||||
#
|
||||
|
||||
use strict;
|
||||
use warnings;
|
||||
|
||||
use File::Spec qw(make_path);
|
||||
use Test::More tests => 37;
|
||||
use Test::Output;
|
||||
use English qw(-no_match_vars);
|
||||
|
||||
use testutil;
|
||||
use Stow::Util qw(canon_path);
|
||||
|
||||
init_test_dirs();
|
||||
cd("$TEST_DIR/target");
|
||||
|
||||
# Note that each of the following tests use a distinct set of files
|
||||
|
||||
my $stow;
|
||||
my %conflicts;
|
||||
|
||||
#
|
||||
# unstow a simple tree minimally
|
||||
#
|
||||
|
||||
$stow = new_compat_Stow();
|
||||
|
||||
make_path('../stow/pkg1/bin1');
|
||||
make_file('../stow/pkg1/bin1/file1');
|
||||
make_link('bin1', '../stow/pkg1/bin1');
|
||||
|
||||
$stow->plan_unstow('pkg1');
|
||||
$stow->process_tasks();
|
||||
ok(
|
||||
$stow->get_conflict_count == 0 &&
|
||||
-f '../stow/pkg1/bin1/file1' && ! -e 'bin1'
|
||||
=> 'unstow a simple tree'
|
||||
);
|
||||
|
||||
#
|
||||
# unstow a simple tree from an existing directory
|
||||
#
|
||||
$stow = new_compat_Stow();
|
||||
|
||||
make_path('lib2');
|
||||
make_path('../stow/pkg2/lib2');
|
||||
make_file('../stow/pkg2/lib2/file2');
|
||||
make_link('lib2/file2', '../../stow/pkg2/lib2/file2');
|
||||
$stow->plan_unstow('pkg2');
|
||||
$stow->process_tasks();
|
||||
ok(
|
||||
$stow->get_conflict_count == 0 &&
|
||||
-f '../stow/pkg2/lib2/file2' && -d 'lib2'
|
||||
=> 'unstow simple tree from a pre-existing directory'
|
||||
);
|
||||
|
||||
#
|
||||
# fold tree after unstowing
|
||||
#
|
||||
$stow = new_compat_Stow();
|
||||
|
||||
make_path('bin3');
|
||||
|
||||
make_path('../stow/pkg3a/bin3');
|
||||
make_file('../stow/pkg3a/bin3/file3a');
|
||||
make_link('bin3/file3a' => '../../stow/pkg3a/bin3/file3a'); # emulate stow
|
||||
|
||||
make_path('../stow/pkg3b/bin3');
|
||||
make_file('../stow/pkg3b/bin3/file3b');
|
||||
make_link('bin3/file3b' => '../../stow/pkg3b/bin3/file3b'); # emulate stow
|
||||
$stow->plan_unstow('pkg3b');
|
||||
$stow->process_tasks();
|
||||
ok(
|
||||
$stow->get_conflict_count == 0 &&
|
||||
-l 'bin3' &&
|
||||
readlink('bin3') eq '../stow/pkg3a/bin3'
|
||||
=> 'fold tree after unstowing'
|
||||
);
|
||||
|
||||
#
|
||||
# existing link is owned by stow but is invalid so it gets removed anyway
|
||||
#
|
||||
$stow = new_compat_Stow();
|
||||
|
||||
make_path('bin4');
|
||||
make_path('../stow/pkg4/bin4');
|
||||
make_file('../stow/pkg4/bin4/file4');
|
||||
make_invalid_link('bin4/file4', '../../stow/pkg4/bin4/does-not-exist');
|
||||
|
||||
$stow->plan_unstow('pkg4');
|
||||
$stow->process_tasks();
|
||||
ok(
|
||||
$stow->get_conflict_count == 0 &&
|
||||
! -e 'bin4/file4'
|
||||
=> q(remove invalid link owned by stow)
|
||||
);
|
||||
|
||||
#
|
||||
# Existing link is not owned by stow
|
||||
#
|
||||
$stow = new_compat_Stow();
|
||||
|
||||
make_path('../stow/pkg5/bin5');
|
||||
make_invalid_link('bin5', '../not-stow');
|
||||
|
||||
$stow->plan_unstow('pkg5');
|
||||
# Unlike the corresponding stow_contents.t test, this doesn't
|
||||
# cause any conflicts.
|
||||
#
|
||||
#like(
|
||||
# $Conflicts[-1], qr(can't unlink.*not owned by stow)
|
||||
# => q(existing link not owned by stow)
|
||||
#);
|
||||
ok(
|
||||
-l 'bin5' && readlink('bin5') eq '../not-stow'
|
||||
=> q(existing link not owned by stow)
|
||||
);
|
||||
|
||||
#
|
||||
# Target already exists, is owned by stow, but points to a different package
|
||||
#
|
||||
$stow = new_compat_Stow();
|
||||
|
||||
make_path('bin6');
|
||||
make_path('../stow/pkg6a/bin6');
|
||||
make_file('../stow/pkg6a/bin6/file6');
|
||||
make_link('bin6/file6', '../../stow/pkg6a/bin6/file6');
|
||||
|
||||
make_path('../stow/pkg6b/bin6');
|
||||
make_file('../stow/pkg6b/bin6/file6');
|
||||
|
||||
$stow->plan_unstow('pkg6b');
|
||||
ok(
|
||||
$stow->get_conflict_count == 0 &&
|
||||
-l 'bin6/file6' &&
|
||||
readlink('bin6/file6') eq '../../stow/pkg6a/bin6/file6'
|
||||
=> q(ignore existing link that points to a different package)
|
||||
);
|
||||
|
||||
#
|
||||
# Don't unlink anything under the stow directory
|
||||
#
|
||||
make_path('stow'); # make out stow dir a subdir of target
|
||||
$stow = new_compat_Stow(dir => 'stow');
|
||||
|
||||
# emulate stowing into ourself (bizarre corner case or accident)
|
||||
make_path('stow/pkg7a/stow/pkg7b');
|
||||
make_file('stow/pkg7a/stow/pkg7b/file7b');
|
||||
make_link('stow/pkg7b', '../stow/pkg7a/stow/pkg7b');
|
||||
|
||||
capture_stderr();
|
||||
$stow->plan_unstow('pkg7b');
|
||||
is($stow->get_tasks, 0, 'no tasks to process when unstowing pkg7b');
|
||||
ok(
|
||||
$stow->get_conflict_count == 0 &&
|
||||
-l 'stow/pkg7b' &&
|
||||
readlink('stow/pkg7b') eq '../stow/pkg7a/stow/pkg7b'
|
||||
=> q(don't unlink any nodes under the stow directory)
|
||||
);
|
||||
like($stderr,
|
||||
qr/WARNING: skipping target which was current stow directory stow/
|
||||
=> "warn when unstowing from ourself");
|
||||
uncapture_stderr();
|
||||
|
||||
#
|
||||
# Don't unlink any nodes under another stow directory
|
||||
#
|
||||
$stow = new_compat_Stow(dir => 'stow');
|
||||
|
||||
make_path('stow2'); # make our alternate stow dir a subdir of target
|
||||
make_file('stow2/.stow');
|
||||
|
||||
# emulate stowing into ourself (bizarre corner case or accident)
|
||||
make_path('stow/pkg8a/stow2/pkg8b');
|
||||
make_file('stow/pkg8a/stow2/pkg8b/file8b');
|
||||
make_link('stow2/pkg8b', '../stow/pkg8a/stow2/pkg8b');
|
||||
|
||||
capture_stderr();
|
||||
$stow->plan_unstow('pkg8a');
|
||||
is($stow->get_tasks, 0, 'no tasks to process when unstowing pkg8a');
|
||||
ok(
|
||||
$stow->get_conflict_count == 0 &&
|
||||
-l 'stow2/pkg8b' &&
|
||||
readlink('stow2/pkg8b') eq '../stow/pkg8a/stow2/pkg8b'
|
||||
=> q(don't unlink any nodes under another stow directory)
|
||||
);
|
||||
like($stderr,
|
||||
qr/WARNING: skipping target which was current stow directory stow/
|
||||
=> "warn when skipping unstowing");
|
||||
uncapture_stderr();
|
||||
|
||||
#
|
||||
# overriding already stowed documentation
|
||||
#
|
||||
|
||||
# This will be used by this and subsequent tests
|
||||
sub check_protected_dirs_skipped {
|
||||
for my $dir (qw{stow stow2}) {
|
||||
like($stderr,
|
||||
qr/WARNING: skipping protected directory $dir/
|
||||
=> "warn when skipping protected directory $dir");
|
||||
}
|
||||
uncapture_stderr();
|
||||
}
|
||||
|
||||
$stow = new_compat_Stow(override => ['man9', 'info9']);
|
||||
make_file('stow/.stow');
|
||||
|
||||
make_path('../stow/pkg9a/man9/man1');
|
||||
make_file('../stow/pkg9a/man9/man1/file9.1');
|
||||
make_path('man9/man1');
|
||||
make_link('man9/man1/file9.1' => '../../../stow/pkg9a/man9/man1/file9.1'); # emulate stow
|
||||
|
||||
make_path('../stow/pkg9b/man9/man1');
|
||||
make_file('../stow/pkg9b/man9/man1/file9.1');
|
||||
capture_stderr();
|
||||
$stow->plan_unstow('pkg9b');
|
||||
$stow->process_tasks();
|
||||
ok(
|
||||
$stow->get_conflict_count == 0 &&
|
||||
!-l 'man9/man1/file9.1'
|
||||
=> 'overriding existing documentation files'
|
||||
);
|
||||
check_protected_dirs_skipped();
|
||||
|
||||
#
|
||||
# deferring to already stowed documentation
|
||||
#
|
||||
$stow = new_compat_Stow(defer => ['man10', 'info10']);
|
||||
|
||||
make_path('../stow/pkg10a/man10/man1');
|
||||
make_file('../stow/pkg10a/man10/man1/file10a.1');
|
||||
make_path('man10/man1');
|
||||
make_link('man10/man1/file10a.1' => '../../../stow/pkg10a/man10/man1/file10a.1');
|
||||
|
||||
# need this to block folding
|
||||
make_path('../stow/pkg10b/man10/man1');
|
||||
make_file('../stow/pkg10b/man10/man1/file10b.1');
|
||||
make_link('man10/man1/file10b.1' => '../../../stow/pkg10b/man10/man1/file10b.1');
|
||||
|
||||
|
||||
make_path('../stow/pkg10c/man10/man1');
|
||||
make_file('../stow/pkg10c/man10/man1/file10a.1');
|
||||
capture_stderr();
|
||||
$stow->plan_unstow('pkg10c');
|
||||
is($stow->get_tasks, 0, 'no tasks to process when unstowing pkg10c');
|
||||
ok(
|
||||
$stow->get_conflict_count == 0 &&
|
||||
readlink('man10/man1/file10a.1') eq '../../../stow/pkg10a/man10/man1/file10a.1'
|
||||
=> 'defer to existing documentation files'
|
||||
);
|
||||
check_protected_dirs_skipped();
|
||||
|
||||
#
|
||||
# Ignore temp files
|
||||
#
|
||||
$stow = new_compat_Stow(ignore => ['~', '\.#.*']);
|
||||
|
||||
make_path('../stow/pkg12/man12/man1');
|
||||
make_file('../stow/pkg12/man12/man1/file12.1');
|
||||
make_file('../stow/pkg12/man12/man1/file12.1~');
|
||||
make_file('../stow/pkg12/man12/man1/.#file12.1');
|
||||
make_path('man12/man1');
|
||||
make_link('man12/man1/file12.1' => '../../../stow/pkg12/man12/man1/file12.1');
|
||||
|
||||
capture_stderr();
|
||||
$stow->plan_unstow('pkg12');
|
||||
$stow->process_tasks();
|
||||
ok(
|
||||
$stow->get_conflict_count == 0 &&
|
||||
!-e 'man12/man1/file12.1'
|
||||
=> 'ignore temp files'
|
||||
);
|
||||
check_protected_dirs_skipped();
|
||||
|
||||
#
|
||||
# Unstow an already unstowed package
|
||||
#
|
||||
$stow = new_compat_Stow();
|
||||
capture_stderr();
|
||||
$stow->plan_unstow('pkg12');
|
||||
is($stow->get_tasks, 0, 'no tasks to process when unstowing pkg12');
|
||||
ok(
|
||||
$stow->get_conflict_count == 0
|
||||
=> 'unstow already unstowed package pkg12'
|
||||
);
|
||||
check_protected_dirs_skipped();
|
||||
|
||||
#
|
||||
# Unstow a never stowed package
|
||||
#
|
||||
|
||||
eval { remove_dir("$TEST_DIR/target"); };
|
||||
mkdir("$TEST_DIR/target");
|
||||
|
||||
$stow = new_compat_Stow();
|
||||
capture_stderr();
|
||||
$stow->plan_unstow('pkg12');
|
||||
is($stow->get_tasks, 0, 'no tasks to process when unstowing pkg12 which was never stowed');
|
||||
ok(
|
||||
$stow->get_conflict_count == 0
|
||||
=> 'unstow never stowed package pkg12'
|
||||
);
|
||||
check_protected_dirs_skipped();
|
||||
|
||||
#
|
||||
# Unstowing when target contains a real file shouldn't be an issue.
|
||||
#
|
||||
make_file('man12/man1/file12.1');
|
||||
|
||||
$stow = new_compat_Stow();
|
||||
capture_stderr();
|
||||
$stow->plan_unstow('pkg12');
|
||||
is($stow->get_tasks, 0, 'no tasks to process when unstowing pkg12 for third time');
|
||||
%conflicts = $stow->get_conflicts;
|
||||
ok(
|
||||
$stow->get_conflict_count == 1 &&
|
||||
$conflicts{unstow}{pkg12}[0]
|
||||
=~ m!existing target is neither a link nor a directory: man12/man1/file12\.1!
|
||||
=> 'unstow pkg12 for third time'
|
||||
);
|
||||
check_protected_dirs_skipped();
|
||||
|
||||
#
|
||||
# unstow a simple tree minimally when cwd isn't target
|
||||
#
|
||||
cd('../..');
|
||||
$stow = new_Stow(dir => "$TEST_DIR/stow", target => "$TEST_DIR/target");
|
||||
|
||||
make_path("$TEST_DIR/stow/pkg13/bin13");
|
||||
make_file("$TEST_DIR/stow/pkg13/bin13/file13");
|
||||
make_link("$TEST_DIR/target/bin13", '../stow/pkg13/bin13');
|
||||
|
||||
$stow->plan_unstow('pkg13');
|
||||
$stow->process_tasks();
|
||||
ok(
|
||||
$stow->get_conflict_count == 0 &&
|
||||
-f "$TEST_DIR/stow/pkg13/bin13/file13" && ! -e "$TEST_DIR/target/bin13"
|
||||
=> 'unstow a simple tree'
|
||||
);
|
||||
|
||||
#
|
||||
# unstow a simple tree minimally with absolute stow dir when cwd isn't
|
||||
# target
|
||||
#
|
||||
$stow = new_Stow(dir => canon_path("$TEST_DIR/stow"),
|
||||
target => "$TEST_DIR/target");
|
||||
|
||||
make_path("$TEST_DIR/stow/pkg14/bin14");
|
||||
make_file("$TEST_DIR/stow/pkg14/bin14/file14");
|
||||
make_link("$TEST_DIR/target/bin14", '../stow/pkg14/bin14');
|
||||
|
||||
$stow->plan_unstow('pkg14');
|
||||
$stow->process_tasks();
|
||||
ok(
|
||||
$stow->get_conflict_count == 0 &&
|
||||
-f "$TEST_DIR/stow/pkg14/bin14/file14" && ! -e "$TEST_DIR/target/bin14"
|
||||
=> 'unstow a simple tree with absolute stow dir'
|
||||
);
|
||||
|
||||
#
|
||||
# unstow a simple tree minimally with absolute stow AND target dirs
|
||||
# when cwd isn't target
|
||||
#
|
||||
$stow = new_Stow(dir => canon_path("$TEST_DIR/stow"),
|
||||
target => canon_path("$TEST_DIR/target"));
|
||||
|
||||
make_path("$TEST_DIR/stow/pkg15/bin15");
|
||||
make_file("$TEST_DIR/stow/pkg15/bin15/file15");
|
||||
make_link("$TEST_DIR/target/bin15", '../stow/pkg15/bin15');
|
||||
|
||||
$stow->plan_unstow('pkg15');
|
||||
$stow->process_tasks();
|
||||
ok(
|
||||
$stow->get_conflict_count == 0 &&
|
||||
-f "$TEST_DIR/stow/pkg15/bin15/file15" && ! -e "$TEST_DIR/target/bin15"
|
||||
=> 'unstow a simple tree with absolute stow and target dirs'
|
||||
);
|
||||
|
||||
|
||||
# Todo
|
||||
#
|
||||
# Test cleaning up subdirs with --paranoid option
|
||||
|
Loading…
Reference in a new issue