Convert to native NQP-rx regex; move last bits of Glue functionality to Util; kill...
[parrot-plumage:parrot-plumage.git] / t / sanity.t
1 #! parrot-nqp
2
3 our $PLUMAGE;
4
5 MAIN();
6
7 sub MAIN () {
8     # Load testing tools
9     pir::load_language('parrot');
10     pir::compreg__PS('parrot').import('Test::More');
11
12     # Load Util library
13     pir::load_bytecode('src/lib/Util.pbc');
14
15     # Set correct path for plumage binary
16     $PLUMAGE := fscat(['.'], 'plumage');
17
18     # Run all sanity tests for plumage
19     run_tests();
20 }
21
22 sub run_tests () {
23     plan(18);
24
25     # Fuzz tests
26     test_invalid();
27     test_plumage_invalid();
28     test_plumage_info_invalid();
29     test_plumage_configure_invalid();
30     test_plumage_build_invalid();
31     test_plumage_test_invalid();
32     test_plumage_install_invalid();
33
34     # Missing argument tests
35     test_plumage_no_args();
36     test_plumage_fetch_no_args();
37
38     # Behavior tests
39     test_plumage_usage();
40     test_plumage_version();
41     test_plumage_info();
42 }
43
44
45 #
46 # FUZZ TESTS
47 #
48
49 sub test_invalid() {
50     my $success := do_run('invalidjunkdoesnotexist');
51     nok($success, 'do_run()ing invalidjunk returns false');
52 }
53
54 sub test_plumage_invalid() {
55     my $success := do_run($PLUMAGE, 'asdfversion');
56     nok($success, 'plumage returns failure for invalid commands');
57 }
58
59 sub test_plumage_info_invalid() {
60     my $output := qx($PLUMAGE, 'info', 'coboloncogs');
61     ok($output ~~ /:s I don.t know anything about project .coboloncogs./,
62        "command 'info' errors properly for unknown project name");
63 }
64
65 sub test_plumage_configure_invalid() {
66     my $output := qx($PLUMAGE, 'configure', 'coboloncogs');
67     ok($output ~~ /:s I don.t know anything about project .coboloncogs./,
68        "command 'configure' errors properly for unknown project name");
69 }
70
71 sub test_plumage_build_invalid() {
72     my $output := qx($PLUMAGE, 'build', 'coboloncogs');
73     ok($output ~~ /:s I don.t know anything about project .coboloncogs./,
74        "command 'build' errors properly for unknown project name");
75 }
76
77 sub test_plumage_test_invalid() {
78     my $output := qx($PLUMAGE, 'test', 'coboloncogs');
79     ok($output ~~ /:s I don.t know anything about project .coboloncogs./,
80        "command 'test' errors properly for unknown project name");
81 }
82
83 sub test_plumage_install_invalid() {
84     my $output := qx($PLUMAGE, 'install', 'coboloncogs');
85     ok($output ~~ /:s I don.t know anything about project .coboloncogs./,
86        "command 'install' errors properly for unknown project name");
87 }
88
89
90 #
91 # MISSING ARGUMENT TESTS
92 #
93
94 sub test_plumage_no_args() {
95     my $output := qx($PLUMAGE);
96     ok($output ~~ /:s Print program version and copyright/,   'no args give usage');
97     ok($output ~~ /:s Print info about a particular project/, 'no args give usage');
98 }
99
100 sub test_plumage_fetch_no_args() {
101     my $output := qx($PLUMAGE, 'fetch');
102     ok($output ~~ /:s Please specify a project to act on./, 'fetch without args asks for project name');
103 }
104
105
106 #
107 # BEHAVIOR TESTS
108 #
109
110 sub test_plumage_usage() {
111     my $output := qx($PLUMAGE, 'usage');
112     ok($output ~~ /:s Print program version and copyright/,   'usage explains how to view version and copyright');
113     ok($output ~~ /:s Print info about a particular project/, 'usage explains how to get info on a project');
114 }
115
116 sub test_plumage_version() {
117     my $success := do_run($PLUMAGE, 'version');
118     ok($success, 'plumage version returns success');
119
120     my $output := qx($PLUMAGE, 'version');
121     ok($output ~~ /:s Parrot Plumage/,    'plumage version knows its name');
122     ok($output ~~ /:s Parrot Foundation/, 'version mentions Parrot Foundation');
123     ok($output ~~ /:s Artistic License/,  'version mentions Artistic License');
124 }
125
126 sub test_plumage_info() {
127     my $output := qx($PLUMAGE, 'info', 'rakudo');
128     ok($output ~~ /:s Perl 6 on Parrot/, 'info rakudo');
129     ok($output ~~ /dependency\-info/,    'info rakudo');
130 }