[svn:parrot] r35925 - in trunk/languages/pipp: config/makefiles src/common t/php

Author: bernhard
Date: Fri Jan 23 13:47:39 2009
New Revision: 35925

Modified:
   trunk/languages/pipp/config/makefiles/root.in
   trunk/languages/pipp/src/common/php_file.pir
   trunk/languages/pipp/src/common/php_filesystem.pir
   trunk/languages/pipp/src/common/php_standard.pir
   trunk/languages/pipp/t/php/filesystem.t

Log:
[Pipp] first stab at 'dirname'

Modified: trunk/languages/pipp/config/makefiles/root.in
==============================================================================
--- trunk/languages/pipp/config/makefiles/root.in	(original)
+++ trunk/languages/pipp/config/makefiles/root.in	Fri Jan 23 13:47:39 2009
@@ -72,6 +72,7 @@
   src/common/php_exec.pir \
   src/common/php_file.pir \
   src/common/php_filestat.pir \
+  src/common/php_filesystem.pir \
   src/common/php_formatted_print.pir \
   src/common/php_fsock.pir \
   src/common/php_ftok.pir \

Modified: trunk/languages/pipp/src/common/php_file.pir
==============================================================================
--- trunk/languages/pipp/src/common/php_file.pir	(original)
+++ trunk/languages/pipp/src/common/php_file.pir	Fri Jan 23 13:47:39 2009
@@ -1,4 +1,4 @@
-# Copyright (C) 2008, The Perl Foundation.
+# Copyright (C) 2008-2009, The Perl Foundation.
 # $Id$
 
 =head1 NAME
@@ -94,18 +94,6 @@
     not_implemented()
 .end
 
-=item C<string dirname(string path)>
-
-Returns the directory name component of the path
-
-NOT IMPLEMENTED.
-
-=cut
-
-.sub 'dirname'
-    not_implemented()
-.end
-
 =item C<bool fclose(resource fp)>
 
 Close an open file pointer

Modified: trunk/languages/pipp/src/common/php_filesystem.pir
==============================================================================
--- trunk/languages/pipp/src/common/php_filesystem.pir	(original)
+++ trunk/languages/pipp/src/common/php_filesystem.pir	Fri Jan 23 13:47:39 2009
@@ -3,7 +3,7 @@
 
 =head1 NAME
 
-php_filesystem.pir - PHP filesystem Standard Library
+php_filesystem.pir - PHP filesystem extension
 
 =head1 DESCRIPTION
 
@@ -15,14 +15,40 @@
 
 =item C<string dirname(string path)>
 
-Returns the directory name component of the path
-
-NOT IMPLEMENTED.
+Returns the directory name component of the path.
+Under Windows the forward and backward slash are tried for directory separators.
+Under Windows forward slashes are replaced by backslashes.
+For the root dir a slash is appended.
 
 =cut
 
 .sub 'dirname'
-    not_implemented()
+    .param pmc path
+
+    .local pmc slash
+    slash = get_hll_global 'DIRECTORY_SEPARATOR'
+    .local string slash_str
+    slash_str = slash
+
+    ne slash_str, '\\', L1
+        # TODO: fix the DOS case
+        .local pmc split_sub, p6rule, regex
+        split_sub  = get_root_global ['parrot';'PGE';'Util'], 'split'
+        p6rule = compreg 'PGE::Perl6Regex'
+        regex  = p6rule('[\\|/]')
+        $P0 = split_sub(regex, path)
+        goto L2
+  L1:
+        $S0 = path
+        $P0 = split '/', $S0
+  L2:
+
+    $S0 = pop $P0
+    $S0 = join slash_str, $P0
+    ne $S0, '', L3
+        $S0 = slash
+  L3:
+    .RETURN_STRING($S0)
 .end
 
 =back

Modified: trunk/languages/pipp/src/common/php_standard.pir
==============================================================================
--- trunk/languages/pipp/src/common/php_standard.pir	(original)
+++ trunk/languages/pipp/src/common/php_standard.pir	Fri Jan 23 13:47:39 2009
@@ -19,6 +19,7 @@
 .include 'languages/pipp/src/common/php_exec.pir'
 .include 'languages/pipp/src/common/php_file.pir'
 .include 'languages/pipp/src/common/php_filestat.pir'
+.include 'languages/pipp/src/common/php_filesystem.pir'
 .include 'languages/pipp/src/common/php_formatted_print.pir'
 .include 'languages/pipp/src/common/php_fsock.pir'
 .include 'languages/pipp/src/common/php_ftok.pir'

Modified: trunk/languages/pipp/t/php/filesystem.t
==============================================================================
--- trunk/languages/pipp/t/php/filesystem.t	(original)
+++ trunk/languages/pipp/t/php/filesystem.t	Fri Jan 23 13:47:39 2009
@@ -23,15 +23,29 @@
 use FindBin;
 use lib "$FindBin::Bin/../../../../lib", "$FindBin::Bin/../../lib";
 
-use Parrot::Test tests => 1;
+use Parrot::Test   tests => 5;
 use Parrot::Config qw( %PConfig );
 
+# test dirname
+{
+    my @test_cases = (
+        ['a/b'                    => 'a' ],
+        ['a/b/c'                  => 'a/b' ],
+        ['axxxx/bxxxx/cxxxx'      => 'axxxx/bxxxx' ],
+        ['axxxx'                  => 'axxxx/bxxxx', todo => 'not yet' ],
+        ['/not_there'             => $PConfig{slash} ],
+    );
 
-language_output_is( 'Pipp', <<'CODE', $PConfig{slash}, 'dirname("/not_there")', todo => 'not yet' );
+    foreach ( @test_cases ) {
+        my ( $path, $dirname, @extra ) = @{$_};
+
+        language_output_is( 'Pipp', <<"CODE", $dirname, qq{dirname('$path')}, @extra );
 <?php
-  echo dirname("/not_there");
+  echo dirname('$path');
 ?>
 CODE
+    }
+}
 
 # Local Variables:
 #   mode: cperl