The Trunk: MorphicTests-mt.65.mcz

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

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

Name: MorphicTests-mt.65
Author: mt
Time: 17 September 2020, 3:41:47.157573 pm
UUID: 50b2cc27-06d5-5d40-936d-7b029ddc01b1
Ancestors: MorphicTests-mt.64, MorphicTests-ct.61

Updates layout tests following MorphicTests-nice.61 (inbox->treated). Complements Morphic-mt.1683. Merges MorphicTests-ct.61 (inbox->trunk).

=============== Diff against MorphicTests-mt.64 ===============

Item was changed:
  TestCase subclass: #MorphLayoutTest
+ instanceVariableNames: 'reset'
- instanceVariableNames: ''
  classVariableNames: ''
  poolDictionaries: ''
  category: 'MorphicTests-Layouts'!

Item was removed:
- ----- Method: MorphLayoutTest>>testScrollPaneBarUpdate (in category 'tests') -----
- testScrollPaneBarUpdate
-
- | oldPreferences |
- oldPreferences := ScrollPane useRetractableScrollBars.
- [| child container |
- ScrollPane useRetractableScrollBars: false.
- container := ScrollPane new color: Color green; extent: 300 @ 300; showVScrollBarOnlyWhenNeeded; showHScrollBarOnlyWhenNeeded.
- container scroller addMorphBack: (child := Morph new color: Color red; extent: 100 @ 100).
-
- self ensureLayout: container.
- self assert: container hScrollBar owner isNil.
- self assert: container vScrollBar owner isNil.
-
- child extent: 400 @ 100.
- self ensureLayout: container.
- self assert: container hScrollBar owner notNil.
- self assert: container vScrollBar owner isNil.
-
- child extent: 400 @ 400.
- self ensureLayout: container.
- self assert: container hScrollBar owner notNil.
- self assert: container hScrollBar owner notNil]
- ensure: [ScrollPane useRetractableScrollBars: oldPreferences]!

Item was added:
+ ----- Method: MorphicEventTests>>test02MouseOver (in category 'tests') -----
+ test02MouseOver
+
+ | m1 m2 |
+ m1 := MorphForEventTests new.
+ m2 := MorphForEventTests new.
+
+ m1 extent: 20@20; topLeft: 0@0.
+ m2 extent: 20@20; topLeft: 40@0.
+
+ m1 openInWorld: world.
+ m2 openInWorld: world.
+
+ hand handleEvent: (self redMouseDownAt: m1 center).
+ hand handleEvent: (self redMouseUpAt: m1 center).
+ hand handleEvent: (self redMouseDownAt: m2 center).
+ hand handleEvent: (self redMouseUpAt: m2 center).
+
+ self
+ checkEventOrder: #(mouseMove mouseEnter mouseDown mouseUp mouseLeave)
+ forEvents: m1 eventsDuringBubble
+ ignoreMouseOver: true.
+
+ self
+ checkEventOrder: #(mouseMove mouseEnter mouseDown mouseUp)
+ forEvents: m2 eventsDuringBubble
+ ignoreMouseOver: true.
+ !

Item was removed:
- ----- Method: MorphicEventTests>>test02MouserOver (in category 'tests') -----
- test02MouserOver
-
- | m1 m2 |
- m1 := MorphForEventTests new.
- m2 := MorphForEventTests new.
-
- m1 extent: 20@20; topLeft: 0@0.
- m2 extent: 20@20; topLeft: 40@0.
-
- m1 openInWorld: world.
- m2 openInWorld: world.
-
- hand handleEvent: (self redMouseDownAt: m1 center).
- hand handleEvent: (self redMouseUpAt: m1 center).
- hand handleEvent: (self redMouseDownAt: m2 center).
- hand handleEvent: (self redMouseUpAt: m2 center).
-
- self
- checkEventOrder: #(mouseMove mouseEnter mouseDown mouseUp mouseLeave)
- forEvents: m1 eventsDuringBubble
- ignoreMouseOver: true.
-
- self
- checkEventOrder: #(mouseMove mouseEnter mouseDown mouseUp)
- forEvents: m2 eventsDuringBubble
- ignoreMouseOver: true.
- !

Item was changed:
  TestCase subclass: #TableLayoutTest
+ instanceVariableNames: 'container reset'
- instanceVariableNames: 'container'
  classVariableNames: ''
  poolDictionaries: ''
  category: 'MorphicTests-Layouts'!

Item was added:
+ ----- Method: TableLayoutTest>>setUp (in category 'running') -----
+ setUp
+
+ super setUp.
+
+ reset := {
+ ([:enable | [self useRetractableScrollBars: enable]]
+ value: self useRetractableScrollBars)
+ in: [:block | self useRetractableScrollBars: false].
+ }.!

Item was added:
+ ----- Method: TableLayoutTest>>tearDown (in category 'running') -----
+ tearDown
+
+ reset do: #value.
+ super tearDown.!

Item was changed:
  ----- Method: TableLayoutTest>>testPluggableTextMorph (in category 'tests') -----
  testPluggableTextMorph
 
+ | ptm |
- | oldPreferences |
- oldPreferences := ScrollPane useRetractableScrollBars.
- [| ptm |
- ScrollPane useRetractableScrollBars: false.
  ptm := PluggableTextMorph new
  extent: 100@50;
  setText: 'Hello World!! Hello World!! Hello World!! Hello World!!';
  wrapFlag: true.
+
-
  container := self newContainer addMorphBack: ptm.
  self ensureLayout: container.
  self assert: 100@50 equals: container extent.
 
  self assert: ptm vIsScrollbarShowing.
  self deny: ptm hIsScrollbarShowing.
 
  "Make it a one-liner."
  ptm wrapFlag: false.
  self ensureLayout: container.
  self deny: ptm vIsScrollbarShowing.
  self assert: ptm hIsScrollbarShowing.
 
  "Make it a one-liner without the horizontal scrollbar."
  ptm hideScrollBarsIndefinitely.
  self ensureLayout: container.
  self deny: ptm vIsScrollbarShowing.
+ self deny: ptm hIsScrollbarShowing.
- self deny: ptm hIsScrollbarShowing]
- ensure: [ScrollPane useRetractableScrollBars: oldPreferences].
  !

Item was changed:
  ----- Method: TableLayoutTest>>testPluggableTextMorphScrollBarNotNeeded (in category 'tests') -----
  testPluggableTextMorphScrollBarNotNeeded
  "The entire test might fit if the scroll bar would only disappear..."
 
+ | ptm |
- | oldPreferences |
- oldPreferences := ScrollPane useRetractableScrollBars.
- [| ptm |
- ScrollPane useRetractableScrollBars: false.
  ptm := PluggableTextMorph new
  extent: 100@50;
  setText: 'Hello World!! Hello World!! \\\ Hello World!! Hello World!!' withCRs.
  container := self newContainer addMorphBack: ptm.
 
  "Make it fit exactly first."
  ptm hResizing: #shrinkWrap; vResizing: #shrinkWrap.
  self ensureLayout: container.
  ptm hResizing: #rigid; vResizing: #rigid.
  ptm wrapFlag: true.
 
  "No scrollbars required."
  self ensureLayout: container.
  self deny: ptm vIsScrollbarShowing.
 
  "It wraps immediately."
  ptm width: ptm width - 5.
  self ensureLayout: container.
  self assert: ptm vIsScrollbarShowing.
 
  "No scrollbars required."
  ptm width: ptm width + 5.
  self ensureLayout: container.
+ self deny: ptm vIsScrollbarShowing.!
- self deny: ptm vIsScrollbarShowing]
- ensure: [ScrollPane useRetractableScrollBars: oldPreferences]!

Item was added:
+ ----- Method: TableLayoutTest>>testScrollPaneBarUpdate (in category 'tests - scroll panes') -----
+ testScrollPaneBarUpdate
+
+ | child container |
+ container := ScrollPane new color: Color green; extent: 300 @ 300; showVScrollBarOnlyWhenNeeded; showHScrollBarOnlyWhenNeeded.
+ container scroller addMorphBack: (child := Morph new color: Color red; extent: 100 @ 100).
+
+ self ensureLayout: container.
+ self assert: container hScrollBar owner isNil.
+ self assert: container vScrollBar owner isNil.
+
+ child extent: 400 @ 100.
+ self ensureLayout: container.
+ self assert: container hScrollBar owner notNil.
+ self assert: container vScrollBar owner isNil.
+
+ child extent: 400 @ 400.
+ self ensureLayout: container.
+ self assert: container hScrollBar owner notNil.
+ self assert: container hScrollBar owner notNil!

Item was changed:
  ----- Method: TableLayoutTest>>testScrollPaneShrinkWrap (in category 'tests') -----
  testScrollPaneShrinkWrap
 
+ | scroll scrollContent |
- | oldPreferences |
- oldPreferences := ScrollPane useRetractableScrollBars.
- [| scroll scrollContent |
- ScrollPane useRetractableScrollBars: false.
  container := self newContainer
  vResizing: #rigid;
  addMorphBack: (self newMorph extent: 50 @ 50);
  addMorphBack: (scroll := ScrollPane new
  hResizing: #shrinkWrap;
  vResizing: #spaceFill;
  showVScrollBarOnlyWhenNeeded;
  hideHScrollBarIndefinitely).
 
  " shrinkWrap the horizontal axis but scroll vertically "
  scroll scroller
  layoutPolicy: TableLayout new;
  addMorphBack: (scrollContent := self newMorph extent: 200 @ 500).
 
  container extent: 1 @ 300.
  self ensureLayout: container.
  self assert: container left = (container layoutChanged; fullBounds; left). "Do not be jumpy."
  self assert: (200 + scroll scrollBarThickness + scroll borderWidth) @ 300 equals: scroll extent.
 
  scrollContent extent: 300 @ 500.
  self ensureLayout: container.
+ self assert: (300 + scroll scrollBarThickness + scroll borderWidth) @ 300 equals: scroll extent!
- self assert: (300 + scroll scrollBarThickness + scroll borderWidth) @ 300 equals: scroll extent]
- ensure: [ScrollPane useRetractableScrollBars: oldPreferences].
- !

Item was added:
+ ----- Method: TableLayoutTest>>testScrollerFill (in category 'tests - scroll panes') -----
+ testScrollerFill
+ "A scroll pane's scroller (i.e., the transform morph) has always #spaceFill behavior within the scroll pane's layout. Thus, submorphs (here: title and content) can themselves be #spaceFill. Embed a text morph to check height-for-width compatibility."
+
+ | content title |
+ container := ScrollPane new.
+
+ container scroller
+ layoutPolicy: TableLayout new;
+ color: Color random;
+ addMorphBack: (title := TextMorph new hResizing: #spaceFill; contents: 'Here comes an interesting title');
+ addMorphBack: (content := self newMorph extent: 400 @ 400; hResizing: #spaceFill).
+ container extent: 50 @ 50. "Pick an extent so that the title must wrap!!"
+ self ensureLayout: container.
+
+ "container openInHand."
+
+ container extent: 500 @ 500.
+ self ensureLayout: container.
+ self assert: 500 @ 500 equals: container extent.
+ self assert: 500 - (container borderWidth  * 2) @ 400 equals: content extent.
+
+ container extent: 300 @ 300.
+ self ensureLayout: container.
+ self assert: 300 @ 300 equals: container extent.
+ self assert: 300 - container borderWidth - container scrollBarThickness @ 400 equals: content extent!

Item was added:
+ ----- Method: TableLayoutTest>>testScrollerFillWithContainer (in category 'tests - scroll panes') -----
+ testScrollerFillWithContainer
+ "A scroll pane's scroller (i.e., the transform morph) has always #spaceFill behavior within the scroll pane's layout. Thus, submorphs (here: title and content) can themselves be #spaceFill. Embed a text morph to check height-for-width compatibility. Add an extra container between scroller and title/content."
+
+ | content title |
+ container := ScrollPane new.
+
+ container scroller
+ layoutPolicy: TableLayout new;
+ addMorphBack: (self newContainer
+ hResizing: #spaceFill;
+ vResizing: #spaceFill;
+ listDirection: #topToBottom;
+ addMorphBack: (title := TextMorph new hResizing: #spaceFill; contents: 'Here comes an interesting title');
+ addMorphBack: (content := self newMorph extent: 400 @ 400; hResizing: #spaceFill)).
+ container extent: 50 @ 50. "Pick an extent so that the title must wrap!!"
+ self ensureLayout: container.
+
+ "container openInHand."
+
+ container extent: 500 @ 500.
+ self ensureLayout: container.
+ self assert: 500 @ 500 equals: container extent.
+ self assert: 500 - (container borderWidth  * 2) @ 400 equals: content extent.
+
+ container extent: 300 @ 300.
+ self ensureLayout: container.
+ self assert: 300 @ 300 equals: container extent.
+ self assert: 300 - container borderWidth - container scrollBarThickness @ 400 equals: content extent!

Item was changed:
  ----- Method: TableLayoutTest>>testShrinkWrapScrollPaneAlwaysShowBars (in category 'tests') -----
  testShrinkWrapScrollPaneAlwaysShowBars
 
+ | scroll scrollContent |
- | oldPreferences |
- oldPreferences := ScrollPane useRetractableScrollBars.
- [| scroll scrollContent |
- ScrollPane useRetractableScrollBars: false.
  container := self newContainer
  vResizing: #shrinkWrap;
  hResizing: #shrinkWrap;
  addMorphBack: (scroll := ScrollPane new
  hResizing: #shrinkWrap;
  vResizing: #shrinkWrap;
  alwaysShowHScrollBar;
  alwaysShowVScrollBar).
 
  scroll scroller
  layoutPolicy: TableLayout new;
  addMorphBack: (scrollContent := self newMorph extent: 300 @ 300).
 
  self ensureLayout: container.
+ self assert: (300 @ 300) + scroll scrollBarThickness + scroll borderWidth equals: container extent!
- self assert: (300 @ 300) + scroll scrollBarThickness + scroll borderWidth equals: container extent]
- ensure: [ScrollPane useRetractableScrollBars: oldPreferences].
- !

Item was changed:
  ----- Method: TableLayoutTest>>testSidebarAndScrollingView (in category 'tests - example layouts') -----
  testSidebarAndScrollingView
  " construct a container that has a fixed size sidebar on the left and a scrolling window that adapts flexibly to the container's size "
 
+ | scrolling sidebar content title |
- | oldPreferences |
- oldPreferences := ScrollPane useRetractableScrollBars.
- [| scrolling sidebar content title |
- ScrollPane useRetractableScrollBars: false.
  container := self newContainer
  addMorphBack: (sidebar := self newMorph width: 200; hResizing: #rigid; vResizing: #spaceFill);
  addMorphBack: (scrolling := ScrollPane new hResizing: #spaceFill; vResizing: #spaceFill).
 
  scrolling scroller
  layoutPolicy: TableLayout new;
  addMorphBack: (self newContainer
  hResizing: #spaceFill;
  vResizing: #spaceFill;
  listDirection: #topToBottom;
  addMorphBack: (title := TextMorph new hResizing: #spaceFill; contents: 'Here comes a title');
  addMorphBack: (content := self newMorph extent: 400 @ 400; hResizing: #spaceFill)).
+ self ensureLayout: container.
+
  "container openInHand."
 
  container extent: 500 @ 500.
  self ensureLayout: container.
  self assert: 200 @ 500 equals: sidebar extent.
  self assert: 300 @ 500 equals: scrolling extent.
  self assert: 300 - (scrolling borderWidth  * 2) @ 400 equals: content extent.
 
  container extent: 300 @ 300.
  self ensureLayout: container.
  self assert: 200 @ 300 equals: sidebar extent.
  self assert: 100 @ 300 equals: scrolling extent.
+ self assert: 100 - scrolling borderWidth - scrolling scrollBarThickness @ 400 equals: content extent!
- self assert: 100 - scrolling borderWidth - scrolling scrollBarThickness @ 400 equals: content extent]
- ensure: [ScrollPane useRetractableScrollBars: oldPreferences]!

Item was added:
+ ----- Method: TableLayoutTest>>useRetractableScrollBars (in category 'running') -----
+ useRetractableScrollBars
+
+ ^ ScrollPane classPool at: #UseRetractableScrollBars!

Item was added:
+ ----- Method: TableLayoutTest>>useRetractableScrollBars: (in category 'running') -----
+ useRetractableScrollBars: aBoolean
+ "Re-implemented to avoid triggering #allSubInstancesDo:."
+
+ ScrollPane classPool at: #UseRetractableScrollBars put: aBoolean.!

Hi Marcel,
here is an attempt at answering an old mail (this one was still in my client).
this breaks my preference... See below

Le jeu. 17 sept. 2020 à 15:41, <[hidden email]> a écrit :
Hmph... This is brainfuck code... It should be:

    reset := {
        ([:enable | [self useRetractableScrollBars: enable]]
            value: self useRetractableScrollBars)
            in: [:block | self useRetractableScrollBars: false. block].
    }.

or just:

    reset := {
        ([:enable | [self useRetractableScrollBars: enable]]
            value: self useRetractableScrollBars)
    }.
    self useRetractableScrollBars: false