The London Perl and Raku Workshop takes place on 26th Oct 2024. If your company depends on Perl, please consider sponsoring and/or attending.
Changes 019
MANIFEST 02
META.yml 010
README 11
String.pm 116
t/close.t 036
t/read.t 114
7 files changed (This is a version diff) 1388
@@ -1,3 +1,22 @@
+2005-12-05   Gisle Aas <gisle@ActiveState.com>
+
+   Release 1.08
+
+   The untie code in close() just seemed wrong, so just
+   remove it.  The object still seems to get cleaned up
+   on various versions perl.
+
+
+
+2005-10-24   Gisle Aas <gisle@ActiveState.com>
+
+   Release 1.07
+
+   Make sure read() will not return negative values.
+   <https://rt.cpan.org/Ticket/Display.html?id=13841>
+
+
+
 2004-11-05   Gisle Aas <gisle@ActiveState.com>
 
    Release 1.06
@@ -3,8 +3,10 @@ MANIFEST
 Makefile.PL
 README
 String.pm
+t/close.t
 t/para.t
 t/read.t
 t/seek.t
 t/truncate.t
 t/write.t
+META.yml                                 Module meta-data (added by MakeMaker)
@@ -0,0 +1,10 @@
+# http://module-build.sourceforge.net/META-spec.html
+#XXXXXXX This is a prototype!!!  It will change in the future!!! XXXXX#
+name:         IO-String
+version:      1.08
+version_from: String.pm
+installdirs:  site
+requires:
+
+distribution_type: module
+generated_by: ExtUtils::MakeMaker version 6.17
@@ -13,7 +13,7 @@ Installation as usual:
 Documentation is embedded in the module.
 
 
-Copyright 1998-2003 Gisle Aas.  <gisle@aas.no>
+Copyright 1998-2005 Gisle Aas.  <gisle@aas.no>
 
 This library is free software; you can redistribute it and/or
 modify it under the same terms as Perl itself.
@@ -1,6 +1,6 @@
 package IO::String;
 
-# Copyright 1998-2004 Gisle Aas.
+# Copyright 1998-2005 Gisle Aas.
 #
 # This library is free software; you can redistribute it and/or
 # modify it under the same terms as Perl itself.
@@ -8,7 +8,7 @@ package IO::String;
 require 5.005_03;
 use strict;
 use vars qw($VERSION $DEBUG $IO_CONSTANTS);
-$VERSION = "1.06";  # $Date: 2004/11/05 15:05:27 $
+$VERSION = "1.08";  # $Date: 2005/12/05 12:00:47 $
 
 use Symbol ();
 
@@ -79,13 +79,7 @@ sub close
     delete *$self->{buf};
     delete *$self->{pos};
     delete *$self->{lno};
-    if ($] >= 5.006 && $[ < 5.007) {
-	# perl-5.6.x segfaults on untie, so avoid it
-    }
-    else {
-	untie *$self;
-	undef *$self;
-    }
+    undef *$self if $] eq "5.008";  # workaround for some bug
     return 1;
 }
 
@@ -308,12 +302,13 @@ sub read
 {
     my $self = shift;
     my $buf = *$self->{buf};
-    return unless $buf;
+    return undef unless $buf;
 
     my $pos = *$self->{pos};
     my $rem = length($$buf) - $pos;
     my $len = $_[1];
     $len = $rem if $len > $rem;
+    return undef if $len < 0;
     if (@_ > 2) { # read offset
 	substr($_[0],$_[2]) = substr($$buf, $pos, $len);
     }
@@ -548,7 +543,7 @@ L<IO::File>, L<IO::Stringy>, L<perlfunc/open>
 
 =head1 COPYRIGHT
 
-Copyright 1998-2003 Gisle Aas.
+Copyright 1998-2005 Gisle Aas.
 
 This library is free software; you can redistribute it and/or
 modify it under the same terms as Perl itself.
@@ -0,0 +1,36 @@
+#!perl -w
+
+print "1..1\n";
+
+use strict;
+use IO::String;
+
+my $str = "abcd";
+
+my $destroyed = 0;
+
+{
+    package MyStr;
+    @MyStr::ISA = qw(IO::String);
+
+    sub DESTROY {
+	$destroyed++;
+	print "DESTROY @_\n";
+    }
+}
+
+
+my $rounds = 5;
+
+for (1..$rounds) {
+   my $io = MyStr->new($str);
+   die unless $io->getline eq "abcd";
+   $io->close;
+   undef($io);
+   print "-\n";
+}
+
+print "XXX $destroyed\n";
+
+print "not " unless $destroyed == $rounds;
+print "ok 1\n";
@@ -1,4 +1,4 @@
-print "1..13\n";
+print "1..17\n";
 
 $str = <<EOT;
 This is an example
@@ -94,3 +94,16 @@ print "not " unless $io->eof;
 print "ok 13\n";
 
 
+$io->setpos(0);
+print "not " if defined(read($io, $buf, -1));
+print "ok 14\n";
+
+print "not " unless read($io, $buf, 0) == 0;
+print "ok 15\n";
+
+print "not " unless read($io, $buf, 4) == 4 && $buf eq "This";
+print "ok 16\n";
+
+$str = "";
+print "not " if defined(read($io, $buf, 4));
+print "ok 17\n";