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 ++++++++++++++++++++++++++++++++++++++++++++++++- Perl/t/test-no-crash.pl | 10 ++--- 2 files changed, 100 insertions(+), 7 deletions(-) (limited to 'Perl/t') 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; diff --git a/Perl/t/test-no-crash.pl b/Perl/t/test-no-crash.pl index dda953b..5a6274d 100644 --- a/Perl/t/test-no-crash.pl +++ b/Perl/t/test-no-crash.pl @@ -168,7 +168,7 @@ sub creating_items { &test_eval (1, "add", 'curve', 1, [30,0 , 150,10, 100,110, 10,100, 50,140]); &test_eval (1, "add", 'rectangle', 1, [400,400 , 450,220]); &test_eval (1, "add", 'triangles', 1, [200,200 , 300,200 , 300,300, 200,300], - -colors => ["blue:50", "red:20", "green:80"]); + -colors => ["blue;50", "red;20", "green;80"]); $image1 = $zinc->Photo(-file => Tk::findINC("icon.gif") ); $image2 = $zinc->Photo(-file => Tk::findINC("Xcamel.gif") ); @@ -261,8 +261,8 @@ sub creating_datas { 'gradient' => ['green', 'LemonChiffon', '#c84', '#4488cc', '#888ccc444', 'red'], ## TBC 'gradientlist' => [['green'], ['LemonChiffon'], ['#c84'], ['#4488cc'], ['#888ccc444'], ['red', 'green'], ['red', 'green', 'blue'], - ['red:50', 'green:50', 'blue:50'], - ['blue:0', 'green:50', 'red:90'], + ['red;50', 'green;50', 'blue;50'], + ['blue;0', 'green;50', 'red;90'], ], ## TBC 'dimension' => [0..5, 10, 50, 100, 0.0, 5.5, 100.5, 4.5], ## and floats ?! 'edgelist' => ['left', 'right', 'top', 'bottom', 'contour', 'oblique', 'counteroblique'], ## +combinations! @@ -304,7 +304,7 @@ sub creating_datas { 'bitmaplist' => ['AlphaStipple0', 'AlphaStipple3', 'AlphaStipple14', 'AlphaStipple11', 'AlphaStipple7'], 'capstyle' => 'butt', 'gradient' => 'LemonChiffon', - 'gradientlist' => ['red:50', 'green:50', 'blue:50'], + 'gradientlist' => ['red;50', 'green;50', 'blue;50'], 'dimension' => 45, 'edgelist' => 'contour', 'font' => '6x10', @@ -818,7 +818,7 @@ if ($tests{5}) { # #### &test_illegal_call # for example: -# calling a methode for an non-existing item +# calling a method for an non-existing item # getting coords, contours, fields, etc... of non-existing index # # cloning, deleting topgroup -- cgit v1.1