File: tests_from_zdump

package info (click to toggle)
libdatetime-timezone-perl 1:1.20-1+2010k
  • links: PTS, VCS
  • area: main
  • in suites: squeeze
  • size: 4,508 kB
  • ctags: 2,667
  • sloc: perl: 2,340; sh: 68; makefile: 5
file content (248 lines) | stat: -rwxr-xr-x 7,358 bytes parent folder | download
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
192
193
194
195
196
197
198
199
200
201
202
203
204
205
206
207
208
209
210
211
212
213
214
215
216
217
218
219
220
221
222
223
224
225
226
227
228
229
230
231
232
233
234
235
236
237
238
239
240
241
242
243
244
245
246
247
248
#!/usr/bin/perl -w

use strict;

use lib './lib';

use DateTime::TimeZone;
use File::Spec;
use Getopt::Long;

my %opts;
GetOptions(
    'name:s'     => \@{ $opts{name} },
    'zoneinfo:s' => \$opts{zoneinfo},
    'zdump:s'    => \$opts{zdump},
    'verbose'    => \$opts{verbose},
    'help'       => \$opts{help},
);

if ( $opts{help} ) {
    print <<'EOF';

This script uses the zdump utility to generate comprehensive tests for
time zones.

Tests are generated as files in the t/ directory starting with "zd_".

By default, it generates tests for all time zones.

For each time zone name, it checks to see that the zoneinfo directory
has a corresponding file.  This is done because zdump will happily
generate garbage output if given a non-existent time zone name.

Note, if your version of the zoneinfo data is different from that used
to generate the Perl time zone modules then you will almost certainly
end up generating some tests that fail.

It takes the following arguments:

  --name      Only create tests for this zone.
              May be given multiple times.

  --zoneinfo  The location of your zoneinfo directory.
              Defaults to /usr/share/zoneinfo.

  --zdump     Path to zdump binary.  Default is just 'zdump'.

  --verbose   Blab about what it's doing as it does it.

  --help      What you are reading

EOF

    exit;
}

$opts{zoneinfo} ||= '/usr/share/zoneinfo';

die "No zoneinfo directory at $opts{zoneinfo}!\n" unless -d $opts{zoneinfo};

$opts{zdump} ||= 'zdump';

my $x = 1;
my %months = map { $_ => $x++ } qw( Jan Feb Mar Apr May Jun
    Jul Aug Sep Oct Nov Dec);

my @pieces = qw( year month day hour minute second );

my @names
    = @{ $opts{name} } ? @{ $opts{name} } : DateTime::TimeZone::all_names();
foreach my $tz_name (@names) {
    unless ( -e File::Spec->catfile( $opts{zoneinfo}, split /\//, $tz_name ) )
    {
        print "\nNo zoneinfo file for $tz_name - skipping\n"
            if $opts{verbose};
        next;
    }

    print "\nGetting change data for $tz_name\n" if $opts{verbose};

    my @tests;
    my $command = "$opts{zdump} -v $tz_name";
    my @lines   = `$command`;

    die
        qq|Nothing returning from calling "$command".  Did you specify a valid zdump binary?\n|
        unless @lines;

    my $last_short_name = '';
    foreach my $line (@lines) {

        # This seems to happen on 64-bit systems.
        next if $line =~ /= NULL$/;

        my (
            $utc_mon_name, $utc_day, $utc_hour, $utc_min, $utc_sec, $utc_year,
            $loc_mon_name, $loc_day, $loc_hour, $loc_min, $loc_sec, $loc_year,
            $short_name, $is_dst, $offset_from_utc
            )
            = $line =~ m/ ^
                        \w+(?:\/[\w\/-]+)? # zone name
                        \s+
                        \w\w\w        # UTC day name
                        \s+
                        (\w\w\w)      # UTC month name
                        \s+
                        (\d+)         # UTC day of month
                        \s+
                        (\d\d):(\d\d):(\d\d)  # UTC time
                        \s+
                        (\d\d\d\d)    # UTC year
                        \s+
                        (?:UTC|GMT)   # some systems say one, some the other
                        \s+
                        =
                        \s+
                        \w\w\w        # local day name
                        \s+
                        (\w\w\w)      # local month name
                        \s+
                        (\d+)         # local day of month
                        \s+
                        (\d\d):(\d\d):(\d\d)  # local time
                        \s+
                        (\d\d\d\d)    # local year
                        \s+
                        (\w+)         # local short name
                        \s+
                        isdst=(1|0)
                        \s+
                        gmtoff=(-?\d+)
                      /x;

        unless ($1) {
            warn "Can't parse zump output:\n$line\n";
            next;
        }

        # On a 32-bit system, I suspect that this will generate bogus
        # changes at the edges (1901 & 2038), but on my 64-bit system
        # it works for those years.

        # There seems to be a bug (on my system, at least) where the
        # last change zdump generates has the local zone as UTC. For
        # example, see Africa/Cairo, which in 2408 supposedly goes
        # from EEST to UTC.
        if (   $last_short_name
            && $short_name eq 'UTC'
            && $last_short_name ne 'UTC' ) {
            print
                "  skipping $last_short_name -> $short_name change in $loc_year\n"
                if $opts{verbose};
            next;
        }

        my $utc_month = $months{$utc_mon_name};
        my $loc_month = $months{$loc_mon_name};

        # use '1 * ' to make sure everything is treated as numbers,
        push @tests, {
            time_zone => $tz_name,
            utc       => {
                year   => 1 * $utc_year,
                month  => 1 * $utc_month,
                day    => 1 * $utc_day,
                hour   => 1 * $utc_hour,
                minute => 1 * $utc_min,
                second => 1 * $utc_sec,
            },
            local => {
                year   => 1 * $loc_year,
                month  => 1 * $loc_month,
                day    => 1 * $loc_day,
                hour   => 1 * $loc_hour,
                minute => 1 * $loc_min,
                second => 1 * $loc_sec,
            },
            short_name => $short_name,
            is_dst     => 1 * $is_dst,
            offset     => 1 * $offset_from_utc,
            };

        $last_short_name = $short_name;
    }

    unless (@tests) {
        print
            "No change data in time_t range for $tz_name - can't create tests\n"
            if $opts{verbose};
        next;
    }

    local *T;

    ( my $test_file_name = $tz_name ) =~ s,/,-,g;
    my $file = File::Spec->catfile( 't', "zd_$test_file_name.t" );
    open T, ">$file"
        or die "Cannot write to $file: $!";

    print "Creating tests for $tz_name in $file\n" if $opts{verbose};

    my $test_count = scalar @tests * 9;

    print T <<"EOF";
#!/usr/bin/perl -w

use strict;

use DateTime;

use Test::More tests => $test_count;

EOF

    foreach my $t (@tests) {
        my $utc_new = join ', ', map {"$_ => $t->{utc}{$_}"} @pieces;

        # This makes finding tests that fail much easier.
        my $local_datetime = sprintf(
            '%04d-%02d-%02d %02d:%02d:%02d',
            @{ $t->{local} }{qw( year month day hour minute second )}
        );

        print T <<"EOF";
{
    my \$dt = DateTime->new( $utc_new,
                            time_zone => 'UTC',
                           );
    \$dt->set_time_zone( '$t->{time_zone}' );

EOF

        foreach my $p (@pieces) {
            print T <<"EOF";
    is( \$dt->$p, $t->{local}{$p}, 'local $p should be $t->{local}{$p} ($local_datetime)' );
EOF
        }

        print T <<"EOF";

    is( \$dt->is_dst, $t->{is_dst}, 'is_dst should be $t->{is_dst} ($local_datetime)' );
    is( \$dt->offset, $t->{offset}, 'offset should be $t->{offset} ($local_datetime)' );
    is( \$dt->time_zone_short_name, '$t->{short_name}', 'short name should be $t->{short_name} ($local_datetime)' );
}

EOF
    }
}