Applied : PerlIO::Via::* support

[Rafael Garcia-Suarez]

Comments welcome.

Change 17393 by rgs@rgs-home on 2002/07/01 18:25:22

        Allow PerlIO::Via to look for modules in the default
        namespace PerlIO::Via::.

Affected files ...

.... //depot/perl/ext/PerlIO/Via/Via.pm#9 edit
.... //depot/perl/ext/PerlIO/Via/Via.xs#18 edit
.... //depot/perl/ext/PerlIO/t/via.t#4 edit

Differences ...

==== //depot/perl/ext/PerlIO/Via/Via.pm#9 (text) ====

@@ -15,6 +15,11 @@
 
    open($fh,"<:Via(Some::Package)",...);
 
+   use PerlIO::Via::SomeLayer;
+
+   # Assume PerlIO::Via:: default namespace when SomeLayer.pm is not found
+   open($fh,"<:Via(SomeLayer)",...);
+
 =head1 DESCRIPTION
 
 The package to be used as a layer should implement at least some of the

==== //depot/perl/ext/PerlIO/Via/Via.xs#18 (text) ====

@@ -142,6 +142,12 @@
      char *pkg = SvPV(arg,pkglen);
      s->obj = SvREFCNT_inc(arg);
      s->stash  = gv_stashpvn(pkg, pkglen, FALSE);
+     if (!s->stash)
+      {
+       s->obj = newSVpvn(Perl_form(aTHX_ "PerlIO::Via::%s",pkg), pkglen + 13);
+       SvREFCNT_dec(arg);
+       s->stash = gv_stashpvn(SvPVX(s->obj), pkglen + 13, FALSE);
+      }
      if (s->stash)
       {
        SV *modesv = (mode) ? sv_2mortal(newSVpvn(mode,strlen(mode))) : Nullsv;

==== //depot/perl/ext/PerlIO/t/via.t#4 (text) ====

@@ -14,7 +14,7 @@
 
 my $tmp = "via$$";
 
-use Test::More tests => 13;
+use Test::More tests => 15;
 
 my $fh;
 my $a = join("", map { chr } 0..255) x 10;
@@ -65,6 +65,14 @@
     is( $warnings, "",  "don't warn about unknown package" );
 }
 
+my $obj = '';
+sub Foo::PUSHED                        { $obj = shift; -1; }
+sub PerlIO::Via::Bar::PUSHED   { $obj = shift; -1; }
+open $fh, '<:Via(Foo)', "foo";
+is( $obj, 'Foo', 'search for package Foo' );
+open $fh, '<:Via(Bar)', "bar";
+is( $obj, 'PerlIO::Via::Bar', 'search for package PerlIO::Via::Bar' );
+
 END {
     1 while unlink $tmp;
 }