[svn:parrot] r34763 - in trunk/languages/pipp: src/pct t/php

[bernhard]

Author: bernhard
Date: Thu Jan  1 13:27:02 2009
New Revision: 34763

Modified:
   trunk/languages/pipp/src/pct/actions.pm
   trunk/languages/pipp/t/php/oo.t

Log:
[Pipp] Call __construct of the Class if available.
Add a TODO test case for the global section returning a PippObject.


Modified: trunk/languages/pipp/src/pct/actions.pm
==============================================================================
--- trunk/languages/pipp/src/pct/actions.pm     (original)
+++ trunk/languages/pipp/src/pct/actions.pm     Thu Jan  1 13:27:02 2009
@@ -1,4 +1,4 @@
-# Copyright (C) 2008, The Perl Foundation.
+# Copyright (C) 2008-2009, The Perl Foundation.
 # $Id$
 
 =begin comments
@@ -28,8 +28,8 @@
                          :hll('pipp')
                      );
 
+
         # set up scope 'package' for the superglobals
-        # TODO: use a loop
         $block.symbol_defaults( :scope('lexical') );
         for ( '$_GET', '$_POST', '$_SERVER', '$_GLOBALS',
               '$_FILES', '$_COOKIE', '$_SESSION', '$_REQUEST', '$_ENV' ) {
@@ -210,11 +210,16 @@
 }
 
 method constructor_call($/) {
+    my $class_name := ~$<CLASS_NAME>;
+
     make
         PAST::Op.new(
-            # :inline( "$S1 = 'member'\n$P2 = new 'PhpString'\n$P2 = 
'workaround in actions.pm:215'\n%r = new %0\nsetattribute %r, $S1, $P2" ),
-            :inline( "%r = new %0" ),                                          
         
-            ~$<CLASS_NAME>
+            :inline('    %r = new %0',
+                    "    \$P0 = get_global ['" ~ $class_name ~ "'], 
'__construct'",
+                    '    if null $P0 goto no_constructor',
+                    '    $P0(%r)',
+                    '  no_constructor:'),                                      
             
+            $class_name
         );
 }
 
@@ -229,7 +234,7 @@
         );
 }
 
-# TODO: merged with rule 'constant'
+# TODO: merge with rule 'constant'
 method class_constant($/) {
     make
         PAST::Op.new(

Modified: trunk/languages/pipp/t/php/oo.t
==============================================================================
--- trunk/languages/pipp/t/php/oo.t     (original)
+++ trunk/languages/pipp/t/php/oo.t     Thu Jan  1 13:27:02 2009
@@ -1,4 +1,4 @@
-# Copyright (C) 2008, The Perl Foundation.
+# Copyright (C) 2008-2009, The Perl Foundation.
 # $Id$
 
 =head1 NAME
@@ -20,7 +20,7 @@
 use FindBin;
 use lib "$FindBin::Bin/../../../../lib", "$FindBin::Bin/../../lib";
 
-use Parrot::Test tests => 9;
+use Parrot::Test tests => 10;
 
 language_output_is( 'Pipp', <<'CODE', <<'OUT', 'definition of a class' );
 <?php
@@ -80,6 +80,7 @@
 
     function bums() {
         echo "The function bums() in class Dings has been called.\n";
+        return '';
     }
 }
 
@@ -219,7 +220,26 @@
 four
 OUT
 
-language_output_is( 'Pipp', <<'CODE', <<'OUT', 'class with constructor', todo 
=> 'constructor not called yet' )
+language_output_is( 'Pipp', <<'CODE', <<'OUT', 'class with constructor' );
+<?php
+
+class Foo {
+    function __construct() {
+        echo "method __construct() of class Foo was called.\n";
+    }
+}
+
+$foo = new Foo;
+echo 'Dummy statement, so that $foo is not returned.';
+echo "\n";
+
+?>
+CODE
+method __construct() of class Foo was called.
+Dummy statement, so that $foo is not returned.
+OUT
+
+language_output_is( 'Pipp', <<'CODE', <<'OUT', 'class with constructor, 
returning a PippObject', todo => 'PippObject has no get_bool' );
 <?php
 
 class Foo {