Slight modifications to even better display zinc methods calls as code

and addition of some tests

2 files changed, 181 insertions, 43 deletions

diff --git a/Perl/Zinc/TraceUtils.pm b/Perl/Zinc/TraceUtils.pm
index 55714f9..5a9536f 100644
--- a/Perl/Zinc/TraceUtils.pm
+++ b/Perl/Zinc/TraceUtils.pm
@@ -8,84 +8,132 @@ use strict;
 use Tk::Font;
 use Tk::Photo;
 use vars qw(@EXPORT);
-@EXPORT = qw(printItem printArray printList);
+@EXPORT = qw(printItem printArray printList Item Array List);
 
 
-### to print something
 sub printItem {
+    print &Item (@_);
+}
+
+sub printArray {
+    print &Array (@_);
+}
+
+sub printList {
+    print &List (@_);
+}
+
+sub Item {
     my ($value) = @_;
     my $ref = ref($value);
 #    print "VALUE=$value REF=$ref\n";
     if ($ref eq 'ARRAY') {
-	printArray ( @{$value} );
-    }
-    elsif ($ref eq 'CODE') {
-	print "{CODE}";
-    }
-    elsif ($ref eq 'Tk::Photo') {
+	return Array ( @{$value} );
+    } elsif ($ref eq 'CODE') {
+	return "{CODE}";
+    } elsif ($ref eq 'Tk::Photo') {
 #	print " **** $value ***** ";
-	print "Tk::Photo(\"". scalar $value->cget('-file') . "\")";
-    }
-    elsif ($ref eq 'Tk::Font') {
-	print "'$value'";
+	return "Tk::Photo(\"". scalar $value->cget('-file') . "\")";
+    } elsif ($ref eq 'Tk::Font') {
+	return "'$value'";
+    } elsif ($ref eq '') {  # scalar 
+	print "value: $value\n";
+	if (defined $value) {
+	    print "defined value: $value\n";
+	    { no strict;
+	      if ($value eq eval ($value)) {
+		  return $value;
+	      } else {
+		  return "'$value'";
+	      }
+	      use strict;
+	  }
+	} else {
+	    return "_undef";
+	}
+    } else { # some  class instance
+	return $value;
     }
-    elsif ($ref eq '') {  # scalar 
+    
+} # end Item
+
+### to print something
+sub Item {
+    my ($value) = @_;
+    my $ref = ref($value);
+#    print "VALUE=$value REF=$ref\n";
+    if ($ref eq 'ARRAY') {
+	return Array ( @{$value} );
+    } elsif ($ref eq 'CODE') {
+	return "{CODE}";
+    } elsif ($ref eq 'Tk::Photo') {
+#	print " **** $value ***** ";
+	return "Tk::Photo(\"". scalar $value->cget('-file') . "\")";
+    } elsif ($ref eq 'Tk::Font') {
+	return "'$value'";
+    } elsif ($ref eq '') {  # scalar 
 	if (defined $value) {
-	    if ($value eq '') {
-		print  "''";
-	    } elsif ($value =~ /\s/
+	    if ($value =~ /^-?\d+(\.\d*(e[+-]?\d+)?)?$/ or # -1. or 1.0
+		$value =~ /^-[a-zA-Z]([\w])*$/ # -option1 or -option-1
+		) {
+		return $value;
+	    } elsif ($value eq ''
+		     or $value =~ /\s/
 		     or $value =~ /^[a-zA-Z]/
-		     or $value =~ /^[\W]$/ ) {
-		print "'$value'";
-	    }  else {
-		print $value;
+		     or $value =~ /^[\W]/
+		     ) {
+		return "'$value'";
+	    } else {
+		return $value;
 	    }
+	} else {
+	    return "_undef";
 	}
-	else {
-	    print "undef";
-	}
-    }
-    else { # some  class instance
+    } else { # some  class instance
 	return $value;
     }
     
-} # end printitem
+} # end Item
 
 
 ### to print a list of something
-sub printArray {
+sub Array {
     my (@values) = @_;
     if (! scalar @values) {
-	print "[]";
+	return "[]";
     }
     else {  # the list is not empty
-	my @res;
-	print "[";
+	my $res = "[";
 	while (@values) {
 	    my $value = shift @values;
-	    &printItem ($value);
-	    print ", " if (@values);
+	    $res .= &Item ($value);
+	    $res .= ", " if (@values);
 	}
-	print "]" ;
+	return $res. "]" ;
     }
     
-} # end printArray
+} # end Array
 
 
-sub printList {
-    print "(";
+sub List {
+    my $res = "(";
     while (@_) {
 	my $v = shift @_;
-	printItem $v;
-	if ($v =~ /^-\w+/) {
-	    print " => ";
-	} elsif (@_) {
-	    print ", ";
+	$res .= Item ($v);
+	if (@_ > 0) {
+	    ## still some elements
+	    if ($v =~ /^-\d+$/) {
+		$res .= ", ";
+	    } elsif ($v =~ /^-\w+$/) {
+		$res .= " => ";
+	    } else {
+		$res .= ", ";
+	    }
 	}
     }
-    print ")";
+    return $res. ")";
     
-} # end printList
+} # end List
 
 1;
 
diff --git a/Perl/t/traceutils.t b/Perl/t/traceutils.t
new file mode 100644
index 0000000..ad18813
--- /dev/null
+++ b/Perl/t/traceutils.t
@@ -0,0 +1,90 @@
+#!/usr/bin/perl -w
+
+#
+# $Id: traceutils.t,v 1.1 2003-11-07 15:36:49 mertz Exp $
+# Author: Christophe Mertz
+#
+
+# testing Tk::Zinc::TraceUtils utilities
+
+use Tk::Zinc::TraceUtils;
+use strict;
+
+BEGIN {
+    if (!eval q{
+#        use Test::More qw(no_plan);
+        use Test::More tests => 14;
+        1;
+    }) {
+        print "# tests only work properly with installed Test::More module\n";
+        print "1..1\n";
+        print "ok 1\n";
+        exit;
+    }
+    if (!eval q{
+	use Tk::Zinc::TraceUtils;
+ 	1;
+    }) {
+        print "unable to load Tk::ZincTraceUtils";
+        print "1..1\n";
+        print "ok 1\n";
+        exit;
+    }
+}
+
+
+
+#### creating different images, bitmaps and pixmaps...
+
+my $arg;
+
+$arg = "1";
+is (&Item ($arg), $arg, "testing " . $arg);
+
+SKIP: {
+    my $mw;
+    skip "not able to create a MainWindow", 3 if !eval q{$mw = MainWindow->new()} ;
+    require Tk::Font;
+    my $font = $mw->fontCreate("testfont", -family => "Helvetica");
+    
+    like ($font, qr/^testfont/, "font creation");
+    is (&Item ($font), "'testfont'", "testing " . "testfont"); # not so sure about this result!
+    print "$font : ", ref($font), "\n";
+    is (&List (-font => $font), "(-font => 'testfont')", );
+}
+
+$arg = "()";
+is (&List (eval $arg), $arg, "empty list: ". $arg);
+
+$arg = "(-option_without_value)";
+is (&List (eval $arg), $arg, $arg);
+
+$arg = "(1, 2, 3, 4)";
+is (&List (eval $arg), $arg, $arg);
+
+$arg = "(-1, -2, -3, -4)";
+is (&List (eval $arg), $arg, $arg);
+
+$arg = "(1.2, -2, .01, -1.2e+22, 1.02e+34)";
+
+is (&List (eval $arg), ($arg =~ s/\.01/0.01/ , $arg ), $arg);
+
+$arg = "('-1aa' => -2, '-a b', -1.2)";
+is (&List (eval $arg), $arg, $arg);
+
+$arg = "(-option => -2, -option2 => -1.2, -option3)";
+is (&List (eval $arg), $arg, $arg);
+
+$arg = "('icon', 1, -priority => 210, -visible => 1)";
+is (&List (eval $arg), $arg, $arg);
+
+$arg = "('text', 1, -font => '-adobe-helvetica-bold-r-normal-*-120-*-*-*-*-*-*')";
+is (&List (eval $arg), $arg, $arg);
+
+
+$arg = "-option, -2, -option2, -1.2, -option3";
+is (&Array (eval "(".$arg.")"), "[".$arg."]", "[".$arg."]");
+
+
+
+diag("############## Tk::Zinc::TraceUtils test");