The Perl Toolchain Summit needs more sponsors. If your company depends on Perl, please support this very important event.
#!perl
#===============================================================================
#
# t/cryptfile-leaktest.pl
#
# DESCRIPTION
#   Test script to check for leaks in the crypt_file() function.
#
#   This file is intentionally named so as not to be included in the main test
#   suite when running "make test" or equivalent because it is not easy for it
#   to determine for itself if it is leaking, nor to say how long it should be
#   run for to be sure.
#
#   Instead, users should manually run this test by typing:
#
#       perl -Mblib t/cryptfile-leaktest.pl
#
#   from the top-level directory.
#
# COPYRIGHT
#   Copyright (C) 2004-2006, 2014 Steve Hay.  All rights reserved.
#
# LICENCE
#   You may distribute under the terms of either the GNU General Public License
#   or the Artistic License, as specified in the LICENCE file.
#
#===============================================================================

use 5.008001;

use strict;
use warnings;

use Cwd qw(abs_path);
use Fcntl qw(:seek);
use File::Spec::Functions qw(canonpath catdir catfile updir);
use FindBin qw($Bin);

#===============================================================================
# INITIALIZATION
#===============================================================================

BEGIN {
    my $top_dir = canonpath(abs_path(catdir($Bin, updir())));
    my $lib_dir = catfile($top_dir, 'blib', 'lib', 'Filter', 'Crypto');

    if (-f catfile($lib_dir, 'CryptFile.pm')) {
        require Filter::Crypto::CryptFile;
        Filter::Crypto::CryptFile->import();
    }
    else {
        die "CryptFile component not built!\n";
    }
}

#===============================================================================
# MAIN PROGRAM
#===============================================================================

MAIN: {
    my $file = 'test.pl';
    my $prog = qq[print "Hello, world.\\n";\n];

    my($fh, $interrupted, $i);

    open $fh, ">$file" or die "Can't create file '$file': $!\n";
    print $fh $prog;
    close $fh;

    print "Running crypt_file() indefinitely.\n" .
          "Watch your memory usage (PID $$), and press Ctrl+C to quit.\n" .
          "Press RETURN to begin...\n";
    <STDIN>;

    $interrupted = 0;

    $SIG{INT} = sub {
        print "Caught SIGINT. Terminating.\n";
        # Do not exit here because crypt_file() could have the file open, and we
        # cannot delete an open file on Win32.
        $interrupted = 1;
    };

    for ($i = 1; 1; $i++) {
        print "$i\n";
        crypt_file($file) or die "crypt_file() failed\n";
        if ($interrupted) {
            unlink $file or die "Can't delete file '$file': $!\n";
            exit;
        }
    }
}

#===============================================================================