home *** CD-ROM | disk | FTP | other *** search
/ OS/2 Shareware BBS: 10 Tools / 10-Tools.zip / perl560.zip / t / lib / autoloader.t < prev    next >
Text File  |  1999-07-20  |  2KB  |  122 lines
  1. #!./perl
  2.  
  3. BEGIN {
  4.     chdir 't' if -d 't';
  5.     $dir = "auto-$$";
  6.     unshift @INC, ("./$dir", "../lib");
  7. }
  8.  
  9. print "1..11\n";
  10.  
  11. # First we must set up some autoloader files
  12. mkdir $dir, 0755            or die "Can't mkdir $dir: $!";
  13. mkdir "$dir/auto", 0755     or die "Can't mkdir: $!";
  14. mkdir "$dir/auto/Foo", 0755 or die "Can't mkdir: $!";
  15.  
  16. open(FOO, ">$dir/auto/Foo/foo.al") or die;
  17. print FOO <<'EOT';
  18. package Foo;
  19. sub foo { shift; shift || "foo" }
  20. 1;
  21. EOT
  22. close(FOO);
  23.  
  24. open(BAR, ">$dir/auto/Foo/bar.al") or die;
  25. print BAR <<'EOT';
  26. package Foo;
  27. sub bar { shift; shift || "bar" }
  28. 1;
  29. EOT
  30. close(BAR);
  31.  
  32. open(BAZ, ">$dir/auto/Foo/bazmarkhian.al") or die;
  33. print BAZ <<'EOT';
  34. package Foo;
  35. sub bazmarkhianish { shift; shift || "baz" }
  36. 1;
  37. EOT
  38. close(BAZ);
  39.  
  40. # Let's define the package
  41. package Foo;
  42. require AutoLoader;
  43. @ISA=qw(AutoLoader);
  44.  
  45. sub new { bless {}, shift };
  46.  
  47. package main;
  48.  
  49. $foo = new Foo;
  50.  
  51. print "not " unless $foo->foo eq 'foo';  # autoloaded first time
  52. print "ok 1\n";
  53.  
  54. print "not " unless $foo->foo eq 'foo';  # regular call
  55. print "ok 2\n";
  56.  
  57. # Try an undefined method
  58. eval {
  59.     $foo->will_fail;
  60. };
  61. print "not " unless $@ =~ /^Can't locate/;
  62. print "ok 3\n";
  63.  
  64. # Used to be trouble with this
  65. eval {
  66.     my $foo = new Foo;
  67.     die "oops";
  68. };
  69. print "not " unless $@ =~ /oops/;
  70. print "ok 4\n";
  71.  
  72. # Pass regular expression variable to autoloaded function.  This used
  73. # to go wrong because AutoLoader used regular expressions to generate
  74. # autoloaded filename.
  75. "foo" =~ /(\w+)/;
  76. print "not " unless $1 eq 'foo';
  77. print "ok 5\n";
  78.  
  79. print "not " unless $foo->bar($1) eq 'foo';
  80. print "ok 6\n";
  81.  
  82. print "not " unless $foo->bar($1) eq 'foo';
  83. print "ok 7\n";
  84.  
  85. print "not " unless $foo->bazmarkhianish($1) eq 'foo';
  86. print "ok 8\n";
  87.  
  88. print "not " unless $foo->bazmarkhianish($1) eq 'foo';
  89. print "ok 9\n";
  90.  
  91. # test recursive autoloads
  92. open(F, ">$dir/auto/Foo/a.al") or die;
  93. print F <<'EOT';
  94. package Foo;
  95. BEGIN { b() }
  96. sub a { print "ok 11\n"; }
  97. 1;
  98. EOT
  99. close(F);
  100.  
  101. open(F, ">$dir/auto/Foo/b.al") or die;
  102. print F <<'EOT';
  103. package Foo;
  104. sub b { print "ok 10\n"; }
  105. 1;
  106. EOT
  107. close(F);
  108. Foo::a();
  109.  
  110. # cleanup
  111. END {
  112. return unless $dir && -d $dir;
  113. unlink "$dir/auto/Foo/foo.al";
  114. unlink "$dir/auto/Foo/bar.al";
  115. unlink "$dir/auto/Foo/bazmarkhian.al";
  116. unlink "$dir/auto/Foo/a.al";
  117. unlink "$dir/auto/Foo/b.al";
  118. rmdir "$dir/auto/Foo";
  119. rmdir "$dir/auto";
  120. rmdir "$dir";
  121. }
  122.