Oregami
Repositories/oxedyne/fe2o3

oxedyne/fe2o3/fe2o3_text/tests/regex_oracle/changes.pl

3.4 KiB, 1 run

created by r1870400018:60334, which is this file's identity for as long as the history lasts, whatever it is later renamed to

download · who wrote it · its history

1#!/usr/bin/env perl
2# Writes props_changed.txt: every (property, code point) whose value the Unicode Character
3# Database changed between Perl's Unicode version (props_expected.txt) and the version the tables
4# are generated from, for the code points assigned in the older one. tests/regex.rs accepts a
5# disagreement with Perl only where it is listed here, so the list explains each difference by
6# Unicode's own changes rather than by a tolerance.
7#
8# The files are fetched with curl and cached under the system temporary directory, as the table
9# generator caches them. Run from this directory:
10#
11# perl changes.pl 15.0.0 17.0.0 > props_changed.txt
12use strict;
13use warnings;
14use File::Spec;
15use File::Path qw(make_path);
16
17my ($old, $new) = @ARGV;
18die "usage: changes.pl OLD NEW\n" unless $old && $new;
19
20my @files = qw(
21 ucd/UnicodeData.txt ucd/Scripts.txt ucd/ScriptExtensions.txt ucd/PropList.txt
22 ucd/DerivedCoreProperties.txt ucd/emoji/emoji-data.txt
23);
24
25sub fetch {
26 my ($ver, $path) = @_;
27 my $dir = File::Spec->catdir(File::Spec->tmpdir, 'fe2o3_ucd', $ver);
28 make_path($dir);
29 (my $name = $path) =~ s{.*/}{};
30 my $dest = File::Spec->catfile($dir, $name);
31 unless (-s $dest) {
32 system('curl', '-sS', '--fail', '-o', $dest,
33 "https://www.unicode.org/Public/$ver/$path") == 0 or die "curl failed for $path\n";
34 }
35 open my $fh, '<', $dest or die "$dest: $!\n";
36 local $/;
37 return <$fh>;
38}
39
40# Calls $cb->(lo, hi, @fields) for each data line of a property file.
41sub each_range {
42 my ($text, $cb) = @_;
43 for my $line (split /\n/, $text) {
44 $line =~ s/#.*//;
45 next unless $line =~ /\S/;
46 my @f = map { s/^\s+|\s+$//gr } split /;/, $line;
47 my ($lo, $hi) = $f[0] =~ /^([0-9A-F]+)(?:\.\.([0-9A-F]+))?$/ or die "bad range $f[0]\n";
48 $cb->(hex $lo, hex($hi // $lo), @f[1 .. $#f]);
49 }
50}
51
52# Loads one version: gc, sc, raw scx and the binary properties, keyed by code point.
53sub load {
54 my $ver = shift;
55 my %d = (gc => {}, sc => {}, scx => {}, bin => {});
56 my $first;
57 for my $line (split /\n/, fetch($ver, 'ucd/UnicodeData.txt')) {
58 my @f = split /;/, $line;
59 my $cp = hex $f[0];
60 if ($f[1] =~ /, First>$/) { $first = $cp; next; }
61 my $lo = $f[1] =~ /, Last>$/ ? $first : $cp;
62 $d{gc}{$_} = $f[2] for $lo .. $cp;
63 }
64 each_range(fetch($ver, 'ucd/Scripts.txt'), sub { my ($lo, $hi, $v) = @_; $d{sc}{$_} = $v for $lo .. $hi });
65 each_range(fetch($ver, 'ucd/ScriptExtensions.txt'), sub {
66 my ($lo, $hi, $v) = @_;
67 $d{scx}{$_} = join ' ', sort split ' ', $v for $lo .. $hi;
68 });
69 for my $f ('ucd/PropList.txt', 'ucd/DerivedCoreProperties.txt', 'ucd/emoji/emoji-data.txt') {
70 each_range(fetch($ver, $f), sub {
71 my ($lo, $hi, @v) = @_;
72 return unless @v == 1;
73 $d{bin}{$v[0]}{$_} = 1 for $lo .. $hi;
74 });
75 }
76 return \%d;
77}
78
79my ($da, $db) = (load($old), load($new));
80my %props = map { $_ => 1 } (keys %{ $da->{bin} }, keys %{ $db->{bin} });
81for my $cp (sort { $a <=> $b } keys %{ $da->{gc} }) {
82 my $g = sub { $_[0] // '' };
83 printf "gc\t%X\n", $cp if $g->($da->{gc}{$cp}) ne $g->($db->{gc}{$cp});
84 my ($sa, $sb) = ($da->{sc}{$cp} // 'Unknown', $db->{sc}{$cp} // 'Unknown');
85 printf "sc\t%X\n", $cp if $sa ne $sb;
86 my ($xa, $xb) = ($da->{scx}{$cp} // "=$sa", $db->{scx}{$cp} // "=$sb");
87 printf "scx\t%X\n", $cp if $xa ne $xb;
88 for my $p (sort keys %props) {
89 my $in_a = $da->{bin}{$p} && $da->{bin}{$p}{$cp} ? 1 : 0;
90 my $in_b = $db->{bin}{$p} && $db->{bin}{$p}{$cp} ? 1 : 0;
91 printf "%s\t%X\n", $p, $cp if $in_a != $in_b;
92 }
93}