rpms/perl/F-8 perl-5.8.8-TestSimple0.78.patch, NONE, 1.1 perl-5.8.8-rhbz238581.patch, NONE, 1.1 perl.spec, 1.149, 1.150

Marcela Mašláňová (mmaslano) fedora-extras-commits at redhat.com
Thu Mar 20 08:46:26 UTC 2008 

Author: mmaslano

Update of /cvs/pkgs/rpms/perl/F-8
In directory cvs-int.fedora.redhat.com:/tmp/cvs-serv11375

Modified Files:
	perl.spec 
Added Files:
	perl-5.8.8-TestSimple0.78.patch perl-5.8.8-rhbz238581.patch 
Log Message:
- 434865 upgrade Test::Simple
- turn off test on loading Dummy in More.t, can't find module (path problem?)
- 238581: careless use of gethostbyname() in Socket.xs



perl-5.8.8-TestSimple0.78.patch:

--- NEW FILE perl-5.8.8-TestSimple0.78.patch ---
diff -up perl-5.8.8/lib/Test/More.pm.crr perl-5.8.8/lib/Test/More.pm
--- perl-5.8.8/lib/Test/More.pm.crr	2005-10-08 08:56:17.000000000 +0200
+++ perl-5.8.8/lib/Test/More.pm	2008-02-27 11:01:46.000000000 +0100
@@ -1,7 +1,6 @@
 package Test::More;
 
-use 5.004;
-
+use 5.006;
 use strict;
 
 
@@ -16,7 +15,7 @@ sub _carp {
 
 
 use vars qw($VERSION @ISA @EXPORT %EXPORT_TAGS $TODO);
-$VERSION = '0.62';
+$VERSION = '0.78';
 $VERSION = eval $VERSION;    # make the alpha version come out as a number
 
 use Test::Builder::Module;
@@ -31,7 +30,7 @@ use Test::Builder::Module;
              plan
              can_ok  isa_ok
              diag
-	     BAIL_OUT
+             BAIL_OUT
             );
 
 
@@ -41,7 +40,7 @@ Test::More - yet another framework for w
 
 =head1 SYNOPSIS
 
-  use Test::More tests => $Num_Tests;
+  use Test::More tests => 23;
   # or
   use Test::More qw(no_plan);
   # or
@@ -51,20 +50,20 @@ Test::More - yet another framework for w
   require_ok( 'Some::Module' );
 
   # Various ways to say "ok"
-  ok($this eq $that, $test_name);
+  ok($got eq $expected, $test_name);
 
-  is  ($this, $that,    $test_name);
-  isnt($this, $that,    $test_name);
+  is  ($got, $expected, $test_name);
+  isnt($got, $expected, $test_name);
 
   # Rather than print STDERR "# here's what went wrong\n"
   diag("here's what went wrong");
 
-  like  ($this, qr/that/, $test_name);
-  unlike($this, qr/that/, $test_name);
+  like  ($got, qr/expected/, $test_name);
+  unlike($got, qr/expected/, $test_name);
 
-  cmp_ok($this, '==', $that, $test_name);
+  cmp_ok($got, '==', $expected, $test_name);
 
-  is_deeply($complex_structure1, $complex_structure2, $test_name);
+  is_deeply($got_complex_structure, $expected_complex_structure, $test_name);
 
   SKIP: {
       skip $why, $how_many unless $have_some_feature;
@@ -113,7 +112,7 @@ failure.
 
 The preferred way to do this is to declare a plan when you C<use Test::More>.
 
-  use Test::More tests => $Num_Tests;
+  use Test::More tests => 23;
 
 There are rare cases when you will not know beforehand how many tests
 your script is going to run.  In this case, you can declare that you
@@ -226,9 +225,9 @@ respectively.
 
 =item B<ok>
 
-  ok($this eq $that, $test_name);
+  ok($got eq $expected, $test_name);
 
-This simply evaluates any expression (C<$this eq $that> is just a
+This simply evaluates any expression (C<$got eq $expected> is just a
 simple example) and uses that to determine if the test succeeded or
 failed.  A true expression passes, a false one fails.  Very simple.
 
@@ -252,7 +251,7 @@ Should an ok() fail, it will produce som
     #   Failed test 'sufficient mucus'
     #   in foo.t at line 42.
 
-This is actually Test::Simple's ok() routine.
+This is the same as Test::Simple's ok() routine.
 
 =cut
 
@@ -267,8 +266,8 @@ sub ok ($;$) {
 
 =item B<isnt>
 
-  is  ( $this, $that, $test_name );
-  isnt( $this, $that, $test_name );
+  is  ( $got, $expected, $test_name );
+  isnt( $got, $expected, $test_name );
 
 Similar to ok(), is() and isnt() compare their two arguments
 with C<eq> and C<ne> respectively and use the result of that to
@@ -340,17 +339,17 @@ sub isnt ($$;$) {
 
 =item B<like>
 
-  like( $this, qr/that/, $test_name );
+  like( $got, qr/expected/, $test_name );
 
-Similar to ok(), like() matches $this against the regex C<qr/that/>.
+Similar to ok(), like() matches $got against the regex C<qr/expected/>.
 
 So this:
 
-    like($this, qr/that/, 'this is like that');
+    like($got, qr/expected/, 'this is like that');
 
 is similar to:
 
-    ok( $this =~ /that/, 'this is like that');
+    ok( $got =~ /expected/, 'this is like that');
 
 (Mnemonic "This is like that".)
 
@@ -359,9 +358,9 @@ regex reference (i.e. C<qr//>) or (for b
 perls) as a string that looks like a regex (alternative delimiters are
 currently not supported):
 
-    like( $this, '/that/', 'this is like that' );
+    like( $got, '/expected/', 'this is like that' );
 
-Regex options may be placed on the end (C<'/that/i'>).
+Regex options may be placed on the end (C<'/expected/i'>).
 
 Its advantages over ok() are similar to that of is() and isnt().  Better
 diagnostics on failure.
@@ -377,9 +376,9 @@ sub like ($$;$) {
 
 =item B<unlike>
 
-  unlike( $this, qr/that/, $test_name );
+  unlike( $got, qr/expected/, $test_name );
 
-Works exactly as like(), only it checks if $this B<does not> match the
+Works exactly as like(), only it checks if $got B<does not> match the
 given pattern.
 
 =cut
@@ -393,23 +392,23 @@ sub unlike ($$;$) {
 
 =item B<cmp_ok>
 
-  cmp_ok( $this, $op, $that, $test_name );
+  cmp_ok( $got, $op, $expected, $test_name );
 
 Halfway between ok() and is() lies cmp_ok().  This allows you to
 compare two arguments using any binary perl operator.
 
-    # ok( $this eq $that );
-    cmp_ok( $this, 'eq', $that, 'this eq that' );
+    # ok( $got eq $expected );
+    cmp_ok( $got, 'eq', $expected, 'this eq that' );
 
-    # ok( $this == $that );
-    cmp_ok( $this, '==', $that, 'this == that' );
+    # ok( $got == $expected );
+    cmp_ok( $got, '==', $expected, 'this == that' );
 
-    # ok( $this && $that );
-    cmp_ok( $this, '&&', $that, 'this && that' );
+    # ok( $got && $expected );
+    cmp_ok( $got, '&&', $expected, 'this && that' );
     ...etc...
 
-Its advantage over ok() is when the test fails you'll know what $this
-and $that were:
+Its advantage over ok() is when the test fails you'll know what $got
+and $expected were:
 
     not ok 1
     #   Failed test in foo.t at line 12.
@@ -465,6 +464,12 @@ sub can_ok ($@) {
     my $class = ref $proto || $proto;
     my $tb = Test::More->builder;
 
+    unless( $class ) {
+        my $ok = $tb->ok( 0, "->can(...)" );
+        $tb->diag('    can_ok() called with empty class or reference');
+        return $ok;
+    }
+
     unless( @methods ) {
         my $ok = $tb->ok( 0, "$class->can(...)" );
[...3589 lines suppressed...]
 }
 
-sub test_err(@)
+sub test_err
 {
     # do we need to do any setup?
     _start_testing() unless $testing;
@@ -214,7 +213,7 @@ so
 
     test_err("# Failed test ($0 at line ".line_num(+1).")");
 
-C<test_fail> exists as a convenience method that can be called
+C<test_fail> exists as a convenience function that can be called
 instead.  It takes one argument, the offset from the current line that
 the line that causes the fail is on.
 
@@ -376,7 +375,7 @@ sub test_test
 A utility function that returns the line number that the function was
 called on.  You can pass it an offset which will be added to the
 result.  This is very useful for working out the correct text of
-diagnostic methods that contain line numbers.
+diagnostic functions that contain line numbers.
 
 Essentially this is the same as the C<__LINE__> macro, but the
 C<line_num(+3)> idiom is arguably nicer.
@@ -442,10 +441,10 @@ sub color
 
 =head1 BUGS
 
-Calls B<Test::Builder>'s C<no_ending> method turning off the ending
-tests.  This is needed as otherwise it will trip out because we've run
-more tests than we strictly should have and it'll register any
-failures we had that we were testing for as real failures.
+Calls C<<Test::Builder->no_ending>> turning off the ending tests.
+This is needed as otherwise it will trip out because we've run more
+tests than we strictly should have and it'll register any failures we
+had that we were testing for as real failures.
 
 The color function doesn't work unless B<Term::ANSIColor> is installed
 and is compatible with your terminal.
@@ -485,7 +484,7 @@ L<Test::Builder>, L<Test::Builder::Teste
 ####################################################################
 # Helper class that is used to remember expected and received data
 
-package Test::Tester::Tie;
+package Test::Builder::Tester::Tie;
 
 ##
 # add line(s) to be expected
@@ -497,17 +496,17 @@ sub expect
     my @checks = @_;
     foreach my $check (@checks) {
         $check = $self->_translate_Failed_check($check);
-        push @{$self->[2]}, ref $check ? $check : "$check\n";
+        push @{$self->{wanted}}, ref $check ? $check : "$check\n";
     }
 }
 
 
-sub _translate_Failed_check 
+sub _translate_Failed_check
 {
     my($self, $check) = @_;
 
-    if( $check =~ /\A(.*)#     (Failed .*test) \((.*?) at line (\d+)\)\z/ ) {
-        $check = qr/\Q$1\E#\s+\Q$2\E.*?\n?.*?\Q$3\E at line \Q$4\E.*\n?/;
+    if( $check =~ /\A(.*)#     (Failed .*test) \((.*?) at line (\d+)\)\Z(?!\n)/ ) {
+        $check = "/\Q$1\E#\\s+\Q$2\E.*?\\n?.*?\Qat $3\E line \Q$4\E.*\\n?/";
     }
 
     return $check;
@@ -524,10 +523,10 @@ sub check
     # turn off warnings as these might be undef
     local $^W = 0;
 
-    my @checks = @{$self->[2]};
-    my $got = $self->[1];
+    my @checks = @{$self->{wanted}};
+    my $got = $self->{got};
     foreach my $check (@checks) {
-        $check = qr/^\Q$check\E/ unless ref $check;
+        $check = "\Q$check\E" unless ($check =~ s,^/(.*)/$,$1, or ref $check);
         return 0 unless $got =~ s/^$check//;
     }
 
@@ -549,36 +548,36 @@ sub complaint
     if (Test::Builder::Tester::color)
     {
       # get color
-      eval "require Term::ANSIColor";
+      eval { require Term::ANSIColor };
       unless ($@)
       {
-	# colours
+        # colours
 
-	my $green = Term::ANSIColor::color("black").
-	            Term::ANSIColor::color("on_green");
+        my $green = Term::ANSIColor::color("black").
+                    Term::ANSIColor::color("on_green");
         my $red   = Term::ANSIColor::color("black").
                     Term::ANSIColor::color("on_red");
-	my $reset = Term::ANSIColor::color("reset");
+        my $reset = Term::ANSIColor::color("reset");
 
-	# work out where the two strings start to differ
-	my $char = 0;
-	$char++ while substr($got, $char, 1) eq substr($wanted, $char, 1);
-
-	# get the start string and the two end strings
-	my $start     = $green . substr($wanted, 0,   $char);
-	my $gotend    = $red   . substr($got   , $char) . $reset;
-	my $wantedend = $red   . substr($wanted, $char) . $reset;
-
-	# make the start turn green on and off
-	$start =~ s/\n/$reset\n$green/g;
-
-	# make the ends turn red on and off
-	$gotend    =~ s/\n/$reset\n$red/g;
-	$wantedend =~ s/\n/$reset\n$red/g;
-
-	# rebuild the strings
-	$got    = $start . $gotend;
-	$wanted = $start . $wantedend;
+        # work out where the two strings start to differ
+        my $char = 0;
+        $char++ while substr($got, $char, 1) eq substr($wanted, $char, 1);
+
+        # get the start string and the two end strings
+        my $start     = $green . substr($wanted, 0,   $char);
+        my $gotend    = $red   . substr($got   , $char) . $reset;
+        my $wantedend = $red   . substr($wanted, $char) . $reset;
+
+        # make the start turn green on and off
+        $start =~ s/\n/$reset\n$green/g;
+
+        # make the ends turn red on and off
+        $gotend    =~ s/\n/$reset\n$red/g;
+        $wantedend =~ s/\n/$reset\n$red/g;
+
+        # rebuild the strings
+        $got    = $start . $gotend;
+        $wanted = $start . $wantedend;
       }
     }
 
@@ -592,26 +591,30 @@ sub complaint
 sub reset
 {
     my $self = shift;
-    @$self = ($self->[0], '', []);
+    %$self = (
+              type   => $self->{type},
+              got    => '',
+              wanted => [],
+             );
 }
 
 
 sub got
 {
     my $self = shift;
-    return $self->[1];
+    return $self->{got};
 }
 
 sub wanted
 {
     my $self = shift;
-    return $self->[2];
+    return $self->{wanted};
 }
 
 sub type
 {
     my $self = shift;
-    return $self->[0];
+    return $self->{type};
 }
 
 ###
@@ -620,13 +623,16 @@ sub type
 
 sub PRINT  {
     my $self = shift;
-    $self->[1] .= join '', @_;
+    $self->{got} .= join '', @_;
 }
 
 sub TIEHANDLE {
     my($class, $type) = @_;
 
-    my $self = bless [$type], $class;
+    my $self = bless {
+                   type => $type
+               }, $class;
+
     $self->reset;
 
     return $self;

perl-5.8.8-rhbz238581.patch:

--- NEW FILE perl-5.8.8-rhbz238581.patch ---
diff -up perl-5.8.8/ext/Socket/Socket.xs.crr perl-5.8.8/ext/Socket/Socket.xs
--- perl-5.8.8/ext/Socket/Socket.xs.crr	2005-07-08 17:56:17.000000000 +0200
+++ perl-5.8.8/ext/Socket/Socket.xs	2008-03-19 14:24:02.000000000 +0100
@@ -236,7 +236,8 @@ inet_aton(host)
 		(*host != '\0') &&
 		inet_aton(host, &ip_address);
 
-	if (!ok && (phe = gethostbyname(host))) {
+	if (!ok && (phe = gethostbyname(host)) &&
+		phe->h_addrtype == AF_INET && phe->h_length == 4) {
 		Copy( phe->h_addr, &ip_address, phe->h_length, char );
 		ok = 1;
 	}


Index: perl.spec
===================================================================
RCS file: /cvs/pkgs/rpms/perl/F-8/perl.spec,v
retrieving revision 1.149
retrieving revision 1.150
diff -u -r1.149 -r1.150
--- perl.spec	13 Mar 2008 14:21:00 -0000	1.149
+++ perl.spec	20 Mar 2008 08:45:25 -0000	1.150
@@ -24,7 +24,7 @@
 
 Name:           perl
 Version:        %{perl_version}
-Release:        37%{?dist}
+Release:        38%{?dist}
 Epoch:          %{perl_epoch}
 Summary:        The Perl programming language
 Group:          Development/Languages
@@ -136,12 +136,16 @@
 Patch46:	perl-5.8.8-Scalar-Util-19.patch
 # 431774 CGI.pm Version 3.15 Contains Broken File Upload Method
 Patch47:	perl-5.8.8-CGI-3.29.patch
+# update Test::Simple
+Patch48:    perl-5.8.8-TestSimple0.78.patch
+# beter check of gethostbyname, fixed in upstream
+Patch49:    perl-5.8.8-rhbz238581.patch
 
 BuildRoot:      %{_tmppath}/%{name}-%{perl_version}-%{release}-root-%(%{__id_u} -n)
 BuildRequires:  tcsh, dos2unix, man, groff
 BuildRequires:  gdbm-devel, db4-devel
 # Temporary fix for broken buildroots:
-BuildRequires:  gawk
+#BuildRequires:  gawk
 
 # The long line of Perl provides.
 
@@ -410,6 +414,8 @@
 %patch45 -p1
 %patch46 -p1
 %patch47 -p1
+%patch48 -p1
+%patch49 -p1
 
 #
 # Candidates for doc recoding (need case by case review):
@@ -811,6 +817,11 @@
 # Nothing. Nada. Zilch. Zarro. Uh uh. Nope. Sorry.
 
 %changelog
+* Wed Mar 19 2008 Marcela Maslanova <mmaslano at redhat.com> - 4:5.8.8-38
+- 434865 upgrade Test::Simple
+- turn off test on loading Dummy in More.t, can't find module (path problem?)
+- 238581: careless use of gethostbyname() in Socket.xs
+
 * Thu Mar 13 2008 Marcela Maslanova <mmaslano at redhat.com> - 4:5.8.8-37
 - update CGI, because of broken upload method #431774

More information about the fedora-extras-commits mailing list