Author: coke Date: Mon Apr 30 20:39:25 2007 New Revision: 18364 Modified: trunk/ (props changed) trunk/runtime/parrot/library/Range.pir trunk/t/library/range.t
Log: [library] * implement Range.'reversed'() * add more tests. Modified: trunk/runtime/parrot/library/Range.pir ============================================================================== --- trunk/runtime/parrot/library/Range.pir (original) +++ trunk/runtime/parrot/library/Range.pir Mon Apr 30 20:39:25 2007 @@ -1,12 +1,17 @@ =head1 Range -http://perlcabal.org/syn/S03.html#Range_semantics +Based on the Range object described in S03: +L<http://perlcabal.org/syn/S03.html#Range_semantics> =cut .HLL 'parrot', '' .namespace [ 'Range' ] +=head1 macros + +=cut + .macro exhausted_check() .sym pmc exhausted exhausted = getattribute self, 'exhausted' @@ -25,46 +30,74 @@ setattribute self, 'exhausted', exhausted .endm +=head1 :load + +Create the class, with attributes, when this PBC is loaded. -.sub __class_init :anon :load +=cut + +.sub class_init :anon :load $P1 = newclass 'Range' addattribute $P1, 'from' addattribute $P1, 'to' addattribute $P1, 'by' - addattribute $P1, 'reversed' addattribute $P1, 'exhausted' .end -# XXX :method is only specified here so we can get 'self' +# RT#42430 +# :method is only specified here so we can get 'self' + +=head1 :vtable + +=head2 init + +Set some defaults for our attributes. + +=cut + .sub 'init' :vtable :method $P1 = new 'Integer' $P1 = 1 setattribute self, 'by', $P1 $P1 = new 'Boolean' $P1 = 0 - setattribute self, 'reversed', $P1 - $P1 = new 'Boolean' - $P1 = 0 setattribute self, 'exhausted', $P1 .end +=head1 :method + +=head2 get_from + +Return the from attribute + +=cut -# XXX handle reversed. .sub get_from :method .local pmc from from = getattribute self, 'from' .return (from) .end -# XXX handle reversed. +=head2 get_to + +Return the to attribute + +=cut + .sub get_to :method .local pmc to to = getattribute self, 'to' .return (to) .end +=head2 get_min + +Return the min attribute + +=cut + # XXX handle reversed. .sub get_min :method .local pmc from @@ -72,6 +105,12 @@ .return (from) .end +=head2 get_max + +Return the max attribute + +=cut + # XXX handle reversed. .sub get_max :method .local pmc to @@ -79,6 +118,12 @@ .return (to) .end +=head2 get_minmax + +Return the min and max attributes as a 2 element list. + +=cut + .sub get_minmax :method $P1 = new .Array $P1 = 2 @@ -90,6 +135,14 @@ .return ($P1) .end +=head2 shift + +shift a value off the "front" of the range. + +Throw an exception if we're out of values. + +=cut + .sub shift :method .exhausted_check() @@ -97,15 +150,30 @@ from = getattribute self, 'from' to = getattribute self, 'to' by = getattribute self, 'by' + $P0 = clone from $P0 += by setattribute self, 'from', $P0 + + if by < 0 goto neg if $P0 <= to goto done + goto exhaust +neg: + if $P0 >= to goto done +exhaust: .exhausted() done: .return (from) .end +=head2 pop + +pop a value off the "end" of the range. + +Throw an exception if we're out of values. + +=cut + .sub pop :method .exhausted_check() # can we pull a number off the end? @@ -118,17 +186,34 @@ $P0 = clone to $P0 -= by setattribute self, 'to', $P0 - if $P0 >= from goto done + + if by < 0 goto neg + if $P0 >= from goto done + goto exhaust +neg: + if $P0 <= from goto done +exhaust: .exhausted() done: .return (to) .end +=head2 + +Reverse the direction of the range. + +=cut + .sub reverse :method - .local pmc reversed - reversed = getattribute self, 'reversed' - reversed = not reversed - setattribute self, 'reversed', reversed + .local pmc from, to, by + from = getattribute self, 'from' + to = getattribute self, 'to' + setattribute self, 'from', to + setattribute self, 'to', from + + by = getattribute self, 'by' + by = neg by + setattribute self, 'by', by .return(self) .end Modified: trunk/t/library/range.t ============================================================================== --- trunk/t/library/range.t (original) +++ trunk/t/library/range.t Mon Apr 30 20:39:25 2007 @@ -4,11 +4,11 @@ =head1 NAME -range.t +t/library/range.t =head1 SYNOPSIS - % prove range.t + % prove t/library/range.t =head1 DESCRIPTION @@ -30,11 +30,26 @@ load_bytecode 'Range.pir' # XXX eventually convert to pbc. - plan(5) + plan(46) # XXX Convert this to the PDD15 way of creating an object # at the same time you specify the attributes... + test_1() # 5 tests + test_2() # 5 tests + test_3() # 5 tests + test_4() # 5 tests + test_5() # 5 tests + test_6() # 5 tests + test_7() # 4 tests + test_8() # 6 tests + test_9() # 6 tests +.end + +.sub 'test_1' + .local string test_desc + test_desc = "1..3, shift until exhausted" + $P0 = new 'Range' $P1 = new 'Integer' $P1 = 1 @@ -42,7 +57,7 @@ $P1 = new 'Integer' $P1 = 3 setattribute $P0, 'to', $P1 - ok(1, 'Created new range') + ok(1, test_desc) $I0 = $P0.'shift'() is($I0, 1, '1 - 1st') $I0 = $P0.'shift'() @@ -50,21 +65,300 @@ $I0 = $P0.'shift'() is($I0, 3, '1 - 3rd') - push_eh test_1_catch + push_eh catch $I0 = $P0.'shift'() ok(0,'1 - exhausted') - goto test_2 + goto finally + clear_eh + +catch: + # XXX should have more thorough exception check + ok(1,'1 - exhausted') + +finally: + .return() +.end + + +.sub 'test_2' + .local string test_desc + test_desc = "-1..3:by(2), shift until exhausted" + $P0 = new 'Range' + $P1 = new 'Integer' + $P1 = -1 + setattribute $P0, 'from', $P1 + $P1 = new 'Integer' + $P1 = 3 + setattribute $P0, 'to', $P1 + $P1 = new 'Integer' + $P1 = 2 + setattribute $P0, 'by', $P1 + + ok(1, test_desc) + $I0 = $P0.'shift'() + is($I0, -1, '2 - 1st') + $I0 = $P0.'shift'() + is($I0, 1, '2 - 2nd') + $I0 = $P0.'shift'() + is($I0, 3, '2 - 3rd') + + push_eh catch + $I0 = $P0.'shift'() + ok(0,'2 - exhausted') + goto finally + clear_eh + +catch: + # XXX should have more thorough exception check + ok(1,'2 - exhausted') + +finally: + .return() +.end + +.sub 'test_3' + .local string test_desc + test_desc = "-1..4:by(2), shift until exhausted" + $P0 = new 'Range' + $P1 = new 'Integer' + $P1 = -1 + setattribute $P0, 'from', $P1 + $P1 = new 'Integer' + $P1 = 4 + setattribute $P0, 'to', $P1 + $P1 = new 'Integer' + $P1 = 2 + setattribute $P0, 'by', $P1 + + ok(1, test_desc) + $I0 = $P0.'shift'() + is($I0, -1, '3 - 1st') + $I0 = $P0.'shift'() + is($I0, 1, '3 - 2nd') + $I0 = $P0.'shift'() + is($I0, 3, '3 - 3rd') + + push_eh catch + $I0 = $P0.'shift'() + ok(0,'3 - exhausted') + goto finally + clear_eh + +catch: + # XXX should have more thorough exception check + ok(1,'3 - exhausted') + +finally: + .return() +.end + +.sub 'test_4' + .local string test_desc + test_desc = "1..3, pop until exhausted" + + $P0 = new 'Range' + $P1 = new 'Integer' + $P1 = 1 + setattribute $P0, 'from', $P1 + $P1 = new 'Integer' + $P1 = 3 + setattribute $P0, 'to', $P1 + ok(1, test_desc) + $I0 = $P0.'pop'() + is($I0, 3, '4 - 1st') + $I0 = $P0.'pop'() + is($I0, 2, '4 - 2nd') + $I0 = $P0.'pop'() + is($I0, 1, '4 - 3rd') + + push_eh catch + $I0 = $P0.'pop'() + ok(0,'4 - exhausted') + goto finally + clear_eh + +catch: + # XXX should have more thorough exception check + ok(1,'4 - exhausted') + +finally: + .return() +.end + +.sub 'test_5' + .local string test_desc + test_desc = "-1..3:by(2), pop until exhausted" + $P0 = new 'Range' + $P1 = new 'Integer' + $P1 = -1 + setattribute $P0, 'from', $P1 + $P1 = new 'Integer' + $P1 = 3 + setattribute $P0, 'to', $P1 + $P1 = new 'Integer' + $P1 = 2 + setattribute $P0, 'by', $P1 + + ok(1, test_desc) + $I0 = $P0.'pop'() + is($I0, 3, '5 - 1st') + $I0 = $P0.'pop'() + is($I0, 1, '5 - 2nd') + $I0 = $P0.'pop'() + is($I0, -1, '5 - 3rd') + + push_eh catch + $I0 = $P0.'pop'() + ok(0,'5 - exhausted') + goto finally + clear_eh + +catch: + # XXX should have more thorough exception check + ok(1,'5 - exhausted') + +finally: + .return() +.end + +.sub 'test_6' + .local string test_desc + test_desc = "-1..4:by(2), pop until exhausted" + $P0 = new 'Range' + $P1 = new 'Integer' + $P1 = -1 + setattribute $P0, 'from', $P1 + $P1 = new 'Integer' + $P1 = 4 + setattribute $P0, 'to', $P1 + $P1 = new 'Integer' + $P1 = 2 + setattribute $P0, 'by', $P1 + + ok(1, test_desc) + $I0 = $P0.'pop'() + is($I0, 4, '6 - 1st') + $I0 = $P0.'pop'() + is($I0, 2, '6 - 2nd') + $I0 = $P0.'pop'() + is($I0, 0, '6 - 3rd') + + push_eh catch + $I0 = $P0.'pop'() + ok(0,'6 - exhausted') + goto finally + clear_eh + +catch: + # XXX should have more thorough exception check + ok(1,'6 - exhausted') + +finally: + .return() +.end + +.sub 'test_7' + .local string test_desc + test_desc = "1..42.5, shift & pop" + $P0 = new 'Range' + $P1 = new 'Integer' + $P1 = 1 + setattribute $P0, 'from', $P1 + $P1 = new 'Integer' + $P1 = 42.5 + setattribute $P0, 'to', $P1 + + ok(1, test_desc) + $N0 = $P0.'shift'() + is($N0, 1, '7 - 1st') + $N0 = $P0.'pop'() + is($N0, 42.5, '7 - last') + + $N0 = $P0.'get_from'() + is($N0, 2, '7 - from') + + $N0 = $P0.'get_to'() + is($N0, 41.5, '7 - to') + +finally: + .return() +.end + +.sub 'test_8' + .local string test_desc + test_desc = "1..3, reverse, shift until exhausted" + + $P0 = new 'Range' + $P1 = new 'Integer' + $P1 = 1 + setattribute $P0, 'from', $P1 + $P1 = new 'Integer' + $P1 = 3 + setattribute $P0, 'to', $P1 + ok(1, test_desc) + + $P0.'reverse'() + ok(1, '8 - reversed') + + $I0 = $P0.'shift'() + is($I0, 3, '8 - 1st') + $I0 = $P0.'shift'() + is($I0, 2, '8 - 2nd') + $I0 = $P0.'shift'() + is($I0, 1, '8 - 3rd') + + push_eh catch + $I0 = $P0.'shift'() + ok(0,'8 - exhausted') + goto finally clear_eh -test_1_catch: +catch: # XXX should have more thorough exception check - ok(1,'1 - exhuasted') + ok(1,'8 - exhausted') -test_2: - +finally: + .return() +.end + +.sub 'test_9' + .local string test_desc + test_desc = "1..3, reverse, pop until exhausted" + + $P0 = new 'Range' + $P1 = new 'Integer' + $P1 = 1 + setattribute $P0, 'from', $P1 + $P1 = new 'Integer' + $P1 = 3 + setattribute $P0, 'to', $P1 + ok(1, test_desc) + + $P0.'reverse'() + ok(1, '9 - reversed') + + $I0 = $P0.'pop'() + is($I0, 1, '9 - 1st') + $I0 = $P0.'pop'() + is($I0, 2, '9 - 2nd') + $I0 = $P0.'pop'() + is($I0, 3, '9 - 3rd') + + push_eh catch + $I0 = $P0.'pop'() + ok(0,'9 - exhausted') + goto finally + clear_eh + +catch: + # XXX should have more thorough exception check + ok(1,'9 - exhausted') +finally: + .return() .end + # Local Variables: # mode: cperl # cperl-indent-level: 4
