t/compilers/pge/pge_text.t

   1 #!perl
   2 # Copyright (C) 2001-2007, The Perl Foundation.
   3 # $Id$
   4
   5 use strict;
   6 use warnings;
   7 use lib qw( t . lib ../lib ../../lib ../../../lib );
   8 use Test::More;
   9 use Parrot::Test tests => 20;
  10 use Parrot::Test::PGE;
  11
  12 =head1 NAME
  13
  14 t/compilers/pge/pge_text.t - PGE::Text tests
  15
  16 =head1 DESCRIPTION
  17
  18 These tests examine the ability of PGE to match text with brackets in it.
  19
  20 =head1 SYNOPSIS
  21
  22         % prove t/compilers/pge/text_brk.t
  23
  24 =cut
  25
  26 ## First, test direct calls to PGE::Text::bracketed
  27 ##
  28 pir_output_is( <<'CODE', <<'OUT', "bracketed" );
  29 .sub main :main
  30     .local pmc bracketed
  31
  32     load_bytecode 'PGE.pbc'
  33     load_bytecode 'PGE/Text.pir'
  34
  35     bracketed = get_global ['PGE::Text'], "bracketed"
  36
  37     $S0 = "{ nested { and } okay, () and <>,  escaped \\}'s } okay"
  38     $P0 = bracketed($S0)
  39     bsr result
  40     $S0 = "{ nested \n{ and } okay, \n() and <>, escaped \\}'s } okay"
  41     $P0 = bracketed($S0)
  42     bsr result
  43     $S0 = "{ nested { and } okay,  unbalanced ( and < , escaped \\}'s } okay"
  44     $P0 = bracketed($S0, "{}")
  45     bsr result
  46     $S0 = "{ unmatched nested { not okay, nor ( and < } not okay"
  47     $P0 = bracketed($S0, "{}")
  48     bsr result
  49     $S0 = "{ unbalanced nested [ even with } and ] to match not okay"
  50     $P0 = bracketed($S0, "{}[]")
  51     bsr result
  52     $S0 = "<a quoted \">\" unbalanced right bracket> okay"
  53     $P0 = bracketed($S0, "<\">")
  54     bsr result
  55     $S0 = "<quoted \">\" unbalanced of two quotes (`>>>\"\"\">>>>`)> okay"
  56     $P0 = bracketed($S0, "<\"`>")
  57     bsr result
  58     $S0 = "<a misquoted '>' bracket ends string>"
  59     $P0 = bracketed($S0, "<\"`>")
  60     bsr result
  61     .return ()
  62
  63   result:
  64     if $P0 goto succeed
  65     print "failed\n"
  66     ret
  67   succeed:
  68     $I0 = $P0."to"()
  69     $S1 = substr $S0, $I0
  70     print $S1
  71     print "\n"
  72     ret
  73 .end
  74 CODE
  75  okay
  76  okay
  77  okay
  78 failed
  79 failed
  80  okay
  81  okay
  82 ' bracket ends string>
  83 OUT
  84
  85 ## Now, test calls as subrules
  86 ##
  87 my $PTB = "^<PGE::Text::bracketed>\$";
  88 p6rule_is( "{ nested { and } okay, () and <> pairs okay }",      $PTB );
  89 p6rule_is( "{ nested { and } okay, () <>, escaped \\}'s okay }", $PTB );
  90 p6rule_isnt( "{ unmatched nested { not okay }", $PTB );
  91 p6rule_isnt( "{ unmatched nested ( not okay }", $PTB );
  92
  93 ## parameterized with {}
  94 $PTB = "^<PGE::Text::bracketed: {}>";
  95 p6rule_is( "{ nested { } okay, unbalanced (, <, escaped \\} okay}", $PTB );
  96 p6rule_isnt( "{ unmatched nested { not okay }",              $PTB );
  97 p6rule_isnt( "{ unmatched nested { not okay, nor ( and < }", $PTB );
  98
  99 ## parameterized with {}[]" (nested and quoted)
 100 $PTB = '^<PGE::Text::bracketed: {}[]"`>';
 101 p6rule_isnt( '{ unbalanced nested [ with } and ] not okay', $PTB );
 102 p6rule_is( '{ balanced nested [ with ] and ( is } okay',          $PTB );
 103 p6rule_is( '{ a quoted "}" unbalanced right bracket} okay',       $PTB );
 104 p6rule_is( '{ quoted "}" unbalanced quotes (`}}}"""}}}}`)} okay', $PTB );
 105
 106 ## escaped bracket characters in regex, nesting not checked
 107 ## There might be a better suited file for these tests
 108 p6rule_is( '{ opening at start of string', '^\{' );
 109 p6rule_is( 'opening { at end of string {', '\{$' );
 110 p6rule_is( '} closing at start of string', '^\}' );
 111 p6rule_is( 'closing } at end of string }', '\}$' );
 112 p6rule_is( '[ opening at start of string', '^\[' );
 113 p6rule_is( 'opening [ at end of string [', '\[$' );
 114 p6rule_is( '] closing at start of string', '^\]' );
 115 p6rule_is( 'closing ] at end of string ]', '\]$' );
 116
 117 # Local Variables:
 118 #   mode: cperl
 119 #   cperl-indent-level: 4
 120 #   fill-column: 100
 121 # End:
 122 # vim: expandtab shiftwidth=4: