Convert to native NQP-rx regex; move last bits of Glue functionality to Util; kill...
[parrot-plumage:parrot-plumage.git] / t / 03-util.t
1 #! parrot-nqp
2
3 my $*EXECUTABLE_NAME;
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 library to be tested
13     pir::load_bytecode('src/lib/Util.pbc');
14
15     # Run all tests for this library
16     run_tests();
17 }
18
19 sub run_tests () {
20     plan(42);
21
22     test_hash_exists();
23     test_hash_keys();
24     test_hash_kv();
25
26     test_set_from_array();
27
28     test_subst();
29
30     test_path_exists();
31     test_is_dir();
32
33     test_qx();
34 }
35
36 sub test_hash_exists() {
37     my %opt;
38     %opt<foobar> := 42;
39
40     ok( %opt.exists('foobar'),   'exists works for existing keys');
41     nok(%opt.exists('zanzibar'), 'exists works for non-existent keys');
42 }
43
44 sub test_hash_keys() {
45     my %hash;
46
47     my @keys := %hash.keys;
48
49     is(@keys, 0, 'keys on empty hash is empty');
50
51     %hash<moof> := 42;
52     @keys       := %hash.keys;
53
54     is(@keys,    1,      'keys on hash with one entry has one element');
55     is(@keys[0], 'moof', '... and that element is correct');
56
57     %hash<dogcow> := "sloop";
58     @keys         := %hash.keys;
59
60     is(@keys,    2,          'keys on hash with two entries has two elements');
61     ok(@keys[0] eq 'moof'
62     || @keys[1] eq 'moof',   '... and the old key is there');
63     ok(@keys[0] eq 'dogcow'
64     || @keys[1] eq 'dogcow', '... and the new key is there');
65
66     %hash<foo> := 1;
67     %hash<bar> := 2;
68     %hash<baz> := 3;
69     @keys      := %hash.keys;
70
71     is(@keys, 5, 'keys on hash with five entries has five elements');
72 }
73
74 sub test_hash_kv() {
75     my %kv_hash;
76
77     my @kv := %kv_hash.kv;
78
79     is(@kv, 0, 'kv on empty hash is empty');
80
81     %kv_hash<flux> := 13;
82     @kv            := %kv_hash.kv;
83
84     is(@kv,    2,      'kv on hash with one entry has two elements');
85     is(@kv[0], 'flux', '... and the key is correct');
86     is(@kv[1], 13,     '... and the value is correct');
87
88     %kv_hash<romp> := "party";
89     @kv            := %kv_hash.kv;
90
91     is(@kv,    4,         'kv on hash with two entries has four elements');
92     ok(@kv[0] eq 'flux'
93     || @kv[2] eq 'flux',  '... and the old key is there');
94     ok(@kv[0] eq 'romp'
95     || @kv[2] eq 'romp',  '... and the new key is there');
96     ok(@kv[1] eq 13
97     || @kv[3] eq 13,      '... and the old value is there');
98     ok(@kv[1] eq 'party'
99     || @kv[3] eq 'party', '... and the new value is there');
100     ok(@kv[0] eq 'flux' && @kv[1] eq '13'
101     || @kv[2] eq 'flux' && @kv[3] eq '13',
102                           'and the keys and values are matched');
103
104     %kv_hash<uno> := 1;
105     %kv_hash<two> := 2;
106     %kv_hash<11>  := 3;
107     @kv           := %kv_hash.kv;
108
109     is(@kv, 10, 'kv on hash with five entries has ten elements');
110 }
111
112 sub test_set_from_array() {
113     my @array;
114     my %set  := set_from_array(@array);
115     my @keys := %set.keys;
116     is(@keys, 0, 'set_from_array on empty array produces empty set');
117
118     @array := (1, "two", "two", 3, '3', 3);
119     %set   := set_from_array(@array);
120     @keys  := %set.keys;
121     is(@keys,     3, 'set_from_array on array with dups has correct number of keys');
122     is(%set<1>,   1, '... and first key is in set');
123     is(%set<two>, 1, '... and second key is in set');
124     is(%set<3>,   1, '... and third key is in set');
125     nok(%set.exists('four'), '... and non-existant key is not in set');
126 }
127
128 sub test_subst() {
129     my $string := 'chewbacca';
130     my $subst  := subst($string, /a/, 'x');
131     is($subst,  'chewbxccx', 'subst works with plain string replacement');
132     is($string, 'chewbacca', 'plain string subst edits a clone');
133
134     my $text  := 'wookie';
135     my $fixed := subst($text, /w|k/, replacement);
136     is($fixed, 'wwookkie', 'subst works with code replacement');
137     is($text,  'wookie',   'code replacement subst edits a clone');
138 }
139
140 sub replacement($match) {
141     my $orig := ~$match;
142
143     return $orig ~ $orig;
144 }
145
146 sub test_path_exists() {
147     ok( path_exists('.'),            'path_exists finds .');
148     nok(path_exists('DOESNOTEXIST'), 'path_exists returns false for nonexistent files');
149 }
150
151 sub test_is_dir() {
152     ok( is_dir('.'),            '. is a directory');
153     nok(is_dir('DOESNOTEXIST'), 'is_dir returns false for nonexistent dirs');
154     nok(is_dir('harness'),      'is_dir returns false for normal files');
155 }
156
157 sub test_qx() {
158     my $output;
159     my $!;
160
161     is(qx(''), '', 'qx("") returns an empty string');
162
163     $output := qx('IHOPETHATTHISPATHDOESNOTEXISTANDISEXECUTABLEANDRETURNSTRUE');
164     like($output, ':s not (found|recognized)','qx() on invalid path returns not found error');
165     isnt($!, 0, '... and the exit status is non-zero');
166
167     $output := qx($*EXECUTABLE_NAME, '-e', '"say(42); pir::exit(0)"');
168     is($output, "42\n", 'qx() captures output of exit(0) program, retaining line endings');
169     is($!,      0,      '... and the exit status is correct');
170
171     $output := qx($*EXECUTABLE_NAME, '-e', '"say(21); pir::exit(1)"');
172     is($output, "21\n", 'qx() captures output of exit(1) program, retaining line endings');
173     is($!,      1,      '... and the exit status is correct');
174 }