Changeset 5008

Timestamp:

06/26/05 19:19:20 (4 years ago)

Author:

iblech

svk:copy_cache_prev:

6856

Message:

Syntax but ($obj but {...}).
* t/oo/syntax-but.t -- Fixed test.
* Prelude -- Added Pugs::Internals helper sub.
* Pugs.Eval -- Implemented syntax but in the interpreter core...
* Pugs.Compile -- ...and in the compiler part of Pugs.

Files:

• src/Pugs/Compile.hs (modified) (1 diff)
• src/Pugs/Eval.hs (modified) (1 diff)
• src/perl6/Prelude.pm (modified) (1 diff)
• t/oo/syntax-but.t (modified) (1 diff)

src/Pugs/Compile.hs

@@ -342 +342 @@
         let op = "&infix:" ++ init syn
         compile $ Syn "=" [lhs, App (Var op) Nothing [lhs, exp]]
+    compile (Syn "but" [obj, block]) =
+        compile $ App (Var "&Pugs::Internals::but_block") Nothing [obj, block]
     compile exp = compError exp
 

src/Pugs/Eval.hs

@@ -339 +339 @@
         , subCont = cont
         }
+
+reduceSyn "but" [obj, block] = do
+    evalExp $ App (Var "&Pugs::Internals::but_block") Nothing [obj, block]
 
 reduceSyn name [cond, bodyIf, bodyElse]

src/perl6/Prelude.pm

@@ -181 +181 @@
     $ret;
 }
+
+sub Pugs::Internals::but_block ($obj, Code $code) {
+    $code($obj);
+    $obj;
+}

t/oo/syntax-but.t

@@ -17 +17 @@
 #   };
 
-plan 4;
+plan 7;
 
-class SampleClass { has $.var }
-
+# Without an own class
 {
   my $was_in_but_block;
   my $topic_in_but_block;
 
-  my $obj = eval 'SampleClass.new but {
+  my $num = 3 but {
     $was_in_but_block++;
-    $topic_in_but_block++;
+    $topic_in_but_block = $_;
+    23;
+  };
+
+  is $num,                3, "syntax but worked on a literal";
+  ok $was_in_but_block,      "syntax but on a literal was executed";
+  is $topic_in_but_block, 3, "topic in syntax but on a literal was correct";
+}
+
+# With an own class
+{
+  class SampleClass { has $.attr }
+
+  my $was_in_but_block;
+  my $topic_in_but_block;
+
+  my $obj = SampleClass.new but {
+    $was_in_but_block++;
+    $topic_in_but_block = $_;
     .attr = 42;
     23;
-  }';
+  };
 
   ok $was_in_but_block, 'syntax but ($obj but {...}) was executed';
   cmp_ok $topic_in_but_block, &infix:<=:=>, $obj,
     'topic in syntax but ($obj but {...}) was correct';
-  is try { $obj.attr }, 42, "attribute setting worked correctly in syntax but";
-  cmp_ok $obj, &infix:<!=>, 23, "syntax but returned the original object";
+  my $attr = try { $obj.attr };
+  is $attr, 42, "attribute setting worked correctly in syntax but";
+  cmp_ok $obj, &infix:<~~>, SampleClass, "syntax but returned the original object";
 }