[squeak-dev] The Trunk: GraphicsTests-mt.50.mcz

[c***@source.squeak.org]

Marcel Taeumel uploaded a new version of GraphicsTests to project The Trunk:
http://source.squeak.org/trunk/GraphicsTests-mt.50.mcz

==================== Summary ====================

Name: GraphicsTests-mt.50
Author: mt
Time: 2 December 2018, 11:52:32.350325 am
UUID: 47215a6d-cd2c-b749-8e8b-402fef91d861
Ancestors: GraphicsTests-pre.49

Fixes categories for point tests. Adds tests for infix rectangle creation.

=============== Diff against GraphicsTests-pre.49 ===============

Item was changed:
SystemOrganization addCategory: #'GraphicsTests-Files'!
SystemOrganization addCategory: #'GraphicsTests-Primitives'!
- SystemOrganization addCategory: #'GraphicsTests-Transformations'!
SystemOrganization addCategory: #'GraphicsTests-Text'!

Item was changed:
+ ----- Method: PointTest>>testBasicFourDirections (in category 'tests') -----
- ----- Method: PointTest>>testBasicFourDirections (in category 'testing - testing') -----
testBasicFourDirections
"fourDirections returns the four rotation of the receiver in counter clockwise order with the receiver appearing last. "

| samples results rejects |
self assert: (0 asPoint fourDirections) = (Array new: 4 withAll: 0 asPoint) .
samples := 0 asPoint eightNeighbors .
results := {
{ 0 @ -1 . -1 @ 0 . 0 @ 1 . 1 @ 0}.
{ 1 @ -1 . -1 @ -1 . -1 @ 1 . 1 @ 1}.
{ 1 @ 0 . 0 @ -1 . -1 @ 0 . 0 @ 1}.
{ 1 @ 1 . 1 @ -1 . -1 @ -1 . -1 @ 1}.
{ 0 @ 1 . 1 @ 0 . 0 @ -1 . -1 @ 0}.
{-1 @ 1 . 1 @ 1 . 1 @ -1 . -1 @ -1}.
{-1 @ 0 . 0 @ 1 . 1 @ 0 . 0 @ -1}.
{-1 @ -1 . -1 @ 1 . 1 @ 1 . 1 @ -1} } .

rejects := (1 to: samples size ) reject: [ :each |
(samples at: each) fourDirections = (results at: each) ] .

self assert: rejects isEmpty!

Item was changed:
+ ----- Method: PointTest>>testBearingToPoint (in category 'tests') -----
- ----- Method: PointTest>>testBearingToPoint (in category 'tests - testing') -----
testBearingToPoint

self assert: (0 @ 0 bearingToPoint: 0 @ 0) = 0.
self assert: (0 @ 0 bearingToPoint: 0 @ -1) = 0.
self assert: (0 @ 0 bearingToPoint: 1 @ 0) = 90.
self assert: (0 @ 0 bearingToPoint: 0 @ 1) = 180.
self assert: (0 @ 0 bearingToPoint: -1 @ 0) = 270.
self assert: (0 @ 0 bearingToPoint: 1 @ 1) = 135.
self assert: (0 @ 0 bearingToPoint: 0.01 @ 0) = 90.
self assert: (0 @ 0 bearingToPoint: -2 @ -3) = 326.
self assert: (0 @ 0 bearingToPoint: -0 @ 0) = 0.

self assert: (-2 @ -3 bearingToPoint: 0 @ 0) = 146.!

Item was changed:
+ ----- Method: PointTest>>testFourDirectionsInvarients (in category 'tests') -----
- ----- Method: PointTest>>testFourDirectionsInvarients (in category 'testing - testing') -----
testFourDirectionsInvarients
" fourDirections returns the four rotation of the reciever in counter clockwise order with the reciever appearing last. "

| samples rejects |

samples :=
0 asPoint eightNeighbors .

rejects :=
(1 to: samples size ) reject: [ :each |
(samples at: each) fourDirections last = ( samples at: each) ] .

self assert: ( rejects isEmpty) .


!

Item was changed:
+ ----- Method: PointTest>>testFourDirectionsRotationInvarients (in category 'tests') -----
- ----- Method: PointTest>>testFourDirectionsRotationInvarients (in category 'testing - testing') -----
testFourDirectionsRotationInvarients
" fourDirections returns the four rotation of the reciever in counter clockwise order with the reciever appearing last. "

| samples rejects |

samples :=
0 asPoint eightNeighbors .

rejects :=
(1 to: samples size ) reject: [ :each | | answer |
(answer := (samples at: each) fourDirections ) .
(1 to: 4) allSatisfy: [ :eachDirIndex |
( answer atWrap: eachDirIndex) leftRotated
= (( answer atWrap: eachDirIndex + 1) ) ] ] .

self assert: ( rejects isEmpty) .


!

Item was changed:
+ ----- Method: PointTest>>testIsZero (in category 'tests') -----
- ----- Method: PointTest>>testIsZero (in category 'tests - testing') -----
testIsZero

self assert: (***@0) isZero.
self deny: (***@1) isZero.
self deny: (***@0) isZero.
self deny: (***@1) isZero.!

Item was changed:
+ ----- Method: PointTest>>testNormal (in category 'tests') -----
- ----- Method: PointTest>>testNormal (in category 'testing - testing') -----
testNormal
"quick check of results for #normal."
| samples rejects results |
samples := 0 asPoint eightNeighbors , (Array with: 0 asPoint) .

results :=
{ 0.0 @ 1.0 .
-0.707106781186547 @ 0.707106781186547 .
-1.0 @ 0.0 .
-0.707106781186547 @ -0.707106781186547 .
0.0 @ -1.0 .
0.707106781186547 @ -0.707106781186547 .
1.0 @ 0.0 .
0.707106781186547 @ 0.707106781186547 .
-1 @ 0} .

rejects := (1 to: samples size ) reject:
[ :each | ((samples at: each) normal - (results at: each)) abs < 1e-15 asPoint ] .

self assert: rejects isEmpty!

Item was changed:
+ ----- Method: PointTest>>testNormal2 (in category 'tests') -----
- ----- Method: PointTest>>testNormal2 (in category 'testing - testing') -----
testNormal2
"quick check of results for #normal.
differs from the other testNormal in the way that the difference is measured."

| samples rejects results differences |
samples := 0 asPoint eightNeighbors , (Array with: 0 asPoint) .

results :=
{ 0.0 @ 1.0 .
-0.707106781186547 @ 0.707106781186547 .
-1.0 @ 0.0 .
-0.707106781186547 @ -0.707106781186547 .
0.0 @ -1.0 .
0.707106781186547 @ -0.707106781186547 .
1.0 @ 0.0 .
0.707106781186547 @ 0.707106781186547 .
-1 @ 0} .
differences := samples with: results collect: [ :each :eachResult |
each normal - eachResult ] .

rejects := differences reject: [ :each |
(each x closeTo: 0.0) and: [each y closeTo: 0.0] ] .

self assert: rejects isEmpty!

Item was added:
+ ----- Method: PointTest>>testRectangleMix (in category 'tests') -----
+ testRectangleMix
+
+ {
+ Rectangle center: ***@60 extent: ***@100.
+ Rectangle origin: ***@10 extent: ***@100.
+ Rectangle origin: ***@10 corner: ***@110.
+
+ ***@60 inflate: ***@100.
+ ***@10 extent: ***@100.
+ ***@10 corner: ***@110.
+ } permutationsDo: [:rects |
+ rects overlappingPairsDo: [:r1 :r2 |
+ self assert: r1 equals: r2]].!

Item was added:
+ ----- Method: PointTest>>testRectangleWithCorner (in category 'tests') -----
+ testRectangleWithCorner
+
+ self
+ assert: (Rectangle origin: ***@10 corner: ***@110)
+ equals: (***@10 corner: ***@110).!

Item was added:
+ ----- Method: PointTest>>testRectangleWithExtent (in category 'tests') -----
+ testRectangleWithExtent
+
+ self
+ assert: (Rectangle origin: ***@50 extent: ***@100)
+ equals: (***@50 extent: ***@100).!

Item was added:
+ ----- Method: PointTest>>testRectangleWithInflate (in category 'tests') -----
+ testRectangleWithInflate
+
+ self
+ assert: (Rectangle center: ***@50 extent: ***@100)
+ equals: (***@50 inflate: ***@100).!

Item was changed:
+ ----- Method: PointTest>>testRotations (in category 'tests') -----
- ----- Method: PointTest>>testRotations (in category 'testing - testing') -----
testRotations
" Here we are testing rightRotated and leftRotated which are new.
Because there is really no coverage for point functions this also serves as a tests of sorts for
rotateBy:CenterAt:"

| samples |
samples :=
0 asPoint eightNeighbors
, (Array with: 0 asPoint) .

self assert: (samples allSatisfy: [ :each |
each rightRotated leftRotated = each ] ) .

self assert: (samples allSatisfy: [ :each |
each rightRotated = (each rotateBy: #right centerAt: 0 asPoint)] ) .

self assert: (samples allSatisfy: [ :each |
each leftRotated = (each rotateBy: #left centerAt: 0 asPoint ) ] ) .

self assert: (samples allSatisfy: [ :each |
each negated = (each rotateBy: #pi centerAt: 0 asPoint ) ] ) .

self assert: (samples allSatisfy: [ :each |
each leftRotated leftRotated leftRotated leftRotated = each ]) .

self assert: (samples allSatisfy: [ :each |
each rightRotated rightRotated rightRotated rightRotated = each ] ) .
!

Item was changed:
+ ----- Method: PointTest>>testSign (in category 'tests') -----
- ----- Method: PointTest>>testSign (in category 'testing - testing') -----
testSign
| samples results rejects |
samples := 0 asPoint eightNeighbors , (Array with: 0 asPoint).

results := samples collect: [ :each | each sign ].

rejects := (1 to: samples size ) reject: [ :each |
(samples at: each) = (results at: each) ] .

self assert: (rejects isEmpty)


!

Item was changed:
+ ----- Method: PointTest>>testTheta (in category 'tests') -----
- ----- Method: PointTest>>testTheta (in category 'testing - testing') -----
testTheta
| result dir tan x y |
self assert: ((0 @ 1) theta - 90.0 degreesToRadians) abs < 1e-15.
self assert: ((0 @ -1) theta - 270.0 degreesToRadians) abs < 1e-15.
" See code of old and new theta"
x := 1.0 . y := -1.0.
tan := y / x .
dir := tan arcTan.
result := 360.0 degreesToRadians + dir.
self assert: ((x @ y) theta - result) abs < 1e-15.
x := -1.0. "Don't reuse old results when you want numeric precision!!"
tan := y / x .
dir := tan arcTan.
result := 180.0 degreesToRadians + dir.
self assert: ((x @ y) theta - result) abs < 1e-15.

!

Item was changed:
+ ----- Method: PointTest>>testZeroPointNormal (in category 'tests') -----
- ----- Method: PointTest>>testZeroPointNormal (in category 'testing - testing') -----
testZeroPointNormal
"old: normal of zero point raised divide by zero error.
new: normal of zero point returns a direction right rotated from zero points direction."

self assert: 90 equals: (0