view release on metacpan or  search on metacpan

t/load.t  view on Meta::CPAN

        [ q!m:='a b','c d'!,   [ 'm',  ':=', 'x',           q!'a b','c d'!, 'x',  'x',      'x',        'x' ] ], # set list with quotes
        [ "m:=$big_list",      [ 'm',  ':=', 'x',           $big_list,      'x',  'x',      'x',        'x' ] ], # set list with quotes
        [ 'm=a,"a b "',        [ 'm',  'x',  'x',           'x',            '=',  'x',      'a,"a b "', 'x' ] ],

        # set list with quotes,old style
        #                              id_operation                        leaf_operation
        # string                 elt   op   (param)          id             op    (param)      val        note
        [ 'a:b#C',             [ 'a',  ':',  'x',           'b',            'x',  'x',      'x',        'C' ] ], # fetch elt and add comment
        [ 'a:"b\""#"\"c"',     [ 'a',  ':',  'x',           '"b\""',        'x',  'x',      'x',        '"\"c"' ] ] ,
        # fetch elt and add comment with quotes
        [ 'a:b=c#C',           [ 'a',  ':',  'x',           'b',            '=',  'x',      'c',        'C' ] ], # fetch and assign elt and add comment
        [ 'a:-',               [ 'a',  ':-', 'x',           'x',            'x',  'x',      'x',        'x' ] ], # empty list
        [ 'a:-b',              [ 'a',  ':-', 'x',           'b',            'x',  'x',      'x',        'x' ] ], # remove id b
        [ 'a:-=b',             [ 'a',  ':-=','x',           'b',            'x',  'x',      'x',        'x' ] ], # remove value b from list or hash
        [ 'a:-~/b/',           [ 'a',  ':-~','x',           '/b/',          'x',  'x',      'x',        'x' ] ], # remove value matching stuff
        [ 'a:=~s/b/c/g',       [ 'a',  ':=~','x',           's/b/c/g',      'x',  'x',      'x',        'x' ] ] ,

        # subsitute value value matching stuff
        #                              id_operation                        leaf_operation
        # string                 elt   op   (param)          id             op    (param)      val        note
        [ 'a:@',               [ 'a',  ':@', 'x',           'x',            'x',  'x',      'x',        'x' ] ], # sort list
        [ 'a:.b',              [ 'a',  ':.b','x',           'x',            'x',  'x',      'x',        'x' ] ], # function called on elt
        [ 'a:.b(foo)',         [ 'a',  ':.b','foo',         'x',            'x',  'x',      'x',        'x' ] ], # idem with param
        [ 'a:<c',              [ 'a',  ':<', 'x',           'c',            'x',  'x',      'x',        'x' ] ], # push value
        [ 'a:>c',              [ 'a',  ':>', 'x',           'c',            'x',  'x',      'x',        'x' ] ], # unshift value
        [ 'a:b<c',             [ 'a',  ':',  'x',           'b',            '<',  'x',      'c',        'x' ] ], # insert at index
        [ 'a:=b<c',            [ 'a',  ':=', 'x',           'b',            '<',  'x',      'c',        'x' ] ], # insert at value
        [ 'a:~/b/<c',          [ 'a',  ':~', 'x',           '/b/',          '<',  'x',      'c',        'x' ] ], # insert at matching value

        # function call
        [ 'a:.b("foo(a > b)")', [ 'a',  ':.b','"foo(a > b)"','x',            'x',  'x',      'x',        'x' ] ], # tricky value with ()
        [ q!a:.b('foo(a > b)')!,[ 'a',  ':.b',"'foo(a > b)'",'x',            'x',  'x',      'x',        'x' ] ], # tricky value with ()
        [ 'a:.b("bar","foo(a > b)")', [ 'a',  ':.b','"bar","foo(a > b)"','x','x',  'x',      'x',        'x' ] ], # tricky value with ()
        [ q!a:.b('bar','foo(a > b)')!,[ 'a',  ':.b',"'bar','foo(a > b)'",'x','x',  'x',      'x',        'x' ] ], # tricky value with ()
    );

    foreach my $subtest (@regexp_test) {
        my ( $cmd, $ref ) = @$subtest;
        my @res = Config::Model::Loader::_split_cmd($cmd);

        #print Dumper $res,"\n";
        foreach (@res) {
            $_ = 'x' unless defined $_;
        }
        eq_or_diff( \@res, $ref, "test _split_cmd with '$cmd'" );
    }
};

$model->load('Master' => 'dump_load_model.pl',);

$model->augment_config_class(
    name => 'Master',
    element => [
        # uses to test .set_to_std_value
        two => {
            type => 'leaf',
            value_type => 'uniline',
            compute => {
                allow_override => 1,
                use_eval => 1,
                formula => '1+1;'
            }
        },
    ]
);

my $inst = $model->instance(
    root_class_name => 'Master',
    instance_name   => 'test1'
);
ok( $inst, "created dummy instance" );

my $root;

subtest "check with embedded \n" => sub {
    #  also check that instance can load before config_root is called
    my $step = qq!#"root cooment " std_id:ab X=Bv -\na_string="titi and\nfoo" !;
    ok( $inst->load( step => $step ), "load steps with embedded \\n" );
    $root = $inst->config_root;
    is( $root->fetch_element('a_string')->fetch, "titi and\nfoo", "check a_string" );
};


subtest "check with embedded \n and \\n" => sub {
    my $step = q!a_string="titi and\nfoo and \\\\n literal" !;
    ok( $root->load( step => $step ), 'load steps with embedded \n and \\n' );
    is( $root->fetch_element('a_string')->fetch, "titi and\nfoo and \\n literal", "check a_string" );
};

subtest "check search up for element" => sub {
    my $step = qq!std_id:ab X=Bv /a_string="titi and\ntoto" !;
    ok( $root->load( step => $step ), "load steps with /a_string" );
    is( $root->fetch_element('a_string')->fetch, "titi and\ntoto", "check a_string found with search" );
};

subtest "check that : action fails on a leaf" => sub {
    my $step = qq!a_string:toto!; # should blow up
    throws_ok { $root->load( step => $step ) ; }
        qr/f/, "use ':' on a leaf";
};

subtest "test apply regexp" => sub {
    my $step = qq!a_string=~s/TOTO/tata/i!;
    ok( $root->load( step => $step ), "load steps with apply regexp" );
    is( $root->fetch_element('a_string')->fetch, qq!titi and\ntata!, "check a_string after regexp" );
};

subtest "test apply regexp with embedded spaces" => sub {
    my $step = qq!a_string=~"s/titi and\n//""!;
    ok(
        $root->load( step => $step ),
        "load steps with apply regexp with embedded spaces"
    );
    is( $root->fetch_element('a_string')->fetch,
        qq!tata!, "check a_string after regexp with embedded spaces" );
};

subtest "check with embedded quotes" => sub {
    my $step = qq!std_id:ab X=Bv -\na_string="\"titi\" and \"toto\"" std_id:bc X=Av!;
    ok( $root->load( step => $step ), "load steps with embedded quotes" );
    is(