1#!/bin/sh
2# -*- mode: cperl; coding: utf-8-unix; -*-
3
4eval 'exec ${PERL-perl} -Sx "$0" ${1+"$@"}'
5  if 0;
6
7#!perl
8#line 9
9
10use strict;
11use warnings;
12
13use File::Basename;
14
15my $outfile = "t/scope-nested-const.t";
16
17my $dirname = dirname(__FILE__);
18chdir $dirname
19  or die "$dirname: chdir failed: $!";
20
21chomp(my $gitroot = `git rev-parse --show-toplevel`);
22chdir $gitroot
23  or die "$gitroot: chdir failed: $!";
24
25open my($fh), ">", $outfile
26  or die "$outfile: can't open file for writing: $!";
27
28use Algorithm::Combinatorics 'permutations';
29
30my $data = [
31            ['bigint',   'Math::BigInt'  ],
32            ['bigfloat', 'Math::BigFloat'],
33            ['bigrat',   'Math::BigRat'  ],
34           ];
35
36print $fh <<'EOF' or die "$outfile: print failed: $!";
37# -*- mode: perl; -*-
38
39use strict;
40use warnings;
41
42use Test::More;
43
44plan skip_all => 'Need at least Perl v5.10.1' if $] < "5.010001";
45
46plan tests => 96;
47EOF
48
49my $iter = permutations([0, 1, 2]);
50while (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
61note "\\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}
104EOF
105}
106
107close($fh)
108  or die "$outfile: can't close file after writing: $!";
109
110print "Wrote '$outfile'\n";
111