Permalink
Browse files

Add IO::Spec::QNX to make Unix more efficient

QNX and Neutrino(nto) use //path special syntax, but there's no need
to penalize every other unix with extra operations in canonpath.
Plus it was never tested on qnx so it didn't even work... now fixed
Seriously, what bozo implemented this in the first place?
  • Loading branch information...
1 parent d67185a commit c929f048b80a6d8c3144f6b5d47d3656b96c814a @labster labster committed Jul 3, 2013
Showing with 25 additions and 16 deletions.
  1. +3 −0 src/core/IO/Spec.pm
  2. +17 −0 src/core/IO/Spec/QNX.pm
  3. +4 −16 src/core/IO/Spec/Unix.pm
  4. +1 −0 tools/build/Makefile-Parrot.in
View
@@ -8,6 +8,9 @@ my class IO::Spec {
'Win32' => 'Win32',
'cygwin' => 'Cygwin',
'Cygwin' => 'Cygwin',
+ 'qnx' => 'QNX',
+ 'QNX' => 'QNX',
+ 'nto' => 'QNX',
# <MacOS Mac> »=>» 'Mac',
# 'VMS' => 'VMS'
);
View
@@ -0,0 +1,17 @@
+my class IO::Spec::QNX is IO::Spec::Unix {
+
+ method canonpath ($path is copy, :$parent) {
+ # Handle POSIX-style node names beginning with double slash (qnx, nto)
+ # (POSIX says: "a pathname that begins with two successive slashes
+ # may be interpreted in an implementation-defined manner, although
+ # more than two leading slashes shall be treated as a single slash.")
+ my $node = '';
+ if $path ~~ s {^ ( '//' <-[ / ]>+ ) '/'? $} = ''
+ or $path ~~ s {^ ( '//' <-[ / ]>+ ) '/' } = '/'
+ { $node = ~ $0; }
+
+ $path = IO::Spec::Unix.canonpath($path, :$parent);
+
+ $node ~ $path;
+ }
+}
View
@@ -2,19 +2,8 @@ my class IO::Spec { ... }
my class IO::Spec::Unix {
- method canonpath( $path is copy ) {
- $path;
- return unless $path.defined;
-
- # Handle POSIX-style node names beginning with double slash (qnx, nto)
- # (POSIX says: "a pathname that begins with two successive slashes
- # may be interpreted in an implementation-defined manner, although
- # more than two leading slashes shall be treated as a single slash.")
- my $node = '';
- if ( so $*OS eq 'qnx'|'nto' ) #double slashes special on these OSes
- && ( $path ~~ s {^ ( '//' <-[ / ]>+ ) '/'? $} = ''
- || $path ~~ s {^ ( '//' <-[ / ]>+ ) '/' } = '/' )
- { $node = ~ $0; }
+ method canonpath( $path is copy --> Str ) {
+ return '' if $path eq '';
$path ~~ s:g { '//' '/'* } = '/'; # xx////xx -> xx/xx
$path ~~ s:g { '/.'+ ['/' | $] } = '/'; # xx/././xx -> xx/xx
@@ -23,11 +12,10 @@ my class IO::Spec::Unix {
unless $path eq "/" {
$path ~~ s { '/' $ } = ''; # xx/ -> xx :)
}
-
- return "$node$path";
+ $path;
}
- method curdir { '.' }
+ method curdir { '.' }
method updir { '..' }
method rootdir { '/' }
method devnull { '/dev/null' }
@@ -212,6 +212,7 @@ CORE_SOURCES = \
src/core/IO/Spec/Unix.pm \
src/core/IO/Spec/Win32.pm \
src/core/IO/Spec/Cygwin.pm \
+ src/core/IO/Spec/QNX.pm \
src/core/IO/Spec.pm \
src/core/IO.pm \
src/core/IO/ArgFiles.pm \

0 comments on commit c929f04

Please sign in to comment.