Start to refactor IO::Handle encoding/bin mode.

This introduces a $!decoder attribute to IO::Handle. The presence of this is now used internally to determine if the handle is in binary mode. The $.encoding attribute is now a `Str` rather than a `str`, and will be the Str type object in the case where the file is in binary mode. It is now an error to pass both :bin and :enc to `open`. It is also an error to do char-level operations on a handle opened in binary mode (we do support mixed binary/Str operations, provided you know and understand the caveats, but then the file must be opened in normal/character mode in order to do that; this is because it needs extra bookkeeping that we can skip in binary mode). Some places set a default utf-8 encoding in their signatures, and so triggered the new sanity check when passing those along to `open`; they now just pass an undefined `$enc` in that case, which also concentrates the choice of that default better in IO::Handle. There remain further places that we might wish to remove `= 'utf-8'` also; these ones removed were those that caused breakage. Along the way, the setup of IO::Pipe objects in Proc was refactored to eliminate various bits of poking into IO::Handle internals from Proc, and this happily also reduced duplicated setup code.
rakudo · May 26, 2017 · ba40946 · ba40946
1 parent 4052a7c
commit ba40946
Show file tree

Hide file tree

Showing 5 changed files with 86 additions and 47 deletions.
diff --git a/src/core/Exception.pm b/src/core/Exception.pm
@@ -593,6 +593,15 @@ my class X::IO::Chmod does X::IO {
     }
 }
 
+my class X::IO::BinaryAndEncoding does X::IO {
+    method message { "Cannot open a handle in binary mode (:bin) and also specify an encoding" }
+}
+
+my class X::IO::BinaryMode does X::IO {
+    has $.trying;
+    method message { "Cannot do '$.trying' on a handle in binary mode" }
+}
+
 my role X::Comp is Exception {
     has $.filename;
     has $.pos;

diff --git a/src/core/IO/Handle.pm b/src/core/IO/Handle.pm
@@ -8,7 +8,8 @@ my class IO::Handle {
     has $.chomp is rw = Bool::True;
     has $.nl-in = ["\x0A", "\r\n"];
     has Str:D $.nl-out is rw = "\n";
-    has str $.encoding = 'utf8';
+    has Str $.encoding;
+    has Rakudo::Internals::VMBackedDecoder $!decoder;
 
     method open(IO::Handle:D:
       :$r, :$w, :$x, :$a, :$update,
@@ -20,7 +21,7 @@ my class IO::Handle {
       :$exclusive is copy,
       :$bin,
       :$chomp = $!chomp,
-      :$enc   = $!encoding,
+      :$enc = $!encoding,
       :$nl-in is copy = $!nl-in,
       Str:D :$nl-out is copy = $!nl-out,
     ) {
@@ -91,15 +92,19 @@ my class IO::Handle {
             }
             $!chomp = $chomp;
             $!nl-out = $nl-out;
+            if $bin {
+                die X::IO::BinaryAndEncoding.new if nqp::isconcrete($enc);
+            }
+            else {
+                $!encoding = Rakudo::Internals.NORMALIZE_ENCODING($enc || 'utf-8');
+                # XXX Remove next two lines after streaming decoder is in use
+                nqp::setencoding($!PIO, $!encoding);
 #?if !jvm
-            Rakudo::Internals.SET_LINE_ENDING_ON_HANDLE($!PIO, $!nl-in = $nl-in);
+                Rakudo::Internals.SET_LINE_ENDING_ON_HANDLE($!PIO, $!nl-in = $nl-in);
 #?endif
-            nqp::if( $bin || nqp::iseq_s($enc, 'bin'),
-                ($!encoding = 'bin'),
-                nqp::setencoding($!PIO,
-                    $!encoding = Rakudo::Internals.NORMALIZE_ENCODING($enc),
-                )
-            );
+                $!decoder := Rakudo::Internals::VMBackedDecoder.new($!encoding);
+                $!decoder.set-line-separators($!nl-in.list);
+            }
             return self;
         }
 
@@ -136,13 +141,17 @@ my class IO::Handle {
 
         $!chomp = $chomp;
         $!nl-out = $nl-out;
-        Rakudo::Internals.SET_LINE_ENDING_ON_HANDLE($!PIO, $!nl-in = $nl-in);
-        nqp::if( $bin || nqp::iseq_s($enc, 'bin'),
-            ($!encoding = 'bin'),
-            nqp::setencoding($!PIO,
-                $!encoding = Rakudo::Internals.NORMALIZE_ENCODING($enc),
-            )
-        );
+        if $bin {
+            die X::IO::BinaryAndEncoding.new if nqp::isconcrete($enc);
+        }
+        else {
+            $!encoding = Rakudo::Internals.NORMALIZE_ENCODING($enc || 'utf-8');
+            # XXX Remove next two lines after streaming decoder is in use
+            nqp::setencoding($!PIO, $!encoding);
+            Rakudo::Internals.SET_LINE_ENDING_ON_HANDLE($!PIO, $!nl-in = $nl-in);
+            $!decoder := Rakudo::Internals::VMBackedDecoder.new($!encoding);
+            $!decoder.set-line-separators($!nl-in.list);
+        }
         self;
     }
 
@@ -176,6 +185,7 @@ my class IO::Handle {
     }
 
     method get(IO::Handle:D:) {
+        $!decoder or die X::IO::BinaryMode.new(:trying<get>);
         nqp::if(
           $!chomp,
           nqp::if(
@@ -191,6 +201,7 @@ my class IO::Handle {
     }
 
     method getc(IO::Handle:D:) {
+        $!decoder or die X::IO::BinaryMode.new(:trying<getc>);
         nqp::if(nqp::chars(my str $c = nqp::getcfh($!PIO)),$c,Nil)
     }
 
@@ -200,6 +211,7 @@ my class IO::Handle {
 
     proto method words (|) { * }
     multi method words(IO::Handle:D \SELF: $limit, :$close) {
+        $!decoder or die X::IO::BinaryMode.new(:trying<words>);
         nqp::istype($limit,Whatever) || $limit == Inf
           ?? self.words(:$close)
           !! $close
@@ -208,6 +220,7 @@ my class IO::Handle {
             !! self.words.head($limit.Int)
     }
     multi method words(IO::Handle:D: :$close) {
+        $!decoder or die X::IO::BinaryMode.new(:trying<words>);
         Seq.new(class :: does Iterator {
             has $!handle;
             has $!close;
@@ -312,6 +325,7 @@ my class IO::Handle {
     }
 
     method !LINES-ITERATOR (IO::Handle:D:) {
+        $!decoder or die X::IO::BinaryMode.new(:trying<lines>);
         nqp::if(
           nqp::eqaddr(self.WHAT,IO::Handle),
           nqp::if(
@@ -406,6 +420,7 @@ my class IO::Handle {
     }
 
     method readchars(Int(Cool:D) $chars = $*DEFAULT-READ-ELEMS) {
+        $!decoder or die X::IO::BinaryMode.new(:trying<readchars>);
 #?if jvm
         my Buf $buf := Buf.new;   # nqp::readcharsfh doesn't work on the JVM
         # a char = 2 bytes
@@ -418,28 +433,28 @@ my class IO::Handle {
     }
 
     method Supply(IO::Handle:D: :$size = $*DEFAULT-READ-ELEMS --> Supply:D) {
-        if nqp::iseq_s($!encoding, 'bin') { # handle is in binary mode
+        if $!decoder { # handle is in character mode
             supply {
-                my $buf := self.read($size);
+                my int $chars = $size;
+                my str $str = self.readchars($chars);
                 nqp::while(
-                  nqp::elems($buf),
+                  nqp::chars($str),
                   nqp::stmts(
-                    (emit $buf),
-                    ($buf := self.read($size))
+                    (emit nqp::p6box_s($str)),
+                    ($str = self.readchars($chars))
                   )
                 );
                 done;
             }
         }
         else {
             supply {
-                my int $chars = $size;
-                my str $str = self.readchars($chars);
+                my $buf := self.read($size);
                 nqp::while(
-                  nqp::chars($str),
+                  nqp::elems($buf),
                   nqp::stmts(
-                    (emit nqp::p6box_s($str)),
-                    ($str = self.readchars($chars))
+                    (emit $buf),
+                    ($buf := self.read($size))
                   )
                 );
                 done;
@@ -489,6 +504,7 @@ my class IO::Handle {
 
     proto method print(|) { * }
     multi method print(IO::Handle:D: Str:D \x --> True) {
+        $!decoder or die X::IO::BinaryMode.new(:trying<print>);
         nqp::writefh($!PIO, x.encode($!encoding));
     }
     multi method print(IO::Handle:D: **@list is raw --> True) { # is raw gives List, which is cheaper
@@ -497,6 +513,7 @@ my class IO::Handle {
 
     proto method put(|) { * }
     multi method put(IO::Handle:D: Str:D \x --> True) {
+        $!decoder or die X::IO::BinaryMode.new(:trying<put>);
         nqp::writefh($!PIO,
           nqp::concat(nqp::unbox_s(x), nqp::unbox_s($!nl-out)).encode($!encoding))
     }
@@ -505,10 +522,12 @@ my class IO::Handle {
     }
 
     multi method say(IO::Handle:D: \x --> True) {
+        $!decoder or die X::IO::BinaryMode.new(:trying<say>);
         nqp::writefh($!PIO,
           nqp::concat(nqp::unbox_s(x.gist), nqp::unbox_s($!nl-out)).encode($!encoding))
     }
     multi method say(IO::Handle:D: |) {
+        $!decoder or die X::IO::BinaryMode.new(:trying<say>);
         my Mu $args := nqp::p6argvmarray();
         nqp::shift($args);
         my str $conc = '';
@@ -517,6 +536,7 @@ my class IO::Handle {
     }
 
     method print-nl(IO::Handle:D: --> True) {
+        $!decoder or die X::IO::BinaryMode.new(:trying<print-nl>);
         nqp::writefh($!PIO, $!nl-out.encode($!encoding));
     }
 
@@ -538,6 +558,7 @@ my class IO::Handle {
         # NOTE: THIS METHOD WILL BE DEPRECATED IN 6.d in favour of .slurp()
         # Testing of it in roast master has been removed and only kept in 6.c
         # If you're changing this code for whatever reason, test with 6.c-errata
+        $!decoder or die X::IO::BinaryMode.new(:trying<slurp-rest>);
         LEAVE self.close if $close;
         self.encoding($enc) if $enc.defined;
         nqp::p6box_s(nqp::readallfh($!PIO));
@@ -546,15 +567,15 @@ my class IO::Handle {
     method slurp(IO::Handle:D: :$close) {
         my $res;
         nqp::if(
-          nqp::iseq_s($!encoding, 'bin'),
+          $!decoder,
+          ($res := nqp::p6box_s(nqp::readallfh($!PIO))),
           nqp::stmts(
             ($res := buf8.new),
             nqp::while(
               nqp::elems(my $buf := nqp::readfh($!PIO, buf8.new, 0x100000)),
               $res.append($buf)
             )
-          ),
-          ($res := nqp::p6box_s(nqp::readallfh($!PIO))),
+          )
         );
 
         # don't sink result of .close; it might be a failed Proc

diff --git a/src/core/IO/Path.pm b/src/core/IO/Path.pm
@@ -625,7 +625,7 @@ my class IO::Path is Cool does IO {
           nqp::if(
             nqp::istype(
               (my $handle := IO::Handle.new(:path(self)).open(
-                :enc(%_<enc> || 'utf8'), :bin(%_<bin>), :mode<ro>)),
+                :enc(%_<enc>), :bin(%_<bin>), :mode<ro>)),
               Failure,),
             $handle, # our open failed; return the Failure object here,
             nqp::stmts(
@@ -646,7 +646,7 @@ my class IO::Path is Cool does IO {
               $_))) # <-- we've succeeded in slow-path; that's the data
     }
 
-    method spurt(IO::Path:D: $data, :$enc = 'utf8', :$append, :$createonly) {
+    method spurt(IO::Path:D: $data, :$enc, :$append, :$createonly) {
         my $fh := self.open:
             :$enc,     :bin(nqp::istype($data, Blob)),
             :mode<wo>, :create, :exclusive($createonly),

diff --git a/src/core/IO/Pipe.pm b/src/core/IO/Pipe.pm
@@ -1,5 +1,23 @@
 my class IO::Pipe is IO::Handle {
     has $.proc;
+
+    method TWEAK(:$enc, :$bin, Mu :$PIO --> Nil) {
+        if $bin {
+            die X::IO::BinaryAndEncoding.new if nqp::isconcrete($enc);
+        }
+        else {
+            my $encoding = Rakudo::Internals.NORMALIZE_ENCODING($enc || 'utf-8');
+            nqp::bindattr(self, IO::Handle, '$!encoding', $encoding);
+            # XXX Remove next three lines after streaming decoder is in use
+            nqp::bindattr(self, IO::Handle, '$!PIO', nqp::decont($PIO));
+            nqp::setencoding(nqp::decont($PIO), $encoding);
+            Rakudo::Internals.SET_LINE_ENDING_ON_HANDLE(nqp::decont($PIO), $.nl-in);
+            my $decoder := Rakudo::Internals::VMBackedDecoder.new($encoding);
+            $decoder.set-line-separators($.nl-in.list);
+            nqp::bindattr(self, IO::Handle, '$!decoder', $decoder);
+        }
+    }
+
     method close(IO::Pipe:D:) {
         my $PIO := nqp::getattr(nqp::decont(self), IO::Handle, '$!PIO');
         $!proc.status( nqp::closefh_i($PIO) ) if nqp::defined($PIO);

diff --git a/src/core/Proc.pm b/src/core/Proc.pm
@@ -13,7 +13,7 @@ my class Proc {
 
     submethod BUILD(:$in = '-', :$out = '-', :$err = '-', :$exitcode,
                     Bool :$bin, Bool :$chomp = True, Bool :$merge, :$command,
-                    Str:D :$enc = 'utf8', Str:D :$nl = "\n", :$signal --> Nil) {
+                    Str :$enc, Str:D :$nl = "\n", :$signal --> Nil) {
         if $merge {
             die "Executing programs with :merge is known to be broken\n"
               ~ "Please see https://rt.perl.org//Public/Bug/Display.html?id=128594 for the bug report.\n";
@@ -24,13 +24,10 @@ my class Proc {
             $!flags += nqp::const::PIPE_INHERIT_IN;
         }
         elsif $in === True {
-            $!in     = IO::Pipe.new(:proc(self), :path(''), :$chomp, nl-out => $nl);
             $!in_fh := nqp::syncpipe();
             $!flags += nqp::const::PIPE_CAPTURE_IN;
-            Rakudo::Internals.SET_LINE_ENDING_ON_HANDLE($!in_fh, $nl);
-            nqp::setencoding($!in_fh,Rakudo::Internals.NORMALIZE_ENCODING($enc))
-              unless $bin;
-            nqp::bindattr(nqp::decont($!in), IO::Handle, '$!PIO', $!in_fh);
+            $!in     = IO::Pipe.new(:proc(self), :path(''), :$chomp, :$enc, :$bin,
+                nl-out => $nl, :PIO($!in_fh));
         }
         elsif nqp::istype($in, Str) && $in eq '-' {
             $!in_fh := nqp::null();
@@ -42,13 +39,10 @@ my class Proc {
         }
 
         if $out === True || $merge {
-            $!out     = IO::Pipe.new(:proc(self), :path(''), :$chomp, nl-in => $nl);
             $!out_fh := nqp::syncpipe();
             $!flags  += nqp::const::PIPE_CAPTURE_OUT;
-            Rakudo::Internals.SET_LINE_ENDING_ON_HANDLE($!out_fh, $nl);
-            nqp::setencoding($!out_fh,Rakudo::Internals.NORMALIZE_ENCODING($enc))
-              unless $bin;
-            nqp::bindattr(nqp::decont($!out), IO::Handle, '$!PIO', $!out_fh);
+            $!out     = IO::Pipe.new(:proc(self), :path(''), :$chomp, :$enc, :$bin,
+                nl-in => $nl, :PIO($!out_fh));
         }
         elsif nqp::istype($out, IO::Handle) && $out.DEFINITE {
             $!out_fh := nqp::getattr(nqp::decont($out), IO::Handle, '$!PIO');
@@ -77,13 +71,10 @@ my class Proc {
             $!flags  += nqp::const::PIPE_INHERIT_ERR;
         }
         elsif $err === True {
-            $!err     = IO::Pipe.new(:proc(self), :path(''), :$chomp, nl-in =>  $nl);
             $!err_fh := nqp::syncpipe();
             $!flags  += nqp::const::PIPE_CAPTURE_ERR;
-            Rakudo::Internals.SET_LINE_ENDING_ON_HANDLE($!err_fh, $nl);
-            nqp::setencoding($!err_fh,Rakudo::Internals.NORMALIZE_ENCODING($enc))
-              unless $bin;
-            nqp::bindattr(nqp::decont($!err), IO::Handle, '$!PIO', $!err_fh);
+            $!err     = IO::Pipe.new(:proc(self), :path(''), :$chomp, :$enc, :$bin,
+                nl-in => $nl, :PIO($!err_fh));
         }
         else {
             $!err_fh := nqp::null();