New test file for collections and doProcessCollection subrotine.

diff --git a/system/modules/CNFMeta.pm b/system/modules/CNFMeta.pm
index fb4fa47209d79ea12b05ae0e7ff0435a3175c970..1d88ad0ec0b862d19453f492cb8f79d9e903fcf5 100644 (file)
--- a/system/modules/CNFMeta.pm
+++ b/system/modules/CNFMeta.pm
@@ -71,6 +71,8 @@ sub _import_into_this_package {
          # Process or load last (includes get priority 1, tree type will get priority 4).
          *{"${caller}::meta_process_last"}   = sub {return _meta("PROCESS_LAST")};
          *{"${caller}::meta_const"}          = sub {return _meta("CONST")};
+         # Match whitespace as split delimiter.
+         *{"${caller}::meta_match_delimited"}  = sub {return _meta("MATCH_DELIMITED")};
          ###
          # Tree instruction has been scripted in collapsed nodes shorthand format.
          # Shortife is parsed faster and with less recursion, but can be prone to script errors,

diff --git a/system/modules/CNFParser.pm b/system/modules/CNFParser.pm
index bb2b500acedca22d93c6be4b60acfe54edb1fdf2..a2bbc3ce6a8f3132219ab33f254682870df7808c 100644 (file)
--- a/system/modules/CNFParser.pm
+++ b/system/modules/CNFParser.pm
@@ -130,6 +130,7 @@ our $meta_priority      = meta_priority();
 our $meta_on_demand     = meta_on_demand();
 our $meta_process_last  = meta_process_last();
 our $meta_const         = meta_const();
+our $meta_delimited     = meta_match_delimited();
 
 
 ###
@@ -462,7 +463,74 @@ sub template { my ($self, $property, %macros) = @_;
     }
 }
 #
-
+#private to parser sub.
+sub doProcessCollection{ my($self,$e,$t,$v) = @_;
+    my $isArray = $t=~ m/^@/;
+    my $IsConstant = ($v =~ s/$meta_const/""/sexi);
+    my @lst = ($v =~ s/$meta_delimited// && $isArray?split(DELIMITER(), $v):split('\n', $v));
+    my @props = map {
+            s/^\s+|\s+$//;   # strip unwanted spaces
+            s/^\s*["']|['"]$//g;#strip quotes
+            #s/>+//;# strip dangling CNF tag
+            $_ ? $_ : undef   # return the modified string
+       } @lst;
+    if($isArray){
+            if($CNF::RESERVED_WORDS{$t}){
+                $self->warn("ERROR collection is trying to use a reserved property name -> $t.");
+                next
+            }else{
+                    my @arr=();
+                    foreach  (@props){
+                        push @arr, $_ if($_ && length($_)>0);
+                    }
+                    $properties{$t}=\@arr;
+            }
+    }else{
+            my %hsh;
+            my $macro = 0;
+            if(exists($properties{$t})){
+                if($CNF::RESERVED_WORDS{$t}){
+                    $self->warn("Skipped a try to overwrite a reserved property -> $t.");
+                    next
+                }else{
+                    %hsh =  %{$properties{$t}}
+                }
+            }else{
+                %hsh =();
+            }
+            foreach  my $p(@props){
+                if($p && $p eq 'MACRO'){$macro=1}
+                elsif( $p && length($p)>0 ){
+                    my @pair = ($p=~/\s*([-+_\w]*)\s*[=:]\s*(.*)/s);#split(/\s*=\s*/, $p);
+                    next if (@pair != 2 || $pair[0] =~ m/^[#\\\/]+/m);#skip, it is a comment or not '=' delimited line.
+                    my $name  = $pair[0];
+                    my $value = $pair[1]; $value =~ s/^\s*["']|['"]$//g;#strip quotes
+                    if($IsConstant && $p =~ m/\$[A-Z]+/){# if meta constant we check $p if signified to transfer into a CNF constance.
+                        if(not exists $self->{$name}){
+                            $self->{$name} = $value;
+                            next;
+                        }
+                    }
+                    if($macro){
+                        my @arr = ($value =~ m/(\$\$\$.+?\$\$\$)/gm);
+                        foreach my $find(@arr) {
+                            my $s = $find; $s =~ s/^\$\$\$|\$\$\$$//g;
+                            my $r = $anechoic->{$s};
+                            $r = $self->{$s} if !$r;
+                            $r = $instructs{$s} if !$r;
+                            CNFParserException->throw(
+                                error=>"Unable to find property for $t.$name -> $find\n",
+                                show_trace=>$self->{STACK_TRACE}
+                            ) if !$r;
+                            $value =~ s/\Q$find\E/$r/g;
+                        }
+                    }
+                    $hsh{$name}=$value;  $self->log("macro $t.$name->$value") if $self->{DEBUG}
+                }
+            }
+            $properties{$t}=\%hsh;
+    }
+}
 #private to parser sub.
 sub doInstruction { my ($self,$e,$t,$v,$is_tagged) = @_;
     my $DO_ENABLED = $self->{'DO_ENABLED'};  my $priority = 4; my $isMetaConst;
@@ -472,6 +540,10 @@ sub doInstruction { my ($self,$e,$t,$v,$is_tagged) = @_;
        $t = $itm->{ins};
        $v = $itm->{val};
        $priority = $itm->{'^'};
+       if($t&&$t=~/^[@%]/){ #Is possibly numbered list collection type, with e not instruction the name.
+         doProcessCollection($self,$t,$e,$v);
+         return; 
+       }
     }
     $is_tagged = defined($t); $t = $e if not $is_tagged;
     if($t eq 'CONST' or $t eq 'CONSTANT'){#Single constant with multiline value;
@@ -912,72 +984,7 @@ sub parse {  my ($self, $cnf_file, $content, $del_keys) = @_;
                 }
 
             }elsif ($e =~ m/^@|%/){#collection processing?
-                my $isArray = $t=~ m/^@/;
-                my $IsConstant = ($v =~ s/$meta_const/""/sexi);
-                my @lst = ($isArray?split(DELIMITER(), $v):split('\n', $v));
-                my @props = map {
-                        s/^\s+|\s+$//;   # strip unwanted spaces
-                        s/^\s*["']|['"]$//g;#strip quotes
-                        #s/>+//;# strip dangling CNF tag
-                        $_ ? $_ : undef   # return the modified string
-                    } @lst;
-                if($isArray){
-                    if($CNF::RESERVED_WORDS{$t}){
-                       $self->warn("ERROR collection is trying to use a reserved property name -> $t.");
-                       next
-                    }else{
-                            my @arr=();
-                            foreach  (@props){
-                                push @arr, $_ if($_ && length($_)>0);
-                            }
-                            $properties{$t}=\@arr;
-                    }
-                }else{
-                    my %hsh;
-                    my $macro = 0;
-                    if(exists($properties{$t})){
-                        if($CNF::RESERVED_WORDS{$t}){
-                           $self->warn("Skipped a try to overwrite a reserved property -> $t.");
-                           next
-                        }else{
-                           %hsh =  %{$properties{$t}}
-                        }
-                    }else{
-                       %hsh =();
-                    }
-                    foreach  my $p(@props){
-                        if($p && $p eq 'MACRO'){$macro=1}
-                        elsif( $p && length($p)>0 ){
-                            my @pair = ($p=~/\s*([-+_\w]*)\s*[=:]\s*(.*)/s);#split(/\s*=\s*/, $p);
-                            next if (@pair != 2 || $pair[0] =~ m/^[#\\\/]+/m);#skip, it is a comment or not '=' delimited line.
-                            my $name  = $pair[0];
-                            my $value = $pair[1]; $value =~ s/^\s*["']|['"]$//g;#strip quotes
-                            if($IsConstant && $p =~ m/\$[A-Z]+/){# if meta constant we check $p if signified to transfer into a CNF constance.
-                               if(not exists $self->{$name}){
-                                  $self->{$name} = $value;
-                                  next;
-                               }
-                            }
-                            if($macro){
-                                my @arr = ($value =~ m/(\$\$\$.+?\$\$\$)/gm);
-                                foreach my $find(@arr) {
-                                    my $s = $find; $s =~ s/^\$\$\$|\$\$\$$//g;
-                                    my $r = $anechoic->{$s};
-                                    $r = $self->{$s} if !$r;
-                                    $r = $instructs{$s} if !$r;
-                                    CNFParserException->throw(
-                                        error=>"Unable to find property for $t.$name -> $find\n",
-                                        show_trace=>$self->{STACK_TRACE}
-                                    ) if !$r;
-                                    $value =~ s/\Q$find\E/$r/g;
-                                }
-                            }
-                            $hsh{$name}=$value;  $self->log("macro $t.$name->$value") if $self->{DEBUG}
-                        }
-                    }
-                    $properties{$t}=\%hsh;
-                }
-                next;
+                doProcessCollection($self,$e,$t,$v)
             }elsif(!$t && $e && $v){
                 $anechoic->{$e} = $v;
             }else{

diff --git a/tests/testCNFCollections.pl b/tests/testCNFCollections.pl
new file mode 100644 (file)
index 0000000..c310b11
--- /dev/null
+++ b/tests/testCNFCollections.pl
@@ -0,0 +1,67 @@
+#!/usr/bin/env perl
+use warnings; use strict; 
+use Syntax::Keyword::Try;
+use lib::relative ('.','../system/modules');
+
+require CNFParser;
+require TestManager;
+my $test = TestManager -> new($0);
+my $cnf;
+try{  
+
+   ###
+   # Test instance creation.
+   ###
+   die $test->failed() if not $cnf = CNFParser->blank()->parseString(q(
+<<@<@array1> _MATCH_DELIMITED_
+1 2 3 4
+>>
+<<@<@array2>
+"1 2 3 4"
+>>
+// Following qualifies as an named list.
+<<@A$$<@> ___MATCH_DELIMITED_
+1,2,3
+4,5 6
+>>
+<<%A$$<%> 
+hello = "world"
+ask: How are you today?
+>>
+));
+       $test->case("Passed new instance CNFParser.",'1');
+       $test->subcase('CNFParser->VERSION is '.CNFParser->VERSION);
+   #  
+       $test-> nextCase();
+   #
+       $test->case("Test array.",'2');
+       my @array1 = $cnf -> property('@array1');
+       $test->evaluate('Array has 4 elements?',scalar(@array1),4); 
+       my @array2 = $cnf -> property('@array2');
+       $test->evaluate('Array has 1 element?',scalar(@array2),1); 
+       $test->evaluate('Array[0] has value 1 2 3 4?',$array2[0],"1 2 3 4"); 
+       my @A0 = $cnf -> property('@A0');
+       $test->evaluate('Array has 6 elements?',scalar(@A0),6); 
+    #  
+       $test-> nextCase();
+    #
+       $test->case("Test as a hash property.",'3');
+       my %A1 = $cnf -> property('@A1');
+       $test->evaluate('Hash has two keys?',scalar(keys %A1),2); 
+       $test->evaluate('hello eq "world"?',$A1{hello},'world'); 
+       $test->evaluate('ask eq "How are you today?"?',$A1{ask},'How are you today?'); 
+   
+ 
+   #   
+   $test->done();    
+   #
+}
+catch{ 
+   $test -> dumpTermination($@);   
+   $test -> doneFailed();
+}
+
+#
+#  TESTING THE FOLLOWING IS FROM HERE  #
+#
+

diff --git a/tests/testCollections.pl b/tests/testCollections.pl
index 51e50c533b1aace53fb54887bfc91a847c314227..5b9c01916ac14bf0c25356bc9aa970802fc205f1 100644 (file)
--- a/tests/testCollections.pl
+++ b/tests/testCollections.pl
@@ -1,9 +1,7 @@
 #!/usr/bin/env perl
 use warnings; use strict;
 use Syntax::Keyword::Try;
-use lib "system/modules";
-
-
+use lib::relative ('.','../system/modules');
 
 require TestManager;
 require CNFParser;
@@ -55,13 +53,13 @@ try{
     # Test array instance creation.
     # $test->case("Test hsh property.");
     $test->case('Test @array property.');
-    $cnf ->parse(undef,q(<<@<@array>
+    $cnf ->parse(undef,q(<<@<@array> __MATCH_DELIMITED__
          1,2
          3,4
     >>
     ));
     my @array = $cnf ->property('@array');
-    #Important -> In perl array type is auto exanded into arguments.
+    #Important -> In perl array type is auto expanded into arguments.
     # Hence into scalar result we want to pass.
     $test->evaluate('@array contains 4 elements?', scalar(@array), 4);
     $test->evaluate('@array[0]==1', $array[0],1);

diff --git a/tests/testNewTagParsingForVersion2.8.pl b/tests/testNewTagParsingForVersion2.8.pl
index 89de324cccfbde7f5e663e3b729893fda5b25a7c..496bcdd80a6138d7ab56f2871729c601c78e912c 100644 (file)
--- a/tests/testNewTagParsingForVersion2.8.pl
+++ b/tests/testNewTagParsingForVersion2.8.pl
@@ -1,7 +1,6 @@
 #!/usr/bin/env perl
 use warnings; use strict;
-use lib "system/modules";
-#use lib "system/modules";
+use lib::relative ('.','../system/modules');
 
 require TestManager;
 require CNFParser;
@@ -49,7 +48,7 @@ use Syntax::Keyword::Try; try {
     $test->isDefined("A",$cnf->anon('A'));
     $test->evaluate("A==C",$cnf->anon('A'),'C');
     #
-    $script = '  <<@<@Array<1,2,3,4,5>>>';
+    $script = '  <<@<@Array<_MATCH_DELIMITED__1,2,3,4,5>>>';
     $test->subcase($script);
     $cnf->parse(undef,$script);
     my @a = $cnf->property('@Array');