ly/: Create one .ly file for every .ily instrument file
[sunny256-utils.git] / tests / fromhex.t
blob371f34302aff656fc13314b448aebed04c8fbb39
1 #!/usr/bin/env perl
3 #=======================================================================
4 # fromhex.t
5 # File ID: 05b995a4-f988-11dd-aac9-000475e441b9
7 # Test suite for fromhex(1).
9 # Character set: UTF-8
10 # ©opyleft 2008– Øyvind A. Holm <sunny@sunbase.org>
11 # License: GNU General Public License version 2 or later, see end of
12 # file for legal stuff.
13 #=======================================================================
15 use strict;
16 use warnings;
18 BEGIN {
19 use Test::More qw{no_plan};
20 # use_ok() goes here
23 use Getopt::Long;
25 local $| = 1;
27 our $CMDB = "fromhex";
28 our $CMD = "../$CMDB";
30 our %Opt = (
32 'all' => 0,
33 'help' => 0,
34 'quiet' => 0,
35 'todo' => 0,
36 'verbose' => 0,
37 'version' => 0,
41 our $progname = $0;
42 $progname =~ s/^.*\/(.*?)$/$1/;
43 our $VERSION = '0.0.0';
45 my %descriptions = ();
47 Getopt::Long::Configure('bundling');
48 GetOptions(
50 'all|a' => \$Opt{'all'},
51 'help|h' => \$Opt{'help'},
52 'quiet|q+' => \$Opt{'quiet'},
53 'todo|t' => \$Opt{'todo'},
54 'verbose|v+' => \$Opt{'verbose'},
55 'version' => \$Opt{'version'},
57 ) || die("$progname: Option error. Use -h for help.\n");
59 $Opt{'verbose'} -= $Opt{'quiet'};
60 $Opt{'help'} && usage(0);
61 if ($Opt{'version'}) {
62 print_version();
63 exit(0);
66 exit(main());
68 sub main {
69 # {{{
70 my $Retval = 0;
72 diag(sprintf('========== Executing %s v%s ==========',
73 $progname, $VERSION));
75 if ($Opt{'todo'} && !$Opt{'all'}) {
76 goto todo_section;
79 =pod
81 testcmd("$CMD command", # {{{
82 <<'END',
83 [expected stdout]
84 END
85 '',
87 'description',
90 # }}}
92 =cut
94 diag('Testing -h (--help) option...');
95 likecmd("$CMD -h", # {{{
96 '/ Show this help/i',
97 '/^$/',
99 'Option -h prints help screen',
102 # }}}
103 diag('Testing -v (--verbose) option...');
104 likecmd("$CMD -hv", # {{{
105 '/^\n\S+ \d+\.\d+\.\d+/s',
106 '/^$/',
108 'Option -v with -h returns version number and help screen',
111 # }}}
112 diag('Testing --version option...');
113 likecmd("$CMD --version", # {{{
114 '/^\S+ \d+\.\d+\.\d+/',
115 '/^$/',
117 'Option --version returns version number',
120 # }}}
121 testcmd("echo 76 72 c3 b8 76 6c 65 62 c3 b8 74 74 65 | $CMD", # {{{
122 'vrøvlebøtte',
125 'Read standard two-digit lowercase hex',
128 # }}}
129 testcmd("echo 466ac3b873756c66206865722c2076656c6b6f6d6d656e2e | $CMD", # {{{
130 'Fjøsulf her, velkommen.',
133 'No spaces between hex',
136 # }}}
137 testcmd("echo '4j4r6%%574.20 677w26_1756c6+ 573206§9206cg69:612/1.' | $CMD", # {{{
138 'Det graules i lia!',
141 'Ignore non-hex digits',
144 # }}}
145 testcmd("echo 4B4A48426a6b62686a68626a6b6861732F262F36353435252629282f0A | $CMD", # {{{
146 "KJHBjkbhjhbjkhas/&/6545%&)(/\n",
149 'Include upper case',
152 # }}}
153 testcmd("$CMD -d fromhex-files/decimal.txt", # {{{
154 <<'END',
155 __________________________
156 < Have to test decimal too >
157 --------------------------
158 \ ^__^
159 \ (oo)\_______
160 (__)\ )\/\
161 ||----w |
162 || ||
166 'Read decimal numbers with -d, ignore other chars',
169 # }}}
170 testcmd("echo 53 74 65 69 6b 6a 65 20 66 69 6e 65 20 67 61 72 64 69 6e 65 2 | $CMD", # {{{
171 'Steikje fine gardine',
174 'Don\'t output the byte that\'s missing a nibble',
177 # }}}
178 testcmd("$CMD fromhex-files/single.txt", # {{{
179 <<'END',
187 'Read single digits on their own line',
190 # }}}
191 testcmd("$CMD fromhex-files/standardpudding.bin", # {{{
192 <<'END',
193 Standardpudding til Folket. Det er vel ikke for mye forlangt. Eller skal
194 vi sitte her og råtne i luksusen?
196 Mvh ~ +--------,
197 Øyvind _~ + ) + ' |/ _ \
198 ,_______________| |______ , , . (~) + +
199 /________________________/\ . * + U *
200 | || `.
201 +-------------------------------------------------------------_ (o_.'
202 | All you touch and all you see is all your life will ever be. -_ //\
203 | ✭ ✭ ✭ ✭ ✭ ✭ ✭ ✭ ✭ ✭ ✭ ✭ ✭ ✭ ✭ ✭ ✭ ✭ ✭ ✭ ✭ ✭ ✭ ✭ ✭ ✭ ✭ ✭ ✭ ✭ ✭ -_ V_/_
204 +-------------------------------------------------------------------------
208 'Read digits from file with lots of binary noise',
211 # }}}
212 diag('Test -u/--unicode option...');
213 testcmd("echo 59 65 70_2E 20.2192/263a 2190 20 1f6BD | $CMD --unicode", # {{{
214 'Yep. →☺← 🚽',
217 'Read hex values in Unicode mode (--unicode)',
220 # }}}
221 testcmd("echo 89 101 112_46 32%8594 9786 8592+32 128701 | $CMD -du", # {{{
222 'Yep. →☺← 🚽',
225 'Read decimal values in Unicode mode (-u)',
228 # }}}
229 testcmd("echo 89 101 112-46 32%8594?9786 8592b32 128701 | $CMD -d", # {{{
230 'Yep. ',
231 "fromhex: Cannot print byte value 8594 in bytewise mode, use -u\n",
233 'Read high decimal values when not in Unicode mode',
236 # }}}
237 diag('Suppress Perl warnings about invalid UTF-8...');
238 testcmd("echo ffff | $CMD -u", # {{{
239 "\xef\xbf\xbf",
242 "Perl doesn't complain about U+FFFF",
245 # }}}
246 testcmd("echo d800 | $CMD -u", # {{{
247 "\xed\xa0\x80",
250 "Perl doesn't complain about U+D800",
253 # }}}
254 testcmd("echo 65535 | $CMD -ud", # {{{
255 "\xef\xbf\xbf",
258 "Perl doesn't complain about U+FFFF (decimal)",
261 # }}}
262 testcmd("echo 55296 | $CMD -ud", # {{{
263 "\xed\xa0\x80",
266 "Perl doesn't complain about U+D800 (decimal)",
269 # }}}
270 diag('Enable Perl UTF-8 warnings with -w/--warnings');
271 likecmd("echo ffff | $CMD -uw", # {{{
272 '/^\xef\xbf\xbf$/',
273 '/Unicode/',
275 "Perl complains about U+FFFF",
278 # }}}
279 likecmd("echo d800 | $CMD -u --warning", # {{{
280 '/^\xed\xa0\x80$/',
281 '/surrogate .*D800/i',
283 "Perl complains about U+D800",
286 # }}}
287 likecmd("echo 65535 | $CMD -u --decimal -w", # {{{
288 '/^\xef\xbf\xbf$/',
289 '/Unicode/',
291 "Perl complains about U+FFFF (decimal)",
294 # }}}
295 likecmd("echo 55296 | $CMD -udw", # {{{
296 '/^\xed\xa0\x80$/',
297 '/surrogate .*D800/i',
299 "Perl complains about U+D800 (decimal)",
302 # }}}
304 todo_section:
307 if ($Opt{'all'} || $Opt{'todo'}) {
308 diag('Running TODO tests...'); # {{{
310 TODO: {
312 local $TODO = '';
313 # Insert TODO tests here.
316 # TODO tests }}}
319 diag('Testing finished.');
320 return $Retval;
321 # }}}
322 } # main()
324 sub testcmd {
325 # {{{
326 my ($Cmd, $Exp_stdout, $Exp_stderr, $Exp_retval, $Desc) = @_;
327 defined($descriptions{$Desc}) &&
328 BAIL_OUT("testcmd(): '$Desc' description is used twice");
329 $descriptions{$Desc} = 1;
330 my $stderr_cmd = '';
331 my $cmd_outp_str = $Opt{'verbose'} >= 1 ? "\"$Cmd\" - " : '';
332 my $Txt = join('', $cmd_outp_str, defined($Desc) ? $Desc : '');
333 my $TMP_STDERR = "$CMDB-stderr.tmp";
334 my $retval = 1;
336 if (defined($Exp_stderr)) {
337 $stderr_cmd = " 2>$TMP_STDERR";
339 $retval &= is(`$Cmd$stderr_cmd`, $Exp_stdout, "$Txt (stdout)");
340 my $ret_val = $?;
341 if (defined($Exp_stderr)) {
342 $retval &= is(file_data($TMP_STDERR), $Exp_stderr, "$Txt (stderr)");
343 unlink($TMP_STDERR);
344 } else {
345 diag("Warning: stderr not defined for '$Txt'");
347 $retval &= is($ret_val >> 8, $Exp_retval, "$Txt (retval)");
349 return $retval;
350 # }}}
351 } # testcmd()
353 sub likecmd {
354 # {{{
355 my ($Cmd, $Exp_stdout, $Exp_stderr, $Exp_retval, $Desc) = @_;
356 defined($descriptions{$Desc}) &&
357 BAIL_OUT("likecmd(): '$Desc' description is used twice");
358 $descriptions{$Desc} = 1;
359 my $stderr_cmd = '';
360 my $cmd_outp_str = $Opt{'verbose'} >= 1 ? "\"$Cmd\" - " : '';
361 my $Txt = join('', $cmd_outp_str, defined($Desc) ? $Desc : '');
362 my $TMP_STDERR = "$CMDB-stderr.tmp";
363 my $retval = 1;
365 if (defined($Exp_stderr)) {
366 $stderr_cmd = " 2>$TMP_STDERR";
368 $retval &= like(`$Cmd$stderr_cmd`, $Exp_stdout, "$Txt (stdout)");
369 my $ret_val = $?;
370 if (defined($Exp_stderr)) {
371 $retval &= like(file_data($TMP_STDERR), $Exp_stderr, "$Txt (stderr)");
372 unlink($TMP_STDERR);
373 } else {
374 diag("Warning: stderr not defined for '$Txt'");
376 $retval &= is($ret_val >> 8, $Exp_retval, "$Txt (retval)");
378 return $retval;
379 # }}}
380 } # likecmd()
382 sub file_data {
383 # Return file content as a string {{{
384 my $File = shift;
385 my $Txt;
387 open(my $fp, '<', $File) or return undef;
388 local $/ = undef;
389 $Txt = <$fp>;
390 close($fp);
391 return $Txt;
392 # }}}
393 } # file_data()
395 sub print_version {
396 # Print program version {{{
397 print("$progname $VERSION\n");
398 return;
399 # }}}
400 } # print_version()
402 sub usage {
403 # Send the help message to stdout {{{
404 my $Retval = shift;
406 if ($Opt{'verbose'}) {
407 print("\n");
408 print_version();
410 print(<<"END");
412 Usage: $progname [options]
414 Contains tests for the $CMDB(1) program.
416 Options:
418 -a, --all
419 Run all tests, also TODOs.
420 -h, --help
421 Show this help.
422 -q, --quiet
423 Be more quiet. Can be repeated to increase silence.
424 -t, --todo
425 Run only the TODO tests.
426 -v, --verbose
427 Increase level of verbosity. Can be repeated.
428 --version
429 Print version information.
432 exit($Retval);
433 # }}}
434 } # usage()
436 sub msg {
437 # Print a status message to stderr based on verbosity level {{{
438 my ($verbose_level, $Txt) = @_;
440 $verbose_level > $Opt{'verbose'} && return;
441 print(STDERR "$progname: $Txt\n");
442 return;
443 # }}}
444 } # msg()
446 __END__
448 # This program is free software; you can redistribute it and/or modify
449 # it under the terms of the GNU General Public License as published by
450 # the Free Software Foundation; either version 2 of the License, or (at
451 # your option) any later version.
453 # This program is distributed in the hope that it will be useful, but
454 # WITHOUT ANY WARRANTY; without even the implied warranty of
455 # MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.
456 # See the GNU General Public License for more details.
458 # You should have received a copy of the GNU General Public License
459 # along with this program.
460 # If not, see L<http://www.gnu.org/licenses/>.
462 # vim: set fenc=UTF-8 ft=perl fdm=marker ts=4 sw=4 sts=4 et fo+=w :