Changeset 4832
- Timestamp:
- 06/19/05 07:28:00 (4 years ago)
- svk:copy_cache_prev:
- 6641
- Files:
-
- 9 modified
-
ext/Test-Builder/t/021_Test_Builder_Test_Pass.t (modified) (2 diffs)
-
ext/Test-Builder/t/022_Test_Builder_Test_Fail.t (modified) (2 diffs)
-
ext/Test-Builder/t/023_Test_Builder_Test_Skip.t (modified) (2 diffs)
-
ext/Test-Builder/t/024_Test_Builder_Test_TODO.t (modified) (3 diffs)
-
ext/Test-Builder/t/030_Test_Builder_Output.t (modified) (2 diffs)
-
ext/Test-Builder/t/040_Test_Builder_TestPlan.t (modified) (1 diff)
-
src/Pugs/Bind.hs (modified) (1 diff)
-
src/Pugs/Eval.hs (modified) (1 diff)
-
t/oo/attributes/instance.t (modified) (3 diffs)
Legend:
- Unmodified
- Added
- Removed
-
ext/Test-Builder/t/021_Test_Builder_Test_Pass.t
r4597 r4832 17 17 'new() should return a Test::Builder::Test::Pass instance' ); 18 18 19 is( $pass_test.number(), 1, 'number() should return the provided test number' , :todo<bug>);20 ok( $pass_test.passed(), 'passed() should report the right passed value' , :todo<bug>);19 is( $pass_test.number(), 1, 'number() should return the provided test number' ); 20 ok( $pass_test.passed(), 'passed() should report the right passed value' ); 21 21 is( $pass_test.description(), 'first test description', 22 'description() should report the test description' , :todo<bug>);22 'description() should report the test description' ); 23 23 is( $pass_test.diagnostic(), '???', 24 24 'diagnostic() should report the default diagnostic if needed' ); … … 32 32 33 33 is( $pass_diag.diagnostic(), 'some reason this passed', 34 '... or the provided diagnostic' , :todo<bug>);34 '... or the provided diagnostic' ); 35 35 36 36 is( $pass_test.report(), 'ok 1 - first test description', 37 'report() should produce the correct TAP line' , :todo<bug>);37 'report() should produce the correct TAP line' ); 38 38 39 39 my %status = $pass_test.status(); 40 40 is( +( keys %status ), 2, 'status() should return a hash' ); 41 is( %status<passed>, 1, '... with a passed key set to true' , :todo<bug>);41 is( %status<passed>, 1, '... with a passed key set to true' ); 42 42 is( %status<description>, 'first test description', 43 '... and the correct test description' , :todo<bug>);43 '... and the correct test description' ); -
ext/Test-Builder/t/022_Test_Builder_Test_Fail.t
r4597 r4832 17 17 'new() should return a Test::Builder::Test::Fail instance' ); 18 18 19 is( $fail_test.number(), 1, 'number() should return the provided test number' , :todo<bug>);19 is( $fail_test.number(), 1, 'number() should return the provided test number' ); 20 20 ok(!$fail_test.passed(), 'passed() should report the right passed value' ); 21 21 is( $fail_test.description(), 'first test description', 22 'description() should report the test description' , :todo<bug>);22 'description() should report the test description' ); 23 23 is( $fail_test.diagnostic(), '???', 24 24 'diagnostic() should report the default diagnostic if needed' ); … … 32 32 33 33 is( $fail_diag.diagnostic(), 'some reason this failed', 34 '... or the provided diagnostic' , :todo<bug>);34 '... or the provided diagnostic' ); 35 35 36 36 is( $fail_test.report(), 'not ok 1 - first test description', 37 'report() should produce the correct TAP line' , :todo<bug>);37 'report() should produce the correct TAP line' ); 38 38 39 39 my %status = $fail_test.status(); 40 40 is( +( keys %status ), 2, 'status() should return a hash' ); 41 is( %status<passed>, 0, '... with a passed key set to false' , :todo<bug>);41 is( %status<passed>, 0, '... with a passed key set to false' ); 42 42 is( %status<description>, 'first test description', 43 '... and the correct test description' , :todo<bug>);43 '... and the correct test description' ); -
ext/Test-Builder/t/023_Test_Builder_Test_Skip.t
r4604 r4832 18 18 'new() should return a Test::Builder::Test::Skip instance' ); 19 19 20 is( $skip_test.number(), 1, 'number() should return the test number' , :todo<bug>);21 ok( $skip_test.passed(), 'passed() should return the passed value' , :todo<bug>);20 is( $skip_test.number(), 1, 'number() should return the test number' ); 21 ok( $skip_test.passed(), 'passed() should return the passed value' ); 22 22 is( $skip_test.description(), 'first test description', 23 'description() should return the test description' , :todo<bug>);23 'description() should return the test description' ); 24 24 is( $skip_test.diagnostic(), '???', 25 25 'diagnostic() should return the default diagnostic if needed' ); … … 34 34 35 35 is( $skip_diag.diagnostic(), 'some diagnostic message', 36 '... but should return diagnostic if set' , :todo<bug>);36 '... but should return diagnostic if set' ); 37 37 38 38 is( $skip_test.reason(), 'reason for skipping', 39 'reason() should return the test reason' , :todo<bug>);39 'reason() should return the test reason' ); 40 40 41 41 is( $skip_test.report(), 'not ok 1 #skip reason for skipping', 42 'report() should return a TAP-formatted skip message' , :todo<bug>);42 'report() should return a TAP-formatted skip message' ); 43 43 44 44 my %status = $skip_test.status(); 45 45 46 46 is( +( keys %status ), 4, 'status() should return a hash') 47 is( %status<passed>, 1, '... with a passed key set to true' , :todo<bug>);47 is( %status<passed>, 1, '... with a passed key set to true'); 48 48 is( %status<skip>, 1, '... a skip key set to true' ); 49 49 50 is( %status<reason>, 'reason for skipping', '... the skip reason' , :todo<bug>);50 is( %status<reason>, 'reason for skipping', '... the skip reason' ); 51 51 is( %status<description>, 'first test description', 52 '... and the correct test description' , :todo<bug>);52 '... and the correct test description'); -
ext/Test-Builder/t/024_Test_Builder_Test_TODO.t
r4597 r4832 18 18 'new() should return a Test::Builder::Test::TODO instance' ); 19 19 20 is( $todo_test.number(), 1, 'number() should return the right test number' , :todo<bug>);21 ok( $todo_test.passed(), 'passed() should always be true' , :todo<bug>);20 is( $todo_test.number(), 1, 'number() should return the right test number' ); 21 ok( $todo_test.passed(), 'passed() should always be true' ); 22 22 is( $todo_test.description(), 'first test description', 23 'description() should return the test description' , :todo<bug>);23 'description() should return the test description' ); 24 24 is( $todo_test.diagnostic(), '???', 25 25 'diagnostic() should return the default diagnostic if needed' ); … … 33 33 ); 34 34 35 is( $todo_test.diagnostic(), 'some test diagnostic', 36 '... or the provided diagnostic', 37 :todo<feature> ); 35 is( $todo_diag.diagnostic(), 'some test diagnostic', 36 '... or the provided diagnostic' ); 38 37 39 38 is( $todo_test.reason(), 'reason for TODO-ing', 40 'reason() should return the test reason' , :todo<bug>);39 'reason() should return the test reason' ); 41 40 42 41 my %status = $todo_diag.status(); … … 47 46 48 47 is( %status<really_passed>, 0, 49 '... the really_passed key set to the passed value' , :todo<bug>);48 '... the really_passed key set to the passed value' ); 50 49 is( %status<description>, 'first test description', 51 '... and the correct test description' , :todo<bug>);50 '... and the correct test description' ); -
ext/Test-Builder/t/030_Test_Builder_Output.t
r4401 r4832 8 8 use Test::Builder::Output; 9 9 10 my $output = open("output",:w);11 my $error_output = open( "error_output", :w);10 my $output = open('output', :w); 11 my $error_output = open('error_output', :w); 12 12 13 my $ output= Test::Builder::Output.new(13 my $tbo = Test::Builder::Output.new( 14 14 output => $output, 15 15 error_output => $error_output, 16 ); 17 is($output.ref, 'Test::Builder::Output', '... this is a Test::Builder::Output instance'); 16 ); 18 17 19 # NOTE: 20 # the # needs to be removed, but right now 21 # it messed up Test::Harness too much 22 $output.write('#ok 1'); 23 $output.write('#ok 2'); 24 $output.write("#ok 3\ntesting"); 18 is( $tbo.ref, 'Test::Builder::Output', 19 'new() should return a Test::Builder::Output instance' ); 20 21 $tbo.write('ok 1'); 22 $tbo.write('ok 2'); 23 $tbo.write("ok 3\ntesting"); 24 25 $output.close(); 25 26 26 27 my $output_output = slurp('output'); 27 is($output_output, 28 "ok 1 29 ok 2 30 ok 3 31 #testing 32 ", '... got the right output', :todo<feature>); 28 is( $output_output, "ok 1\nok 2\nok 3\n#testing\n", 29 'write() should write to normal output, escaping newlines' ); 33 30 34 $output.diag('this is error output'); 35 $output.diag("this is error output\nover two lines"); 31 $tbo.diag('this is error output'); 32 $tbo.diag("this is error output\nover two lines"); 33 34 $error_output.close(); 36 35 37 36 my $error_output_output = slurp('error_output'); … … 39 38 "#this is error output 40 39 #this is error output 41 #over two lines 42 ", '... got the right error output', :todo<feature>);40 #over two lines\n", 41 'diag() should write to error output, escaping all output' ); 43 42 44 END { 45 unlink("output"); 46 unlink("error_output"); 43 END 44 { 45 unlink( 'output' ); 46 unlink( 'error_output' ); 47 47 } -
ext/Test-Builder/t/040_Test_Builder_TestPlan.t
r4597 r4832 4 4 use Test; 5 5 6 plan 10;6 plan 9; 7 7 8 8 use Test::Builder::TestPlan; 9 10 skip_rest; # XXX - just to get the test parsing for now11 exit;12 9 13 10 my $test_plan = Test::Builder::TestPlan.new(:expect(10)); 14 11 15 12 # NOTE: replace this with proper isa_ok() when that works 16 isa_ok($test_plan, Test::Builder::TestPlan, '... this is a Test::Builder::TestPlan instance'); 13 isa_ok( $test_plan, Test::Builder::TestPlan, 14 'new() should return a Test::Builder::TestPlan instance' ); 17 15 18 dies_ok { 19 $test_plan.expect(); 20 }, '... this property is private, so this should die'; 16 dies_ok { $test_plan.expect() }, 17 '$:expect is a private property, so expect() should die'; 21 18 22 dies_ok { 23 $test_plan.expect(100); 24 }, '... this property is private, so this should die'; 19 dies_ok { $test_plan.expect(100) }, '... as should expect( value )'; 25 20 26 is($test_plan.header(), '1..10', '... got the header we expected', :todo<bug>); 27 is($test_plan.footer(:run(10)), '', '... got the footer we expected :run(10)', :todo<bug>); 28 is($test_plan.footer(:run(8)), 'Expected 10 but ran 8', '... got the footer we expected :run(8)', :todo<bug>); 21 is( $test_plan.header(), '1..10', 'header() should return a valid header' ); 22 is( $test_plan.footer( :run(10) ), '', 23 'footer() should return nothing for running all expected tests' ); 24 is( $test_plan.footer( :run(8) ), 'Expected 10 but ran 8', 25 '... or a missing tests warning for running fewer' ); 29 26 30 27 my $null_test_plan = Test::Builder::NullPlan.new(); 31 28 32 is($null_test_plan.ref, 'Test::Builder::NullPlan', '... this is a Test::Builder::NullPlan instance'); 29 isa_ok( $null_test_plan, 'Test::Builder::NullPlan', 30 'new() should return a Test::Builder::NullPlan instance'); 33 31 34 is($null_test_plan.header(), '', '... null plans have no header'); 35 is($null_test_plan.footer(:run(50)), '1..50', '... got the footer we expected :run(50)'); 32 is( $null_test_plan.header(), '', 33 'header() should return an empty string for a null plan' ); 34 35 is( $null_test_plan.footer(:run(50)), '1..50', 36 'footer() should return the test header for a null plan'); -
src/Pugs/Bind.hs
r4158 r4832 39 39 (bound, exps') = foldr doBind ([], []) (map unPair exps) 40 40 doBind (name, exp) (bound, exps) 41 | Just prm <- find (( name ==) . tail. paramName) prms41 | Just prm <- find ((matchNamedAttribute name) . paramName) prms 42 42 = ( ((prm, exp) : bound), exps ) 43 43 | otherwise 44 44 = ( bound, (Syn "=>" [Val (VStr name), exp]:exps) ) 45 45 46 matchNamedAttribute :: String -> String -> Bool 47 matchNamedAttribute arg (_:'.':param) = param == arg 48 matchNamedAttribute arg (_:':':param) = param == arg 49 matchNamedAttribute arg (_:param) = param == arg 50 matchNamedAttribute _ _ = False 51 46 52 emptyHashExp :: Exp 47 53 emptyHashExp = Val $ VList [] -- VHash $ vCast $ VList [] 54 48 55 emptyArrayExp :: Exp 49 56 emptyArrayExp = Val $ VList [] -- VArray $ vCast $ VList [] -
src/Pugs/Eval.hs
r4573 r4832 827 827 f [ argValue arg | arg <- bound, (argName arg) /= "%_" ] 828 828 applyExp styp bound body = do 829 sequence_ [ evalExp 830 (Syn "=" [Syn "{}" [Val (argValue $ head bound), Val (VStr key)], Val val]) | 831 ApplyArg{ argName = (_:twigil:key), argValue = val } 832 <- bound, (twigil ==) `any` ".:" ] 833 applyThunk styp bound (MkThunk $ evalExp body) 829 let invocant = head bound 830 let (attrib, normal) = partition isAttrib bound 831 ret <- applyThunk styp normal (MkThunk $ evalExp body) 832 sequence_ [ evalExp (Syn "=" [Syn "{}" [Val (argValue invocant), Val (VStr key)], Val val]) | 833 ApplyArg{ argName = (_:_:key), argValue = val } <- attrib ] 834 return ret 835 836 isAttrib :: ApplyArg -> Bool 837 isAttrib ApplyArg{ argName = (_:'.':_) } = True 838 isAttrib ApplyArg{ argName = (_:':':_) } = True 839 isAttrib _ = False 834 840 835 841 applyThunk :: SubType -> [ApplyArg] -> VThunk -> Eval Val -
t/oo/attributes/instance.t
r4821 r4832 144 144 ok($foo ~~ Foo6, '... our Foo6 instance was created'); 145 145 146 is($foo.bar, 1, "getting a public rw attribute (1)" , :todo<bug>);147 is($foo.baz, 2, "getting a public rw attribute (2)" , :todo<bug>);148 is($foo.get_hidden, 3, "getting a private ro attribute (3)" , :todo<bug>);146 is($foo.bar, 1, "getting a public rw attribute (1)" ); 147 is($foo.baz, 2, "getting a public rw attribute (2)" ); 148 is($foo.get_hidden, 3, "getting a private ro attribute (3)" ); 149 149 } 150 150 … … 165 165 ok($foo ~~ Foo6a, '... our Foo6a instance was created'); 166 166 167 is($foo.bar, 1, "getting a public rw attribute (1)" , :todo<bug>);168 is($foo.baz, 5, "getting a public rw attribute (2)" );169 is($foo.get_hidden, 3, "getting a private ro attribute (3)" , :todo<bug>);167 is($foo.bar, 1, "getting a public rw attribute (1)" ); 168 is($foo.baz, 5, "getting a public rw attribute (2)" ); 169 is($foo.get_hidden, 3, "getting a private ro attribute (3)" ); 170 170 } 171 171 … … 226 226 $foo7 = Foo7.new( :bar(4), :baz(5) ); 227 227 is( $foo7.bar, 4, 228 'optional attribute should take passed-in value over default' , :todo<bug>);228 'optional attribute should take passed-in value over default' ); 229 229 is( $foo7.baz, 10, 230 230 '... optional non-attribute should too' );
