view release on metacpan or  search on metacpan

t/42_ceql_grammar.t  view on Meta::CPAN

# -*-cperl-*-
## Test various parts of standard CWB::CEQL grammar

use Test::More tests => 101;
use CWB::CEQL;

our $grammar = new CWB::CEQL;
isa_ok($grammar, "CWB::CEQL"); # T1

## basic tests for wildcard patterns
check_query('ordinary', "literal_string", # T2
            'ordinary');
check_query('me\ta".?\"meta', "literal_string",
            'meta""\.\?""meta');
check_query('ord\inary\,', "wildcard_pattern",
            '"ordinary,"');
check_query('inter+', "wildcard_pattern",
            '"inter.+"');
check_query('[over,under]estimate[d,]', "wildcard_pattern",
            '"(over|under)estimate(d)?"');
check_query('part[,ed,,s]', "wildcard_pattern",
            '"part(ed|s)?"');
check_query('aa[b\*,c\+,\[[a+,b+,]\]]aa', "wildcard_pattern",
            '"aa(b\*|c\+|\[(a.+|b.+)?\])aa"');
check_query('\u\L-\L-\u\L', "wildcard_pattern",
            '"\p{Lu}\p{Ll}+-\p{Ll}+-\p{Lu}\p{Ll}+"');
check_error('ab[,]ba', "wildcard_pattern", # T10
            qr/empty list of alternatives/);
check_error('no\\\\good', "wildcard_pattern",
            qr/literal backslash/);
check_error('also_no_good\\', "wildcard_pattern",
            qr/end in a backslash/);
check_error('one,two,three', "wildcard_pattern",
            qr/alternatives.*within brackets/);
check_error('aa[cd,e[fg,h],aa', "wildcard_pattern",
            qr/bracketing.*balanced.*opening/);
check_error('aa[cd,e[fg,]h,]]aa', "wildcard_pattern",
            qr/bracketing.*balanced.*closing/);

## POS tags and simple POS
check_query('NN*', "pos_tag",       # T16
            'pos="NN.*"');
$grammar->SetParam("pos_attribute", "tag");
check_query('VV[INF,FIN]', "pos_tag",
            'tag="VV(INF|FIN)"');
$grammar->SetParam("pos_attribute", "pos");
check_error('N', "simple_pos",
            qr/no simple.*tags.*available/);
$grammar->SetParam("simple_pos", { # -- example from CEQL manpage
                                  "N" => "NN.*", # common nouns
                                  "V" => "V.*",  # any verb forms
                                  "A" => "JJ.*", # adjectives
                                 });
check_query('N', "simple_pos",
            'pos="NN.*"');
check_error('Noun', "simple_pos",
            qr/not.*simple.*tag.*available.* A N V/);
check_query('NN[S,]', "pos_constraint",
            'pos="NN(S)?"');
check_query('{V}', "pos_constraint",
            'pos="V.*"');
check_query('V%', "pos_constraint", # alternative syntax requested by Serge Sharoff
            'pos="V.*"');
check_error('{N', "pos_constraint",
            qr/lonely curly brace/);

## lemma searches and related options
check_query('[over,under]+tion', "word_or_lemma_constraint", # T25
            'word="(over|under).+tion"%c');
check_query('Bath:C', "word_or_lemma_constraint",
            'word="Bath"');
$grammar->SetParam("default_ignore_case", 0);
check_query('Bath', "word_or_lemma_constraint",
            'word="Bath"');
$grammar->SetParam("default_ignore_case", 1);
check_query('DEJA:Cd', "word_or_lemma_constraint",
            'word="DEJA"%d');
check_query('{sing}', "word_or_lemma_constraint",
            'lemma="sing"%c');
check_query('sing%', "word_or_lemma_constraint", # alternative syntax
            'lemma="sing"%c');
check_query('{I}:C', "word_or_lemma_constraint",
            'lemma="I"');
check_query('{\A-\A}:d', "word_or_lemma_constraint",
            'lemma="\pL+-\pL+"%cd');
check_query('\A-\A%:d', "word_or_lemma_constraint", # alternative syntax
            'lemma="\pL+-\pL+"%cd');
check_query('\{[-,--]\%:C', "word_or_lemma_constraint", # escape % in alternative syntax
            'word="\{(-|--)%"');