[Bps-public-commit] r12628 - in pie/branches/named-params: lib/PIE

jesse at bestpractical.com jesse at bestpractical.com
Fri May 23 02:10:34 EDT 2008


Author: jesse
Date: Fri May 23 02:10:33 2008
New Revision: 12628

Modified:
   pie/branches/named-params/lib/PIE/Builder.pm
   pie/branches/named-params/lib/PIE/Evaluator.pm
   pie/branches/named-params/t/01basic.t

Log:
now we actually fail the test for a good reason. our return value stack is leaky


Modified: pie/branches/named-params/lib/PIE/Builder.pm
==============================================================================
--- pie/branches/named-params/lib/PIE/Builder.pm	(original)
+++ pie/branches/named-params/lib/PIE/Builder.pm	Fri May 23 02:10:33 2008
@@ -10,12 +10,13 @@
 sub build_op_expression {
     my ($self, $name, $args) = @_;
     my $class = "PIE::Expression::$name";
-    if ($class->require) {
+    $class->require;
+    if($class->can('meta')){
         die unless $class->meta->does_role("PIE::Evaluatable");
-        $class->new( map { $_ => $self->build_expression( $args->{$_} ) } keys %$args );
+        return    $class->new( map { $_ => $self->build_expression( $args->{$_} ) } keys %$args );
     }
     else {
-        PIE::Expression->new( name => $name, args => { map { $_ => $self->build_expression( $args->{$_} ) } keys %$args } );
+        return PIE::Expression->new( name => $name, args => { map { $_ => $self->build_expression( $args->{$_} ) } keys %$args } );
     }
 }
 

Modified: pie/branches/named-params/lib/PIE/Evaluator.pm
==============================================================================
--- pie/branches/named-params/lib/PIE/Evaluator.pm	(original)
+++ pie/branches/named-params/lib/PIE/Evaluator.pm	Fri May 23 02:10:33 2008
@@ -22,17 +22,19 @@
              });
 
 sub run {
-    my $self = shift;
+    my $self       = shift;
     my $expression = shift;
-    eval { 
-    my $ret = $expression->evaluate($self);
-    $self->result->value($ret) ; # XXX TODO - we should be separating out success and value
-    $self->result->success(1);
+    eval {
+        my $ret = $expression->evaluate($self);
+        $self->result->value($ret);
+        $self->result->success(1);
     };
-    if (my $err = $@) {
-#        die $err; # for now
-    
+    if ( my $err = $@ ) {
+
+        #        die $err; # for now
+
         $self->result->success(0);
+        $self->result->value(undef);
         $self->result->error($err);
     }
 

Modified: pie/branches/named-params/t/01basic.t
==============================================================================
--- pie/branches/named-params/t/01basic.t	(original)
+++ pie/branches/named-params/t/01basic.t	Fri May 23 02:10:33 2008
@@ -50,14 +50,14 @@
 );
 
 my $eval7 = PIE::Evaluator->new();
-$eval7->apply_script($script);
+$eval7->apply_script_named_args($script, {} );
 ok( $eval7->result->success );
 ok( $eval7->result->value );
 
 my $script2 = PIE::Lambda->new( nodes => [$if_true] );
 
 my $eval8 = PIE::Evaluator->new();
-$eval8->apply_script($script2);
+$eval8->apply_script_named_args($script2, {});
 ok( $eval8->result->success );
 ok( $eval8->result->value );
 
@@ -69,53 +69,35 @@
         my $arg    = $args{'tested-string'};
         my $regexp = $args{'regexp'};
 
-        return $arg =~ m/$regexp/;
+        return ($arg =~ m/$regexp/ )? 1 : 0;
     },
 
     args => {
-        'tested-string' => PIE::FunctionArgument->new(
-            name => 'tested-string' => type => 'Str'
-        ),
+        'tested-string' => PIE::FunctionArgument->new( name => 'tested-string' => type => 'Str'),
         'regex' => PIE::FunctionArgument->new( name => 'regex', type => 'Str' )
         }
 
 );
 
 $eval9->set_named( 'match-regexp' => $MATCH_REGEX );
-
-my $match_script = PIE::Lambda->new(
-    nodes => [ PIE::Expression->new( name => 'match-regexp' ) ],
-    args  => {
-        'tested-string' => PIE::FunctionArgument->new(
-            name => 'tested-string',
-            type => 'Str'
-        ),
-        'regex' =>
-            PIE::FunctionArgument->new( name => 'regex', type => 'Regex' )
-    }
-);
-
 $eval9->apply_script_named_args(
-    $match_script,
-    {   'tested-string' =>
-            PIE::Expression::String->new( value => 'I do love hardware' ),
+    $MATCH_REGEX, 
+    {   'tested-string' => PIE::Expression::String->new( value => 'I do love software' ),
         'regex' => PIE::Expression::String->new( value => 'software' )
     }
 );
 
 ok( $eval9->result->success );
-
 is( $eval9->result->value, 1 );
-my $builder = PIE::Builder->new();
-
-#use YAML;
 
+my $builder = PIE::Builder->new();
 my $eval10 = PIE::Evaluator->new();
 $eval10->set_named( 'match-regexp' => $MATCH_REGEX );
 
 $eval10->apply_script_named_args(
     $builder->defun(
-        ops => [ { name => 'IfThen',
+        ops => [
+            {   name => 'IfThen',
                 args => {
                     'if_true'   => 'hate',
                     'if_false'  => 'love',
@@ -124,11 +106,15 @@
                         args => {
                             regex           => 'software',
                             'tested-string' => 'foo',
-                            } } } } ],
+                        }
+                    }
+                }
+            }
+        ],
         args => {},
     ),
     {},
 );
-ok( $eval10->result->success );
-is( $eval10->result->value, ' love ' );
+ok( $eval10->result->success, " Did not get an error: ".$eval10->result->error );
+is( $eval10->result->value, 'love' );
 



More information about the Bps-public-commit mailing list