Fix objectify()'s handling of "foreign objects".

- Fix handling of "foreign objects" so they are converted to the
  appropriate class (Math::BigInt or Math::BigFloat).
- Avoid code duplication by using only one loop.
- Loop over indexes rather than array elements to make code cleaner.
- Fix incorrect code comments, add more code comments and clearify
  existing ones.
- Correct handling of undefs to make the code consistent. objectify()
  gave different output when the initial "shortcut" was removed.
- Add test file verifying that RT#16221 is fixed.

This fix closes RT #16221 and RT #52124. This patch supersedes Perl #86146.

2 files changed, 199 insertions, 87 deletions

diff --git a/dist/Math-BigInt/lib/Math/BigInt.pm b/dist/Math-BigInt/lib/Math/BigInt.pm
index 796b75aba1..4757db1026 100644
--- a/dist/Math-BigInt/lib/Math/BigInt.pm
+++ b/dist/Math-BigInt/lib/Math/BigInt.pm
@@ -2589,102 +2589,137 @@ sub as_oct
 ##############################################################################
 # private stuff (internal use only)
 
-sub objectify
-  {
-  # check for strings, if yes, return objects instead
- 
-  # the first argument is number of args objectify() should look at it will
-  # return $count+1 elements, the first will be a classname. This is because
-  # overloaded '""' calls bstr($object,undef,undef) and this would result in
-  # useless objects being created and thrown away. So we cannot simple loop
-  # over @_. If the given count is 0, all arguments will be used.
- 
-  # If the second arg is a ref, use it as class.
-  # If not, try to use it as classname, unless undef, then use $class 
-  # (aka Math::BigInt). The latter shouldn't happen,though.
-
-  # caller:			   gives us:
-  # $x->badd(1);                => ref x, scalar y
-  # Class->badd(1,2);           => classname x (scalar), scalar x, scalar y
-  # Class->badd( Class->(1),2); => classname x (scalar), ref x, scalar y
-  # Math::BigInt::badd(1,2);    => scalar x, scalar y
-  # In the last case we check number of arguments to turn it silently into
-  # $class,1,2. (We can not take '1' as class ;o)
-  # badd($class,1) is not supported (it should, eventually, try to add undef)
-  # currently it tries 'Math::BigInt' + 1, which will not work.
-
-  # some shortcut for the common cases
-  # $x->unary_op();
-  return (ref($_[1]),$_[1]) if (@_ == 2) && ($_[0]||0 == 1) && ref($_[1]);
-
-  my $count = abs(shift || 0);
-  
-  my (@a,$k,$d);		# resulting array, temp, and downgrade 
-  if (ref $_[0])
-    {
-    # okay, got object as first
-    $a[0] = ref $_[0];
+sub objectify {
+    # Convert strings and "foreign objects" to the objects we want.
+
+    # The first argument, $count, is the number of following arguments that
+    # objectify() looks at and converts to objects. The first is a classname.
+    # If the given count is 0, all arguments will be used.
+
+    # After the count is read, objectify obtains the name of the class to which
+    # the following arguments are converted. If the second argument is a
+    # reference, use the reference type as the class name. Otherwise, if it is
+    # a string that looks like a class name, use that. Otherwise, use $class.
+
+    # Caller:                        Gives us:
+    #
+    # $x->badd(1);                => ref x, scalar y
+    # Class->badd(1,2);           => classname x (scalar), scalar x, scalar y
+    # Class->badd(Class->(1),2);  => classname x (scalar), ref x, scalar y
+    # Math::BigInt::badd(1,2);    => scalar x, scalar y
+
+    # A shortcut for the common case $x->unary_op():
+
+    return (ref($_[1]), $_[1]) if (@_ == 2) && ($_[0]||0 == 1) && ref($_[1]);
+
+    # Check the context.
+
+    unless (wantarray) {
+        require Carp;
+        Carp::croak ("${class}::objectify() needs list context");
     }
-  else
+
+    # Get the number of arguments to objectify.
+
+    my $count = shift;
+    $count ||= @_;
+
+    # Initialize the output array.
+
+    my @a = @_;
+
+    # If the first argument is a reference, use that reference type as our
+    # class name. Otherwise, if the first argument looks like a class name,
+    # then use that as our class name. Otherwise, use the default class name.
+
     {
-    # nope, got 1,2 (Class->xxx(1) => Class,1 and not supported)
-    $a[0] = $class;
-    $a[0] = shift if $_[0] =~ /^[A-Z].*::/;	# classname as first?
+        if (ref($a[0])) {               # reference?
+            unshift @a, ref($a[0]);
+            last;
+        }
+        if ($a[0] =~ /^[A-Z].*::/) {    # string with class name?
+            last;
+        }
+        unshift @a, $class;             # default class name
     }
 
-  no strict 'refs';
-  # disable downgrading, because Math::BigFLoat->foo('1.0','2.0') needs floats
-  if (defined ${"$a[0]::downgrade"})
-    {
-    $d = ${"$a[0]::downgrade"};
-    ${"$a[0]::downgrade"} = undef;
+    no strict 'refs';
+
+    # What we upgrade to, if anything.
+
+    my $up = ${"$a[0]::upgrade"};
+
+    # Disable downgrading, because Math::BigFloat -> foo('1.0','2.0') needs
+    # floats.
+
+    my $down;
+    if (defined ${"$a[0]::downgrade"}) {
+        $down = ${"$a[0]::downgrade"};
+        ${"$a[0]::downgrade"} = undef;
     }
 
-  my $up = ${"$a[0]::upgrade"};
-  # print STDERR "# Now in objectify, my class is today $a[0], count = $count\n";
-  if ($count == 0)
-    {
-    while (@_)
-      {
-      $k = shift;
-      if (!ref($k))
-        {
-        $k = $a[0]->new($k);
+    for my $i (1 .. $count) {
+        my $ref = ref $a[$i];
+
+        # If it is an object of the right class, all is fine.
+
+        if ($ref eq $a[0]) {
+            next;
         }
-      elsif (!defined $up && ref($k) ne $a[0])
-	{
-	# foreign object, try to convert to integer
-        $k->can('as_number') ?  $k = $k->as_number() : $k = $a[0]->new($k);
-	}
-      push @a,$k;
-      }
-    }
-  else
-    {
-    while ($count > 0)
-      {
-      $count--; 
-      $k = shift;
-      if (!ref($k))
-        {
-        $k = $a[0]->new($k);
+
+        # Don't do anything with undefs.
+
+        unless (defined($a[$i])) {
+            next;
         }
-      elsif (ref($k) ne $a[0] and !defined $up || ref $k ne $up)
-	{
-	# foreign object, try to convert to integer
-        $k->can('as_number') ? $k = $k->as_number() : $k = $a[0]->new($k);
-	}
-      push @a,$k;
-      }
-    push @a,@_;		# return other params, too
-    }
-  if (! wantarray)
-    {
-    require Carp; Carp::croak ("$class objectify needs list context");
+
+        # Perl scalars are fed to the appropriate constructor.
+
+        unless ($ref) {
+            $a[$i] = $a[0] -> new($a[$i]);
+            next;
+        }
+
+        # Upgrading is OK, so skip further tests if the argument is upgraded.
+
+        if (defined $up && $ref eq $up) {
+            next;
+        }
+
+        # If we want a Math::BigInt, see if the object can become one.
+        # Support the old misnomer as_number().
+
+        if ($a[0] eq 'Math::BigInt') {
+            if ($a[$i] -> can('as_int')) {
+                $a[$i] = $a[$i] -> as_int();
+                next;
+            }
+            if ($a[$i] -> can('as_number')) {
+                $a[$i] = $a[$i] -> as_number();
+                next;
+            }
+        }
+
+        # If we want a Math::BigFloat, see if the object can become one.
+
+        if ($a[0] eq 'Math::BigFloat') {
+            if ($a[$i] -> can('as_float')) {
+                $a[$i] = $a[$i] -> as_float();
+                next;
+            }
+        }
+
+        # Last resort.
+
+        $a[$i] = $a[0] -> new($a[$i]);
     }
-  ${"$a[0]::downgrade"} = $d;
-  @a;
-  }
+
+    # Reset the downgrading.
+
+    ${"$a[0]::downgrade"} = $down;
+
+    return @a;
+}
 
 sub _register_callback
   {
diff --git a/dist/Math-BigInt/t/rt-16221.t b/dist/Math-BigInt/t/rt-16221.t
new file mode 100755
index 0000000000..a1dc2c6a3a
--- /dev/null
+++ b/dist/Math-BigInt/t/rt-16221.t
@@ -0,0 +1,77 @@
+#!/usr/bin/perl
+#
+# Verify that
+#   - Math::BigInt::objectify() calls as_int() (or as_number(), as a fallback)
+#     if the target object class is Math::BigInt.
+#   - Math::BigInt::objectify() calls as_float() if the target object class is
+#     Math::BigFloat.
+#
+# See RT #16221 and RT #52124.
+
+use strict;
+use warnings;
+
+package main;
+
+use Test::More tests => 2;
+use Math::BigInt;
+use Math::BigFloat;
+
+############################################################################
+
+my $int = Math::BigInt->new(10);
+my $int_percent = My::Percent::Float->new(100);
+
+is($int * $int_percent, 10);
+
+############################################################################
+
+my $float = Math::BigFloat->new(10);
+my $float_percent = My::Percent::Float->new(100);
+
+is($float * $float_percent, 10);
+
+############################################################################
+
+package My::Percent::Int;
+
+sub new {
+    my $class = shift;
+    my $num = shift;
+    return bless \$num, $class;
+}
+
+sub as_number {
+    my $self = shift;
+    return Math::BigInt->new($$self / 100);
+}
+
+sub as_string {
+    my $self = shift;
+    return $$self;
+}
+
+############################################################################
+
+package My::Percent::Float;
+
+sub new {
+    my $class = shift;
+    my $num = shift;
+    return bless \$num, $class;
+}
+
+sub as_int {
+    my $self = shift;
+    return Math::BigInt->new($$self / 100);
+}
+
+sub as_float {
+    my $self = shift;
+    return Math::BigFloat->new($$self / 100);
+}
+
+sub as_string {
+    my $self = shift;
+    return $$self;
+}