home *** CD-ROM | disk | FTP | other *** search
/ OS/2 Shareware BBS: 10 Tools / 10-Tools.zip / perl560.zip / t / op / universal.t < prev    next >
Text File  |  2000-03-14  |  2KB  |  107 lines
  1. #!./perl
  2. #
  3. # check UNIVERSAL
  4. #
  5.  
  6. BEGIN {
  7.     chdir 't' if -d 't';
  8.     unshift @INC, '../lib' if -d '../lib';
  9. }
  10.  
  11. print "1..73\n";
  12.  
  13. $a = {};
  14. bless $a, "Bob";
  15. print "not " unless $a->isa("Bob");
  16. print "ok 1\n";
  17.  
  18. package Human;
  19. sub eat {}
  20.  
  21. package Female;
  22. @ISA=qw(Human);
  23.  
  24. package Alice;
  25. @ISA=qw(Bob Female);
  26. sub drink {}
  27. sub new { bless {} }
  28.  
  29. $Alice::VERSION = 2.718;
  30.  
  31. package main;
  32.  
  33. my $i = 2;
  34. sub test { print "not " unless shift; print "ok $i\n"; $i++; }
  35.  
  36. $a = new Alice;
  37.  
  38. test $a->isa("Alice");
  39.  
  40. test $a->isa("Bob");
  41.  
  42. test $a->isa("Female");
  43.  
  44. test $a->isa("Human");
  45.  
  46. test ! $a->isa("Male");
  47.  
  48. test $a->can("drink");
  49.  
  50. test $a->can("eat");
  51.  
  52. test ! $a->can("sleep");
  53.  
  54. my $b = 'abc';
  55. my @refs = qw(SCALAR SCALAR     LVALUE      GLOB ARRAY HASH CODE);
  56. my @vals = (  \$b,   \3.14, \substr($b,1,1), \*b,  [],  {}, sub {} );
  57. for ($p=0; $p < @refs; $p++) {
  58.     for ($q=0; $q < @vals; $q++) {
  59.         test UNIVERSAL::isa($vals[$p], $refs[$q]) eq ($p==$q or $p+$q==1);
  60.     };
  61. };
  62.  
  63. test ! UNIVERSAL::can(23, "can");
  64.  
  65. test $a->can("VERSION");
  66.  
  67. test $a->can("can");
  68. test ! $a->can("export_tags");    # a method in Exporter
  69.  
  70. test (eval { $a->VERSION }) == 2.718;
  71.  
  72. test ! (eval { $a->VERSION(2.719) }) &&
  73.          $@ =~ /^Alice version 2.71(?:9|8999\d+) required--this is only version 2.718 at /;
  74.  
  75. test (eval { $a->VERSION(2.718) }) && ! $@;
  76.  
  77. my $subs = join ' ', sort grep { defined &{"UNIVERSAL::$_"} } keys %UNIVERSAL::;
  78. if ('a' lt 'A') {
  79.     test $subs eq "can isa VERSION";
  80. } else {
  81.     test $subs eq "VERSION can isa";
  82. }
  83.  
  84. test $a->isa("UNIVERSAL");
  85.  
  86. # now use UNIVERSAL.pm and see what changes
  87. eval "use UNIVERSAL";
  88.  
  89. test $a->isa("UNIVERSAL");
  90.  
  91. my $sub2 = join ' ', sort grep { defined &{"UNIVERSAL::$_"} } keys %UNIVERSAL::; 
  92. # XXX import being here is really a bug
  93. if ('a' lt 'A') {
  94.     test $sub2 eq "can import isa VERSION";
  95. } else {
  96.     test $sub2 eq "VERSION can import isa";
  97. }
  98.  
  99. eval 'sub UNIVERSAL::sleep {}';
  100. test $a->can("sleep");
  101.  
  102. test ! UNIVERSAL::can($b, "can");
  103.  
  104. test ! $a->can("export_tags");    # a method in Exporter
  105.  
  106. test ! UNIVERSAL::isa("\xff\xff\xff\0", 'HASH');
  107.