From 2cb6f9f985d7b6b3f2ab21a4a33ca190f7bbf6b9 Mon Sep 17 00:00:00 2001 From: mertz Date: Mon, 24 Mar 2003 15:28:55 +0000 Subject: passage aux gradients nouvzaux (>> 3.2.6h) --- Perl/t/test-methods.pl | 97 ++++++++++++++++++++++++++++++++++++++++++++++++-- 1 file changed, 95 insertions(+), 2 deletions(-) (limited to 'Perl/t/test-methods.pl') diff --git a/Perl/t/test-methods.pl b/Perl/t/test-methods.pl index 0573289..88a0d10 100644 --- a/Perl/t/test-methods.pl +++ b/Perl/t/test-methods.pl @@ -18,7 +18,7 @@ my @testsList = ( 2 => 'test_forbidden_operations_on_root_group (quick)', 3 => 'test_errors (quick)', 4 => 'test_bboxes (quick)', -# 5 => 'test_coords (quick)', + 5 => 'test_gradient_coding (quick)', ); my %testsHash; { my @tests = @testsList; @@ -111,6 +111,82 @@ my $zinc = $mw->Zinc(-width => 500, -height => 500, &setZincLog($zinc); +sub test_gradient_coding { + &log (0, "#---- Start of test_gradient_coding ----\n"); + my $log_level = 2 ; + ### CM to be done! + + ### first testing legal gradient + foreach (0..2) { + my $i=0; + foreach my $g ("red", "bLue","#ff00ff","rgb:12/34/56","CIEXYZ:1.2/0.9/3.4", + "CIEuvY:0.5/.4/0.9", "CIExyY:.52/0.1/0.8", "CIELab:99.1/43./56.1", + "CIELuv:88/-1/-2.1", "TekHVC:345/1.2/100", + ) { + ## first simple color, with different X legal coding + &test_eval ($log_level, "gname", $g,"grad".$i); + $i++; + ## the same color with transparency + my $transparency = ($i * 4) % 101; + &test_eval ($log_level, "gname", "$g;$transparency","grad".$i); + $i++; + } + + ## different axial gradient without the gradient type at the beginning + foreach my $g ("red|blue", "red |blue", "red | blue", + "red|green|blue", "red |green|blue", "red |green |blue", "red | green|blue" + , "red |green| blue", "red |green | blue", "red | green | blue") { + ## first simple color, with different X legal coding + &test_eval ($log_level, "gname", $g,"grad".$i); + $i++; + } + ## different axial gradient with explicit gradient type at the beginning + ## and different angle value! + foreach my $angle qw(0 12 90 271 360) { + foreach my $g ("=axial $angle |red|blue", + "=axial $angle | red|blue", + "=axial $angle | red |blue", + "=axial $angle | red | blue", + "=axial $angle | red|green|blue", + "=axial $angle |red |green|blue", + "=axial $angle |red |green |blue", + "=axial $angle |red | green|blue", + "red |green| blue", + "red |green | blue", + "red | green | blue", + ) { + ## first simple color, with different X legal coding + &test_eval ($log_level, "gname", $g,"grad".$i); + $i++; + } + } + # and now deleting unused named gradient + foreach my $j (0..$i-1) { + &test_eval ($log_level, "gdelete", "grad".$j); + } + } + + ### and now testing illegal gradient + my $i=-1; + &test_no_eval ("X color name with blank inside", + $log_level, "gname", "navy blue","grad".$i++); + &test_no_eval ("bad gradient type", + $log_level, "gname", "=badtype 1 |red|blue","grad".$i++); + &test_no_eval ("axial gradient with excessive parameters", + $log_level, "gname", "=axial 67 1 |red|blue","grad".$i++); + &test_no_eval ("radial gradient with excessive parameters", + $log_level, "gname", "=radial 30 32 1 |red|blue","grad".$i++); + &test_no_eval ("path gradient with excessive parameters", + $log_level, "gname", "=path 30 32 1 |red|blue","grad".$i++); + ## testing bad types for gradient type + # to be done + foreach my $j (0..$i-1) { + &test_eval ($log_level, "gdelete", "grad".$j); + } + + &log (0, "#---- End of test_gradient_coding -----\n"); +} # end of test_gradient_coding + ## TkZinc bbox method doesn't return correct values for bbox. This test # function tries to find out in which cases these bbox are wrong sub test_bboxes { @@ -311,6 +387,19 @@ sub test_errors { &creating_items; + ## add method with bad argument + # In a curve, it is an error to have more than two succcessive control points + # or to start or finish a curve with a control point. + &test_no_eval ("having more than two succcessive control points", + $log_level, "add", 'curve', 1, + [ [10,20], [30,40,'c'], [50,60,'c'], [70,80,'c'], [90,100] ]); + &test_no_eval ("starting a curve with a control point", + $log_level, "add", 'curve', 1, + [ [30,40,'c'], [50,60], [70,80], [90,100] ]); + &test_no_eval ("finishing a curve with a control point", + $log_level, "add", 'curve', 1, + [ [30,40,], [50,60,'c'], [70,80], [90,100,'c'] ]); + # Text indices # sel.first Refers to the first character of the selection in the item. # If the selection is not in the item, this form returns an error. @@ -447,7 +536,7 @@ sub creating_items { $zinc->add('arc', 1, [10,10 , 50,50], -tags => ['arc']); $zinc->add('curve', 1, [30,0 , 150,10, 100,110, 10,100, 50,140], -tags => ['curve']); $zinc->add('triangles', 1, [200,200 , 300,200 , 300,300, 200,300], - -colors => ["blue:50", "red:20", "green:80"], -tags => ['triangles']); + -colors => ["blue;50", "red;20", "green;80"], -tags => ['triangles']); $zinc->add('window', 1, -tags => ['window']); foreach my $tag qw(group track waypoint tabular text icon reticle map rectangle arc curve triangles window) { @@ -566,6 +655,10 @@ if ($tests{4}) { &test_bboxes; } +if ($tests{5}) { + &test_gradient_coding; +} + ### we should also test multicontour curves if ($tests{5}) { # &test_coords; -- cgit v1.1