← Back to branch summary

~ubuntu-branches/ubuntu/vivid/icu4j-4.4/vivid

« back to all changes in this revision

Viewing changes to perf-tests/normperf.pl

  • Committer: Bazaar Package Importer
  • Author(s): Niels Thykier
  • Date: 2011-08-02 15:50:33 UTC
  • Revision ID: james.westby@ubuntu.com-20110802155033-itjzsl21y2lqdonn
Tags: upstream-4.4.2
Import upstream version 4.4.2

Show diffs side-by-side

added added

removed removed

Lines of Context:
perf-tests/normperf.pl
 
1
#!/usr/local/bin/perl
 
2
# *******************************************************************************
 
3
# * Copyright (C) 2002-2007 International Business Machines Corporation and     *
 
4
# * others. All Rights Reserved.                                                *
 
5
# *******************************************************************************
 
6
 
 
7
use strict;
 
8
 
 
9
# Assume we are running within the icu4j root directory
 
10
use lib 'src/com/ibm/icu/dev/test/perf';
 
11
use Dataset;
 
12
 
 
13
#---------------------------------------------------------------------
 
14
# Test class
 
15
my $TESTCLASS = 'com.ibm.icu.dev.test.perf.NormalizerPerformanceTest'; 
 
16
 
 
17
# Methods to be tested.  Each pair represents a test method and
 
18
# a baseline method which is used for comparison.
 
19
my @METHODS  = (
 
20
                ['TestJDK_NFD_NFC_Text',  'TestICU_NFD_NFC_Text'],
 
21
                ['TestJDK_NFC_NFC_Text',  'TestICU_NFC_NFC_Text'],
 
22
#               ['TestJDK_NFC_NFD_Text',  'TestICU_NFC_NFD_Text'],
 
23
                ['TestJDK_NFC_Orig_Text', 'TestICU_NFC_Orig_Text'],
 
24
                ['TestJDK_NFD_NFC_Text',  'TestICU_NFD_NFC_Text'],
 
25
                ['TestJDK_NFD_NFD_Text',  'TestICU_NFD_NFD_Text'],
 
26
                ['TestJDK_NFD_Orig_Text', 'TestICU_NFD_Orig_Text'], 
 
27
               );
 
28
 
 
29
# Patterns which define the set of characters used for testing.
 
30
 
 
31
my $SOURCEDIR ="src/com/ibm/icu/dev/test/perf/data/collation/";
 
32
 
 
33
my @OPTIONS = (
 
34
#                      src text                     src encoding  mode  
 
35
                    [ "TestNames_SerbianSH.txt",    "UTF-8", "b"],
 
36
#                   [ "arabic.txt",                 "UTF-8", "b"],
 
37
#                   [ "french.txt",                 "UTF-8", "b"],
 
38
#                   [ "greek.txt",                  "UTF-8", "b"],
 
39
#                   [ "hebrew.txt",                 "UTF-8", "b"],
 
40
#                   [ "hindi.txt" ,                 "UTF-8", "b"],
 
41
#                   [ "japanese.txt",               "UTF-8", "b"],
 
42
#                   [ "korean.txt",                 "UTF-8", "b"],
 
43
#                   [ "s-chinese.txt",              "UTF-8", "b"],
 
44
#                   [ "french.txt",                 "UTF-8", "b"],
 
45
#                   [ "greek.txt",                  "UTF-8", "b"],
 
46
#                   [ "hebrew.txt",                 "UTF-8", "b"],
 
47
#                   [ "hindi.txt" ,                 "UTF-8", "b"],
 
48
#                   [ "japanese.txt",               "UTF-8", "b"],
 
49
#                   [ "korean.txt",                 "UTF-8", "b"],
 
50
#                   [ "s-chinese.txt",              "UTF-8", "b"],
 
51
#                   [ "arabic.html",                "UTF-8", "b"],
 
52
#                   [ "czech.html",                 "UTF-8", "b"],
 
53
#                   [ "danish.html",                "UTF-8", "b"],
 
54
#                   [ "english.html",               "UTF-8", "b"],
 
55
#                   [ "esperanto.html",             "UTF-8", "b"],
 
56
#                   [ "french.html",                "UTF-8", "b"],
 
57
#                   [ "georgian.html",              "UTF-8", "b"],
 
58
#                   [ "german.html",                "UTF-8", "b"],
 
59
#                   [ "greek.html",                 "UTF-8", "b"],
 
60
#                   [ "hebrew.html",                "UTF-8", "b"],
 
61
#                   [ "hindi.html",                 "UTF-8", "b"],
 
62
#                   [ "icelandic.html",             "UTF-8", "b"],
 
63
#                   [ "interlingua.html",           "UTF-8", "b"],
 
64
#                   [ "italian.html",               "UTF-8", "b"],
 
65
#                   [ "japanese.html",              "UTF-8", "b"],
 
66
#                   [ "korean.html",                "UTF-8", "b"],
 
67
#                   [ "lithuanian.html",            "UTF-8", "b"],
 
68
#                   [ "maltese.html",               "UTF-8", "b"],
 
69
#                   [ "persian.html",               "UTF-8", "b"],
 
70
#                   [ "polish.html",                "UTF-8", "b"],
 
71
#                   [ "portuguese.html",            "UTF-8", "b"],
 
72
#                   [ "romanian.html",              "UTF-8", "b"],
 
73
#                   [ "russian.html",               "UTF-8", "b"],
 
74
#                   [ "s-chinese.html",             "UTF-8", "b"],
 
75
#                   [ "spanish.html",               "UTF-8", "b"],
 
76
#                   [ "swedish.html",               "UTF-8", "b"],
 
77
#                   [ "t-chinese.html",             "UTF-8", "b"],
 
78
#                   [ "welsh.html",                 "UTF-8", "b"],
 
79
                    [ "TestNames_Asian.txt",        "UTF-8", "l"],
 
80
                    [ "TestNames_Chinese.txt",      "UTF-8", "l"],
 
81
                    [ "TestNames_Japanese.txt",     "UTF-8", "l"],
 
82
                    [ "TestNames_Japanese_h.txt",   "UTF-8", "l"],
 
83
                    [ "TestNames_Japanese_k.txt",   "UTF-8", "l"],
 
84
                    [ "TestNames_Korean.txt",       "UTF-8", "l"],
 
85
                    [ "TestNames_Latin.txt",        "UTF-8", "l"],
 
86
                    [ "TestNames_SerbianSH.txt",    "UTF-8", "l"],
 
87
                    [ "TestNames_SerbianSR.txt",    "UTF-8", "l"],
 
88
                    [ "TestNames_Thai.txt",         "UTF-8", "l"],
 
89
                    [ "Testnames_Russian.txt",      "UTF-8", "l"], 
 
90
              );
 
91
 
 
92
my $CALIBRATE = 2;  # duration in seconds for initial calibration
 
93
my $DURATION  = 10; # duration in seconds for each pass
 
94
my $NUMPASSES = 4;  # number of passes.  If > 1 then the first pass
 
95
                    # is discarded as a JIT warm-up pass.
 
96
 
 
97
my $TABLEATTR = 'BORDER="1" CELLPADDING="4" CELLSPACING="0"';
 
98
 
 
99
my $PLUS_MINUS = "±";
 
100
 
 
101
if ($NUMPASSES < 3) {
 
102
    die "Need at least 3 passes.  One is discarded (JIT warmup) and need two to have 1 degree of freedom (t distribution).";
 
103
}
 
104
 
 
105
my $OUT; # see out()
 
106
 
 
107
main();
 
108
 
 
109
#---------------------------------------------------------------------
 
110
# ...
 
111
sub main {
 
112
    my $date = localtime;
 
113
    my $title = "ICU4J Performance Test $date";
 
114
 
 
115
    my $html = $date;
 
116
    $html =~ s/://g; # ':' illegal
 
117
    $html =~ s/\s*\d+$//; # delete year
 
118
    $html =~ s/^\w+\s*//; # delete dow
 
119
    $html = "perf $html.html";
 
120
 
 
121
    open(HTML,">$html") or die "Can't write to $html: $!";
 
122
 
 
123
    print HTML <<EOF;
 
124
<!DOCTYPE HTML PUBLIC "-//W3C//DTD HTML 4.01//EN"
 
125
   "http://www.w3.org/TR/html4/strict.dtd">
 
126
<HTML>
 
127
   <HEAD>
 
128
      <TITLE>$title</TITLE>
 
129
   </HEAD>
 
130
   <BODY>
 
131
EOF
 
132
    print HTML "<H1>$title</H1>\n";
 
133
 
 
134
    print HTML "<H2>$TESTCLASS</H2>\n";
 
135
 
 
136
    my $raw = "";
 
137
 
 
138
    for my $methodPair (@METHODS) {
 
139
 
 
140
        my $testMethod = $methodPair->[0];
 
141
        my $baselineMethod = $methodPair->[1];
 
142
 
 
143
        print HTML "<P><TABLE $TABLEATTR><TR><TD>\n";
 
144
        print HTML "<P><B>$testMethod vs. $baselineMethod</B></P>\n";
 
145
        
 
146
        print HTML "<P><TABLE $TABLEATTR BGCOLOR=\"#CCFFFF\">\n";
 
147
        print HTML "<TR><TD>Options</TD><TD>$testMethod</TD>";
 
148
        print HTML "<TD>$baselineMethod</TD><TD>Ratio</TD></TR>\n";
 
149
 
 
150
        $OUT = '';
 
151
 
 
152
        for my $pat (@OPTIONS) {
 
153
            print HTML "<TR><TD>@$pat[0], @$pat[2]</TD>\n";
 
154
 
 
155
            out("<P><TABLE $TABLEATTR WIDTH=\"100%\">");
 
156
 
 
157
            # measure the test method
 
158
            out("<TR><TD>");
 
159
            print "\n$testMethod [@$pat]\n";
 
160
            my $t = measure2($testMethod, $pat, -$DURATION);
 
161
            out("</TD></TR>");
 
162
            print HTML "<TD>", formatSeconds(4, $t->getMean(), $t->getError);
 
163
            print HTML "/event</TD>\n";
 
164
 
 
165
            # measure baseline method
 
166
            out("<TR><TD>");
 
167
            print "\n$baselineMethod [@$pat]\n";
 
168
            my $b = measure2($baselineMethod, $pat, -$DURATION);
 
169
            out("</TD></TR>");
 
170
            print HTML "<TD>", formatSeconds(4, $b->getMean(), $t->getError);
 
171
            print HTML "/event</TD>\n";
 
172
 
 
173
            out("</TABLE></P>");
 
174
 
 
175
            # output ratio
 
176
            my $r = $t->divide($b);
 
177
            my $mean = $r->getMean() - 1;
 
178
            my $color = $mean < 0 ? "RED" : "BLACK";
 
179
            print HTML "<TD><B><FONT COLOR=\"$color\">", formatPercent(3, $mean, $r->getError);
 
180
            print HTML "</FONT></B></TD></TR>\n";
 
181
        }
 
182
 
 
183
        print HTML "</TABLE></P>\n";
 
184
 
 
185
        print HTML "<P>Raw data:</P>\n";
 
186
        print HTML $OUT;
 
187
        print HTML "</TABLE></P>\n";
 
188
    }
 
189
 
 
190
    print HTML <<EOF;
 
191
   </BODY>
 
192
</HTML>
 
193
EOF
 
194
    close(HTML) or die "Can't close $html: $!";
 
195
}
 
196
 
 
197
#---------------------------------------------------------------------
 
198
# Append text to the global variable $OUT
 
199
sub out {
 
200
    $OUT .= join('', @_);
 
201
}
 
202
 
 
203
#---------------------------------------------------------------------
 
204
# Append text to the global variable $OUT
 
205
sub outln {
 
206
    $OUT .= join('', @_) . "\n";
 
207
}
 
208
 
 
209
#---------------------------------------------------------------------
 
210
# Measure a given test method with a give test pattern using the
 
211
# global run parameters.
 
212
#
 
213
# @param the method to run
 
214
# @param the pattern defining characters to test
 
215
# @param if >0 then the number of iterations per pass.  If <0 then
 
216
#        (negative of) the number of seconds per pass.
 
217
#
 
218
# @return a Dataset object, scaled by iterations per pass and
 
219
#         events per iteration, to give time per event
 
220
#
 
221
sub measure2 {
 
222
    my @data = measure1(@_);
 
223
    my $iterPerPass = shift(@data);
 
224
    my $eventPerIter = shift(@data);
 
225
 
 
226
    shift(@data) if (@data > 1); # discard first run
 
227
 
 
228
    my $ds = Dataset->new(@data);
 
229
    $ds->setScale(1.0e-3 / ($iterPerPass * $eventPerIter));
 
230
    $ds;
 
231
}
 
232
 
 
233
#---------------------------------------------------------------------
 
234
# Measure a given test method with a give test pattern using the
 
235
# global run parameters.
 
236
#
 
237
# @param the method to run
 
238
# @param the pattern defining characters to test
 
239
# @param if >0 then the number of iterations per pass.  If <0 then
 
240
#        (negative of) the number of seconds per pass.
 
241
#
 
242
# @return array of:
 
243
#         [0] iterations per pass
 
244
#         [1] events per iteration
 
245
#         [2..] ms reported for each pass, in order
 
246
#
 
247
sub measure1 {
 
248
    my $method = shift;
 
249
    my $pat = shift;
 
250
    my $iterCount = shift; # actually might be -seconds/pass
 
251
 
 
252
    out("<P>Measuring $method for input file @$pat[0] in @$pat[2] , ");
 
253
    if ($iterCount > 0) {
 
254
        out("$iterCount iterations/pass, $NUMPASSES passes</P>\n");
 
255
    } else {
 
256
        out(-$iterCount, " seconds/pass, $NUMPASSES passes</P>\n");
 
257
    }
 
258
 
 
259
    # is $iterCount actually -seconds/pass?
 
260
    if ($iterCount < 0) {
 
261
 
 
262
        # calibrate: estimate ms/iteration
 
263
        print "Calibrating...";
 
264
        my @t = callJava($method, $pat, -$CALIBRATE, 1);
 
265
        print "done.\n";
 
266
 
 
267
        my @data = split(/\s+/, $t[0]->[2]);
 
268
        $data[0] *= 1.0e+3;
 
269
 
 
270
        my $timePerIter = 1.0e-3 * $data[0] / $data[1];
 
271
    
 
272
        # determine iterations/pass
 
273
        $iterCount = int(-$iterCount / $timePerIter + 0.5);
 
274
 
 
275
        out("<P>Calibration pass ($CALIBRATE sec): ");
 
276
        out("$data[0] ms, ");
 
277
        out("$data[1] iterations = ");
 
278
        out(formatSeconds(4, $timePerIter), "/iteration<BR>\n");
 
279
    }
 
280
    
 
281
    # run passes
 
282
    print "Measuring $iterCount iterations x $NUMPASSES passes...";
 
283
    my @t = callJava($method, $pat, $iterCount, $NUMPASSES);
 
284
    print "done.\n";
 
285
    my @ms = ();
 
286
    my @b; # scratch
 
287
    for my $a (@t) {
 
288
        # $a->[0]: method name, corresponds to $method
 
289
        # $a->[1]: 'begin' data, == $iterCount
 
290
        # $a->[2]: 'end' data, of the form <ms> <loops> <eventsPerIter>
 
291
        # $a->[3...]: gc messages from JVM during pass
 
292
        @b = split(/\s+/, $a->[2]);
 
293
        push(@ms, $b[0] * 1.0e+3);
 
294
    }
 
295
    my $eventsPerIter = $b[2];
 
296
 
 
297
    out("Iterations per pass: $iterCount<BR>\n");
 
298
    out("Events per iteration: $eventsPerIter<BR>\n");
 
299
 
 
300
    my @ms_str = @ms;
 
301
    $ms_str[0] .= " (discarded)" if (@ms_str > 1);
 
302
    out("Raw times (ms/pass): ", join(", ", @ms_str), "<BR>\n");
 
303
 
 
304
    ($iterCount, $eventsPerIter, @ms);
 
305
}
 
306
 
 
307
#---------------------------------------------------------------------
 
308
# Invoke java to run $TESTCLASS, passing it the given parameters.
 
309
#
 
310
# @param the method to run
 
311
# @param the number of iterations, or if negative, the duration
 
312
#        in seconds.  If more than on pass is desired, pass in
 
313
#        a string, e.g., "100 100 100".
 
314
# @param the pattern defining characters to test
 
315
#
 
316
# @return an array of results.  Each result is an array REF
 
317
#         describing one pass.  The array REF contains:
 
318
#         ->[0]: The method name as reported
 
319
#         ->[1]: The params on the '= <meth> begin ...' line
 
320
#         ->[2]: The params on the '= <meth> end ...' line
 
321
#         ->[3..]: GC messages from the JVM, if any
 
322
#
 
323
sub callJava {
 
324
    my $method = shift;
 
325
    my $pat = shift;
 
326
    my $n = shift;
 
327
    my $passes = shift;
 
328
    
 
329
    my $fileName = $SOURCEDIR . @$pat[0] ; 
 
330
    my $n = ($n < 0) ? "-t ".(-$n) : "-i ".$n;
 
331
    
 
332
    my $cmd = "java -classpath classes $TESTCLASS $method $n -p $passes -f $fileName -e @$pat[1] -@$pat[2]";
 
333
    print "[$cmd]\n"; # for debugging
 
334
    open(PIPE, "$cmd|") or die "Can't run \"$cmd\"";
 
335
    my @out;
 
336
    while (<PIPE>) {
 
337
        push(@out, $_);
 
338
    }
 
339
    close(PIPE) or die "Java failed: \"$cmd\"";
 
340
 
 
341
    @out = grep(!/^\#/, @out);  # filter out comments
 
342
 
 
343
    #print "[", join("\n", @out), "]\n";
 
344
 
 
345
    my @results;
 
346
    my $method = '';
 
347
    my $data = [];
 
348
    foreach (@out) {
 
349
        next unless (/\S/);
 
350
 
 
351
        if (/^=\s*(\w+)\s*(\w+)\s*(.*)/) {
 
352
            my ($m, $state, $d) = ($1, $2, $3);
 
353
            #print "$_ => [[$m $state $data]]\n";
 
354
            if ($state eq 'begin') {
 
355
                die "$method was begun but not finished" if ($method);
 
356
                $method = $m;
 
357
                push(@$data, $d);
 
358
                push(@$data, ''); # placeholder for end data
 
359
            } elsif ($state eq 'end') {
 
360
                if ($m ne $method) {
 
361
                    die "$method end does not match: $_";
 
362
                }
 
363
                $data->[1] = $d; # insert end data at [1]
 
364
                #print "#$method:", join(";",@$data), "\n";
 
365
                unshift(@$data, $method); # add method to start
 
366
 
 
367
                push(@results, $data);
 
368
                $method = '';
 
369
                $data = [];
 
370
            } else {
 
371
                die "Can't parse: $_";
 
372
            }
 
373
        }
 
374
 
 
375
        elsif (/^\[/) {
 
376
            if ($method) {
 
377
                push(@$data, $_);
 
378
            } else {
 
379
                # ignore extraneous GC notices
 
380
            }
 
381
        }
 
382
 
 
383
        else {
 
384
            die "Can't parse: $_";
 
385
        }
 
386
    }
 
387
 
 
388
    die "$method was begun but not finished" if ($method);
 
389
 
 
390
    @results;
 
391
}
 
392
 
 
393
#|#---------------------------------------------------------------------
 
394
#|# Format a confidence interval, as given by a Dataset.  Output is as
 
395
#|# as follows:
 
396
#|#   241.23 - 241.98 => 241.5 +/- 0.3
 
397
#|#   241.2 - 243.8 => 242 +/- 1
 
398
#|#   211.0 - 241.0 => 226 +/- 15 or? 230 +/- 20
 
399
#|#   220.3 - 234.3 => 227 +/- 7
 
400
#|#   220.3 - 300.3 => 260 +/- 40
 
401
#|#   220.3 - 1000 => 610 +/- 390 or? 600 +/- 400
 
402
#|#   0.022 - 0.024 => 0.023 +/- 0.001
 
403
#|#   0.022 - 0.032 => 0.027 +/- 0.005
 
404
#|#   0.022 - 1.000 => 0.5 +/- 0.5
 
405
#|# In other words, take one significant digit of the error value and
 
406
#|# display the mean to the same precision.
 
407
#|sub formatDataset {
 
408
#|    my $ds = shift;
 
409
#|    my $lower = $ds->getMean() - $ds->getError();
 
410
#|    my $upper = $ds->getMean() + $ds->getError();
 
411
#|    my $scale = 0;
 
412
#|    # Find how many initial digits are the same
 
413
#|    while ($lower < 1 ||
 
414
#|           int($lower) == int($upper)) {
 
415
#|        $lower *= 10;
 
416
#|        $upper *= 10;
 
417
#|        $scale++;
 
418
#|    }
 
419
#|    while ($lower >= 10 &&
 
420
#|           int($lower) == int($upper)) {
 
421
#|        $lower /= 10;
 
422
#|        $upper /= 10;
 
423
#|        $scale--;
 
424
#|    }
 
425
#|}
 
426
 
 
427
#---------------------------------------------------------------------
 
428
# Format a number, optionally with a +/- delta, to n significant
 
429
# digits.
 
430
#
 
431
# @param significant digit, a value >= 1
 
432
# @param multiplier
 
433
# @param time in seconds to be formatted
 
434
# @optional delta in seconds
 
435
#
 
436
# @return string of the form "23" or "23 +/- 10".
 
437
#
 
438
sub formatNumber {
 
439
    my $sigdig = shift;
 
440
    my $mult = shift;
 
441
    my $a = shift;
 
442
    my $delta = shift; # may be undef
 
443
    
 
444
    my $result = formatSigDig($sigdig, $a*$mult);
 
445
    if (defined($delta)) {
 
446
        my $d = formatSigDig($sigdig, $delta*$mult);
 
447
        # restrict PRECISION of delta to that of main number
 
448
        if ($result =~ /\.(\d+)/) {
 
449
            # TODO make this work for values with all significant
 
450
            # digits to the left of the decimal, e.g., 1234000.
 
451
 
 
452
            # TODO the other thing wrong with this is that it
 
453
            # isn't rounding the $delta properly.  Have to put
 
454
            # this logic into formatSigDig().
 
455
            my $x = length($1);
 
456
            $d =~ s/\.(\d{$x})\d+/.$1/;
 
457
        }
 
458
        $result .= " $PLUS_MINUS " . $d;
 
459
    }
 
460
    $result;
 
461
}
 
462
 
 
463
#---------------------------------------------------------------------
 
464
# Format a time, optionally with a +/- delta, to n significant
 
465
# digits.
 
466
#
 
467
# @param significant digit, a value >= 1
 
468
# @param time in seconds to be formatted
 
469
# @optional delta in seconds
 
470
#
 
471
# @return string of the form "23 ms" or "23 +/- 10 ms".
 
472
#
 
473
sub formatSeconds {
 
474
    my $sigdig = shift;
 
475
    my $a = shift;
 
476
    my $delta = shift; # may be undef
 
477
 
 
478
    my @MULT = (1   , 1e3,  1e6,  1e9);
 
479
    my @SUFF = ('s' , 'ms', 'us', 'ns');
 
480
 
 
481
    # Determine our scale
 
482
    my $i = 0;
 
483
    ++$i while ($a*$MULT[$i] < 1 && $i < @MULT);
 
484
    
 
485
    formatNumber($sigdig, $MULT[$i], $a, $delta) . ' ' . $SUFF[$i];
 
486
}
 
487
 
 
488
#---------------------------------------------------------------------
 
489
# Format a percentage, optionally with a +/- delta, to n significant
 
490
# digits.
 
491
#
 
492
# @param significant digit, a value >= 1
 
493
# @param value to be formatted, as a fraction, e.g. 0.5 for 50%
 
494
# @optional delta, as a fraction
 
495
#
 
496
# @return string of the form "23 %" or "23 +/- 10 %".
 
497
#
 
498
sub formatPercent {
 
499
    my $sigdig = shift;
 
500
    my $a = shift;
 
501
    my $delta = shift; # may be undef
 
502
    
 
503
    formatNumber($sigdig, 100, $a, $delta) . ' %';
 
504
}
 
505
 
 
506
#---------------------------------------------------------------------
 
507
# Format a number to n significant digits without using exponential
 
508
# notation.
 
509
#
 
510
# @param significant digit, a value >= 1
 
511
# @param number to be formatted
 
512
#
 
513
# @return string of the form "1234" "12.34" or "0.001234".  If
 
514
#         number was negative, prefixed by '-'.
 
515
#
 
516
sub formatSigDig {
 
517
    my $n = shift() - 1;
 
518
    my $a = shift;
 
519
 
 
520
    local $_ = sprintf("%.${n}e", $a);
 
521
    my $sign = (s/^-//) ? '-' : '';
 
522
 
 
523
    my $a_e;
 
524
    my $result;
 
525
    if (/^(\d)\.(\d+)e([-+]\d+)$/) {
 
526
        my ($d, $dn, $e) = ($1, $2, $3);
 
527
        $a_e = $e;
 
528
        $d .= $dn;
 
529
        $e++;
 
530
        $d .= '0' while ($e > length($d));
 
531
        while ($e < 1) {
 
532
            $e++;
 
533
            $d = '0' . $d;
 
534
        }
 
535
        if ($e == length($d)) {
 
536
            $result = $sign . $d;
 
537
        } else {
 
538
            $result = $sign . substr($d, 0, $e) . '.' . substr($d, $e);
 
539
        }
 
540
    } else {
 
541
        die "Can't parse $_";
 
542
    }
 
543
    $result;
 
544
}
 
545
 
 
546
#eof