t/aggregate/psgi_file.t

   1 use strict;
   2 use warnings;
   3 use Test::More;
   4 use FindBin;
   5 use lib "$FindBin::Bin/../lib";
   6 use File::Temp qw/ tempdir /;
   7 use TestApp;
   8 use File::Spec;
   9 use Carp qw/croak/;
  10
  11 my $home = tempdir( CLEANUP => 1 );
  12 my $path = File::Spec->catfile($home, 'testapp.psgi');
  13 open(my $psgi, '>', $path)
  14     or die;
  15 print $psgi q{
  16 use strict;
  17 use warnings;
  18 use TestApp;
  19
  20 TestApp->psgi_app;
  21 };
  22 close($psgi);
  23
  24 my ($saved_stdout, $saved_stderr);
  25 my $stdout = !open( $saved_stdout, '>&'. STDOUT->fileno );
  26 my $stderr = !open( $saved_stderr, '>&'. STDERR->fileno );
  27 open( STDOUT, '+>', undef )
  28             or croak("Can't reopen stdout to /dev/null");
  29 open( STDERR, '+>', undef )
  30             or croak("Can't reopen stdout to /dev/null");
  31 # Check we wrote out something that compiles
  32 system($^X, '-I', "$FindBin::Bin/../lib", '-c', $path)
  33     ? fail('.psgi does not compile')
  34     : pass('.psgi compiles');
  35
  36 if ($stdout) {
  37     open( STDOUT, '>&'. fileno($saved_stdout) );
  38 }
  39 if ($stderr) {
  40     open( STDERR, '>&'. fileno($saved_stderr) );
  41 }
  42
  43 # NOTE - YOU *CANNOT* do something like:
  44 #my $psgi_ref = require $path;
  45 # otherwise this test passes!
  46 # I don't exactly know why that is yet, however, to be safe for future, that
  47 # is why this test writes out its own .psgi file in a temp directory - so that that
  48 # path has never been require'd before, and will never be require'd again..
  49
  50 local TestApp->config->{home} = $home;
  51
  52 my $failed = 0;
  53 eval {
  54     # Catch infinite recursion (or anything else)
  55     local $SIG{__WARN__} = sub { warn(@_); $failed = 1; die; };
  56     TestApp->_finalized_psgi_app;
  57 };
  58 ok(!$@, 'No exception')
  59     or diag $@;
  60 ok(!$failed, 'TestApp->_finalized_psgi_app works');
  61
  62 done_testing;