Find file
Fetching contributors…
Cannot retrieve contributors at this time
550 lines (414 sloc) 11.4 KB
#!./parrot
# Copyright (C) 2001-2010, Parrot Foundation.
=head1 NAME
t/library/getopt_obj.t - testing the PIR module Getopt::Obj
=head1 SYNOPSIS
% prove t/library/getopt_obj.t
=head1 DESCRIPTION
This test program tries to handle command line arguments with the
module F<runtime/parrot/library/Getopt/Obj.pir>.
=cut
.sub main :main
.include 'test_more.pir'
load_bytecode "Getopt/Obj.pbc"
plan(49)
test_basic_long_options()
test_basic_short_options()
test_simple_array()
test_mixing_long_and_short_with_array()
test_hash()
test_bundling_short_options()
test_ignored_options()
test_double_dash_stop()
test_notOptStop()
test_optarg()
test_pass_through()
test_lone_dash()
test_push_interface()
test_missing_spec()
test_missing_argument()
.end
# 1
.sub test_basic_long_options
.local pmc argv
argv = new 'ResizablePMCArray'
push argv, '--foo=bar'
push argv, '--bar=3.14'
push argv, '--bax=3'
push argv, '--baz'
push argv, '--quux'
push argv, 'frobz'
.local pmc getopts
getopts = new ['Getopt';'Obj']
$P0 = getopts."add"()
$P0."long"("foo")
$P0."type"('String')
$P0 = getopts."add"()
$P0."long"("bar")
$P0."type"('Float')
$P0 = getopts."add"()
$P0."long"("bax")
$P0."type"('Integer')
$P0 = getopts."add"()
$P0."long"("baz")
$P0 = getopts."add"()
$P0."long"("quux")
$P0."type"("String")
$P0.'optarg'(0)
$P1 = getopts."get_options"(argv)
$S0 = $P1["foo"]
is($S0, 'bar', 'basic long options')
$S0 = $P1["bar"]
is($S0, 3.14, 'basic long options')
$S0 = $P1["bax"]
is($S0, 3, 'basic long options')
$S0 = $P1["baz"]
is($S0, 1, 'basic long options')
$S0 = $P1["quux"]
is($S0, 'frobz', 'basic long options')
.end
# 2
.sub test_basic_short_options
.local pmc argv
argv = new 'ResizablePMCArray'
push argv, '-f'
push argv, 'bar'
push argv, '-Abc'
push argv, '-c'
.local pmc getopts
getopts = new ['Getopt';'Obj']
$P0 = getopts."add"()
$P0."short"("f")
$P0."type"('String')
$P0 = getopts."add"()
$P0."short"("A")
$P0."type"('String')
$P0 = getopts."add"()
$P0."short"("c")
$P1 = getopts."get_options"(argv)
$S0 = $P1["f"]
is($S0, 'bar', 'basic short options')
$S0 = $P1["A"]
is($S0, 'bc', 'basic short options')
$S0 = $P1["c"]
is($S0, '1', 'basic short options')
.end
# 3
.sub test_simple_array
.local pmc argv
argv = new 'ResizablePMCArray'
push argv, '-Iinca'
push argv, '-Iincb'
.local pmc getopts
getopts = new ['Getopt';'Obj']
$P0 = getopts."add"()
$P0."short"("I")
$P0."type"('Array')
$P1 = getopts."get_options"(argv)
$S0 = $P1["I";0]
is($S0, 'inca', 'simple array')
$S0 = $P1["I";1]
is($S0, 'incb', 'simple array')
.end
# 4
.sub test_mixing_long_and_short_with_array
.local pmc argv
argv = new 'ResizablePMCArray'
push argv, '-Iinca'
push argv, '--include=incb'
.local pmc getopts
getopts = new ['Getopt';'Obj']
$P0 = getopts."add"()
$P0."long"("include")
$P0."short"("I")
$P0."type"('Array')
$P1 = getopts."get_options"(argv)
$S0 = $P1["include";0]
is($S0, 'inca', 'mixing long and short with array')
$S0 = $P1["include";1]
is($S0, 'incb', 'mixing long and short with array')
.end
# 5
.sub test_hash
.local pmc argv
argv = new 'ResizablePMCArray'
push argv, '-Dfoo=bar'
push argv, '--define=bax=baz'
push argv, '-Dfoobar'
.local pmc getopts
getopts = new ['Getopt';'Obj']
$P0 = getopts."add"()
$P0."long"("define")
$P0."short"("D")
$P0."type"('Hash')
$P1 = getopts."get_options"(argv)
$S0 = $P1["define";"foo"]
is($S0, 'bar', 'hash')
$S0 = $P1["define";"bax"]
is($S0, 'baz', 'hash')
$S0 = $P1["define";"foobar"]
is($S0, 1, 'hash')
.end
# 6
.sub test_bundling_short_options
.local pmc argv
argv = new 'ResizablePMCArray'
push argv, '-abc'
.local pmc getopts
getopts = new ['Getopt';'Obj']
$P0 = getopts."add"()
$P0."short"("a")
$P0 = getopts."add"()
$P0."short"("b")
$P0 = getopts."add"()
$P0."short"("c")
$P1 = getopts."get_options"(argv)
$S0 = $P1["a"]
is($S0, 1, 'bundling short options')
$S0 = $P1["b"]
is($S0, 1, 'bundling short options')
$S0 = $P1["c"]
is($S0, 1, 'bundling short options')
.end
# 7
.sub test_ignored_options
.local pmc argv
argv = new 'ResizablePMCArray'
push argv, '--ignore'
push argv, '--foo'
.local pmc getopts
getopts = new ['Getopt';'Obj']
getopts."notOptStop"(1)
$P0 = getopts."add"()
$P0."long"("foo")
$P1 = getopts."get_options"(argv)
$S0 = $P1["foo"]
is($S0, '1', 'ignored options')
$S0 = argv[0]
is($S0, '--ignore', 'ignored options')
.end
# 8
.sub test_double_dash_stop
.local pmc argv
argv = new 'ResizablePMCArray'
push argv, '--foo'
push argv, '--'
push argv, '--bar'
.local pmc getopts
getopts = new ['Getopt';'Obj']
$P0 = getopts."add"()
$P0."long"("foo")
$P0 = getopts."add"()
$P0."long"("bar")
$P1 = getopts."get_options"(argv)
$S0 = $P1["foo"]
is($S0, 1, 'double dash stop')
# Hash sets an nonexistent value to ''
$S0 = $P1["bar"]
is($S0, '', 'double dash stop')
$S0 = argv[0]
is($S0, '--bar', 'double dash stop')
.end
# 9
.sub test_notOptStop
.local pmc argv
argv = new 'ResizablePMCArray'
push argv, '--foo'
push argv, 'foo'
push argv, '--bar'
.local pmc getopts
getopts = new ['Getopt';'Obj']
getopts."notOptStop"(1)
$P0 = getopts."add"()
$P0."long"("foo")
$P0 = getopts."add"()
$P0."long"("bar")
$P1 = getopts."get_options"(argv)
$S0 = $P1["foo"]
is($S0, 1, 'notOptStop')
$S0 = $P1["bar"]
is($S0, '', 'notOptStop')
$S0 = argv[0]
is($S0, 'foo', 'notOptStop')
$S0 = argv[1]
is($S0, '--bar', 'notOptStop')
.end
# 10
.sub test_optarg
.local pmc argv
argv = new 'ResizablePMCArray'
push argv, '--foo'
push argv, '-f'
push argv, '-bbar'
.local pmc getopts
getopts = new ['Getopt';'Obj']
getopts."notOptStop"(1)
$P0 = getopts."add"()
$P0."long"("foo")
$P0."optarg"(1)
$P0."type"('String')
$P0 = getopts."add"()
$P0."short"("f")
$P0."optarg"(1)
$P0."type"('String')
$P0 = getopts."add"()
$P0."short"("b")
$P0."optarg"(1)
$P0."type"('String')
$P1 = getopts."get_options"(argv)
$S0 = $P1["foo"]
is($S0, '', 'optarg')
$S0 = $P1["f"]
is($S0, '', 'optarg')
$S0 = $P1["b"]
is($S0, 'bar', 'optarg')
.end
# 11
.sub test_pass_through
.local pmc argv
argv = new 'ResizablePMCArray'
push argv, '--foo'
push argv, 'foo'
push argv, '--bar'
push argv, 'bar'
.local pmc getopts
getopts = new ['Getopt';'Obj']
$P0 = getopts."add"()
$P0."long"("foo")
$P0 = getopts."add"()
$P0."long"("bar")
$P1 = getopts."get_options"(argv)
$S0 = $P1["foo"]
is($S0, 1, 'pass through')
$S0 = $P1["bar"]
is($S0, 1, 'pass through')
$S0 = argv[0]
is($S0, 'foo', 'pass through')
$S0 = argv[1]
is($S0, 'bar', 'pass through')
.end
# 12
.sub test_lone_dash
.local pmc argv
argv = new 'ResizablePMCArray'
push argv, '--foo'
push argv, '-'
push argv, '--bar'
.local pmc getopts
getopts = new ['Getopt';'Obj']
$P0 = getopts."add"()
$P0."long"("foo")
$P0 = getopts."add"()
$P0."long"("bar")
$P1 = getopts."get_options"(argv)
$S0 = $P1["foo"]
is($S0, 1, 'lone dash')
$S0 = $P1["bar"]
is($S0, 1, 'lone dash')
$S0 = argv[0]
is($S0, '-', 'lone dash')
.end
# 13
.sub test_push_interface
.local pmc argv
argv = new 'ResizablePMCArray'
push argv, '--foo=file'
push argv, '-bfile.txt'
push argv, '-x'
push argv, 'file.t'
push argv, '-z'
push argv, 'text'
push argv, '-I'
push argv, 'texta'
push argv, '-I'
push argv, 'textb'
push argv, '-Dfoo=bar'
push argv, '--define=bax=baz'
push argv, '-Dfoobar'
.local pmc getopts
getopts = new ['Getopt';'Obj']
push getopts, 'foo=s'
push getopts, 'bar|b=s'
push getopts, 'bax|x=s'
push getopts, 'baz|z:s'
push getopts, 'I=@'
push getopts, 'define|D:%'
$P1 = getopts."get_options"(argv)
$S0 = $P1["foo"]
is($S0, 'file', 'push interface')
$S0 = $P1["bar"]
is($S0, 'file.txt', 'push interface')
$S0 = $P1["bax"]
is($S0, 'file.t', 'push interface')
$S0 = $P1["baz"]
is($S0, '', 'push interface')
$S0 = $P1["I";0]
is($S0, 'texta', 'push interface')
$S0 = $P1["I";1]
is($S0, 'textb', 'push interface')
$S0 = $P1["define";"foo"]
is($S0, 'bar', 'push interface')
$S0 = $P1["define";"bax"]
is($S0, 'baz', 'push interface')
$S0 = $P1["define";"foobar"]
is($S0, 1, 'push interface')
$S0 = argv[0]
is($S0, 'text', 'push interface')
.end
# 14
.sub test_missing_spec
dies_ok(<<'CODE', 'missing_spec')
.sub main :main
.local pmc argv
argv = new 'ResizablePMCArray'
push argv, '--foo=file'
load_bytecode "Getopt/Obj.pbc"
.local pmc getopts
getopts = new ['Getopt';'Obj']
$P1 = getopts."get_options"(argv)
$S0 = $P1["foo"]
print "foo is "
print $S0
print "\n"
$S0 = argv[0]
print "argv[0] is "
print $S0
print "\n"
.end
CODE
.end
# 15
.sub test_missing_argument
dies_ok(<<'CODE', "missing argument")
.sub main :main
.local pmc argv
argv = new 'ResizablePMCArray'
push argv, '--foo=file'
push argv, '--bar'
load_bytecode "Getopt/Obj.pbc"
.local pmc getopts
getopts = new ['Getopt';'Obj']
push getopts, 'foo=s'
push getopts, 'bar=s'
$P1 = getopts."get_options"(argv)
$S0 = $P1["foo"]
print "foo is "
print $S0
print "\n"
$S0 = argv[0]
print "argv[0] is "
print $S0
print "\n"
.end
CODE
.end
=head1 AUTHOR
Joshua Isom - C<loneowl@ritalin.shout.net>
=head1 SEE ALSO
F<runtime/parrot/library/Getopt/Obj.pir>
=cut
# Local Variables:
# mode: pir
# fill-column: 100
# End:
# vim: expandtab shiftwidth=4 ft=pir: