view release on metacpan or  search on metacpan

lib/B/DeparseTree/TreeMain.pm  view on Meta::CPAN

	$info = $self->coderef2info($func);
    }
    return $self->info2str($info);
}

sub const {
    my $self = shift;
    my($sv, $cx) = @_;
    if ($self->{'use_dumper'}) {
	return $self->const_dumper($sv, $cx);
    }
    if (class($sv) eq "SPECIAL") {
	# sv_undef, sv_yes, sv_no
	my $text = ('undef', '1', $self->maybe_parens("!1", $cx, 21))[$$sv-1];
	return $self->info_from_string('const: special', $sv, $text);
    }
    if (class($sv) eq "NULL") {
	return $self->info_from_string('const: NULL', $sv, 'undef');
    }
    # convert a version object into the "v1.2.3" string in its V magic
    if ($sv->FLAGS & SVs_RMG) {
	for (my $mg = $sv->MAGIC; $mg; $mg = $mg->MOREMAGIC) {
	    if ($mg->TYPE eq 'V') {
		return $self->info_from_string('const_magic', $sv,
					       $mg->PTR);
	    }
	}
    }

    if ($sv->FLAGS & SVf_IOK) {
	my $str = $sv->int_value;
	$str = $self->maybe_parens($str, $cx, 21) if $str < 0;
	return $self->info_from_string("const: integer $str", $sv, $str);
    } elsif ($sv->FLAGS & SVf_NOK) {
	my $nv = $sv->NV;
	if ($nv == 0) {
	    if (pack("F", $nv) eq pack("F", 0)) {
		# positive zero
		return $self->info_from_string('const: float positive 0',
					       $sv,
					       "0");
	    } else {
		# negative zero
		return $self->info_from_string('const: float negative 0',
					       $sv, $self,
					       $self->maybe_parens("-.0", $cx, 21));
	    }
	} elsif (1/$nv == 0) {
	    if ($nv > 0) {
		# positive infinity
		return $self->info_from_string('const: float +infinity',
					       $sv,
					       $self->maybe_parens("9**9**9", $cx, 22));
	    } else {
		# negative infinity
		return $self->info_from_string('const: float -infinity',
					       $sv,
					       $self->maybe_parens("-9**9**9", $cx, 21));
	    }
	} elsif ($nv != $nv) {
	    # NaN
	    if (pack("F", $nv) eq pack("F", sin(9**9**9))) {
		# the normal kind
		return info_from_text($sv, $self, "sin(9**9**9)", 'const_Nan', {});
	    } elsif (pack("F", $nv) eq pack("F", -sin(9**9**9))) {
		# the inverted kind
		return info_from_text($sv, $self, $self->maybe_parens("-sin(9**9**9)", $cx, 21),
				 'const: float Nan invert', {});
	    } else {
		# some other kind
		my $hex = unpack("h*", pack("F", $nv));
		return info_from_text($sv, $self, qq'unpack("F", pack("h*", "$hex"))',
				 'const: Na na na', {});
	    }
	}
	# first, try the default stringification
	my $str = "$nv";
	if ($str != $nv) {
	    # failing that, try using more precision
	    $str = sprintf("%.${max_prec}g", $nv);
	    # if (pack("F", $str) ne pack("F", $nv)) {
	    if ($str != $nv) {
		# not representable in decimal with whatever sprintf()
		# and atof() Perl is using here.
		my($mant, $exp) = B::Deparse::split_float($nv);
		return info_from_text($sv, $self, $self->maybe_parens("$mant * 2**$exp", $cx, 19),
				 'const: float not-sprintf/atof-able', {});
	    }
	}
	$str = $self->maybe_parens($str, $cx, 21) if $nv < 0;
	return info_from_text($sv, $self, $str, 'constant nv', {});
    } elsif ($sv->FLAGS & SVf_ROK && $sv->can("RV")) {
	my $ref = $sv->RV;
	if (class($ref) eq "AV") {
	    my $list_info = $self->list_const($sv, 2, $ref->ARRAY);
	    return info_from_list($sv, $self, ['[', $list_info->{text}, ']'], '', 'const_av',
		{body => [$list_info]});
	} elsif (class($ref) eq "HV") {
	    my %hash = $ref->ARRAY;
	    my @elts;
	    for my $k (sort keys %hash) {
		push @elts, "$k => " . $self->const($hash{$k}, 6);
	    }
	    return info_from_list($sv, $self, ["{", join(", ", @elts), "}"], '',
				  'constant hash value', {});
	} elsif (class($ref) eq "CV") {
	    BEGIN {
		if ($] > 5.0150051) {
		    require overloading;
		    unimport overloading;
		}
	    }
	    if ($] > 5.0150051 && $self->{curcv} &&
		$self->{curcv}->object_2svref == $ref->object_2svref) {
		return $self->info_from_string('sub __SUB__', $sv,
					       $self->keyword("__SUB__"));
	    }
	    my $sub_info = $self->deparse_sub($ref);
	    return info_from_list($sub_info->{op}, $self, ["sub ", $sub_info->{text}], '',
				  'constant sub 2',
				  {body => [$sub_info]});