Revision 83846468
b/.ghci | ||
---|---|---|
1 |
:set -isrc -ihtest |
|
1 |
:set -isrc -itest/hs |
b/.gitignore | ||
---|---|---|
87 | 87 |
/man/*.gen |
88 | 88 |
/man/footer.man |
89 | 89 |
|
90 |
# htest
|
|
91 |
/htest/hail
|
|
92 |
/htest/hbal
|
|
93 |
/htest/hcheck
|
|
94 |
/htest/hinfo
|
|
95 |
/htest/hroller
|
|
96 |
/htest/hscan
|
|
97 |
/htest/hspace
|
|
98 |
/htest/hpc-htools
|
|
99 |
/htest/hpc-mon-collector
|
|
100 |
/htest/test
|
|
90 |
# test/hs
|
|
91 |
/test/hs/hail
|
|
92 |
/test/hs/hbal
|
|
93 |
/test/hs/hcheck
|
|
94 |
/test/hs/hinfo
|
|
95 |
/test/hs/hroller
|
|
96 |
/test/hs/hscan
|
|
97 |
/test/hs/hspace
|
|
98 |
/test/hs/hpc-htools
|
|
99 |
/test/hs/hpc-mon-collector
|
|
100 |
/test/hs/test
|
|
101 | 101 |
|
102 | 102 |
# tools |
103 | 103 |
/tools/kvm-ifup |
... | ... | |
129 | 129 |
# automatically-built Haskell files |
130 | 130 |
/src/Ganeti/Constants.hs |
131 | 131 |
/src/Ganeti/Version.hs |
132 |
/htest/Test/Ganeti/TestImports.hs |
|
132 |
/test/hs/Test/Ganeti/TestImports.hs |
b/Makefile.am | ||
---|---|---|
65 | 65 |
src/Ganeti/HTools/Backend \ |
66 | 66 |
src/Ganeti/HTools/Program \ |
67 | 67 |
src/Ganeti/Query \ |
68 |
htest \
|
|
69 |
htest/Test \
|
|
70 |
htest/Test/Ganeti \
|
|
71 |
htest/Test/Ganeti/Block \
|
|
72 |
htest/Test/Ganeti/Block/Drbd \
|
|
73 |
htest/Test/Ganeti/Confd \
|
|
74 |
htest/Test/Ganeti/HTools \
|
|
75 |
htest/Test/Ganeti/HTools/Backend \
|
|
76 |
htest/Test/Ganeti/Query
|
|
68 |
test/hs \
|
|
69 |
test/hs/Test \
|
|
70 |
test/hs/Test/Ganeti \
|
|
71 |
test/hs/Test/Ganeti/Block \
|
|
72 |
test/hs/Test/Ganeti/Block/Drbd \
|
|
73 |
test/hs/Test/Ganeti/Confd \
|
|
74 |
test/hs/Test/Ganeti/HTools \
|
|
75 |
test/hs/Test/Ganeti/HTools/Backend \
|
|
76 |
test/hs/Test/Ganeti/Query
|
|
77 | 77 |
|
78 | 78 |
DIRS = \ |
79 | 79 |
$(HS_DIRS) \ |
... | ... | |
84 | 84 |
doc/examples \ |
85 | 85 |
doc/examples/gnt-debug \ |
86 | 86 |
doc/examples/hooks \ |
87 |
htest/data \
|
|
88 |
htest/data/rapi \
|
|
89 |
htest/shelltests \
|
|
87 |
test/data/htools \
|
|
88 |
test/data/htools/rapi \
|
|
89 |
test/hs/shelltests \
|
|
90 | 90 |
lib \ |
91 | 91 |
lib/build \ |
92 | 92 |
lib/client \ |
... | ... | |
184 | 184 |
$(HS_ALL_PROGS) $(HS_BUILT_SRCS) \ |
185 | 185 |
$(HS_BUILT_TEST_HELPERS) \ |
186 | 186 |
src/ganeti-confd \ |
187 |
.hpc/*.mix src/*.tix htest/*.tix \
|
|
187 |
.hpc/*.mix src/*.tix test/hs/*.tix \
|
|
188 | 188 |
doc/hs-lint.html |
189 | 189 |
|
190 | 190 |
GENERATED_FILES = \ |
... | ... | |
415 | 415 |
|
416 | 416 |
HS_ALL_PROGS = \ |
417 | 417 |
$(HS_PROGS) \ |
418 |
htest/hpc-htools \
|
|
419 |
htest/hpc-mon-collector \
|
|
420 |
htest/test \
|
|
418 |
test/hs/hpc-htools \
|
|
419 |
test/hs/hpc-mon-collector \
|
|
420 |
test/hs/test \
|
|
421 | 421 |
src/hconfd \ |
422 | 422 |
src/rpc-test |
423 | 423 |
|
424 | 424 |
HS_PROG_SRCS = $(patsubst %,%.hs,$(HS_ALL_PROGS)) |
425 |
HS_BUILT_TEST_HELPERS = $(HS_BIN_ROLES:%=htest/%) htest/hail
|
|
425 |
HS_BUILT_TEST_HELPERS = $(HS_BIN_ROLES:%=test/hs/%) test/hs/hail
|
|
426 | 426 |
|
427 | 427 |
HFLAGS = \ |
428 | 428 |
-O -Wall -Werror -isrc \ |
... | ... | |
432 | 432 |
|
433 | 433 |
# extra flags that can be overriden on the command line (e.g. -Wwarn, etc.) |
434 | 434 |
HEXTRA = |
435 |
# internal extra flags (used for htest/test mainly)
|
|
435 |
# internal extra flags (used for test/hs/test mainly)
|
|
436 | 436 |
HEXTRA_INT = |
437 | 437 |
# exclude options for coverage reports |
438 | 438 |
HPCEXCL = --exclude Main \ |
... | ... | |
515 | 515 |
src/Ganeti/Utils.hs |
516 | 516 |
|
517 | 517 |
HS_TEST_SRCS = \ |
518 |
htest/Test/Ganeti/Attoparsec.hs \
|
|
519 |
htest/Test/Ganeti/BasicTypes.hs \
|
|
520 |
htest/Test/Ganeti/Block/Drbd/Parser.hs \
|
|
521 |
htest/Test/Ganeti/Block/Drbd/Types.hs \
|
|
522 |
htest/Test/Ganeti/Common.hs \
|
|
523 |
htest/Test/Ganeti/Confd/Types.hs \
|
|
524 |
htest/Test/Ganeti/Confd/Utils.hs \
|
|
525 |
htest/Test/Ganeti/Daemon.hs \
|
|
526 |
htest/Test/Ganeti/Errors.hs \
|
|
527 |
htest/Test/Ganeti/HTools/Backend/Simu.hs \
|
|
528 |
htest/Test/Ganeti/HTools/Backend/Text.hs \
|
|
529 |
htest/Test/Ganeti/HTools/CLI.hs \
|
|
530 |
htest/Test/Ganeti/HTools/Cluster.hs \
|
|
531 |
htest/Test/Ganeti/HTools/Container.hs \
|
|
532 |
htest/Test/Ganeti/HTools/Graph.hs \
|
|
533 |
htest/Test/Ganeti/HTools/Instance.hs \
|
|
534 |
htest/Test/Ganeti/HTools/Loader.hs \
|
|
535 |
htest/Test/Ganeti/HTools/Node.hs \
|
|
536 |
htest/Test/Ganeti/HTools/PeerMap.hs \
|
|
537 |
htest/Test/Ganeti/HTools/Types.hs \
|
|
538 |
htest/Test/Ganeti/JSON.hs \
|
|
539 |
htest/Test/Ganeti/Jobs.hs \
|
|
540 |
htest/Test/Ganeti/JQueue.hs \
|
|
541 |
htest/Test/Ganeti/Luxi.hs \
|
|
542 |
htest/Test/Ganeti/Network.hs \
|
|
543 |
htest/Test/Ganeti/Objects.hs \
|
|
544 |
htest/Test/Ganeti/OpCodes.hs \
|
|
545 |
htest/Test/Ganeti/Query/Filter.hs \
|
|
546 |
htest/Test/Ganeti/Query/Language.hs \
|
|
547 |
htest/Test/Ganeti/Query/Query.hs \
|
|
548 |
htest/Test/Ganeti/Rpc.hs \
|
|
549 |
htest/Test/Ganeti/Ssconf.hs \
|
|
550 |
htest/Test/Ganeti/THH.hs \
|
|
551 |
htest/Test/Ganeti/TestCommon.hs \
|
|
552 |
htest/Test/Ganeti/TestHTools.hs \
|
|
553 |
htest/Test/Ganeti/TestHelper.hs \
|
|
554 |
htest/Test/Ganeti/Types.hs \
|
|
555 |
htest/Test/Ganeti/Utils.hs
|
|
518 |
test/hs/Test/Ganeti/Attoparsec.hs \
|
|
519 |
test/hs/Test/Ganeti/BasicTypes.hs \
|
|
520 |
test/hs/Test/Ganeti/Block/Drbd/Parser.hs \
|
|
521 |
test/hs/Test/Ganeti/Block/Drbd/Types.hs \
|
|
522 |
test/hs/Test/Ganeti/Common.hs \
|
|
523 |
test/hs/Test/Ganeti/Confd/Types.hs \
|
|
524 |
test/hs/Test/Ganeti/Confd/Utils.hs \
|
|
525 |
test/hs/Test/Ganeti/Daemon.hs \
|
|
526 |
test/hs/Test/Ganeti/Errors.hs \
|
|
527 |
test/hs/Test/Ganeti/HTools/Backend/Simu.hs \
|
|
528 |
test/hs/Test/Ganeti/HTools/Backend/Text.hs \
|
|
529 |
test/hs/Test/Ganeti/HTools/CLI.hs \
|
|
530 |
test/hs/Test/Ganeti/HTools/Cluster.hs \
|
|
531 |
test/hs/Test/Ganeti/HTools/Container.hs \
|
|
532 |
test/hs/Test/Ganeti/HTools/Graph.hs \
|
|
533 |
test/hs/Test/Ganeti/HTools/Instance.hs \
|
|
534 |
test/hs/Test/Ganeti/HTools/Loader.hs \
|
|
535 |
test/hs/Test/Ganeti/HTools/Node.hs \
|
|
536 |
test/hs/Test/Ganeti/HTools/PeerMap.hs \
|
|
537 |
test/hs/Test/Ganeti/HTools/Types.hs \
|
|
538 |
test/hs/Test/Ganeti/JSON.hs \
|
|
539 |
test/hs/Test/Ganeti/Jobs.hs \
|
|
540 |
test/hs/Test/Ganeti/JQueue.hs \
|
|
541 |
test/hs/Test/Ganeti/Luxi.hs \
|
|
542 |
test/hs/Test/Ganeti/Network.hs \
|
|
543 |
test/hs/Test/Ganeti/Objects.hs \
|
|
544 |
test/hs/Test/Ganeti/OpCodes.hs \
|
|
545 |
test/hs/Test/Ganeti/Query/Filter.hs \
|
|
546 |
test/hs/Test/Ganeti/Query/Language.hs \
|
|
547 |
test/hs/Test/Ganeti/Query/Query.hs \
|
|
548 |
test/hs/Test/Ganeti/Rpc.hs \
|
|
549 |
test/hs/Test/Ganeti/Ssconf.hs \
|
|
550 |
test/hs/Test/Ganeti/THH.hs \
|
|
551 |
test/hs/Test/Ganeti/TestCommon.hs \
|
|
552 |
test/hs/Test/Ganeti/TestHTools.hs \
|
|
553 |
test/hs/Test/Ganeti/TestHelper.hs \
|
|
554 |
test/hs/Test/Ganeti/Types.hs \
|
|
555 |
test/hs/Test/Ganeti/Utils.hs
|
|
556 | 556 |
|
557 | 557 |
HS_LIBTEST_SRCS = $(HS_LIB_SRCS) $(HS_TEST_SRCS) |
558 | 558 |
|
559 | 559 |
HS_BUILT_SRCS = \ |
560 |
htest/Test/Ganeti/TestImports.hs \
|
|
560 |
test/hs/Test/Ganeti/TestImports.hs \
|
|
561 | 561 |
src/Ganeti/Constants.hs \ |
562 | 562 |
src/Ganeti/Version.hs |
563 | 563 |
HS_BUILT_SRCS_IN = $(patsubst %,%.in,$(HS_BUILT_SRCS)) |
... | ... | |
684 | 684 |
$(HEXTRA) $(HEXTRA_INT) $@ |
685 | 685 |
@touch "$@" |
686 | 686 |
|
687 |
# for the htest/test binary, we need to enable profiling/coverage
|
|
688 |
htest/test: HEXTRA_INT=-fhpc -ihtest
|
|
687 |
# for the test/hs/test binary, we need to enable profiling/coverage
|
|
688 |
test/hs/test: HEXTRA_INT=-fhpc -itest/hs
|
|
689 | 689 |
|
690 | 690 |
# we compile the hpc-htools binary with the program coverage |
691 |
htest/hpc-htools: HEXTRA_INT=-fhpc
|
|
691 |
test/hs/hpc-htools: HEXTRA_INT=-fhpc
|
|
692 | 692 |
|
693 | 693 |
# we compile the hpc-mon-collector binary with the program coverage |
694 |
htest/hpc-mon-collector: HEXTRA_INT=-fhpc
|
|
694 |
test/hs/hpc-mon-collector: HEXTRA_INT=-fhpc
|
|
695 | 695 |
|
696 | 696 |
# test dependency |
697 |
htest/offline-tests.sh: htest/hpc-htools htest/hpc-mon-collector
|
|
697 |
test/hs/offline-tests.sh: test/hs/hpc-htools test/hs/hpc-mon-collector
|
|
698 | 698 |
|
699 | 699 |
# rules for building profiling-enabled versions of the haskell |
700 | 700 |
# programs: hs-prof does the full two-step build, whereas |
... | ... | |
828 | 828 |
$(HS_LIBTEST_SRCS) $(HS_BUILT_SRCS_IN) \ |
829 | 829 |
$(HS_PROG_SRCS) \ |
830 | 830 |
src/lint-hints.hs \ |
831 |
htest/cli-tests-defs.sh \
|
|
832 |
htest/offline-test.sh \
|
|
831 |
test/hs/cli-tests-defs.sh \
|
|
832 |
test/hs/offline-test.sh \
|
|
833 | 833 |
.ghci |
834 | 834 |
|
835 | 835 |
man_MANS = \ |
... | ... | |
872 | 872 |
man/footer.man man/footer.html $(mangen) |
873 | 873 |
|
874 | 874 |
TEST_FILES = \ |
875 |
htest/data/clean-nonzero-score.data \
|
|
876 |
htest/data/common-suffix.data \
|
|
877 |
htest/data/empty-cluster.data \
|
|
878 |
htest/data/hail-alloc-drbd.json \
|
|
879 |
htest/data/hail-change-group.json \
|
|
880 |
htest/data/hail-invalid-reloc.json \
|
|
881 |
htest/data/hail-node-evac.json \
|
|
882 |
htest/data/hail-reloc-drbd.json \
|
|
883 |
htest/data/hbal-excl-tags.data \
|
|
884 |
htest/data/hbal-split-insts.data \
|
|
885 |
htest/data/invalid-node.data \
|
|
886 |
htest/data/missing-resources.data \
|
|
887 |
htest/data/n1-failure.data \
|
|
888 |
htest/data/rapi/groups.json \
|
|
889 |
htest/data/rapi/info.json \
|
|
890 |
htest/data/rapi/instances.json \
|
|
891 |
htest/data/rapi/nodes.json \
|
|
892 |
htest/shelltests/htools-balancing.test \
|
|
893 |
htest/shelltests/htools-basic.test \
|
|
894 |
htest/shelltests/htools-dynutil.test \
|
|
895 |
htest/shelltests/htools-excl.test \
|
|
896 |
htest/shelltests/htools-hail.test \
|
|
897 |
htest/shelltests/htools-hspace.test \
|
|
898 |
htest/shelltests/htools-invalid.test \
|
|
899 |
htest/shelltests/htools-multi-group.test \
|
|
900 |
htest/shelltests/htools-no-backend.test \
|
|
901 |
htest/shelltests/htools-rapi.test \
|
|
902 |
htest/shelltests/htools-single-group.test \
|
|
903 |
htest/shelltests/htools-text-backend.test \
|
|
904 |
htest/shelltests/htools-mon-collector.test \
|
|
875 |
test/data/htools/clean-nonzero-score.data \
|
|
876 |
test/data/htools/common-suffix.data \
|
|
877 |
test/data/htools/empty-cluster.data \
|
|
878 |
test/data/htools/hail-alloc-drbd.json \
|
|
879 |
test/data/htools/hail-change-group.json \
|
|
880 |
test/data/htools/hail-invalid-reloc.json \
|
|
881 |
test/data/htools/hail-node-evac.json \
|
|
882 |
test/data/htools/hail-reloc-drbd.json \
|
|
883 |
test/data/htools/hbal-excl-tags.data \
|
|
884 |
test/data/htools/hbal-split-insts.data \
|
|
885 |
test/data/htools/invalid-node.data \
|
|
886 |
test/data/htools/missing-resources.data \
|
|
887 |
test/data/htools/n1-failure.data \
|
|
888 |
test/data/htools/rapi/groups.json \
|
|
889 |
test/data/htools/rapi/info.json \
|
|
890 |
test/data/htools/rapi/instances.json \
|
|
891 |
test/data/htools/rapi/nodes.json \
|
|
892 |
test/hs/shelltests/htools-balancing.test \
|
|
893 |
test/hs/shelltests/htools-basic.test \
|
|
894 |
test/hs/shelltests/htools-dynutil.test \
|
|
895 |
test/hs/shelltests/htools-excl.test \
|
|
896 |
test/hs/shelltests/htools-hail.test \
|
|
897 |
test/hs/shelltests/htools-hspace.test \
|
|
898 |
test/hs/shelltests/htools-invalid.test \
|
|
899 |
test/hs/shelltests/htools-multi-group.test \
|
|
900 |
test/hs/shelltests/htools-no-backend.test \
|
|
901 |
test/hs/shelltests/htools-rapi.test \
|
|
902 |
test/hs/shelltests/htools-single-group.test \
|
|
903 |
test/hs/shelltests/htools-text-backend.test \
|
|
904 |
test/hs/shelltests/htools-mon-collector.test \
|
|
905 | 905 |
test/data/bdev-drbd-8.0.txt \ |
906 | 906 |
test/data/bdev-drbd-8.3.txt \ |
907 | 907 |
test/data/bdev-drbd-disk.txt \ |
... | ... | |
1040 | 1040 |
test/py/qa.qa_config_unittest.py \ |
1041 | 1041 |
test/py/tempfile_fork_unittest.py |
1042 | 1042 |
|
1043 |
haskell_tests = htest/test
|
|
1043 |
haskell_tests = test/hs/test
|
|
1044 | 1044 |
|
1045 | 1045 |
dist_TESTS = \ |
1046 | 1046 |
test/py/check-cert-expired_unittest.bash \ |
... | ... | |
1056 | 1056 |
|
1057 | 1057 |
if WANT_HSTESTS |
1058 | 1058 |
nodist_TESTS += $(haskell_tests) |
1059 |
dist_TESTS += htest/offline-test.sh
|
|
1059 |
dist_TESTS += test/hs/offline-test.sh
|
|
1060 | 1060 |
check_SCRIPTS += \ |
1061 |
htest/hpc-htools \
|
|
1062 |
htest/hpc-mon-collector \
|
|
1061 |
test/hs/hpc-htools \
|
|
1062 |
test/hs/hpc-mon-collector \
|
|
1063 | 1063 |
$(HS_BUILT_TEST_HELPERS) |
1064 | 1064 |
endif |
1065 | 1065 |
|
... | ... | |
1106 | 1106 |
test/py/import-export_unittest.bash \ |
1107 | 1107 |
test/py/cli-test.bash \ |
1108 | 1108 |
test/py/bash_completion.bash \ |
1109 |
htest/offline-test.sh \
|
|
1110 |
htest/cli-tests-defs.sh \
|
|
1109 |
test/hs/offline-test.sh \
|
|
1110 |
test/hs/cli-tests-defs.sh \
|
|
1111 | 1111 |
$(all_python_code) \ |
1112 | 1112 |
$(HS_LIBTEST_SRCS) $(HS_PROG_SRCS) |
1113 | 1113 |
|
... | ... | |
1269 | 1269 |
PYTHONPATH=. $(RUN_IN_TEMPDIR) $(CURDIR)/$(CONVERT_CONSTANTS); \ |
1270 | 1270 |
} > $@ |
1271 | 1271 |
|
1272 |
htest/Test/Ganeti/TestImports.hs: htest/Test/Ganeti/TestImports.hs.in \
|
|
1272 |
test/hs/Test/Ganeti/TestImports.hs: test/hs/Test/Ganeti/TestImports.hs.in \
|
|
1273 | 1273 |
$(built_base_sources) |
1274 | 1274 |
set -e; \ |
1275 | 1275 |
{ cat $< ; \ |
... | ... | |
1433 | 1433 |
tools/node-daemon-setup: MODULE = ganeti.tools.node_daemon_setup |
1434 | 1434 |
tools/prepare-node-join: MODULE = ganeti.tools.prepare_node_join |
1435 | 1435 |
tools/node-cleanup: MODULE = ganeti.tools.node_cleanup |
1436 |
$(HS_BUILT_TEST_HELPERS): TESTROLE = $(patsubst htest/%,%,$@)
|
|
1436 |
$(HS_BUILT_TEST_HELPERS): TESTROLE = $(patsubst test/hs/%,%,$@)
|
|
1437 | 1437 |
|
1438 | 1438 |
$(PYTHON_BOOTSTRAP): Makefile | stamp-directories |
1439 | 1439 |
test -n "$(MODULE)" || { echo Missing module; exit 1; } |
... | ... | |
1469 | 1469 |
echo '# This file is automatically generated, do not edit!'; \ |
1470 | 1470 |
echo "# Edit Makefile.am instead."; \ |
1471 | 1471 |
echo; \ |
1472 |
echo "HTOOLS=$(TESTROLE) exec ./htest/hpc-htools \"\$$@\""; \
|
|
1472 |
echo "HTOOLS=$(TESTROLE) exec ./test/hs/hpc-htools \"\$$@\""; \
|
|
1473 | 1473 |
} > $@ |
1474 | 1474 |
chmod u+x $@ |
1475 | 1475 |
|
... | ... | |
1552 | 1552 |
test -z "$$error" |
1553 | 1553 |
|
1554 | 1554 |
.PHONY: hs-check |
1555 |
hs-check: htest/test htest/hpc-htools htest/hpc-mon-collector $(HS_BUILT_TEST_HELPERS) \
|
|
1555 |
hs-check: test/hs/test test/hs/hpc-htools test/hs/hpc-mon-collector $(HS_BUILT_TEST_HELPERS) \
|
|
1556 | 1556 |
| $(BUILT_PYTHON_SOURCES) |
1557 | 1557 |
@rm -f *.tix |
1558 |
./htest/test
|
|
1559 |
HBINARY="./htest/hpc-htools" ./htest/offline-test.sh
|
|
1558 |
./test/hs/test
|
|
1559 |
HBINARY="./test/hs/hpc-htools" ./test/hs/offline-test.sh
|
|
1560 | 1560 |
|
1561 | 1561 |
# E111: indentation is not a multiple of four |
1562 | 1562 |
# E121: continuation line indentation is not a multiple of four |
... | ... | |
1606 | 1606 |
--repeat $(pep8_python_code) |
1607 | 1607 |
|
1608 | 1608 |
# FIXME: remove ignore "Use void" when GHC 6.x is deprecated |
1609 |
HLINT_EXCLUDES = src/Ganeti/THH.hs htest/hpc-htools.hs
|
|
1609 |
HLINT_EXCLUDES = src/Ganeti/THH.hs test/hs/hpc-htools.hs
|
|
1610 | 1610 |
.PHONY: hlint |
1611 | 1611 |
hlint: $(HS_BUILT_SRCS) src/lint-hints.hs |
1612 | 1612 |
@test -n "$(HLINT)" || { echo 'hlint' not found during configure; exit 1; } |
... | ... | |
1768 | 1768 |
$(python_tests) |
1769 | 1769 |
|
1770 | 1770 |
.PHONY: hs-coverage |
1771 |
hs-coverage: $(haskell_tests) htest/hpc-htools htest/hpc-mon-collector
|
|
1771 |
hs-coverage: $(haskell_tests) test/hs/hpc-htools test/hs/hpc-mon-collector
|
|
1772 | 1772 |
rm -f *.tix |
1773 | 1773 |
$(MAKE) $(AM_MAKEFLAGS) hs-check |
1774 | 1774 |
@mkdir_p@ $(COVERAGE_HS_DIR) |
b/autotools/run-in-tempdir | ||
---|---|---|
8 | 8 |
tmpdir=$(mktemp -d -t gntbuild.XXXXXXXX) |
9 | 9 |
trap "rm -rf $tmpdir" EXIT |
10 | 10 |
|
11 |
mkdir $tmpdir/doc |
|
11 |
# fully copy items |
|
12 |
cp -r autotools daemons scripts lib tools qa $tmpdir |
|
12 | 13 |
|
13 |
cp -r autotools daemons scripts lib tools test qa $tmpdir
|
|
14 |
mkdir $tmpdir/doc
|
|
14 | 15 |
ln -s $PWD/doc/examples $tmpdir/doc |
15 | 16 |
|
17 |
mkdir $tmpdir/test/ |
|
18 |
cp -r test/py $tmpdir/test/py |
|
19 |
ln -s $PWD/test/data $tmpdir/test |
|
20 |
ln -s $PWD/test/hs $tmpdir/test |
|
21 |
|
|
16 | 22 |
mv $tmpdir/lib $tmpdir/ganeti |
17 | 23 |
ln -T -s $tmpdir/ganeti $tmpdir/lib |
18 | 24 |
|
19 |
mkdir -p $tmpdir/src $tmpdir/htest
|
|
25 |
mkdir -p $tmpdir/src $tmpdir/test/hs
|
|
20 | 26 |
for hfile in htools ganeti-confd mon-collector; do |
21 | 27 |
if [ -e src/$hfile ]; then |
22 | 28 |
ln -s $PWD/src/$hfile $tmpdir/src/ |
23 | 29 |
fi |
24 | 30 |
done |
25 | 31 |
|
26 |
for hfile in hpc-htools test offline-test.sh cli-tests-defs.sh \ |
|
27 |
hbal hscan hspace hinfo hcheck hail hroller hpc-mon-collector; do |
|
28 |
if [ -e htest/$hfile ]; then |
|
29 |
ln -s $PWD/htest/$hfile $tmpdir/htest/ |
|
30 |
fi |
|
31 |
done |
|
32 |
|
|
33 | 32 |
cd $tmpdir && GANETI_TEMP_DIR="$tmpdir" "$@" |
b/doc/devnotes.rst | ||
---|---|---|
180 | 180 |
|
181 | 181 |
For Haskell tests:: |
182 | 182 |
|
183 |
$ make htest/test && ./htest/test -t %pattern%
|
|
183 |
$ make test/hs/test && ./test/hs/test -t %pattern%
|
|
184 | 184 |
|
185 | 185 |
Where ``pattern`` can be a simple test pattern (e.g. ``comma``, |
186 | 186 |
matching any test whose name contains ``comma``), a test pattern |
/dev/null | ||
---|---|---|
1 |
{-# LANGUAGE TemplateHaskell #-} |
|
2 |
|
|
3 |
{-| Unittests for Attoparsec support for unicode -} |
|
4 |
|
|
5 |
{- |
|
6 |
|
|
7 |
Copyright (C) 2012 Google Inc. |
|
8 |
|
|
9 |
This program is free software; you can redistribute it and/or modify |
|
10 |
it under the terms of the GNU General Public License as published by |
|
11 |
the Free Software Foundation; either version 2 of the License, or |
|
12 |
(at your option) any later version. |
|
13 |
|
|
14 |
This program is distributed in the hope that it will be useful, but |
|
15 |
WITHOUT ANY WARRANTY; without even the implied warranty of |
|
16 |
MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU |
|
17 |
General Public License for more details. |
|
18 |
|
|
19 |
You should have received a copy of the GNU General Public License |
|
20 |
along with this program; if not, write to the Free Software |
|
21 |
Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA |
|
22 |
02110-1301, USA. |
|
23 |
|
|
24 |
-} |
|
25 |
|
|
26 |
module Test.Ganeti.Attoparsec (testAttoparsec) where |
|
27 |
|
|
28 |
import Test.HUnit |
|
29 |
|
|
30 |
import Test.Ganeti.TestHelper |
|
31 |
|
|
32 |
import qualified Data.Attoparsec.Text as A |
|
33 |
import Data.Attoparsec.Text (Parser) |
|
34 |
import Data.Text (pack, unpack) |
|
35 |
|
|
36 |
-- | Unicode test string, first part. |
|
37 |
part1 :: String |
|
38 |
part1 = "äßĉ" |
|
39 |
|
|
40 |
-- | Unicode test string, second part. |
|
41 |
part2 :: String |
|
42 |
part2 = "ðèق" |
|
43 |
|
|
44 |
-- | Simple parser able to split a string in two parts, name and |
|
45 |
-- value, separated by a '=' sign. |
|
46 |
simpleParser :: Parser (String, String) |
|
47 |
simpleParser = do |
|
48 |
n <- A.takeTill (\c -> A.isHorizontalSpace c || c == '=') |
|
49 |
A.skipWhile A.isHorizontalSpace |
|
50 |
_ <- A.char '=' |
|
51 |
A.skipWhile A.isHorizontalSpace |
|
52 |
v <- A.takeTill A.isEndOfLine |
|
53 |
return (unpack n, unpack v) |
|
54 |
|
|
55 |
{-# ANN case_unicodeParsing "HLint: ignore Use camelCase" #-} |
|
56 |
-- | Tests whether a Unicode string is still Unicode after being |
|
57 |
-- parsed. |
|
58 |
case_unicodeParsing :: Assertion |
|
59 |
case_unicodeParsing = |
|
60 |
case A.parseOnly simpleParser text of |
|
61 |
Right (name, value) -> do |
|
62 |
assertEqual "name part" part1 name |
|
63 |
assertEqual "value part" part2 value |
|
64 |
Left msg -> assertFailure $ "Failed to parse: " ++ msg |
|
65 |
where text = Data.Text.pack $ part1 ++ " = \t" ++ part2 |
|
66 |
|
|
67 |
testSuite "Attoparsec" |
|
68 |
[ 'case_unicodeParsing |
|
69 |
] |
/dev/null | ||
---|---|---|
1 |
{-# LANGUAGE TemplateHaskell, FlexibleInstances, TypeSynonymInstances #-} |
|
2 |
{-# OPTIONS_GHC -fno-warn-orphans #-} |
|
3 |
|
|
4 |
{-| Unittests for ganeti-htools. |
|
5 |
|
|
6 |
-} |
|
7 |
|
|
8 |
{- |
|
9 |
|
|
10 |
Copyright (C) 2009, 2010, 2011, 2012 Google Inc. |
|
11 |
|
|
12 |
This program is free software; you can redistribute it and/or modify |
|
13 |
it under the terms of the GNU General Public License as published by |
|
14 |
the Free Software Foundation; either version 2 of the License, or |
|
15 |
(at your option) any later version. |
|
16 |
|
|
17 |
This program is distributed in the hope that it will be useful, but |
|
18 |
WITHOUT ANY WARRANTY; without even the implied warranty of |
|
19 |
MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU |
|
20 |
General Public License for more details. |
|
21 |
|
|
22 |
You should have received a copy of the GNU General Public License |
|
23 |
along with this program; if not, write to the Free Software |
|
24 |
Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA |
|
25 |
02110-1301, USA. |
|
26 |
|
|
27 |
-} |
|
28 |
|
|
29 |
module Test.Ganeti.BasicTypes (testBasicTypes) where |
|
30 |
|
|
31 |
import Test.QuickCheck hiding (Result) |
|
32 |
import Test.QuickCheck.Function |
|
33 |
|
|
34 |
import Control.Applicative |
|
35 |
import Control.Monad |
|
36 |
|
|
37 |
import Test.Ganeti.TestHelper |
|
38 |
import Test.Ganeti.TestCommon |
|
39 |
|
|
40 |
import Ganeti.BasicTypes |
|
41 |
|
|
42 |
-- Since we actually want to test these, don't tell us not to use them :) |
|
43 |
|
|
44 |
{-# ANN module "HLint: ignore Functor law" #-} |
|
45 |
{-# ANN module "HLint: ignore Monad law, left identity" #-} |
|
46 |
{-# ANN module "HLint: ignore Monad law, right identity" #-} |
|
47 |
{-# ANN module "HLint: ignore Use >=>" #-} |
|
48 |
{-# ANN module "HLint: ignore Use ." #-} |
|
49 |
|
|
50 |
-- * Arbitrary instances |
|
51 |
|
|
52 |
instance (Arbitrary a) => Arbitrary (Result a) where |
|
53 |
arbitrary = oneof [ Bad <$> arbitrary |
|
54 |
, Ok <$> arbitrary |
|
55 |
] |
|
56 |
|
|
57 |
-- * Test cases |
|
58 |
|
|
59 |
-- | Tests the functor identity law (fmap id == id). |
|
60 |
prop_functor_id :: Result Int -> Property |
|
61 |
prop_functor_id ri = |
|
62 |
fmap id ri ==? ri |
|
63 |
|
|
64 |
-- | Tests the functor composition law (fmap (f . g) == fmap f . fmap g). |
|
65 |
prop_functor_composition :: Result Int |
|
66 |
-> Fun Int Int -> Fun Int Int -> Property |
|
67 |
prop_functor_composition ri (Fun _ f) (Fun _ g) = |
|
68 |
fmap (f . g) ri ==? (fmap f . fmap g) ri |
|
69 |
|
|
70 |
-- | Tests the applicative identity law (pure id <*> v = v). |
|
71 |
prop_applicative_identity :: Result Int -> Property |
|
72 |
prop_applicative_identity v = |
|
73 |
pure id <*> v ==? v |
|
74 |
|
|
75 |
-- | Tests the applicative composition law (pure (.) <*> u <*> v <*> w |
|
76 |
-- = u <*> (v <*> w)). |
|
77 |
prop_applicative_composition :: Result (Fun Int Int) |
|
78 |
-> Result (Fun Int Int) |
|
79 |
-> Result Int |
|
80 |
-> Property |
|
81 |
prop_applicative_composition u v w = |
|
82 |
let u' = fmap apply u |
|
83 |
v' = fmap apply v |
|
84 |
in pure (.) <*> u' <*> v' <*> w ==? u' <*> (v' <*> w) |
|
85 |
|
|
86 |
-- | Tests the applicative homomorphism law (pure f <*> pure x = pure (f x)). |
|
87 |
prop_applicative_homomorphism :: Fun Int Int -> Int -> Property |
|
88 |
prop_applicative_homomorphism (Fun _ f) x = |
|
89 |
((pure f <*> pure x)::Result Int) ==? pure (f x) |
|
90 |
|
|
91 |
-- | Tests the applicative interchange law (u <*> pure y = pure ($ y) <*> u). |
|
92 |
prop_applicative_interchange :: Result (Fun Int Int) |
|
93 |
-> Int -> Property |
|
94 |
prop_applicative_interchange f y = |
|
95 |
let u = fmap apply f -- need to extract the actual function from Fun |
|
96 |
in u <*> pure y ==? pure ($ y) <*> u |
|
97 |
|
|
98 |
-- | Tests the applicative\/functor correspondence (fmap f x = pure f <*> x). |
|
99 |
prop_applicative_functor :: Fun Int Int -> Result Int -> Property |
|
100 |
prop_applicative_functor (Fun _ f) x = |
|
101 |
fmap f x ==? pure f <*> x |
|
102 |
|
|
103 |
-- | Tests the applicative\/monad correspondence (pure = return and |
|
104 |
-- (<*>) = ap). |
|
105 |
prop_applicative_monad :: Int -> Result (Fun Int Int) -> Property |
|
106 |
prop_applicative_monad v f = |
|
107 |
let v' = pure v :: Result Int |
|
108 |
f' = fmap apply f -- need to extract the actual function from Fun |
|
109 |
in v' ==? return v .&&. (f' <*> v') ==? f' `ap` v' |
|
110 |
|
|
111 |
-- | Tests the monad laws (return a >>= k == k a, m >>= return == m, m |
|
112 |
-- >>= (\x -> k x >>= h) == (m >>= k) >>= h). |
|
113 |
prop_monad_laws :: Int -> Result Int |
|
114 |
-> Fun Int (Result Int) |
|
115 |
-> Fun Int (Result Int) |
|
116 |
-> Property |
|
117 |
prop_monad_laws a m (Fun _ k) (Fun _ h) = |
|
118 |
conjoin |
|
119 |
[ printTestCase "return a >>= k == k a" ((return a >>= k) ==? k a) |
|
120 |
, printTestCase "m >>= return == m" ((m >>= return) ==? m) |
|
121 |
, printTestCase "m >>= (\\x -> k x >>= h) == (m >>= k) >>= h)" |
|
122 |
((m >>= (\x -> k x >>= h)) ==? ((m >>= k) >>= h)) |
|
123 |
] |
|
124 |
|
|
125 |
-- | Tests the monad plus laws ( mzero >>= f = mzero, v >> mzero = mzero). |
|
126 |
prop_monadplus_mzero :: Result Int -> Fun Int (Result Int) -> Property |
|
127 |
prop_monadplus_mzero v (Fun _ f) = |
|
128 |
printTestCase "mzero >>= f = mzero" ((mzero >>= f) ==? mzero) .&&. |
|
129 |
-- FIXME: since we have "many" mzeros, we can't test for equality, |
|
130 |
-- just that we got back a 'Bad' value; I'm not sure if this means |
|
131 |
-- our MonadPlus instance is not sound or not... |
|
132 |
printTestCase "v >> mzero = mzero" (isBad (v >> mzero)) |
|
133 |
|
|
134 |
testSuite "BasicTypes" |
|
135 |
[ 'prop_functor_id |
|
136 |
, 'prop_functor_composition |
|
137 |
, 'prop_applicative_identity |
|
138 |
, 'prop_applicative_composition |
|
139 |
, 'prop_applicative_homomorphism |
|
140 |
, 'prop_applicative_interchange |
|
141 |
, 'prop_applicative_functor |
|
142 |
, 'prop_applicative_monad |
|
143 |
, 'prop_monad_laws |
|
144 |
, 'prop_monadplus_mzero |
|
145 |
] |
/dev/null | ||
---|---|---|
1 |
{-# LANGUAGE TemplateHaskell #-} |
|
2 |
|
|
3 |
{-| Unittests for Attoparsec support for unicode -} |
|
4 |
|
|
5 |
{- |
|
6 |
|
|
7 |
Copyright (C) 2012 Google Inc. |
|
8 |
|
|
9 |
This program is free software; you can redistribute it and/or modify |
|
10 |
it under the terms of the GNU General Public License as published by |
|
11 |
the Free Software Foundation; either version 2 of the License, or |
|
12 |
(at your option) any later version. |
|
13 |
|
|
14 |
This program is distributed in the hope that it will be useful, but |
|
15 |
WITHOUT ANY WARRANTY; without even the implied warranty of |
|
16 |
MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU |
|
17 |
General Public License for more details. |
|
18 |
|
|
19 |
You should have received a copy of the GNU General Public License |
|
20 |
along with this program; if not, write to the Free Software |
|
21 |
Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA |
|
22 |
02110-1301, USA. |
|
23 |
|
|
24 |
-} |
|
25 |
|
|
26 |
module Test.Ganeti.Block.Drbd.Parser (testBlock_Drbd_Parser) where |
|
27 |
|
|
28 |
import Test.QuickCheck as QuickCheck hiding (Result) |
|
29 |
import Test.HUnit |
|
30 |
|
|
31 |
import Test.Ganeti.TestHelper |
|
32 |
import Test.Ganeti.TestCommon |
|
33 |
|
|
34 |
import qualified Data.Attoparsec.Text as A |
|
35 |
import Data.List (intercalate) |
|
36 |
import Data.Text (pack) |
|
37 |
|
|
38 |
import Ganeti.Block.Drbd.Parser (drbdStatusParser, commaIntParser) |
|
39 |
import Ganeti.Block.Drbd.Types |
|
40 |
|
|
41 |
{-# ANN module "HLint: ignore Use camelCase" #-} |
|
42 |
|
|
43 |
-- | Function for testing whether a file is parsed correctly. |
|
44 |
testFile :: String -> DRBDStatus -> Assertion |
|
45 |
testFile fileName expectedContent = do |
|
46 |
fileContent <- readPythonTestData fileName |
|
47 |
case A.parseOnly drbdStatusParser $ pack fileContent of |
|
48 |
Left msg -> assertFailure $ "Parsing failed: " ++ msg |
|
49 |
Right obtained -> assertEqual fileName expectedContent obtained |
|
50 |
|
|
51 |
-- | Test a DRBD 8.0 file with an empty line inside. |
|
52 |
case_drbd80_emptyline :: Assertion |
|
53 |
case_drbd80_emptyline = testFile "proc_drbd80-emptyline.txt" $ |
|
54 |
DRBDStatus |
|
55 |
( VersionInfo Nothing Nothing Nothing Nothing |
|
56 |
(Just "5c9f89594553e32adb87d9638dce591782f947e3") |
|
57 |
(Just "root@node1.example.com, 2009-05-22 12:47:52") |
|
58 |
) |
|
59 |
[ DeviceInfo 0 Connected (LocalRemote Primary Secondary) |
|
60 |
(LocalRemote UpToDate UpToDate) 'C' "r---" |
|
61 |
(PerfIndicators 78728316 0 77675644 1277039 254 270 0 0 0 0 |
|
62 |
Nothing Nothing Nothing) |
|
63 |
Nothing |
|
64 |
(Just $ AdditionalInfo 0 61 65657 135 0 0 135) |
|
65 |
(Just $ AdditionalInfo 0 257 11378843 254 0 0 254), |
|
66 |
UnconfiguredDevice 1, |
|
67 |
UnconfiguredDevice 2, |
|
68 |
UnconfiguredDevice 5, |
|
69 |
UnconfiguredDevice 6 |
|
70 |
] |
|
71 |
|
|
72 |
-- | Test a DRBD 8.3 file with a NULL caracter inside. |
|
73 |
case_drbd83_sync_krnl2_6_39 :: Assertion |
|
74 |
case_drbd83_sync_krnl2_6_39 = testFile "proc_drbd83_sync_krnl2.6.39.txt" $ |
|
75 |
DRBDStatus |
|
76 |
( VersionInfo (Just "8.3.1") (Just "88") (Just "86-89") Nothing |
|
77 |
(Just "fd40f4a8f9104941537d1afc8521e584a6d3003c") |
|
78 |
(Just "phil@fat-tyre, 2009-03-27 12:19:49") |
|
79 |
) |
|
80 |
[ DeviceInfo 0 Connected (LocalRemote Primary Secondary) |
|
81 |
(LocalRemote UpToDate UpToDate) 'C' "r----" |
|
82 |
(PerfIndicators 140978 0 9906 131533 27 8 0 0 0 0 (Just 1) |
|
83 |
(Just 'b') (Just 0)) |
|
84 |
Nothing |
|
85 |
Nothing |
|
86 |
Nothing, |
|
87 |
DeviceInfo 1 Connected (LocalRemote Secondary Primary) |
|
88 |
(LocalRemote UpToDate UpToDate) 'C' "r---" |
|
89 |
(PerfIndicators 0 140980 140980 0 0 8 0 0 0 0 (Just 1) (Just 'f') |
|
90 |
(Just 0)) |
|
91 |
Nothing |
|
92 |
Nothing |
|
93 |
Nothing, |
|
94 |
UnconfiguredDevice 2, |
|
95 |
DeviceInfo 3 SyncSource (LocalRemote Primary Secondary) |
|
96 |
(LocalRemote UpToDate Inconsistent) 'A' "r-----" |
|
97 |
(PerfIndicators 373888 0 0 374088 0 22 7 27 7 0 (Just 1) |
|
98 |
(Just 'f') (Just 15358208)) |
|
99 |
(Just $ SyncStatus 2.4 14996 15360 MegaByte (Time 0 4 8) 61736 Nothing |
|
100 |
KiloByte Second) |
|
101 |
Nothing |
|
102 |
Nothing, |
|
103 |
DeviceInfo 4 WFConnection (LocalRemote Primary Unknown) |
|
104 |
(LocalRemote UpToDate DUnknown) 'C' "r----" |
|
105 |
(PerfIndicators 140978 0 9906 131534 27 8 0 0 0 0 (Just 1) |
|
106 |
(Just 'b') (Just 0)) |
|
107 |
Nothing |
|
108 |
Nothing |
|
109 |
Nothing |
|
110 |
] |
|
111 |
|
|
112 |
-- | Test a DRBD 8.3 file with an ongoing synchronization. |
|
113 |
case_drbd83_sync :: Assertion |
|
114 |
case_drbd83_sync = testFile "proc_drbd83_sync.txt" $ |
|
115 |
DRBDStatus |
|
116 |
( VersionInfo (Just "8.3.1") (Just "88") (Just "86-89") Nothing |
|
117 |
(Just "fd40f4a8f9104941537d1afc8521e584a6d3003c") |
|
118 |
(Just "phil@fat-tyre, 2009-03-27 12:19:49") |
|
119 |
) |
|
120 |
[ DeviceInfo 0 Connected (LocalRemote Primary Secondary) |
|
121 |
(LocalRemote UpToDate UpToDate) 'C' "r----" |
|
122 |
(PerfIndicators 140978 0 9906 131533 27 8 0 0 0 0 (Just 1) |
|
123 |
(Just 'b') (Just 0)) |
|
124 |
Nothing |
|
125 |
Nothing |
|
126 |
Nothing, |
|
127 |
DeviceInfo 1 Connected (LocalRemote Secondary Primary) |
|
128 |
(LocalRemote UpToDate UpToDate) 'C' "r---" |
|
129 |
(PerfIndicators 0 140980 140980 0 0 8 0 0 0 0 (Just 1) (Just 'f') |
|
130 |
(Just 0)) |
|
131 |
Nothing |
|
132 |
Nothing |
|
133 |
Nothing, |
|
134 |
UnconfiguredDevice 2, |
|
135 |
DeviceInfo 3 SyncTarget (LocalRemote Primary Secondary) |
|
136 |
(LocalRemote Inconsistent UpToDate) 'C' "r----" |
|
137 |
(PerfIndicators 0 178176 178176 0 104 42 0 0 0 0 (Just 1) |
|
138 |
(Just 'b') (Just 346112)) |
|
139 |
(Just $ SyncStatus 34.9 346112 524288 MegaByte (Time 0 0 5) 59392 |
|
140 |
Nothing KiloByte Second) |
|
141 |
Nothing |
|
142 |
Nothing, |
|
143 |
DeviceInfo 4 WFConnection (LocalRemote Primary Unknown) |
|
144 |
(LocalRemote UpToDate DUnknown) 'C' "r----" |
|
145 |
(PerfIndicators 140978 0 9906 131534 27 8 0 0 0 0 (Just 1) |
|
146 |
(Just 'b') (Just 0)) |
|
147 |
Nothing |
|
148 |
Nothing |
|
149 |
Nothing |
|
150 |
] |
|
151 |
|
|
152 |
-- | Test a DRBD 8.3 file not from git sources, with an ongoing synchronization |
|
153 |
-- and the "want" field |
|
154 |
case_drbd83_sync_want :: Assertion |
|
155 |
case_drbd83_sync_want = testFile "proc_drbd83_sync_want.txt" $ |
|
156 |
DRBDStatus |
|
157 |
( VersionInfo (Just "8.3.11") (Just "88") (Just "86-96") |
|
158 |
(Just "2D876214BAAD53B31ADC1D6") |
|
159 |
Nothing Nothing |
|
160 |
) |
|
161 |
[ DeviceInfo 0 SyncTarget (LocalRemote Secondary Primary) |
|
162 |
(LocalRemote Inconsistent UpToDate) 'C' "r-----" |
|
163 |
(PerfIndicators 0 460288 460160 0 0 28 2 4 1 0 (Just 1) |
|
164 |
(Just 'f') (Just 588416)) |
|
165 |
(Just $ SyncStatus 44.4 588416 1048576 KiloByte (Time 0 0 8) 65736 |
|
166 |
(Just 61440) KiloByte Second) |
|
167 |
Nothing |
|
168 |
Nothing, |
|
169 |
UnconfiguredDevice 1, |
|
170 |
UnconfiguredDevice 2, |
|
171 |
UnconfiguredDevice 3 |
|
172 |
] |
|
173 |
|
|
174 |
-- | Test a DRBD 8.3 file. |
|
175 |
case_drbd83 :: Assertion |
|
176 |
case_drbd83 = testFile "proc_drbd83.txt" $ |
|
177 |
DRBDStatus |
|
178 |
( VersionInfo (Just "8.3.1") (Just "88") (Just "86-89") |
|
179 |
Nothing |
|
180 |
(Just "fd40f4a8f9104941537d1afc8521e584a6d3003c") |
|
181 |
(Just "phil@fat-tyre, 2009-03-27 12:19:49") |
|
182 |
) |
|
183 |
[ DeviceInfo 0 Connected (LocalRemote Primary Secondary) |
|
184 |
(LocalRemote UpToDate UpToDate) 'C' "r----" |
|
185 |
(PerfIndicators 140978 0 9906 131533 27 8 0 0 0 0 (Just 1) |
|
186 |
(Just 'b') (Just 0)) |
|
187 |
Nothing |
|
188 |
Nothing |
|
189 |
Nothing, |
|
190 |
DeviceInfo 1 Connected (LocalRemote Secondary Primary) |
|
191 |
(LocalRemote UpToDate UpToDate) 'C' "r---" |
|
192 |
(PerfIndicators 0 140980 140980 0 0 8 0 0 0 0 (Just 1) (Just 'f') |
|
193 |
(Just 0)) |
|
194 |
Nothing |
|
195 |
Nothing |
|
196 |
Nothing, |
|
197 |
UnconfiguredDevice 2, |
|
198 |
DeviceInfo 4 WFConnection (LocalRemote Primary Unknown) |
|
199 |
(LocalRemote UpToDate DUnknown) 'C' "r----" |
|
200 |
(PerfIndicators 140978 0 9906 131534 27 8 0 0 0 0 (Just 1) |
|
201 |
(Just 'b') (Just 0)) |
|
202 |
Nothing |
|
203 |
Nothing |
|
204 |
Nothing, |
|
205 |
DeviceInfo 5 Connected (LocalRemote Primary Secondary) |
|
206 |
(LocalRemote UpToDate Diskless) 'C' "r----" |
|
207 |
(PerfIndicators 140978 0 9906 131533 19 8 0 0 0 0 (Just 1) |
|
208 |
(Just 'b') (Just 0)) |
|
209 |
Nothing |
|
210 |
Nothing |
|
211 |
Nothing, |
|
212 |
DeviceInfo 6 Connected (LocalRemote Secondary Primary) |
|
213 |
(LocalRemote Diskless UpToDate) 'C' "r---" |
|
214 |
(PerfIndicators 0 140978 140978 0 0 8 0 0 0 0 (Just 1) (Just 'f') |
|
215 |
(Just 0)) |
|
216 |
Nothing |
|
217 |
Nothing |
|
218 |
Nothing, |
|
219 |
DeviceInfo 7 WFConnection (LocalRemote Secondary Unknown) |
|
220 |
(LocalRemote UpToDate DUnknown) 'C' "r---" |
|
221 |
(PerfIndicators 0 140978 140978 0 0 8 0 0 0 0 (Just 1) (Just 'f') |
|
222 |
(Just 0)) |
|
223 |
Nothing |
|
224 |
Nothing |
|
225 |
Nothing, |
|
226 |
DeviceInfo 8 StandAlone (LocalRemote Secondary Unknown) |
|
227 |
(LocalRemote UpToDate DUnknown) ' ' "r---" |
|
228 |
(PerfIndicators 0 140978 140978 0 0 8 0 0 0 0 (Just 1) |
|
229 |
(Just 'f') (Just 0)) |
|
230 |
Nothing |
|
231 |
Nothing |
|
232 |
Nothing |
|
233 |
] |
|
234 |
|
|
235 |
-- | Test a DRBD 8.0 file with a missing device. |
|
236 |
case_drbd8 :: Assertion |
|
237 |
case_drbd8 = testFile "proc_drbd8.txt" $ |
|
238 |
DRBDStatus |
|
239 |
( VersionInfo (Just "8.0.12") (Just "86") (Just "86") Nothing |
|
240 |
(Just "5c9f89594553e32adb87d9638dce591782f947e3") |
|
241 |
(Just "XXX") |
|
242 |
) |
|
243 |
[ DeviceInfo 0 Connected (LocalRemote Primary Secondary) |
|
244 |
(LocalRemote UpToDate UpToDate) 'C' "r---" |
|
245 |
(PerfIndicators 4375577 0 4446279 674 1067 69 0 0 0 0 Nothing |
|
246 |
Nothing Nothing) |
|
247 |
Nothing |
|
248 |
(Just $ AdditionalInfo 0 61 0 0 0 0 0) |
|
249 |
(Just $ AdditionalInfo 0 257 793749 1067 0 0 1067), |
|
250 |
DeviceInfo 1 Connected (LocalRemote Secondary Primary) |
|
251 |
(LocalRemote UpToDate UpToDate) 'C' "r---" |
|
252 |
(PerfIndicators 738320 0 738320 554400 67 0 0 0 0 0 Nothing |
|
253 |
Nothing Nothing) |
|
254 |
Nothing |
|
255 |
(Just $ AdditionalInfo 0 61 0 0 0 0 0) |
|
256 |
(Just $ AdditionalInfo 0 257 92464 67 0 0 67), |
|
257 |
UnconfiguredDevice 2, |
|
258 |
DeviceInfo 4 WFConnection (LocalRemote Primary Unknown) |
|
259 |
(LocalRemote UpToDate DUnknown) 'C' "r---" |
|
260 |
(PerfIndicators 738320 0 738320 554400 67 0 0 0 0 0 Nothing |
|
261 |
Nothing Nothing) |
|
262 |
Nothing |
|
263 |
(Just $ AdditionalInfo 0 61 0 0 0 0 0) |
|
264 |
(Just $ AdditionalInfo 0 257 92464 67 0 0 67), |
|
265 |
DeviceInfo 5 Connected (LocalRemote Primary Secondary) |
|
266 |
(LocalRemote UpToDate Diskless) 'C' "r---" |
|
267 |
(PerfIndicators 4375581 0 4446283 674 1069 69 0 0 0 0 Nothing |
|
268 |
Nothing Nothing) |
|
269 |
Nothing |
|
270 |
(Just $ AdditionalInfo 0 61 0 0 0 0 0) |
|
271 |
(Just $ AdditionalInfo 0 257 793750 1069 0 0 1069), |
|
272 |
DeviceInfo 6 Connected (LocalRemote Secondary Primary) |
|
273 |
(LocalRemote Diskless UpToDate) 'C' "r---" |
|
274 |
(PerfIndicators 0 4375581 5186925 327 75 214 0 0 0 0 Nothing |
|
275 |
Nothing Nothing) |
|
276 |
Nothing |
|
277 |
Nothing |
|
278 |
Nothing, |
|
279 |
DeviceInfo 7 WFConnection (LocalRemote Secondary Unknown) |
|
280 |
(LocalRemote UpToDate DUnknown) 'C' "r---" |
|
281 |
(PerfIndicators 0 0 0 0 0 0 0 0 0 0 Nothing Nothing Nothing) |
|
282 |
Nothing |
|
283 |
(Just $ AdditionalInfo 0 61 0 0 0 0 0) |
|
284 |
(Just $ AdditionalInfo 0 257 0 0 0 0 0), |
|
285 |
DeviceInfo 8 StandAlone (LocalRemote Secondary Unknown) |
|
286 |
(LocalRemote UpToDate DUnknown) ' ' "r---" |
|
287 |
(PerfIndicators 0 0 0 0 0 0 0 0 0 0 Nothing Nothing Nothing) |
|
288 |
Nothing |
|
289 |
(Just $ AdditionalInfo 0 61 0 0 0 0 0) |
|
290 |
(Just $ AdditionalInfo 0 257 0 0 0 0 0) |
|
291 |
] |
|
292 |
|
|
293 |
-- | Function for splitting a list in chunks of a given size. |
|
294 |
-- FIXME: an equivalent function exists in Data.List.Split, but it seems |
|
295 |
-- pointless to add this package as a dependence just for this single |
|
296 |
-- use. In case it is ever added, just remove this function definition |
|
297 |
-- and use the one from the package. |
|
298 |
splitEvery :: Int -> [e] -> [[e]] |
|
299 |
splitEvery i l = map (take i) (splitter l (:) []) where |
|
300 |
splitter [] _ n = n |
|
301 |
splitter li c n = li `c` splitter (drop i li) c n |
|
302 |
|
|
303 |
-- | Function for testing whether a single comma-separated integer is |
|
304 |
-- parsed correctly. |
|
305 |
testCommaInt :: String -> Int -> Assertion |
|
306 |
testCommaInt numString expectedResult = |
|
307 |
case A.parseOnly commaIntParser $ pack numString of |
|
308 |
Left msg -> assertFailure $ "Parsing failed: " ++ msg |
|
309 |
Right obtained -> assertEqual numString expectedResult obtained |
|
310 |
|
|
311 |
-- | Generate a property test for CommaInt numbers in a given range. |
|
312 |
gen_prop_CommaInt :: Int -> Int -> Property |
|
313 |
gen_prop_CommaInt minVal maxVal = |
|
314 |
forAll (choose (minVal, maxVal)) $ \i -> |
|
315 |
case A.parseOnly commaIntParser $ pack (generateCommaInt i) of |
|
316 |
Left msg -> failTest $ "Parsing failed: " ++ msg |
|
317 |
Right obtained -> i ==? obtained |
|
318 |
where generateCommaInt x = |
|
319 |
((reverse . intercalate ",") . splitEvery 3) . reverse $ show x |
|
320 |
|
|
321 |
-- | Test if <4 digit integers are recognized correctly. |
|
322 |
prop_commaInt_noCommas :: Property |
|
323 |
prop_commaInt_noCommas = gen_prop_CommaInt 0 999 |
|
324 |
|
|
325 |
-- | Test if integers with 1 comma are recognized correctly. |
|
326 |
prop_commaInt_1Comma :: Property |
|
327 |
prop_commaInt_1Comma = gen_prop_CommaInt 1000 999999 |
|
328 |
|
|
329 |
-- | Test if integers with multiple commas are recognized correctly. |
|
330 |
prop_commaInt_multipleCommas :: Property |
|
331 |
prop_commaInt_multipleCommas = gen_prop_CommaInt 1000000 (maxBound :: |
|
332 |
Int) |
|
333 |
|
|
334 |
-- | Test whether the parser is actually able to behave as intended with |
|
335 |
-- numbers without commas. That is, if a number with more than 3 digits |
|
336 |
-- is parsed, only up to the first 3 digits are considered (because they |
|
337 |
-- are a valid commaInt), and the rest is ignored. |
|
338 |
-- e.g.: parse "1234" = 123 |
|
339 |
prop_commaInt_max3WithoutComma :: Property |
|
340 |
prop_commaInt_max3WithoutComma = |
|
341 |
forAll (choose (0, maxBound :: Int)) $ \i -> |
|
342 |
case A.parseOnly commaIntParser $ pack (show i) of |
|
343 |
Left msg -> failTest $ "Parsing failed: " ++ msg |
|
344 |
Right obtained -> |
|
345 |
obtained < 1000 .&&. |
|
346 |
getFirst3Digits i ==? obtained |
|
347 |
where getFirst3Digits x = |
|
348 |
if x >= 1000 |
|
349 |
then getFirst3Digits $ x `div` 10 |
|
350 |
else x |
|
351 |
|
|
352 |
-- | Test if non-triplets are handled correctly (they are assumed NOT being part |
|
353 |
-- of the number). |
|
354 |
case_commaInt_non_triplet :: Assertion |
|
355 |
case_commaInt_non_triplet = testCommaInt "61,736,12" 61736 |
|
356 |
|
|
357 |
|
|
358 |
testSuite "Block/Drbd/Parser" |
|
359 |
[ 'case_drbd80_emptyline, |
|
360 |
'case_drbd83_sync_krnl2_6_39, |
|
361 |
'case_drbd83_sync, |
|
362 |
'case_drbd83_sync_want, |
|
363 |
'case_drbd83, |
|
364 |
'case_drbd8, |
|
365 |
'case_commaInt_non_triplet, |
|
366 |
'prop_commaInt_noCommas, |
|
367 |
'prop_commaInt_1Comma, |
|
368 |
'prop_commaInt_multipleCommas, |
|
369 |
'prop_commaInt_max3WithoutComma |
|
370 |
] |
/dev/null | ||
---|---|---|
1 |
{-# LANGUAGE TemplateHaskell #-} |
|
2 |
{-# OPTIONS_GHC -fno-warn-orphans #-} |
|
3 |
|
|
4 |
{-| Unittests for the types representing DRBD status -} |
|
5 |
|
|
6 |
{- |
|
7 |
|
|
8 |
Copyright (C) 2012 Google Inc. |
|
9 |
|
|
10 |
This program is free software; you can redistribute it and/or modify |
|
11 |
it under the terms of the GNU General Public License as published by |
|
12 |
the Free Software Foundation; either version 2 of the License, or |
|
13 |
(at your option) any later version. |
|
14 |
|
|
15 |
This program is distributed in the hope that it will be useful, but |
|
16 |
WITHOUT ANY WARRANTY; without even the implied warranty of |
|
17 |
MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU |
|
18 |
General Public License for more details. |
|
19 |
|
|
20 |
You should have received a copy of the GNU General Public License |
|
21 |
along with this program; if not, write to the Free Software |
|
22 |
Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA |
|
23 |
02110-1301, USA. |
|
24 |
|
|
25 |
-} |
|
26 |
|
|
27 |
module Test.Ganeti.Block.Drbd.Types (testBlock_Drbd_Types) where |
|
28 |
|
|
29 |
import Test.QuickCheck |
|
30 |
|
|
31 |
import Test.Ganeti.TestHelper |
|
32 |
import Test.Ganeti.TestCommon |
|
33 |
|
|
34 |
import Text.JSON |
|
35 |
import Text.Printf |
|
36 |
|
|
37 |
import Ganeti.JSON |
|
38 |
|
|
39 |
import Ganeti.Block.Drbd.Types |
|
40 |
|
|
41 |
{-# ANN module "HLint: ignore Use camelCase" #-} |
|
42 |
{-# ANN module "HLint: ignore Use string literal" #-} |
|
43 |
|
|
44 |
-- * Arbitrary instances |
|
45 |
|
|
46 |
$(genArbitrary ''ConnState) |
|
47 |
$(genArbitrary ''Role) |
|
48 |
$(genArbitrary ''DiskState) |
|
49 |
$(genArbitrary ''SizeUnit) |
|
50 |
$(genArbitrary ''TimeUnit) |
|
51 |
|
|
52 |
-- | Natural numbers generator. |
|
53 |
natural :: Gen Int |
|
54 |
natural = choose (0, maxBound :: Int) |
|
55 |
|
|
56 |
-- | Generator of percentages. |
|
57 |
percent :: Gen Double |
|
58 |
percent = choose (0 :: Double, 100 :: Double) |
|
59 |
|
|
60 |
-- | Generator of write order flags. |
|
61 |
wOrderFlag :: Gen Char |
|
62 |
wOrderFlag = elements ['b', 'f', 'd', 'n'] |
|
63 |
|
|
64 |
-- | Property for testing the JSON serialization of a DeviceInfo. |
|
65 |
prop_DeviceInfo :: Property |
|
66 |
prop_DeviceInfo = do |
|
67 |
minor <- natural |
|
68 |
state <- arbitrary |
|
69 |
locRole <- arbitrary |
|
70 |
remRole <- arbitrary |
|
71 |
locState <- arbitrary |
|
72 |
remState <- arbitrary |
|
73 |
alg <- choose ('A','C') |
|
74 |
ns <- natural |
|
75 |
nr <- natural |
|
76 |
dw <- natural |
|
77 |
dr <- natural |
|
78 |
al <- natural |
|
79 |
bm <- natural |
|
80 |
lc <- natural |
|
81 |
pe <- natural |
|
82 |
ua <- natural |
|
83 |
ap <- natural |
|
84 |
ep <- genMaybe natural |
|
85 |
wo <- genMaybe wOrderFlag |
|
86 |
oos <- genMaybe natural |
|
87 |
let obtained = |
|
88 |
showJSON $ |
|
89 |
DeviceInfo minor state (LocalRemote locRole remRole) |
|
90 |
(LocalRemote locState remState) alg "r----" perfInd |
|
91 |
Nothing |
|
92 |
Nothing |
|
93 |
Nothing |
|
94 |
perfInd = |
|
95 |
PerfIndicators ns nr dw dr al bm lc pe ua ap ep wo oos |
|
96 |
expected = |
|
97 |
makeObj |
|
98 |
[ ("minor", showJSON minor) |
|
99 |
, ("connectionState", showJSON state) |
|
100 |
, ("localRole", showJSON locRole) |
|
101 |
, ("remoteRole", showJSON remRole) |
|
102 |
, ("localState", showJSON locState) |
|
103 |
, ("remoteState", showJSON remState) |
|
104 |
, ("replicationProtocol", showJSON alg) |
|
105 |
, ("ioFlags", showJSON "r----") |
|
106 |
, ("perfIndicators", showJSON perfInd) |
|
107 |
] |
|
108 |
obtained ==? expected |
|
109 |
|
|
110 |
-- | Property for testing the JSON serialization of a PerfIndicators. |
|
111 |
prop_PerfIndicators :: Property |
|
112 |
prop_PerfIndicators = do |
|
113 |
ns <- natural |
|
114 |
nr <- natural |
|
115 |
dw <- natural |
|
116 |
dr <- natural |
|
117 |
al <- natural |
|
118 |
bm <- natural |
|
119 |
lc <- natural |
|
120 |
pe <- natural |
|
121 |
ua <- natural |
|
122 |
ap <- natural |
|
123 |
ep <- genMaybe natural |
|
124 |
wo <- genMaybe wOrderFlag |
|
125 |
oos <- genMaybe natural |
|
126 |
let expected = |
|
127 |
showJSON $ |
|
128 |
PerfIndicators ns nr dw dr al bm lc pe ua ap ep wo oos |
|
129 |
obtained = |
|
130 |
optFieldsToObj |
|
131 |
[ Just ("networkSend", showJSON ns) |
|
132 |
, Just ("networkReceive", showJSON nr) |
|
133 |
, Just ("diskWrite", showJSON dw) |
|
134 |
, Just ("diskRead", showJSON dr) |
|
135 |
, Just ("activityLog", showJSON al) |
|
136 |
, Just ("bitMap", showJSON bm) |
|
137 |
, Just ("localCount", showJSON lc) |
|
138 |
, Just ("pending", showJSON pe) |
|
139 |
, Just ("unacknowledged", showJSON ua) |
|
140 |
, Just ("applicationPending", showJSON ap) |
|
141 |
, optionalJSField "epochs" ep |
|
142 |
, optionalJSField "writeOrder" wo |
|
143 |
, optionalJSField "outOfSync" oos |
|
144 |
] |
|
145 |
obtained ==? expected |
|
146 |
|
|
147 |
-- | Function for testing the JSON serialization of a SyncStatus. |
|
148 |
prop_SyncStatus :: Property |
|
149 |
prop_SyncStatus = do |
|
150 |
perc <- percent |
|
151 |
numer <- natural |
|
152 |
denom <- natural |
|
153 |
sizeU1 <- arbitrary |
|
154 |
h <- choose (0, 23) |
|
155 |
m <- choose (0, 59) |
|
156 |
s <- choose (0, 59) |
|
157 |
sp <- natural |
|
158 |
wa <- genMaybe natural |
|
159 |
sizeU2 <- arbitrary |
|
160 |
timeU <- arbitrary |
|
161 |
let obtained = showJSON $ |
|
162 |
SyncStatus perc numer denom sizeU1 (Time h m s) sp wa sizeU2 timeU |
|
163 |
expected = optFieldsToObj |
|
164 |
[ Just ("percentage", showJSON perc) |
|
165 |
, Just ("progress", showJSON $ show numer ++ "/" ++ show denom) |
|
166 |
, Just ("progressUnit", showJSON sizeU1) |
|
167 |
, Just ("timeToFinish", showJSON |
|
168 |
(printf "%02d:%02d:%02d" h m s :: String)) |
|
169 |
, Just ("speed", showJSON sp) |
|
170 |
, optionalJSField "want" wa |
|
171 |
, Just ("speedUnit", showJSON $ show sizeU2 ++ "/" ++ show timeU) |
|
172 |
] |
|
173 |
obtained ==? expected |
|
174 |
|
|
175 |
testSuite "Block/Drbd/Types" |
|
176 |
[ 'prop_DeviceInfo |
|
177 |
, 'prop_PerfIndicators |
|
178 |
, 'prop_SyncStatus |
|
179 |
] |
/dev/null | ||
---|---|---|
1 |
{-# LANGUAGE TemplateHaskell #-} |
|
2 |
{-# OPTIONS_GHC -fno-warn-orphans #-} |
|
3 |
|
|
4 |
{-| Unittests for the 'Ganeti.Common' module. |
|
5 |
|
|
6 |
-} |
|
7 |
|
|
8 |
{- |
|
9 |
|
|
10 |
Copyright (C) 2009, 2010, 2011, 2012 Google Inc. |
|
11 |
|
|
12 |
This program is free software; you can redistribute it and/or modify |
|
13 |
it under the terms of the GNU General Public License as published by |
|
14 |
the Free Software Foundation; either version 2 of the License, or |
|
15 |
(at your option) any later version. |
|
16 |
|
|
17 |
This program is distributed in the hope that it will be useful, but |
|
18 |
WITHOUT ANY WARRANTY; without even the implied warranty of |
|
19 |
MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU |
|
20 |
General Public License for more details. |
|
21 |
|
|
22 |
You should have received a copy of the GNU General Public License |
|
23 |
along with this program; if not, write to the Free Software |
|
24 |
Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA |
|
25 |
02110-1301, USA. |
|
26 |
|
|
27 |
-} |
|
28 |
|
|
29 |
module Test.Ganeti.Common |
|
30 |
( testCommon |
|
31 |
, checkOpt |
|
32 |
, passFailOpt |
|
33 |
, checkEarlyExit |
|
34 |
) where |
|
35 |
|
|
36 |
import Test.QuickCheck hiding (Result) |
|
37 |
import Test.HUnit |
|
38 |
|
|
39 |
import qualified System.Console.GetOpt as GetOpt |
|
40 |
import System.Exit |
|
41 |
|
|
42 |
import Test.Ganeti.TestHelper |
|
43 |
import Test.Ganeti.TestCommon |
|
44 |
|
|
45 |
import Ganeti.BasicTypes |
|
46 |
import Ganeti.Common |
|
47 |
|
|
48 |
-- | Helper to check for correct parsing of an option. |
|
49 |
checkOpt :: (StandardOptions b) => |
|
50 |
(a -> Maybe String) -- ^ Converts the value into a cmdline form |
|
51 |
-> b -- ^ The default options |
|
52 |
-> (String -> c) -- ^ Fail test function |
|
53 |
-> (String -> d -> d -> c) -- ^ Check for equality function |
|
54 |
-> (a -> d) -- ^ Transforms the value to a compare val |
|
55 |
-> (a, GenericOptType b, b -> d) -- ^ Triple of value, the |
|
56 |
-- option, function to |
|
57 |
-- extract the set value |
|
58 |
-- from the options |
|
59 |
-> c |
|
60 |
checkOpt repr defaults failfn eqcheck valfn |
|
61 |
(val, opt@(GetOpt.Option _ longs _ _, _), fn) = |
|
62 |
case longs of |
|
63 |
[] -> failfn "no long options?" |
|
64 |
cmdarg:_ -> |
|
65 |
case parseOptsInner defaults |
|
66 |
["--" ++ cmdarg ++ maybe "" ("=" ++) (repr val)] |
|
67 |
"prog" [opt] [] of |
|
68 |
Left e -> failfn $ "Failed to parse option '" ++ cmdarg ++ ": " ++ |
|
69 |
show e |
|
70 |
Right (options, _) -> eqcheck ("Wrong value in option " ++ |
|
71 |
cmdarg ++ "?") (valfn val) (fn options) |
|
72 |
|
|
73 |
-- | Helper to check for correct and incorrect parsing of an option. |
|
74 |
passFailOpt :: (StandardOptions b) => |
|
75 |
b -- ^ The default options |
|
76 |
-> (String -> c) -- ^ Fail test function |
|
77 |
-> c -- ^ Pass function |
|
78 |
-> (GenericOptType b, String, String) |
|
79 |
-- ^ The list of enabled options, fail value and pass value |
|
80 |
-> c |
|
81 |
passFailOpt defaults failfn passfn |
|
82 |
(opt@(GetOpt.Option _ longs _ _, _), bad, good) = |
|
83 |
let prefix = "--" ++ head longs ++ "=" |
|
84 |
good_cmd = prefix ++ good |
|
85 |
bad_cmd = prefix ++ bad in |
|
86 |
case (parseOptsInner defaults [bad_cmd] "prog" [opt] [], |
|
87 |
parseOptsInner defaults [good_cmd] "prog" [opt] []) of |
|
88 |
(Left _, Right _) -> passfn |
|
89 |
(Right _, Right _) -> failfn $ "Command line '" ++ bad_cmd ++ |
|
90 |
"' succeeded when it shouldn't" |
|
91 |
(Left _, Left _) -> failfn $ "Command line '" ++ good_cmd ++ |
|
92 |
"' failed when it shouldn't" |
|
93 |
(Right _, Left _) -> |
|
94 |
failfn $ "Command line '" ++ bad_cmd ++ |
|
95 |
"' succeeded when it shouldn't, while command line '" ++ |
|
96 |
good_cmd ++ "' failed when it shouldn't" |
|
97 |
|
|
98 |
-- | Helper to test that a given option is accepted OK with quick exit. |
|
99 |
checkEarlyExit :: (StandardOptions a) => |
|
100 |
a -> String -> [GenericOptType a] -> [ArgCompletion] |
|
101 |
-> Assertion |
|
102 |
checkEarlyExit defaults name options arguments = |
|
103 |
mapM_ (\param -> |
|
104 |
case parseOptsInner defaults [param] name options arguments of |
|
105 |
Left (code, _) -> |
|
106 |
assertEqual ("Program " ++ name ++ |
|
107 |
" returns invalid code " ++ show code ++ |
|
108 |
" for option " ++ param) ExitSuccess code |
|
109 |
_ -> assertFailure $ "Program " ++ name ++ |
|
110 |
" doesn't consider option " ++ |
|
111 |
param ++ " as early exit one" |
|
112 |
) ["-h", "--help", "-V", "--version"] |
|
113 |
|
|
114 |
-- | Test parseYesNo. |
|
115 |
prop_parse_yes_no :: Bool -> Bool -> String -> Property |
|
116 |
prop_parse_yes_no def testval val = |
|
117 |
forAll (elements [val, "yes", "no"]) $ \actual_val -> |
|
118 |
if testval |
|
119 |
then parseYesNo def Nothing ==? Ok def |
|
120 |
else let result = parseYesNo def (Just actual_val) |
|
121 |
in if actual_val `elem` ["yes", "no"] |
|
122 |
then result ==? Ok (actual_val == "yes") |
|
123 |
else property $ isBad result |
|
124 |
|
|
125 |
|
|
126 |
testSuite "Common" |
|
127 |
[ 'prop_parse_yes_no |
|
128 |
] |
/dev/null | ||
---|---|---|
1 |
{-# LANGUAGE TemplateHaskell #-} |
|
2 |
{-# OPTIONS_GHC -fno-warn-orphans #-} |
|
3 |
|
|
4 |
{-| Unittests for ganeti-htools. |
|
5 |
|
|
6 |
-} |
|
7 |
|
|
8 |
{- |
|
9 |
|
|
10 |
Copyright (C) 2009, 2010, 2011, 2012 Google Inc. |
|
11 |
|
|
12 |
This program is free software; you can redistribute it and/or modify |
|
13 |
it under the terms of the GNU General Public License as published by |
|
14 |
the Free Software Foundation; either version 2 of the License, or |
|
15 |
(at your option) any later version. |
|
16 |
|
|
17 |
This program is distributed in the hope that it will be useful, but |
|
18 |
WITHOUT ANY WARRANTY; without even the implied warranty of |
|
19 |
MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU |
|
20 |
General Public License for more details. |
|
21 |
|
|
22 |
You should have received a copy of the GNU General Public License |
|
23 |
along with this program; if not, write to the Free Software |
|
24 |
Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA |
|
25 |
02110-1301, USA. |
|
26 |
|
|
27 |
-} |
|
28 |
|
|
29 |
module Test.Ganeti.Confd.Types |
|
30 |
( testConfd_Types |
|
31 |
, ConfdRequestType(..) |
|
32 |
, ConfdReqField(..) |
|
33 |
, ConfdReqQ(..) |
|
34 |
) where |
|
35 |
|
|
36 |
import Control.Applicative |
|
37 |
import Test.QuickCheck |
|
38 |
import Test.HUnit |
|
39 |
import qualified Text.JSON as J |
|
40 |
|
|
41 |
import Test.Ganeti.TestHelper |
|
42 |
import Test.Ganeti.TestCommon |
|
43 |
|
|
44 |
import Ganeti.Confd.Types as Confd |
|
45 |
|
|
46 |
{-# ANN module "HLint: ignore Use camelCase" #-} |
|
47 |
|
|
48 |
-- * Arbitrary instances |
|
49 |
|
|
50 |
$(genArbitrary ''ConfdRequestType) |
|
51 |
|
|
52 |
$(genArbitrary ''ConfdReqField) |
|
53 |
|
|
54 |
$(genArbitrary ''ConfdReqQ) |
|
55 |
|
|
56 |
instance Arbitrary ConfdQuery where |
|
57 |
arbitrary = oneof [ pure EmptyQuery |
|
58 |
, PlainQuery <$> genName |
|
59 |
, DictQuery <$> arbitrary |
|
60 |
] |
|
61 |
|
|
62 |
$(genArbitrary ''ConfdRequest) |
|
63 |
|
|
64 |
$(genArbitrary ''ConfdReplyStatus) |
|
65 |
|
|
66 |
instance Arbitrary ConfdReply where |
|
67 |
arbitrary = ConfdReply <$> arbitrary <*> arbitrary <*> |
|
68 |
pure J.JSNull <*> arbitrary |
|
69 |
|
|
70 |
$(genArbitrary ''ConfdErrorType) |
|
71 |
|
|
72 |
$(genArbitrary ''ConfdNodeRole) |
|
73 |
|
|
74 |
-- * Test cases |
|
75 |
|
|
76 |
-- | Test 'ConfdQuery' serialisation. |
|
77 |
prop_ConfdQuery_serialisation :: ConfdQuery -> Property |
|
78 |
prop_ConfdQuery_serialisation = testSerialisation |
|
79 |
|
|
80 |
-- | Test bad types deserialisation for 'ConfdQuery'. |
|
81 |
case_ConfdQuery_BadTypes :: Assertion |
|
82 |
case_ConfdQuery_BadTypes = do |
|
83 |
let helper jsval = case J.readJSON jsval of |
|
84 |
J.Error _ -> return () |
|
85 |
J.Ok cq -> assertFailure $ "Parsed " ++ show jsval |
|
86 |
++ " as query " ++ show (cq::ConfdQuery) |
|
87 |
helper $ J.showJSON (1::Int) |
|
88 |
helper $ J.JSBool True |
|
89 |
helper $ J.JSBool False |
Also available in: Unified diff