view release on metacpan or  search on metacpan

lib/Acme/AsciiArtinator.pm  view on Meta::CPAN

    @test_stdin = @{$opts{"test_input$ntest"}} if defined $opts{"test_input$ntest"};
    my $fh;
    if (open($fh, ">", "ascii-art-test-$ntest-$$.pl")) {
      print $fh $CODE;
      close $fh;

      my $output = "";
      if (defined $opts{"test_input$ntest"}) {
	open($fh, ">", "ascii-art-test-$ntest-$$.stdin");
	print $fh @test_stdin;
	close $fh;
	print qq{Running test: $^X ascii-art-test-$ntest-$$.pl @test_argv < ascii-art-test-$ntest-$$.stdin\n} if $DEBUG;
	$output = qx{$^X ascii-art-test-$ntest-$$.pl @test_argv < ascii-art-test-$ntest-$$.stdin};
	unlink "ascii-art-test-$ntest-$$.stdin";
      } else {
	print qq{Running test: $^X ascii-art-test-$ntest-$$.pl @test_argv\n};
	$output = qx{$^X ascii-art-test-$ntest-$$.pl @test_argv};
      }
      print "Ran pre-test # $ntest with argv: \"@test_argv\", stdin: \"@test_stdin\"\n";

      $Acme::AsciiArtinator::TestOutput[$ntest] = $output;
      unlink "ascii-art-test-$ntest-$$.pl";
    } else {
      carp "Could not write code to disk in order to run pre-test.\n";
    }
  } continue {
    $ntest++;
  }


  ###############################################

  my $max_tries = $opts{"retry"} || 100;


  my @tokens = &asciiindex_code($CODE);
  my @contexts = @asciiartinate::contexts;
  my @blocks = &asciiindex_art($PIC);

  my $ipad;
  for ($ipad = 0; $ipad < $max_tries; $ipad++) {
    print "\n\n\n\nPad try # $ipad\n\n\n\n"; 

    my ($newt,$newc) = &pad(\@tokens, \@contexts, \@blocks);
    if (defined $newc) {

      for (my $i=0; $i<@$newt; $i++) {
	print $newt->[$i], "\t", $newc->[$i], "\n";
      }

      @tokens = @$newt;

      if ($opts{"filler"} != 0) {
	&tweak_padding($opts{"filler"}, \@tokens, \@contexts);
      }

      print_code_to_pic($PIC, @tokens);

      my $fh;
      open($fh, ">", $OUTPUT);
      select $fh;
      print_code_to_pic($PIC, @tokens);
      select STDOUT;
      close $fh;

      my $c1 = &compile_check($OUTPUT);
      if ($c1 > 0) {
	croak "Artinated code does not compile! Darn.\n";
	exit $c1 >> 8;
      }

      ##################################################
      #
      # artination complete
      #
      ##################################################

      open($fh,"<", $OUTPUT);
      my @output = <$fh>;
      close $fh;

      # test output
      #
      # make sure artinated code produces same outputs
      # as the original code on the test cases.
      #
      $ntest = 1;
      if (defined $opts{"test_argv1"}) {
	print "Running post-tests on artinated code\n";
      }
      while (defined $opts{"test_argv$ntest"} || defined $opts{"test_input$ntest"}) {
	my (@test_argv, @test_stdin) = ();

	print "Testing output # $ntest:\n";

	@test_argv = @{$opts{"test_argv$ntest"}} if defined $opts{"test_argv$ntest"};
	@test_stdin = @{$opts{"test_input$ntest"}} if defined $opts{"test_input$ntest"};
	my $fh;
	next if !defined $Acme::AsciiArtinator::TestOutput[$ntest];

	my $output = "";
	if (defined $opts{"test_input$ntest"}) {
	  open($fh, ">", "ascii-art-test-$ntest-$$.stdin");
	  print $fh @test_stdin;
	  close $fh;
	  $output = qx{$^X "$OUTPUT" @test_argv < ascii-art-test-$ntest-$$.stdin};
	  unlink "ascii-art-test-$ntest-$$.stdin";
	} else {
	  $output = qx{$^X "$OUTPUT" @test_argv};
	}
	print "Ran post-test # $ntest with argv: \"@test_argv\", stdin: \"@test_stdin\"\n";
    
	if ($output eq $Acme::AsciiArtinator::TestOutput[$ntest]) {
	  print "Post-test # $ntest: PASS\n";
	  $Acme::AsciiArtinator::TestResult[$ntest] = "PASS";
	} else {
	  print "Post-test # $ntest: FAIL\n";
	  $Acme::AsciiArtinator::TestResult[$ntest] = "FAIL";
	  print STDERR "-- " x 13, "\n";
	  print STDERR "Original results for test # $ntest:\n";
	  print STDERR "-- " x 7, "\n";
	  print STDERR $Acme::AsciiArtinator::TestOutput[$ntest];
	  print STDERR "\n", "-- " x 13, "\n";