The Perl Toolchain Summit needs more sponsors. If your company depends on Perl, please support this very important event.
BEGIN {				# Magic Perl CORE pragma
    if ($ENV{PERL_CORE}) {
        chdir 't' if -d 't';
        @INC = '../lib';
    }
    unless (find PerlIO::Layer 'perlio') {
        print "1..0 # Skip: PerlIO not used\n";
        exit 0;
    }
}

use strict;
use warnings;
use Test::More tests => 10 + (2*12);

BEGIN { use_ok('PerlIO::via::Include') }

can_ok( 'PerlIO::via::Include',qw(after before regexp) );
is( PerlIO::via::Include->before,'^#include ',	'check before, #1' );
is( PerlIO::via::Include->after,"\n",		'check after, #1' );
ok( !defined( PerlIO::via::Include->regexp ),	'check regexp, #1' );

my $file = 'test.include';
my $file1 = 'test.1';
my $file2 = 'test.2';

test_this( <<EOD,<<EOD1,<<EOD2,<<RESULT );
This is the original file

\#include $file1

This is the original file again.
EOD
This is file 1

\#include $file2

This is file 1 again.
EOD1
This is file 2
and more in 2
and still 2
EOD2
This is the original file

This is file 1

This is file 2
and more in 2
and still 2

This is file 1 again.

This is the original file again.
RESULT

use_ok('PerlIO::via::Include', regexp => qr#<include file="([^"]+)"/># );
ok( !defined( PerlIO::via::Include->before ),	'check before, #2' );
ok( !defined( PerlIO::via::Include->after ),	'check after, #2' );

# fix different stringification of regexps between Perl versions
( my $regexp= PerlIO::via::Include->regexp ) =~ s#\?[^:]+#?#;
is( $regexp, '(?:<include file="([^"]+)"/>)','check regexp, #2' );

test_this( <<EOD, qq(included from 1, <include file="test.2"/>, magically), qq(included <from number="2"/>), <<RESULT );
<xml><file number="0"/>
 This is to be <include file="test.1"/> in here.
</xml>
EOD
<xml><file number="0"/>
 This is to be included from 1, included <from number="2"/>, magically in here.
</xml>
RESULT

# Remove whatever we created now

ok( unlink( $file,$file1,$file2 ),	'remove test files' );
1 while unlink( $file,$file2,$file2 ); # multiversioned filesystems


sub test_this {

  ok( open( my $out,">$file" ),	"opening '$file' for writing" );
  ok( (print $out $_[0]),	"write to '$file'" );
  ok( close( $out ),		"close writing '$file'" );

  ok( open( $out,">$file1" ),	"opening '$file1' for writing" );
  ok( (print $out $_[1]),	"write to '$file1'" );
  ok( close( $out ),		"close writing '$file1'" );

  ok( open( $out,">$file2" ),	"opening '$file2' for writing" );
  ok( (print $out $_[2]),	"write to '$file2'" );
  ok( close( $out ),		"close writing '$file2'" );

  ok(
   open( my $in,"<:via(Include)",$file ),
   "open '$file' for reading"
  );
  is( join('',<$in>),$_[3],	"check result '$file'"  );
  ok( close( $in ),		"close reading '$file'" );
}