# are specified that don't exactly match.
my $min_floating_slop;
+ # To guard against this program calling something that in turn ends up
+ # calling this program with the same inputs, and hence infinitely
+ # recursing, we keep a stack of the properties that are currently in
+ # progress, pushed upon entry, popped upon return.
+ my @recursed;
+
sub SWASHNEW {
my ($class, $type, $list, $minbits, $none) = @_;
local $^D = 0 if $^D;
+ $class = "" unless defined $class;
print STDERR __LINE__, ": class=$class, type=$type, list=$list, minbits=$minbits, none=$none\n" if DEBUG;
##
if ($type)
{
+
+ # Verify that this isn't a recursive call for this property.
+ # Can't use croak, as it may try to recurse here itself.
+ my $class_type = $class . "::$type";
+ if (grep { $_ eq $class_type } @recursed) {
+ CORE::die "panic: Infinite recursion in SWASHNEW for '$type'\n";
+ }
+ push @recursed, $class_type;
+
$type =~ s/^\s+//;
$type =~ s/\s+$//;
# value indicates the table we should use.
my ($property, $table, @remainder) =
split /\s*[:=]\s*/, $property_and_table, -1;
- return $type if @remainder;
+ if (@remainder) {
+ pop @recursed if @recursed;
+ return $type;
+ }
my $prefix;
if (! defined $table) {
# And convert to canonical form. Quit if not valid.
$property = $utf8::loose_property_name_of{$property};
- return $type unless defined $property;
+ if (! defined $property) {
+ pop @recursed if @recursed;
+ return $type;
+ }
$prefix = "$property=";
print STDERR __LINE__, ": table=$table\n" if DEBUG;
# Don't allow leading nor trailing slashes
- return $type if $table =~ / ^ \/ | \/ $ /x;
+ if ($table =~ / ^ \/ | \/ $ /x) {
+ pop @recursed if @recursed;
+ return $type;
+ }
# Split on slash, in case it is a rational, like \p{1/5}
my @parts = split qr{ \s* / \s* }x, $table, -1;
print __LINE__, ": $type\n" if @parts > 2 && DEBUG;
# Can have maximum of one slash
- return $type if @parts > 2;
+ if (@parts > 2) {
+ pop @recursed if @recursed;
+ return $type;
+ }
foreach my $part (@parts) {
print __LINE__, ": part=$part\n" if DEBUG;
# Result better look like a number. (This test is
# needed because, for example could have a plus in
# the middle.)
- return $type if $part
- !~ / ^ -? [0-9]+ ( \. [0-9]+)? $ /x;
+ if ($part !~ / ^ -? [0-9]+ ( \. [0-9]+)? $ /x) {
+ pop @recursed if @recursed;
+ return $type;
+ }
}
# If a rational...
}
# Quit if didn't find one.
- return $type unless defined $table;
+ if (! defined $table) {
+ pop @recursed if @recursed;
+ return $type;
+ }
}
}
print STDERR __LINE__, ": $property=$table\n" if DEBUG;
## out what to do with $type. Ouch.
##
+ pop @recursed if @recursed;
return $type;
}
my $found = $Cache{$class, $file};
if ($found and ref($found) eq $class) {
print STDERR __LINE__, ": Returning cached '$file' for \\p{$type}\n" if DEBUG;
+ pop @recursed if @recursed;
return $found;
}
elsif ($c =~ /^([0-9a-fA-F]+)/) {
$subobj = utf8->SWASHNEW("", $c, $minbits, 0);
}
- return $subobj unless ref $subobj;
+ if (! ref $subobj) {
+ pop @recursed if @recursed && $type;
+ return $subobj;
+ }
push @extras, $name => $subobj;
$bits = $subobj->{BITS} if $bits < $subobj->{BITS};
}
$Cache{$class, $file} = $SWASH;
}
+ pop @recursed if @recursed && $type;
+
return $SWASH;
}
}