t/comp/package.t

   1 #!./perl
   2
   3 print "1..22\n";
   4
   5 $blurfl = 123;
   6 $foo = 3;
   7
   8 package xyz;
   9
  10 sub new {bless [];}
  11
  12 $bar = 4;
  13
  14 {
  15     package ABC;
  16     $blurfl = 5;
  17     $main'a = $'b;
  18 }
  19
  20 $ABC'dyick = 6;
  21
  22 $xyz = 2;
  23
  24 $main = join(':', sort(keys %main::));
  25 $xyz = join(':', sort(keys %xyz::));
  26 $ABC = join(':', sort(keys %ABC::));
  27
  28 if ('a' lt 'A') {
  29     print $xyz eq 'bar:main:new:xyz:ABC' ? "ok 1\n" : "not ok 1 '$xyz'\n";
  30 } else {
  31     print $xyz eq 'ABC:bar:main:new:xyz' ? "ok 1\n" : "not ok 1 '$xyz'\n";
  32 }
  33 print $ABC eq 'blurfl:dyick' ? "ok 2\n" : "not ok 2 '$ABC'\n";
  34 print $main'blurfl == 123 ? "ok 3\n" : "not ok 3\n";
  35
  36 package ABC;
  37
  38 print $blurfl == 5 ? "ok 4\n" : "not ok 4\n";
  39 eval 'print $blurfl == 5 ? "ok 5\n" : "not ok 5\n";';
  40 eval 'package main; print $blurfl == 123 ? "ok 6\n" : "not ok 6\n";';
  41 print $blurfl == 5 ? "ok 7\n" : "not ok 7\n";
  42
  43 package main;
  44
  45 sub c { caller(0) }
  46
  47 sub foo {
  48    my $s = shift;
  49    if ($s) {
  50         package PQR;
  51         main::c();
  52    }
  53 }
  54
  55 print((foo(1))[0] eq 'PQR' ? "ok 8\n" : "not ok 8\n");
  56
  57 my $Q = xyz->new();
  58 undef %xyz::;
  59 eval { $a = *xyz::new{PACKAGE}; };
  60 print $a eq "__ANON__" ? "ok 9\n" : "not ok 9 # '$a'\n";
  61
  62 eval { $Q->param; };
  63 print $@ =~ /^Can't use anonymous symbol table for method lookup/ ?
  64   "ok 10\n" : "not ok 10 # '$@'\n";
  65
  66 print "$Q" =~ /^__ANON__=/ ? "ok 11\n" : "not ok 11 # '$Q'\n";
  67
  68 print ref $Q eq "__ANON__" ? "ok 12\n" : "not ok 12 # '$Q'\n";
  69
  70 package bug32562;
  71
  72 print       __PACKAGE__  eq 'bug32562' ? "ok 13\n" : "not ok 13\n";
  73 print eval '__PACKAGE__' eq 'bug32562' ? "ok 14\n" : "not ok 14\n";
  74
  75 # test: package NAME VERSION
  76
  77 my @variations = (
  78   '1.00',
  79   '1.00_01',
  80   'v1.2.3',
  81   'v1.2_3',
  82 );
  83
  84 my $test_count = 15;
  85
  86 for my $v ( @variations ) {
  87   my $ok = eval "package withversion $v; $v eq \$withversion::VERSION";
  88   print $ok ? "ok $test_count\n" : "not ok $test_count\n";
  89   $test_count++;
  90 }
  91
  92 eval q/package Foo Bar/;
  93 $@ =~ /syntax error/ or print "not ";
  94 print "ok $test_count\n"; $test_count++;
  95
  96 eval q/package Foo 1a/;
  97 $@ =~ /syntax error/ or print "not ";
  98 print "ok $test_count\n"; $test_count++;
  99
 100 eval q/package Foo v/;
 101 $@ =~ /syntax error/ or print "not ";
 102 print "ok $test_count\n"; $test_count++;
 103
 104 eval q/package Foo $foo/;
 105 $@ =~ /syntax error/ or print "not ";
 106 print "ok $test_count\n"; $test_count++;