cpan/bignum/gentest/scope-nested-const.sh

   1 #!/bin/sh
   2 # -*- mode: cperl; coding: utf-8-unix; -*-
   3
   4 eval 'exec ${PERL-perl} -Sx "$0" ${1+"$@"}'
   5   if 0;
   6
   7 #!perl
   8 #line 9
   9
  10 use strict;
  11 use warnings;
  12
  13 use File::Basename;
  14
  15 my $outfile = "t/scope-nested-const.t";
  16
  17 my $dirname = dirname(__FILE__);
  18 chdir $dirname
  19   or die "$dirname: chdir failed: $!";
  20
  21 chomp(my $gitroot = `git rev-parse --show-toplevel`);
  22 chdir $gitroot
  23   or die "$gitroot: chdir failed: $!";
  24
  25 open my($fh), ">", $outfile
  26   or die "$outfile: can't open file for writing: $!";
  27
  28 use Algorithm::Combinatorics 'permutations';
  29
  30 my $data = [
  31             ['bigint',   'Math::BigInt'  ],
  32             ['bigfloat', 'Math::BigFloat'],
  33             ['bigrat',   'Math::BigRat'  ],
  34            ];
  35
  36 print $fh <<'EOF' or die "$outfile: print failed: $!";
  37 # -*- mode: perl; -*-
  38
  39 use strict;
  40 use warnings;
  41
  42 use Test::More;
  43
  44 plan skip_all => 'Need at least Perl v5.10.1' if $] < "5.010001";
  45
  46 plan tests => 96;
  47 EOF
  48
  49 my $iter = permutations([0, 1, 2]);
  50 while (my $idxs = $iter -> next()) {
  51
  52     my $p0 = $data -> [ $idxs -> [0] ][0];
  53     my $c0 = $data -> [ $idxs -> [0] ][1];
  54     my $p1 = $data -> [ $idxs -> [1] ][0];
  55     my $c1 = $data -> [ $idxs -> [1] ][1];
  56     my $p2 = $data -> [ $idxs -> [2] ][0];
  57     my $c2 = $data -> [ $idxs -> [2] ][1];
  58
  59     print $fh <<"EOF" or die "$outfile: print failed: $!";
  60
  61 note "\\n$p0 -> $p1 -> $p2\\n\\n";
  62
  63 {
  64     note "use $p0;";
  65     use $p0;
  66     is(ref(hex("1")), "$c0", 'ref(hex("1"))');
  67     is(ref(oct("1")), "$c0", 'ref(oct("1"))');
  68
  69     {
  70         note "use $p1;";
  71         use $p1;
  72         is(ref(hex("1")), "$c1", 'ref(hex("1"))');
  73         is(ref(oct("1")), "$c1", 'ref(oct("1"))');
  74
  75         {
  76             note "use $p2;";
  77             use $p2;
  78             is(ref(hex("1")), "$c2", 'ref(hex("1"))');
  79             is(ref(oct("1")), "$c2", 'ref(oct("1"))');
  80
  81             note "no $p2;";
  82             no $p2;
  83             is(ref(hex("1")), "", 'ref(hex("1"))');
  84             is(ref(oct("1")), "", 'ref(oct("1"))');
  85         }
  86
  87         is(ref(hex("1")), "$c1", 'ref(hex("1"))');
  88         is(ref(oct("1")), "$c1", 'ref(oct("1"))');
  89
  90         note "no $p1;";
  91         no $p1;
  92         is(ref(hex("1")), "", 'ref(hex("1"))');
  93         is(ref(oct("1")), "", 'ref(oct("1"))');
  94     }
  95
  96     is(ref(hex("1")), "$c0", 'ref(hex("1"))');
  97     is(ref(oct("1")), "$c0", 'ref(oct("1"))');
  98
  99     note "no $p0;";
 100     no $p0;
 101     is(ref(hex("1")), "", 'ref(hex("1"))');
 102     is(ref(oct("1")), "", 'ref(oct("1"))');
 103 }
 104 EOF
 105 }
 106
 107 close($fh)
 108   or die "$outfile: can't close file after writing: $!";
 109
 110 print "Wrote '$outfile'\n";