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
