kylekrein/live-bootstrap
1
0
Fork 0
mirror of https://github.com/fosslinux/live-bootstrap.git synced 2026-03-04 10:25:25 +01:00
Code Issues Projects Releases Packages Wiki Activity Actions
live-bootstrap/steps/perl-5.36.3/patches/Revert-mktables-Use-builtin-refaddr.patch
Samuel Tyler bbccded731
Use a "real" copyright line
2025-10-17 18:53:10 +11:00

911 lines
36 KiB
Diff
Raw Permalink Blame History

SPDX-FileCopyrightText: 2021 Karl Williamson <khw@cpan.org>
SPDX-FileCopyrightText: 2025 Samuel Tyler <samuel@samuelt.me>
SPDX-License-Identifier: Artistic-1.0
builtin is not available in Perl 5.30. Remove the use of it for now.
From 2cbb69f4dff9a096b47771b8d7c64008458df57a Mon Sep 17 00:00:00 2001
From: Samuel Tyler <fosslinux@aussies.space>
Date: Sun, 7 Sep 2025 14:32:20 +1000
Subject: [PATCH] Revert "mktables: Use builtin::refaddr"
This reverts commit 812ea1980cc75f8ec5d7942ca228dce43bca2d26.
---
lib/unicore/mktables | 222 ++++++++++++++++++++++++-------------------
1 file changed, 125 insertions(+), 97 deletions(-)
diff --git perl-5.36.3/lib/unicore/mktables perl-5.36.3/lib/unicore/mktables
index de2db8467b..ce6995f0f4 100644
--- perl-5.36.3/lib/unicore/mktables
+++ perl-5.36.3/lib/unicore/mktables
@@ -22,7 +22,6 @@ BEGIN { # Get the time the script started running; do it at compilation to
require 5.010_001;
use strict;
use warnings;
-use builtin qw(refaddr);
use Carp;
use Config;
use File::Find;
@@ -33,7 +32,6 @@ use re "/aa";
use feature 'state';
use feature 'signatures';
-no warnings qw( experimental::builtin );
sub DEBUG () { 0 } # Set to 0 for production; 1 for development
my $debugging_build = $Config{"ccflags"} =~ /-DDEBUGGING/;
@@ -1495,7 +1493,10 @@ sub objaddr($addr) {
# every call, and the program is structured so that this is never called
# for a non-blessed object.
- return pack 'J', refaddr $addr;
+ no overloading; # If overloaded, numifying below won't work.
+
+ # Numifying a ref gives its address.
+ return pack 'J', $addr;
}
# These are used only if $annotate is true.
@@ -1856,7 +1857,7 @@ package main;
# Use typeglob to give the anonymous subroutine the name we want
*$destroy_name = sub {
my $self = shift;
- my $addr = pack 'J', refaddr $self;
+ my $addr = do { no overloading; pack 'J', $self; };
$self->$destroy_callback if $destroy_callback;
foreach my $field (keys %{$package_fields{$package}}) {
@@ -1952,7 +1953,7 @@ package main;
# determine using 'eq' for scalars and '==' otherwise.
*$subname = sub ($self, $value) {
use strict "refs";
- my $addr = pack 'J', refaddr $self;
+ my $addr = do { no overloading; pack 'J', $self; };
if (ref $value) {
return if grep { $value == $_ } @{$field->{$addr}};
}
@@ -1984,7 +1985,7 @@ package main;
no strict "refs";
*$subname = sub ($_addr) {
use strict "refs";
- my $addr = pack 'J', refaddr $_addr;
+ my $addr = do { no overloading; pack 'J', $_addr; };
if (ref $field->{$addr} ne 'ARRAY') {
my $type = ref $field->{$addr};
$type = 'scalar' unless $type;
@@ -2005,7 +2006,8 @@ package main;
no strict "refs";
*$subname = sub ($addr) {
use strict "refs";
- return $field->{pack 'J', refaddr $addr};
+ no overloading;
+ return $field->{pack 'J', $addr};
}
}
}
@@ -2015,7 +2017,8 @@ package main;
*$subname = sub ($self, $value) {
use strict "refs";
# $self is $_[0]; $value is $_[1]
- $field->{pack 'J', refaddr $self} = $value;
+ no overloading;
+ $field->{pack 'J', $self} = $value;
return;
}
}
@@ -2320,7 +2323,7 @@ sub trace { return main::trace(@_); }
my $class = shift;
my $self = bless \do{ my $anonymous_scalar }, $class;
- my $addr = pack 'J', refaddr $self;
+ my $addr = do { no overloading; pack 'J', $self; };
# Set defaults
$handler{$addr} = \&main::process_generic_property_file;
@@ -2648,7 +2651,7 @@ END
# flag to make sure extracted files are processed early
state $seen_non_extracted = 0;
- my $addr = pack 'J', refaddr $self;
+ my $addr = do { no overloading; pack 'J', $self; };
my $file = $file{$addr};
@@ -2895,7 +2898,7 @@ END
# been added via insert_lines() will be returned in $_ before the file
# is read again.
- my $addr = pack 'J', refaddr $self;
+ my $addr = do { no overloading; pack 'J', $self; };
# Here the file is open (or if the handle is not a ref, is an open
# 'virtual' file). Get the next line; any inserted lines get priority
@@ -3076,7 +3079,7 @@ END
# insertion code will sort and coalesce the individual code points
# into appropriate ranges.)
- my $addr = pack 'J', refaddr $self;
+ my $addr = do { no overloading; pack 'J', $self; };
while (1) {
@@ -3151,7 +3154,7 @@ END
# # an each_line_handler() on the line.
#
# my $self = shift;
-# my $addr = pack 'J', refaddr $self;
+# my $addr = do { no overloading; pack 'J', $self; };
#
# foreach my $inserted_ref (@{$added_lines{$addr}}) {
# my ($adjusted, $line) = @{$inserted_ref};
@@ -3190,7 +3193,8 @@ END
# Each inserted line is an array, with the first element being 0 to
# indicate that this line hasn't been adjusted, and needs to be
# processed.
- push @{$added_lines{pack 'J', refaddr $self}}, map { [ 0, $_ ] } @lines;
+ no overloading;
+ push @{$added_lines{pack 'J', $self}}, map { [ 0, $_ ] } @lines;
return;
}
@@ -3212,7 +3216,8 @@ END
# Each inserted line is an array, with the first element being 1 to
# indicate that this line has been adjusted
- push @{$added_lines{pack 'J', refaddr $self}}, map { [ 1, $_ ] } @lines;
+ no overloading;
+ push @{$added_lines{pack 'J', $self}}, map { [ 1, $_ ] } @lines;
return;
}
@@ -3222,7 +3227,7 @@ END
# element, and the property in the 2nd. However, since these lines
# can be stacked up, the return is an array of all these arrays.
- my $addr = pack 'J', refaddr $self;
+ my $addr = do { no overloading; pack 'J', $self; };
# If not accepting a list return, just return the first one.
return shift @{$missings{$addr}} unless wantarray;
@@ -3294,7 +3299,7 @@ END
# Hangul syllables in this release only are something else, so if
# using such data, we have to override it
- my $addr = pack 'J', refaddr $self;
+ my $addr = do { no overloading; pack 'J', $self; };
my $object = main::property_ref($property{$addr});
$object->add_map($FIRST_REMOVED_HANGUL_SYLLABLE,
@@ -3306,7 +3311,9 @@ END
sub _insert_property_into_line($self) {
# Add a property field to $_, if this file requires it.
- my $property = $property{pack 'J', refaddr $self};
+ my $addr = do { no overloading; pack 'J', $self; };
+ my $property = $property{$addr};
+
$_ =~ s/(;|$)/; $property$1/;
return;
}
@@ -3318,7 +3325,7 @@ END
# only outputs the first instance of each message, incrementing a
# count so the totals can be output at the end of the file.
- my $addr = pack 'J', refaddr $self;
+ my $addr = do { no overloading; pack 'J', $self; };
$message = 'Unexpected line' unless $message;
@@ -3384,7 +3391,7 @@ package Multi_Default;
my $class = shift;
my $self = bless \do{my $anonymous_scalar}, $class;
- my $addr = pack 'J', refaddr $self;
+ my $addr = do { no overloading; pack 'J', $self; };
while (@_ > 1) {
my $default = shift;
@@ -3400,7 +3407,9 @@ package Multi_Default;
sub get_next_defaults($self) {
# Iterates and returns the next class of defaults.
- return each %{$class_defaults{pack 'J', refaddr $self}};
+ my $addr = do { no overloading; pack 'J', $self; };
+
+ return each %{$class_defaults{$addr}};
}
}
@@ -3447,7 +3456,7 @@ package Alias;
my $class = shift;
my $self = bless \do { my $anonymous_scalar }, $class;
- my $addr = pack 'J', refaddr $self;
+ my $addr = do { no overloading; pack 'J', $self; };
$name{$addr} = shift;
$loose_match{$addr} = shift;
@@ -3507,7 +3516,7 @@ sub trace { return main::trace(@_); }
sub new($class, $_addr, $_end, @_args) {
my $self = bless \do { my $anonymous_scalar }, $class;
- my $addr = pack 'J', refaddr $self;
+ my $addr = do { no overloading; pack 'J', $self; };
$start{$addr} = $_addr;
$end{$addr} = $_end;
@@ -3533,7 +3542,7 @@ sub trace { return main::trace(@_); }
;
sub _operator_stringify($self, $other="", $reversed=0) {
- my $addr = pack 'J', refaddr $self;
+ my $addr = do { no overloading; pack 'J', $self; };
# Output it like '0041..0065 (value)'
my $return = sprintf("%04X", $start{$addr})
@@ -3556,7 +3565,7 @@ sub trace { return main::trace(@_); }
# of writing there are 368676 non-special objects, but the standard
# form is only requested for 22047 of them - ie about 6%.
- my $addr = pack 'J', refaddr $self;
+ my $addr = do { no overloading; pack 'J', $self; };
return $standard_form{$addr} if defined $standard_form{$addr};
@@ -3568,7 +3577,7 @@ sub trace { return main::trace(@_); }
sub dump($self, $indent) {
# Human, not machine readable. For machine readable, comment out this
# entire routine and let the standard one take effect.
- my $addr = pack 'J', refaddr $self;
+ my $addr = do { no overloading; pack 'J', $self; };
my $return = $indent
. sprintf("%04X", $start{$addr})
@@ -3654,7 +3663,7 @@ sub trace { return main::trace(@_); }
return _union($class, $initialize, %args) if defined $initialize;
$self = bless \do { my $anonymous_scalar }, $class;
- my $addr = pack 'J', refaddr $self;
+ my $addr = do { no overloading; pack 'J', $self; };
# Optional parent object, only for debug info.
$owner_name_of{$addr} = delete $args{'Owner'};
@@ -3684,7 +3693,7 @@ sub trace { return main::trace(@_); }
;
sub _operator_stringify($self, $other="", $reversed=0) {
- my $addr = pack 'J', refaddr $self;
+ my $addr = do { no overloading; pack 'J', $self; };
return "Range_List attached to '$owner_name_of{$addr}'"
if $owner_name_of{$addr};
@@ -3749,7 +3758,8 @@ sub trace { return main::trace(@_); }
if (! defined $arg) {
my $message = "";
if (defined $self) {
- $message .= $owner_name_of{pack 'J', refaddr $self};
+ no overloading;
+ $message .= $owner_name_of{pack 'J', $self};
}
Carp::my_carp_bug($message . "Undefined argument to _union. No union done.");
return;
@@ -3774,7 +3784,8 @@ sub trace { return main::trace(@_); }
else {
my $message = "";
if (defined $self) {
- $message .= $owner_name_of{pack 'J', refaddr $self};
+ no overloading;
+ $message .= $owner_name_of{pack 'J', $self};
}
Carp::my_carp_bug($message . "Cannot take the union of a $type. No union done.");
return;
@@ -3821,7 +3832,8 @@ sub trace { return main::trace(@_); }
}
sub range_count($self) { # Return the number of ranges in the range list
- return scalar @{$ranges{pack 'J', refaddr $self}};
+ no overloading;
+ return scalar @{$ranges{pack 'J', $self}};
}
sub min($self) {
@@ -3831,7 +3843,7 @@ sub trace { return main::trace(@_); }
# and having to worry about changing it as ranges are added and
# deleted.
- my $addr = pack 'J', refaddr $self;
+ my $addr = do { no overloading; pack 'J', $self; };
# If the range list is empty, return a large value that isn't adjacent
# to any that could be in the range list, for simpler tests
@@ -3852,7 +3864,8 @@ sub trace { return main::trace(@_); }
# range[$i-1]->end < $codepoint <= range[$i]->end
# So is in the table if and only iff it is at least the start position
# of range $i.
- return 0 if $ranges{pack 'J', refaddr $self}->[$i]->start > $codepoint;
+ no overloading;
+ return 0 if $ranges{pack 'J', $self}->[$i]->start > $codepoint;
return $i + 1;
}
@@ -3862,7 +3875,8 @@ sub trace { return main::trace(@_); }
return unless $i;
# contains() returns 1 beyond where we should look
- return $ranges{pack 'J', refaddr $self}->[$i-1];
+ no overloading;
+ return $ranges{pack 'J', $self}->[$i-1];
}
sub value_of($self, $codepoint) {
@@ -3888,7 +3902,7 @@ sub trace { return main::trace(@_); }
# range[$i-1]->end < $codepoint <= range[$i]->end
# Returns undef if no such $i is possible (e.g. at end of table), or
# if there is an error.
- my $addr = pack 'J', refaddr $self;
+ my $addr = do { no overloading; pack 'J', $self; };
return if $code_point > $max{$addr};
my $r = $ranges{$addr}; # The current list of ranges
@@ -4076,7 +4090,7 @@ sub trace { return main::trace(@_); }
Carp::carp_extra_args(\%args) if main::DEBUG && %args;
- my $addr = pack 'J', refaddr $self;
+ my $addr = do { no overloading; pack 'J', $self; };
if ($operation ne '+' && $operation ne '-') {
Carp::my_carp_bug("$owner_name_of{$addr}First parameter to _add_delete must be '+' or '-'. No action taken.");
@@ -4721,14 +4735,15 @@ sub trace { return main::trace(@_); }
}
sub reset_each_range($self) { # reset the iterator for each_range();
- undef $each_range_iterator{pack 'J', refaddr $self};
+ no overloading;
+ undef $each_range_iterator{pack 'J', $self};
return;
}
sub each_range($self) {
# Iterate over each range in a range list. Results are undefined if
# the range list is changed during the iteration.
- my $addr = pack 'J', refaddr $self;
+ my $addr = do { no overloading; pack 'J', $self; };
return if $self->is_empty;
@@ -4742,7 +4757,7 @@ sub trace { return main::trace(@_); }
}
sub count($self) { # Returns count of code points in range list
- my $addr = pack 'J', refaddr $self;
+ my $addr = do { no overloading; pack 'J', $self; };
my $count = 0;
foreach my $range (@{$ranges{$addr}}) {
@@ -4756,14 +4771,15 @@ sub trace { return main::trace(@_); }
}
sub is_empty($self) { # Returns boolean as to if a range list is empty
- return scalar @{$ranges{pack 'J', refaddr $self}} == 0;
+ no overloading;
+ return scalar @{$ranges{pack 'J', $self}} == 0;
}
sub hash($self) {
# Quickly returns a scalar suitable for separating tables into
# buckets, i.e. it is a hash function of the contents of a table, so
# there are relatively few conflicts.
- my $addr = pack 'J', refaddr $self;
+ my $addr = do { no overloading; pack 'J', $self; };
# These are quickly computable. Return looks like 'min..max;count'
return $self->min . "..$max{$addr};" . scalar @{$ranges{$addr}};
@@ -5312,7 +5328,7 @@ sub trace { return main::trace(@_); }
my $class = shift;
my $self = bless \do { my $anonymous_scalar }, $class;
- my $addr = pack 'J', refaddr $self;
+ my $addr = do { no overloading; pack 'J', $self; };
my %args = @_;
@@ -5497,7 +5513,8 @@ END
sub ranges {
# Returns the array of ranges associated with this table.
- return $range_list{pack 'J', refaddr shift}->ranges;
+ no overloading;
+ return $range_list{pack 'J', shift}->ranges;
}
sub add_alias {
@@ -5538,7 +5555,7 @@ END
# release
$name = ucfirst($name) unless $name =~ /^k[A-Z]/;
- my $addr = pack 'J', refaddr $self;
+ my $addr = do { no overloading; pack 'J', $self; };
# Figure out if should be loosely matched if not already specified.
if (! defined $loose_match) {
@@ -5599,7 +5616,8 @@ END
# This name may be shorter than any existing ones, so clear the cache
# of the shortest, so will have to be recalculated.
- undef $short_name{pack 'J', refaddr $self};
+ no overloading;
+ undef $short_name{pack 'J', $self};
return;
}
@@ -5618,7 +5636,7 @@ END
# Any name with alphabetics is preferred over an all numeric one, even
# if longer.
- my $addr = pack 'J', refaddr $self;
+ my $addr = do { no overloading; pack 'J', $self; };
# For efficiency, don't recalculate, but this means that adding new
# aliases could change what the shortest is, so the code that does
@@ -5721,13 +5739,15 @@ END
}
sub add_description($self, $description) { # Adds the parameter as a short description.
- push @{$description{pack 'J', refaddr $self}}, $description;
+ no overloading;
+ push @{$description{pack 'J', $self}}, $description;
return;
}
sub add_note($self, $note) { # Adds the parameter as a short note.
- push @{$note{pack 'J', refaddr $self}}, $note;
+ no overloading;
+ push @{$note{pack 'J', $self}}, $note;
return;
}
@@ -5738,7 +5758,8 @@ END
chomp $comment;
- push @{$comment{pack 'J', refaddr $self}}, $comment;
+ no overloading;
+ push @{$comment{pack 'J', $self}}, $comment;
return;
}
@@ -5748,7 +5769,7 @@ END
# context, returns the array of comments. In scalar, returns a string
# of each element joined together with a period ending each.
- my $addr = pack 'J', refaddr $self;
+ my $addr = do { no overloading; pack 'J', $self; };
my @list = @{$comment{$addr}};
return @list if wantarray;
my $return = "";
@@ -5765,7 +5786,7 @@ END
# Initialize the table with the argument which is any valid
# initialization for range lists.
- my $addr = pack 'J', refaddr $self;
+ my $addr = do { no overloading; pack 'J', $self; };
# Replace the current range list with a new one of the same exact
# type.
@@ -5819,7 +5840,7 @@ END
# a range equals this one, don't write
# the range
- my $addr = pack 'J', refaddr $self;
+ my $addr = do { no overloading; pack 'J', $self; };
my $write_as_invlist = $write_as_invlist{$addr};
# Start with the header
@@ -6475,7 +6496,7 @@ END
sub set_status($self, $status, $info) { # Set the table's status
# status The status enum value
# info Any message associated with it.
- my $addr = pack 'J', refaddr $self;
+ my $addr = do { no overloading; pack 'J', $self; };
$status{$addr} = $status;
$status_info{$addr} = $info;
@@ -6483,7 +6504,7 @@ END
}
sub set_fate($self, $fate, $reason=undef) { # Set the fate of a table
- my $addr = pack 'J', refaddr $self;
+ my $addr = do { no overloading; pack 'J', $self; };
return if $fate{$addr} == $fate; # If no-op
@@ -6517,7 +6538,7 @@ END
# Don't allow changes to the table from now on. This stores a stack
# trace of where it was called, so that later attempts to modify it
# can immediately show where it got locked.
- my $addr = pack 'J', refaddr $self;
+ my $addr = do { no overloading; pack 'J', $self; };
$locked{$addr} = "";
@@ -6541,7 +6562,7 @@ END
sub carp_if_locked($self) {
# Return whether a table is locked or not, and, by the way, complain
# if is locked
- my $addr = pack 'J', refaddr $self;
+ my $addr = do { no overloading; pack 'J', $self; };
return 0 if ! $locked{$addr};
Carp::my_carp_bug("Can't modify a locked table. Stack trace of locking:\n$locked{$addr}\n\n");
@@ -6549,7 +6570,8 @@ END
}
sub set_file_path($self, @path) { # Set the final directory path for this table
- @{$file_path{pack 'J', refaddr $self}} = @path;
+ no overloading;
+ @{$file_path{pack 'J', $self}} = @path;
return
}
@@ -6691,7 +6713,7 @@ sub trace { return main::trace(@_); }
Write_As_Invlist => 0,
%args);
- my $addr = pack 'J', refaddr $self;
+ my $addr = do { no overloading; pack 'J', $self; };
$anomalous_entries{$addr} = [];
$default_map{$addr} = $default_map;
@@ -6751,7 +6773,7 @@ sub trace { return main::trace(@_); }
sub append_to_body($self) {
# Adds to the written HERE document of the table's body any anomalous
# entries in the table..
- my $addr = pack 'J', refaddr $self;
+ my $addr = do { no overloading; pack 'J', $self; };
return "" unless @{$anomalous_entries{$addr}};
return join("\n", @{$anomalous_entries{$addr}}) . "\n";
@@ -6800,7 +6822,7 @@ sub trace { return main::trace(@_); }
. " present, must be 'full_name'");
}
- my $addr = pack 'J', refaddr $self;
+ my $addr = do { no overloading; pack 'J', $self; };
# Convert the input to the standard equivalent, if any (won't have any
# for $STRING properties)
@@ -6845,7 +6867,7 @@ sub trace { return main::trace(@_); }
sub to_output_map($self) {
# Returns boolean: should we write this map table?
- my $addr = pack 'J', refaddr $self;
+ my $addr = do { no overloading; pack 'J', $self; };
# If overridden, use that
return $to_output_map{$addr} if defined $to_output_map{$addr};
@@ -6923,7 +6945,7 @@ END
# No sense generating a comment if aren't going to write it out.
return if ! $self->to_output_map;
- my $addr = pack 'J', refaddr $self;
+ my $addr = do { no overloading; pack 'J', $self; };
my $property = $self->property;
@@ -7102,7 +7124,7 @@ END
# Called in the middle of write when it finds a range it doesn't know
# how to handle.
- my $addr = pack 'J', refaddr $self;
+ my $addr = do { no overloading; pack 'J', $self; };
my $type = $range->type;
@@ -7244,7 +7266,7 @@ END
# be for all ranges missing from it. It also includes any code points
# which have map_types that don't go in the main table.
- my $addr = pack 'J', refaddr $self;
+ my $addr = do { no overloading; pack 'J', $self; };
my $name = $self->property->swash_name;
@@ -7343,7 +7365,7 @@ END
sub write($self) {
# Write the table to the file.
- my $addr = pack 'J', refaddr $self;
+ my $addr = do { no overloading; pack 'J', $self; };
# Clear the temporaries
undef @multi_code_point_maps;
@@ -7610,7 +7632,7 @@ sub trace { return main::trace(@_); }
Format => $EMPTY_FORMAT,
Write_As_Invlist => 1,
);
- my $addr = pack 'J', refaddr $self;
+ my $addr = do { no overloading; pack 'J', $self; };
$conflicting{$addr} = [ ];
$equivalents{$addr} = [ ];
@@ -7774,7 +7796,7 @@ sub trace { return main::trace(@_); }
# be an optional parameter.
Carp::carp_extra_args(\@_) if main::DEBUG && @_;
- my $addr = pack 'J', refaddr $self;
+ my $addr = do { no overloading; pack 'J', $self; };
# Check if the conflicting name is exactly the same as any existing
# alias in this table (as long as there is a real object there to
@@ -7817,7 +7839,8 @@ sub trace { return main::trace(@_); }
}
# Two tables are equivalent if they have the same leader.
- return $leader{pack 'J', refaddr $self} == $leader{pack 'J', refaddr $other};
+ no overloading;
+ return $leader{pack 'J', $self} == $leader{pack 'J', $other};
return;
}
@@ -7854,7 +7877,7 @@ sub trace { return main::trace(@_); }
my $are_equivalent = $self->is_set_equivalent_to($other);
return if ! defined $are_equivalent || $are_equivalent;
- my $addr = pack 'J', refaddr $self;
+ my $addr = do { no overloading; pack 'J', $self; };
my $current_leader = ($related) ? $parent{$addr} : $leader{$addr};
if ($related) {
@@ -7893,8 +7916,8 @@ sub trace { return main::trace(@_); }
return;
}
- my $leader = pack 'J', refaddr $current_leader;
- my $other_addr = pack 'J', refaddr $other;
+ my $leader = do { no overloading; pack 'J', $current_leader; };
+ my $other_addr = do { no overloading; pack 'J', $other; };
# Any tables that are equivalent to or children of this table must now
# instead be equivalent to or (children) to the new leader (parent),
@@ -7911,7 +7934,7 @@ sub trace { return main::trace(@_); }
next if $table == $other;
trace "setting $other to be the leader of $table, status=$status" if main::DEBUG && $to_trace;
- my $table_addr = pack 'J', refaddr $table;
+ my $table_addr = do { no overloading; pack 'J', $table; };
$leader{$table_addr} = $other;
$matches_all{$table_addr} = $matches_all;
$self->_set_range_list($other->_range_list);
@@ -7944,7 +7967,8 @@ sub trace { return main::trace(@_); }
Carp::my_carp_bug("Can't set $self to be the complement of $other, which itself is the complement of " . $other->complement);
return;
}
- $complement{pack 'J', refaddr $self} = $other;
+ my $addr = do { no overloading; pack 'J', $self; };
+ $complement{$addr} = $other;
# Be sure the other property knows we are depending on them; or the
# other table if it is one in the current property.
@@ -8232,7 +8256,7 @@ sub trace { return main::trace(@_); }
return unless $debugging_build;
- my $addr = pack 'J', refaddr $leader;
+ my $addr = do { no overloading; pack 'J', $leader; };
if ($leader{$addr} != $leader) {
Carp::my_carp_bug(<<END
@@ -8300,7 +8324,7 @@ END
&& $parent == $property->table('N')
&& defined (my $yes = $property->table('Y')))
{
- my $yes_addr = pack 'J', refaddr $yes;
+ my $yes_addr = do { no overloading; pack 'J', $yes; };
@yes_perl_synonyms
= grep { $_->property == $perl }
main::uniques($yes,
@@ -8316,12 +8340,12 @@ END
my @conflicting; # Will hold the table conflicts.
# Look at the parent, any yes synonyms, and all the children
- my $parent_addr = pack 'J', refaddr $parent;
+ my $parent_addr = do { no overloading; pack 'J', $parent; };
for my $table ($parent,
@yes_perl_synonyms,
@{$children{$parent_addr}})
{
- my $table_addr = pack 'J', refaddr $table;
+ my $table_addr = do { no overloading; pack 'J', $table; };
my $table_property = $table->property;
# Tables are separated by a blank line to create a grouping.
@@ -8786,7 +8810,7 @@ sub trace { return main::trace(@_) if main::DEBUG && $to_trace }
my %args = @_;
$self = bless \do { my $anonymous_scalar }, $class;
- my $addr = pack 'J', refaddr $self;
+ my $addr = do { no overloading; pack 'J', $self; };
$directory{$addr} = delete $args{'Directory'};
$file{$addr} = delete $args{'File'};
@@ -8849,7 +8873,8 @@ sub trace { return main::trace(@_) if main::DEBUG && $to_trace }
return;
}
else {
- $map{pack 'J', refaddr $self}->delete_range($other, $other);
+ no overloading;
+ $map{pack 'J', $self}->delete_range($other, $other);
}
return $self;
}
@@ -8862,7 +8887,7 @@ sub trace { return main::trace(@_) if main::DEBUG && $to_trace }
my $name = shift;
my %args = @_;
- my $addr = pack 'J', refaddr $self;
+ my $addr = do { no overloading; pack 'J', $self; };
my $table = $table_ref{$addr}{$name};
my $standard_name = main::standardize($name);
@@ -8936,7 +8961,7 @@ sub trace { return main::trace(@_) if main::DEBUG && $to_trace }
sub delete_match_table($self, $table_to_remove) {
# Delete the table referred to by $2 from the property $1.
- my $addr = pack 'J', refaddr $self;
+ my $addr = do { no overloading; pack 'J', $self; };
# Remove all names that refer to it.
foreach my $key (keys %{$table_ref{$addr}}) {
@@ -8951,7 +8976,7 @@ sub trace { return main::trace(@_) if main::DEBUG && $to_trace }
sub table($self, $name) {
# Return a pointer to the match table (with name given by the
# parameter) associated with this property; undef if none.
- my $addr = pack 'J', refaddr $self;
+ my $addr = do { no overloading; pack 'J', $self; };
return $table_ref{$addr}{$name} if defined $table_ref{$addr}{$name};
@@ -8969,7 +8994,8 @@ sub trace { return main::trace(@_) if main::DEBUG && $to_trace }
# Return a list of pointers to all the match tables attached to this
# property
- return main::uniques(values %{$table_ref{pack 'J', refaddr shift}});
+ no overloading;
+ return main::uniques(values %{$table_ref{pack 'J', shift}});
}
sub directory {
@@ -8978,7 +9004,7 @@ sub trace { return main::trace(@_) if main::DEBUG && $to_trace }
# priority; 'undef' is returned if the type isn't defined;
# or $map_directory for everything else.
- my $addr = pack 'J', refaddr shift;
+ my $addr = do { no overloading; pack 'J', shift; };
return $directory{$addr} if defined $directory{$addr};
return undef if $type{$addr} == $UNKNOWN;
@@ -8995,7 +9021,7 @@ sub trace { return main::trace(@_) if main::DEBUG && $to_trace }
# but otherwise the standard name is used. This is different from the
# external_name, so that the rest of the files, like in lib can use
# the standard name always, without regard to historical precedent.
- my $addr = pack 'J', refaddr $self;
+ my $addr = do { no overloading; pack 'J', $self; };
# Swash names are used only on either
# 1) regular or internal-only map tables
@@ -9016,7 +9042,7 @@ sub trace { return main::trace(@_) if main::DEBUG && $to_trace }
# The whole point of this pseudo property is match tables.
return 1 if $self == $perl;
- my $addr = pack 'J', refaddr $self;
+ my $addr = do { no overloading; pack 'J', $self; };
# Don't generate tables of code points that match the property values
# of a string property. Such a list would most likely have many
@@ -9043,7 +9069,8 @@ sub trace { return main::trace(@_) if main::DEBUG && $to_trace }
return;
}
- return $map{pack 'J', refaddr $self}->map_add_or_replace_non_nulls($map{pack 'J', refaddr $other});
+ no overloading;
+ return $map{pack 'J', $self}->map_add_or_replace_non_nulls($map{pack 'J', $other});
}
sub set_proxy_for {
@@ -9079,7 +9106,7 @@ sub trace { return main::trace(@_) if main::DEBUG && $to_trace }
return;
}
- $type{pack 'J', refaddr $self} = $type;
+ { no overloading; $type{pack 'J', $self} = $type; }
return if $type != $BINARY && $type != $FORCED_BINARY;
my $yes = $self->table('Y');
@@ -9118,7 +9145,7 @@ sub trace { return main::trace(@_) if main::DEBUG && $to_trace }
my $map = shift; # What the range maps to.
# Rest of parameters passed on.
- my $addr = pack 'J', refaddr $self;
+ my $addr = do { no overloading; pack 'J', $self; };
# If haven't the type of the property, gather information to figure it
# out.
@@ -9167,7 +9194,7 @@ sub trace { return main::trace(@_) if main::DEBUG && $to_trace }
# We have been keeping track of what the property values have been,
# and now have the necessary information to figure out the type.
- my $addr = pack 'J', refaddr $self;
+ my $addr = do { no overloading; pack 'J', $self; };
my $type = $type{$addr};
@@ -9223,7 +9250,7 @@ sub trace { return main::trace(@_) if main::DEBUG && $to_trace }
# $reaons - Ignored unless suppressing
sub set_fate($self, $fate, $reason=undef) {
- my $addr = pack 'J', refaddr $self;
+ my $addr = do { no overloading; pack 'J', $self; };
if ($fate >= $SUPPRESSED) {
$why_suppressed{$self->complete_name} = $reason;
}
@@ -9301,7 +9328,8 @@ sub trace { return main::trace(@_) if main::DEBUG && $to_trace }
*$sub = sub {
use strict "refs";
my $self = shift;
- return $map{pack 'J', refaddr $self}->$sub(@_);
+ no overloading;
+ return $map{pack 'J', $self}->$sub(@_);
}
}
@@ -9714,7 +9742,7 @@ sub UCD_name ($table, $alias) {
else {
# Keep track of cycles in the input, and refuse to infinitely loop
- my $addr = pack 'J', refaddr $item;
+ my $addr = do { no overloading; pack 'J', $item; };
if (defined $main::already_output{$addr}) {
return "${indent}ALREADY OUTPUT: $item\n";
}
@@ -9832,7 +9860,7 @@ sub dump_inside_out( $object, $fields_ref ) {
# Dump inside-out hashes in an object's state by converting them to a
# regular hash and then calling simple_dumper on that.
- my $addr = pack 'J', refaddr $object;
+ my $addr = do { no overloading; pack 'J', $object; };
my %hash;
foreach my $key (keys %$fields_ref) {
@@ -9853,7 +9881,7 @@ sub _operator_dot($self, $other="", $reversed=0) {
}
else {
my $ref = ref $$which;
- my $addr = pack 'J', refaddr $$which;
+ my $addr = do { no overloading; pack 'J', $$which; };
$$which = "$ref ($addr)";
}
}
@@ -10857,7 +10885,7 @@ sub output_perl_charnames_line ($code_point, $name) {
$file->carp_bad_line("Unexpected property '$property_name'. Skipped");
next LINE;
}
- $property_addr = pack 'J', refaddr $property_object;
+ { no overloading; $property_addr = pack 'J', $property_object; }
# Defer changing names until have a line that is acceptable
# (the 'next' statement above means is unacceptable)
@@ -10909,7 +10937,7 @@ sub output_perl_charnames_line ($code_point, $name) {
if $file->has_missings_defaults;
foreach my $default_ref (@missings_list) {
my $default = $default_ref->[0];
- my $addr = pack 'J', refaddr property_ref($default_ref->[1]);
+ my $addr = do { no overloading; pack 'J', property_ref($default_ref->[1]); };
# For string properties, the default is just what the
# file says, but non-string properties should already
--
2.49.1
Reference in a new issue View git blame Copy permalink