This is a live mirror of the Perl 5 development currently hosted at https://github.com/perl/perl5
Make DosGlob.t more resilient
[perl5.git] / ext / File-DosGlob / t / DosGlob.t
index 8d950d7..600b87a 100644 (file)
@@ -4,14 +4,17 @@
 # test glob() in File::DosGlob
 #
 
 # test glob() in File::DosGlob
 #
 
+# Make sure it can load before other XS extensions
+use File::DosGlob;
+
 use FindBin;
 use File::Spec::Functions;
 BEGIN {
 use FindBin;
 use File::Spec::Functions;
 BEGIN {
-    chdir catfile $FindBin::Bin, (updir)x3, 't';
+    chdir catdir $FindBin::Bin, (updir)x3, 't';
     @INC = '../lib';
 }
 
     @INC = '../lib';
 }
 
-use Test::More tests => 20;
+use Test::More tests => 21;
 
 # override it in main::
 use File::DosGlob 'glob';
 
 # override it in main::
 use File::DosGlob 'glob';
@@ -132,3 +135,22 @@ if ($cwd =~ /^([a-zA-Z]:)/) {
 } else {
     pass();
 }
 } else {
     pass();
 }
+
+# Test that our internal data are freed when the caller’s op tree is freed,
+# even if iteration has not finished.
+# Using XS::APItest is the only simple way to test this.  Since this is a
+# core-only module, this should be OK.
+SKIP: {
+    require Config;
+    skip "no XS::APItest"
+     unless eval { require XS::APItest; import XS::APItest "sv_count"; 1 };
+    # Use a random number of ops, so that the glob op does not reuse the
+    # same address each time, giving us false passes.
+    my($count,$count2);
+    eval '$x+'x(1+rand() * 100) . '<*>';
+    $count = sv_count();
+    eval '$x+'x(1+rand() * 100) . '<*>';
+    $count2 = sv_count();
+    cmp_ok $count2, '<=', $count,
+     'no leak when partly iterated caller is freed';
+}