SPDX-FileCopyrightText: 2015 Karl Williamson <public@khwilliamson.com>
SPDX-FileCopyrightText: 2025 Samuel Tyler <samuel@samuelt.me>

SPDX-License-Identifier: Artistic-1.0

Partial backport of this commit. This support is required to use the
tables from 5.24.

From a6a212f8e678308557ffd57c2aa98ac504468b0e Mon Sep 17 00:00:00 2001
From: Karl Williamson <khw@cpan.org>
Date: Fri, 26 Jun 2015 11:50:18 -0600
Subject: [PATCH 1/1] mktables: Allow strictly named map tables

There are several types of tables generated by mktables.  Most are
binary (match) tables, but another class is mapping tables.  The names
for these may be loosely matched, but until this commit only the match
tables could have strict matching applied.

Strict matching is used for certain table names where loose could be
ambiguous, and for all names that aren't to be used by anything except
the perl core.
---
 lib/utf8_heavy.pl    | 22 ++++++++++++++++++----
 2 files changed, 51 insertions(+), 9 deletions(-)

diff --git perl-5.22.4/lib/utf8_heavy.pl perl-5.22.4/lib/utf8_heavy.pl
index e0c3d5ed63..b595028460 100644
--- perl-5.22.4/lib/utf8_heavy.pl
+++ perl-5.22.4/lib/utf8_heavy.pl
@@ -404,7 +404,11 @@ sub _loose_name ($) {
                 # If didn't find it, try again with looser matching by editing
                 # out the applicable characters on the rhs and looking up
                 # again.
+                my $strict_property_and_table;
                 if (! defined $file) {
+
+                    # This isn't used unless the name begins with 'to'
+                    $strict_property_and_table = $property_and_table =~  s/^to//r;
                     $table = _loose_name($table);
                     $property_and_table = "$prefix$table";
                     print STDERR __LINE__, ": $property_and_table\n" if DEBUG;
@@ -444,10 +448,19 @@ sub _loose_name ($) {
                 ##
                 # Only check if caller wants non-binary
                 my $retried = 0;
-                if ($minbits != 1 && $property_and_table =~ s/^to//) {{
+                if ($minbits != 1) {
+                    if ($property_and_table =~ s/^to//) {
                     # Look input up in list of properties for which we have
-                    # mapping files.
-                    if (defined ($file =
+                    # mapping files.  First do it with the strict approach
+                        if (defined ($file =
+                            $utf8::strict_property_to_file_of{$strict_property_and_table}))
+                        {
+                            $type = $utf8::file_to_swash_name{$file};
+                            print STDERR __LINE__, ": type set to $type\n" if DEBUG;
+                            $file = "$unicore_dir/$file.pl";
+                            last GETFILE;
+                        }
+                        elsif (defined ($file =
                           $utf8::loose_property_to_file_of{$property_and_table}))
                     {
                         $type = $utf8::file_to_swash_name{$file};
@@ -497,7 +510,8 @@ sub _loose_name ($) {
                         $file = "$unicore_dir/lib/$file.pl" unless $file =~ m!^#/!;
                         last GETFILE;
                     }
-                } }
+                }
+                }
 
                 ##
                 ## If we reach this line, it's because we couldn't figure
-- 
2.49.1

