[Perl-flat-commit-notify] SF.net SVN: perl-flat: [98] trunk/perl-flat

[notifies s. of c. c. <per...@li...>]

Revision: 98
          http://svn.sourceforge.net/perl-flat/?rev=98&view=rev
Author:   estrabd
Date:     2007-02-17 17:05:37 -0800 (Sat, 17 Feb 2007)

Log Message:
-----------
supports test command!

Modified Paths:
--------------
    trunk/perl-flat/dev-scripts/bdetest.pl
    trunk/perl-flat/lib/FLAT/DFA.pm
    trunk/perl-flat/lib/FLAT.pm

Modified: trunk/perl-flat/dev-scripts/bdetest.pl
===================================================================
--- trunk/perl-flat/dev-scripts/bdetest.pl	2007-02-17 19:28:55 UTC (rev 97)
+++ trunk/perl-flat/dev-scripts/bdetest.pl	2007-02-18 01:05:37 UTC (rev 98)
@@ -7,4 +7,9 @@
 use FLAT::PFA;
 use FLAT::Regex::WithExtraOps;
 
-print FLAT::Regex->new($ARGV[0])->as_nfa->as_dfa->as_min_dfa->trim_sinks->as_undirected;
+my $dfa = FLAT::Regex->new($ARGV[0])->as_nfa->as_dfa;
+if ($dfa->is_valid($ARGV[1])) {
+  print "valid" 
+} else {
+  print "not valid" 
+}

Modified: trunk/perl-flat/lib/FLAT/DFA.pm
===================================================================
--- trunk/perl-flat/lib/FLAT/DFA.pm	2007-02-17 19:28:55 UTC (rev 97)
+++ trunk/perl-flat/lib/FLAT/DFA.pm	2007-02-18 01:05:37 UTC (rev 98)
@@ -157,6 +157,29 @@
 
 }
 
+# creates table used by a FLAT::DFA::Validator object to assess
+# the validity of a given string
+
+sub is_valid {
+  my $self = shift;
+  my $string = shift;
+  chomp $string;
+  my $OK = undef;
+  my @stack = split('',$string);
+  # this is confusing all funcs return arrays
+  my @current = $self->get_starting();
+  my $current = pop @current;
+  foreach (@stack) {
+    my @next = $self->successors($current,$_);    
+    if (!@next) {
+      return $OK; #<--returns undef bc no transition found
+    }
+    $current = $next[0];
+  }
+  $OK++ if ($self->is_accepting($current));
+  return $OK;
+}
+
 1;
 
 __END__

Modified: trunk/perl-flat/lib/FLAT.pm
===================================================================
--- trunk/perl-flat/lib/FLAT.pm	2007-02-17 19:28:55 UTC (rev 97)
+++ trunk/perl-flat/lib/FLAT.pm	2007-02-18 01:05:37 UTC (rev 98)
@@ -75,6 +75,7 @@
 	     pfa2undirected
 	     random_pre 
 	     random_re
+	     test
 	     help
 	     );
 
@@ -110,19 +111,20 @@
 
 COMMANDS: 
 %perl -MFLAT -e
-    "compare  're1','re2'" # comares 2 regexs | see note [2] 
-    "dump     're1'"       # dumps parse trees | see note[1]	   
-    "dfa2gv  're1'"        # dumps graphviz graph desc | see note[1]  
-    "nfa2gv  're1'"        # dumps graphviz graph desc | see note[1]  
-    "pfa2gv  're1'"        # dumps graphviz graph desc | see note[1]  
-    dfa2digraph            # dumps directed graph without transitions
-    nfa2digraph            # dumps directed graph without transitions
-    pfa2digraph            # dumps directed graph without transitions
-    dfa2undirected         # dumps undirected graph without transitions
-    nfa2undirected         # dumps undirected graph without transitions
-    pfa2undirected         # dumps undirected graph without transitions
+    "compare  're1','re2'"   # comares 2 regexs | see note [2] 
+    "dump     're1'"         # dumps parse trees | see note[1]	   
+    "dfa2gv  're1'"          # dumps graphviz graph desc | see note[1]  
+    "nfa2gv  're1'"          # dumps graphviz graph desc | see note[1]  
+    "pfa2gv  're1'"          # dumps graphviz graph desc | see note[1]  
+    dfa2digraph              # dumps directed graph without transitions
+    nfa2digraph              # dumps directed graph without transitions
+    pfa2digraph              # dumps directed graph without transitions
+    dfa2undirected           # dumps undirected graph without transitions
+    nfa2undirected           # dumps undirected graph without transitions
+    pfa2undirected           # dumps undirected graph without transitions
     random_pre 
     random_re
+    "test 'regex' 'string1'" # give a regex, reports if subsequent strings are valid
     help
 
 NOTES:
@@ -166,6 +168,42 @@
 END
 }
 
+# dumps directed graph using Kundu notation
+# Usage:
+# perl -MFLAT -e "pfa2directed('a&b&c&d*e*')"
+sub test {
+  shift;  
+  use FLAT::Regex::WithExtraOps;
+  use FLAT::PFA;
+  use FLAT::NFA;
+  use FLAT::DFA;
+  # handles multiple strings; first is considered the regex
+  if (@_) 
+  { my $FA = FLAT::Regex::WithExtraOps->new(shift @_)->as_pfa()->as_nfa->as_dfa(); 
+    foreach (@_)
+    { if ($FA->is_valid($_)) {
+        print "(+): $_\n";
+      } else {
+        print "(-): $_\n";
+      }     
+    } 
+  } else {
+    my $FA;
+    while (<STDIN>) {
+      chomp;
+      if ($. == 1) { #<-- uses first line as regex!
+        $FA = FLAT::Regex::WithExtraOps->new($_)->as_pfa()->as_nfa->as_dfa();
+      } else {
+	if ($FA->is_valid($_)) {
+	  print "(+): $_\n";
+        } else {
+	  print "(-): $_\n";
+	}      
+      }
+    }
+  }
+}
+
 # dumps parse tree
 # Usage:
 # perl -MFLAT -e "dump('re1','re2',...,'reN')"


This was sent by the SourceForge.net collaborative development platform, the world's largest Open Source development site.