Tools__TestRunnerEmbedded.st
author Claus Gittinger <cg@exept.de>
Sun, 03 Jul 2011 19:50:00 +0200
changeset 10069 564aac8f3458
parent 9956 a474bf8fbb86
child 10092 b088e3df4982
permissions -rw-r--r--
changed: #copyright
Ignore whitespace changes - Everywhere: Within whitespace: At end of lines:
9954
aebf22e17733 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
     1
"
aebf22e17733 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
     2
 COPYRIGHT (c) 2006 by eXept Software AG
aebf22e17733 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
     3
	      All Rights Reserved
aebf22e17733 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
     4
aebf22e17733 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
     5
 This software is furnished under a license and may be used
aebf22e17733 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
     6
 only in accordance with the terms of that license and with the
aebf22e17733 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
     7
 inclusion of the above copyright notice.   This software may not
aebf22e17733 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
     8
 be provided or otherwise made available to, or used by, any
aebf22e17733 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
     9
 other person.  No title to or ownership of the software is
aebf22e17733 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
    10
 hereby transferred.
aebf22e17733 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
    11
"
aebf22e17733 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
    12
"{ Package: 'stx:libtool' }"
aebf22e17733 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
    13
aebf22e17733 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
    14
"{ NameSpace: Tools }"
aebf22e17733 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
    15
aebf22e17733 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
    16
AbstractTestRunner subclass:#TestRunnerEmbedded
aebf22e17733 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
    17
	instanceVariableNames:'runnerPanel selectedTestCases selectedClassesHolder
aebf22e17733 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
    18
		selectedProtocolsHolder selectedMethodsHolder
aebf22e17733 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
    19
		methodGeneratorHolder resultHolder resultInfoHolder
aebf22e17733 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
    20
		resultBackgroundColorHolder runningHolder progressHolder'
aebf22e17733 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
    21
	classVariableNames:''
aebf22e17733 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
    22
	poolDictionaries:''
9956
Claus Gittinger <cg@exept.de>
parents: 9954
diff changeset
    23
	category:'SUnit-UI'
9954
aebf22e17733 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
    24
!
aebf22e17733 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
    25
aebf22e17733 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
    26
Object subclass:#SuiteAndResult
aebf22e17733 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
    27
	instanceVariableNames:'suite result'
aebf22e17733 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
    28
	classVariableNames:''
aebf22e17733 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
    29
	poolDictionaries:''
aebf22e17733 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
    30
	privateIn:TestRunnerEmbedded
aebf22e17733 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
    31
!
aebf22e17733 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
    32
aebf22e17733 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
    33
!TestRunnerEmbedded class methodsFor:'documentation'!
aebf22e17733 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
    34
aebf22e17733 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
    35
copyright
aebf22e17733 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
    36
"
aebf22e17733 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
    37
 COPYRIGHT (c) 2006 by eXept Software AG
aebf22e17733 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
    38
	      All Rights Reserved
aebf22e17733 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
    39
aebf22e17733 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
    40
 This software is furnished under a license and may be used
aebf22e17733 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
    41
 only in accordance with the terms of that license and with the
aebf22e17733 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
    42
 inclusion of the above copyright notice.   This software may not
aebf22e17733 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
    43
 be provided or otherwise made available to, or used by, any
aebf22e17733 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
    44
 other person.  No title to or ownership of the software is
aebf22e17733 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
    45
 hereby transferred.
aebf22e17733 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
    46
"
aebf22e17733 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
    47
! !
aebf22e17733 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
    48
aebf22e17733 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
    49
!TestRunnerEmbedded class methodsFor:'interface specs'!
aebf22e17733 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
    50
aebf22e17733 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
    51
windowSpec
aebf22e17733 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
    52
    "This resource specification was automatically generated
aebf22e17733 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
    53
     by the UIPainter of ST/X."
aebf22e17733 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
    54
aebf22e17733 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
    55
    "Do not manually edit this!! If it is corrupted,
aebf22e17733 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
    56
     the UIPainter may not be able to read the specification."
aebf22e17733 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
    57
aebf22e17733 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
    58
    "
aebf22e17733 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
    59
     UIPainter new openOnClass:Tools::TestRunnerEmbedded andSelector:#windowSpec
aebf22e17733 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
    60
     Tools::TestRunnerEmbedded new openInterface:#windowSpec
aebf22e17733 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
    61
     Tools::TestRunnerEmbedded open
aebf22e17733 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
    62
    "
aebf22e17733 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
    63
aebf22e17733 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
    64
    <resource: #canvas>
aebf22e17733 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
    65
aebf22e17733 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
    66
    ^ 
aebf22e17733 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
    67
     #(FullSpec
aebf22e17733 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
    68
        name: windowSpec
aebf22e17733 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
    69
        window: 
aebf22e17733 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
    70
       (WindowSpec
aebf22e17733 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
    71
          label: 'Test Runner Embedded'
aebf22e17733 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
    72
          name: 'Test Runner Embedded'
aebf22e17733 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
    73
          min: (Point 10 10)
aebf22e17733 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
    74
          bounds: (Rectangle 0 0 350 50)
aebf22e17733 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
    75
        )
aebf22e17733 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
    76
        component: 
aebf22e17733 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
    77
       (SpecCollection
aebf22e17733 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
    78
          collection: (
aebf22e17733 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
    79
           (VerticalPanelViewSpec
aebf22e17733 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
    80
              name: 'Runners'
aebf22e17733 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
    81
              layout: (LayoutFrame 5 0 0 0 -5 1 0 1)
aebf22e17733 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
    82
              horizontalLayout: fit
aebf22e17733 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
    83
              verticalLayout: topSpaceFit
aebf22e17733 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
    84
              horizontalSpace: 0
aebf22e17733 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
    85
              verticalSpace: 5
aebf22e17733 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
    86
              elementsChangeSize: true
aebf22e17733 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
    87
              component: 
aebf22e17733 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
    88
             (SpecCollection
aebf22e17733 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
    89
                collection: (
aebf22e17733 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
    90
                 (ViewSpec
aebf22e17733 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
    91
                    name: 'Runner'
aebf22e17733 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
    92
                    backgroundChannel: resultBackgroundColorAspect
aebf22e17733 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
    93
                    component: 
aebf22e17733 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
    94
                   (SpecCollection
aebf22e17733 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
    95
                      collection: (
aebf22e17733 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
    96
                       (HorizontalPanelViewSpec
aebf22e17733 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
    97
                          name: 'RunnerInnerBox'
aebf22e17733 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
    98
                          layout: (LayoutFrame 5 0 0 0 -5 1 0 1)
aebf22e17733 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
    99
                          horizontalLayout: rightSpaceFit
aebf22e17733 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   100
                          verticalLayout: center
aebf22e17733 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   101
                          horizontalSpace: 0
aebf22e17733 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   102
                          elementsChangeSize: true
aebf22e17733 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   103
                          component: 
aebf22e17733 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   104
                         (SpecCollection
aebf22e17733 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   105
                            collection: (
aebf22e17733 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   106
                             (ViewSpec
aebf22e17733 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   107
                                name: 'RunnerInfoBox'
aebf22e17733 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   108
                                backgroundChannel: resultBackgroundColorAspect
aebf22e17733 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   109
                                component: 
aebf22e17733 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   110
                               (SpecCollection
aebf22e17733 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   111
                                  collection: (
aebf22e17733 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   112
                                   (LabelSpec
aebf22e17733 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   113
                                      label: 'Run tests first!!'
aebf22e17733 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   114
                                      name: 'ResultName'
aebf22e17733 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   115
                                      layout: (LayoutFrame 0 0 0 0 0 1 -10 1)
aebf22e17733 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   116
                                      backgroundChannel: resultBackgroundColorAspect
aebf22e17733 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   117
                                      foregroundColor: (Color 100.0 100.0 100.0)
aebf22e17733 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   118
                                      translateLabel: true
aebf22e17733 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   119
                                      labelChannel: resultNameAspect
aebf22e17733 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   120
                                      adjust: left
aebf22e17733 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   121
                                    )
aebf22e17733 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   122
                                   (LabelSpec
aebf22e17733 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   123
                                      name: 'ResultInfo'
aebf22e17733 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   124
                                      layout: (LayoutFrame 0 0 -10 1 0 1 0 1)
aebf22e17733 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   125
                                      style: (FontDescription helvetica medium roman 8)
aebf22e17733 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   126
                                      backgroundChannel: resultBackgroundColorAspect
aebf22e17733 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   127
                                      foregroundColor: (Color 100.0 100.0 100.0)
aebf22e17733 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   128
                                      translateLabel: true
aebf22e17733 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   129
                                      labelChannel: resultInfoAspect
aebf22e17733 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   130
                                      adjust: left
aebf22e17733 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   131
                                    )
aebf22e17733 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   132
                                   (ViewSpec
aebf22e17733 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   133
                                      name: 'ProgressPanel'
aebf22e17733 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   134
                                      layout: (LayoutFrame 0 0 0 0 0 1 0 1)
aebf22e17733 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   135
                                      visibilityChannel: runningHolder
aebf22e17733 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   136
                                      backgroundChannel: resultBackgroundColorAspect
aebf22e17733 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   137
                                      component: 
aebf22e17733 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   138
                                     (SpecCollection
aebf22e17733 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   139
                                        collection: (
aebf22e17733 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   140
                                         (ProgressIndicatorSpec
aebf22e17733 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   141
                                            name: 'RunningProgress'
aebf22e17733 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   142
                                            layout: (LayoutFrame 5 0 -10 0.5 -5 1 10 0.5)
aebf22e17733 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   143
                                            model: progressHolder
aebf22e17733 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   144
                                          )
aebf22e17733 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   145
                                         )
aebf22e17733 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   146
                                       
aebf22e17733 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   147
                                      )
aebf22e17733 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   148
                                    )
aebf22e17733 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   149
                                   )
aebf22e17733 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   150
                                 
aebf22e17733 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   151
                                )
aebf22e17733 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   152
                                extent: (Point 151 30)
aebf22e17733 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   153
                              )
aebf22e17733 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   154
                             (ActionButtonSpec
aebf22e17733 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   155
                                label: 'Debug'
aebf22e17733 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   156
                                name: 'DebugButton'
aebf22e17733 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   157
                                initiallyInvisible: true
aebf22e17733 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   158
                                visibilityChannel: debugVisibleAspect
aebf22e17733 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   159
                                translateLabel: true
aebf22e17733 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   160
                                model: debug
aebf22e17733 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   161
                                extent: (Point 60 25)
aebf22e17733 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   162
                              )
aebf22e17733 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   163
                             (ActionButtonSpec
aebf22e17733 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   164
                                label: 'Run'
aebf22e17733 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   165
                                name: 'Run'
aebf22e17733 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   166
                                translateLabel: true
aebf22e17733 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   167
                                model: run
aebf22e17733 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   168
                                enableChannel: runEnabledHolder
aebf22e17733 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   169
                                extent: (Point 60 25)
aebf22e17733 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   170
                              )
aebf22e17733 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   171
                             (ActionButtonSpec
aebf22e17733 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   172
                                label: 'Run all'
aebf22e17733 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   173
                                name: 'RunAll'
aebf22e17733 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   174
                                translateLabel: true
aebf22e17733 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   175
                                model: runAll
aebf22e17733 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   176
                                enableChannel: runAllEnabledHolder
aebf22e17733 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   177
                                extent: (Point 60 25)
aebf22e17733 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   178
                              )
aebf22e17733 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   179
                             )
aebf22e17733 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   180
                           
aebf22e17733 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   181
                          )
aebf22e17733 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   182
                          postBuildCallback: postBuildRunnerPanel:
aebf22e17733 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   183
                        )
aebf22e17733 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   184
                       )
aebf22e17733 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   185
                     
aebf22e17733 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   186
                    )
aebf22e17733 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   187
                    extent: (Point 340 40)
aebf22e17733 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   188
                  )
aebf22e17733 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   189
                 )
aebf22e17733 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   190
               
aebf22e17733 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   191
              )
aebf22e17733 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   192
            )
aebf22e17733 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   193
           )
aebf22e17733 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   194
         
aebf22e17733 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   195
        )
aebf22e17733 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   196
      )
aebf22e17733 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   197
aebf22e17733 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   198
! !
aebf22e17733 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   199
aebf22e17733 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   200
!TestRunnerEmbedded class methodsFor:'plugIn spec'!
aebf22e17733 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   201
aebf22e17733 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   202
aspectSelectors
aebf22e17733 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   203
    "This resource specification was automatically generated
aebf22e17733 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   204
     by the UIPainter of ST/X."
aebf22e17733 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   205
aebf22e17733 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   206
    "Do not manually edit this. If it is corrupted,
aebf22e17733 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   207
     the UIPainter may not be able to read the specification."
aebf22e17733 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   208
aebf22e17733 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   209
    "Return a description of exported aspects;
aebf22e17733 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   210
     these can be connected to aspects of an embedding application
aebf22e17733 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   211
     (if this app is embedded in a subCanvas)."
aebf22e17733 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   212
aebf22e17733 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   213
    ^ #(
aebf22e17733 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   214
        #methodGeneratorHolder
aebf22e17733 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   215
        #selectedClassesHolder
aebf22e17733 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   216
        #selectedMethodsHolder
aebf22e17733 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   217
        #selectedProtocolsHolder
aebf22e17733 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   218
      ).
aebf22e17733 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   219
aebf22e17733 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   220
! !
aebf22e17733 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   221
aebf22e17733 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   222
!TestRunnerEmbedded methodsFor:'accessing'!
aebf22e17733 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   223
aebf22e17733 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   224
selectedTestMethods
aebf22e17733 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   225
    ^ (self selectedMethodsHolder value ? #()) select:
aebf22e17733 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   226
            [:mthd | 
aebf22e17733 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   227
            (self isTestCaseLike:mthd mclass) 
aebf22e17733 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   228
                and:[ mthd mclass isTestSelector:mthd selector ] ]
aebf22e17733 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   229
aebf22e17733 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   230
    "Created: / 15-03-2010 / 13:21:25 / Jan Vrany <jan.vrany@fit.cvut.cz>"
aebf22e17733 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   231
    "Modified: / 07-09-2010 / 08:30:01 / Jan Vrany <jan.vrany@fit.cvut.cz>"
aebf22e17733 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   232
!
aebf22e17733 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   233
aebf22e17733 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   234
selectedTestMethodsFromProtocols:protocols 
aebf22e17733 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   235
    |methods generator|
aebf22e17733 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   236
aebf22e17733 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   237
    methods := Set new.
aebf22e17733 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   238
    generator := self methodGeneratorHolder value.
aebf22e17733 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   239
    generator ifNotNil:
aebf22e17733 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   240
            [ generator do:
aebf22e17733 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   241
                    [:cls :cat :sel :mthd | 
aebf22e17733 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   242
                    (mthd notNil 
aebf22e17733 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   243
                        and:[ (self isTestCaseLike:cls) and:[ cls isTestSelector:sel ] ]) 
aebf22e17733 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   244
                            ifTrue:[ methods add:mthd ] ] ]
aebf22e17733 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   245
        ifNil:
aebf22e17733 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   246
            [ selectedTestCases do:
aebf22e17733 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   247
                    [:cls | 
aebf22e17733 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   248
                    cls methodsDo:
aebf22e17733 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   249
                            [:mthd | 
aebf22e17733 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   250
                            ((protocols includes:mthd category) 
aebf22e17733 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   251
                                and:[ cls isTestSelector:mthd selector ]) ifTrue:[ methods add:mthd ] ] ] ].
aebf22e17733 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   252
    ^ methods
aebf22e17733 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   253
aebf22e17733 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   254
    "Created: / 15-03-2010 / 19:50:15 / Jan Vrany <jan.vrany@fit.cvut.cz>"
aebf22e17733 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   255
    "Modified: / 07-09-2010 / 08:29:09 / Jan Vrany <jan.vrany@fit.cvut.cz>"
aebf22e17733 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   256
! !
aebf22e17733 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   257
aebf22e17733 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   258
!TestRunnerEmbedded methodsFor:'actions'!
aebf22e17733 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   259
aebf22e17733 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   260
debug
aebf22e17733 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   261
aebf22e17733 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   262
    | suiteAndResult | 
aebf22e17733 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   263
    suiteAndResult := self resultHolder value.
aebf22e17733 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   264
    suiteAndResult suite tests size ~= 1 ifTrue:[^self breakPoint: #jv].
aebf22e17733 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   265
    [suiteAndResult suite tests anyOne debug] fork
aebf22e17733 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   266
aebf22e17733 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   267
    "Created: / 15-03-2010 / 15:43:39 / Jan Vrany <jan.vrany@fit.cvut.cz>"
aebf22e17733 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   268
    "Modified: / 15-03-2010 / 20:09:19 / Jan Vrany <jan.vrany@fit.cvut.cz>"
aebf22e17733 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   269
!
aebf22e17733 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   270
aebf22e17733 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   271
run
aebf22e17733 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   272
aebf22e17733 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   273
    self run:  resultHolder value suite
aebf22e17733 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   274
aebf22e17733 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   275
    "Created: / 10-03-2010 / 19:42:08 / Jan Vrany <jan.vrany@fit.cvut.cz>"
aebf22e17733 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   276
    "Modified: / 15-03-2010 / 20:00:06 / Jan Vrany <jan.vrany@fit.cvut.cz>"
aebf22e17733 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   277
!
aebf22e17733 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   278
aebf22e17733 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   279
run: suite
aebf22e17733 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   280
aebf22e17733 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   281
    | process suiteAndResult |
aebf22e17733 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   282
aebf22e17733 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   283
    suite tests size == 0 ifTrue:[^self].
aebf22e17733 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   284
aebf22e17733 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   285
    process := 
aebf22e17733 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   286
        [| result incr run |
aebf22e17733 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   287
        [
aebf22e17733 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   288
        self progressHolder value: 0.
aebf22e17733 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   289
        self runningHolder value: true.
aebf22e17733 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   290
        incr := 100 / suite tests size.
aebf22e17733 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   291
        run := 0.
aebf22e17733 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   292
        result := suite runAfterEachDo:
aebf22e17733 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   293
            [:test :result|
aebf22e17733 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   294
            run := run + 1.
aebf22e17733 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   295
            self progressHolder value: (incr * run) rounded].
aebf22e17733 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   296
        suiteAndResult := SuiteAndResult
aebf22e17733 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   297
                            suite: suite
aebf22e17733 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   298
                            result: result.
aebf22e17733 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   299
        ] ensure:[
aebf22e17733 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   300
            self resultHolder value: suiteAndResult.
aebf22e17733 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   301
            self runningHolder value: false.
aebf22e17733 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   302
        ]
aebf22e17733 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   303
        ] newProcess.
aebf22e17733 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   304
aebf22e17733 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   305
    process resume.
aebf22e17733 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   306
aebf22e17733 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   307
    "Created: / 11-03-2010 / 10:22:59 / Jan Vrany <jan.vrany@fit.cvut.cz>"
aebf22e17733 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   308
    "Modified: / 06-09-2010 / 21:48:10 / Jan Vrany <jan.vrany@fit.cvut.cz>"
aebf22e17733 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   309
!
aebf22e17733 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   310
aebf22e17733 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   311
runAll
aebf22e17733 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   312
aebf22e17733 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   313
    self run: self suiteForRunAll.
aebf22e17733 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   314
aebf22e17733 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   315
    "Created: / 10-03-2010 / 19:42:08 / Jan Vrany <jan.vrany@fit.cvut.cz>"
aebf22e17733 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   316
    "Modified: / 15-03-2010 / 13:12:58 / Jan Vrany <jan.vrany@fit.cvut.cz>"
aebf22e17733 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   317
! !
aebf22e17733 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   318
aebf22e17733 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   319
!TestRunnerEmbedded methodsFor:'aspects'!
aebf22e17733 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   320
aebf22e17733 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   321
debugVisibleAspect
aebf22e17733 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   322
aebf22e17733 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   323
    ^BlockValue
aebf22e17733 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   324
        with: 
aebf22e17733 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   325
            [:model|
aebf22e17733 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   326
            model 
aebf22e17733 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   327
                ifNil:[false]
aebf22e17733 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   328
                ifNotNil:[model testCount == 1 and:[model hasFailuresOrErrors]]]
aebf22e17733 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   329
        argument:
aebf22e17733 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   330
            self resultHolder
aebf22e17733 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   331
aebf22e17733 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   332
    "Created: / 15-03-2010 / 15:40:54 / Jan Vrany <jan.vrany@fit.cvut.cz>"
aebf22e17733 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   333
!
aebf22e17733 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   334
aebf22e17733 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   335
methodGeneratorHolder
aebf22e17733 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   336
    "return/create the 'methodGeneratorHolder' value holder (automatically generated)"
aebf22e17733 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   337
aebf22e17733 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   338
    methodGeneratorHolder isNil ifTrue:[
aebf22e17733 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   339
        methodGeneratorHolder := ValueHolder new.
aebf22e17733 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   340
        methodGeneratorHolder addDependent:self.
aebf22e17733 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   341
    ].
aebf22e17733 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   342
    ^ methodGeneratorHolder
aebf22e17733 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   343
!
aebf22e17733 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   344
aebf22e17733 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   345
methodGeneratorHolder:something
aebf22e17733 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   346
    "set the 'methodGeneratorHolder' value holder (automatically generated)"
aebf22e17733 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   347
aebf22e17733 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   348
    |oldValue newValue|
aebf22e17733 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   349
aebf22e17733 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   350
    methodGeneratorHolder notNil ifTrue:[
aebf22e17733 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   351
        oldValue := methodGeneratorHolder value.
aebf22e17733 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   352
        methodGeneratorHolder removeDependent:self.
aebf22e17733 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   353
    ].
aebf22e17733 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   354
    methodGeneratorHolder := something.
aebf22e17733 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   355
    methodGeneratorHolder notNil ifTrue:[
aebf22e17733 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   356
        methodGeneratorHolder addDependent:self.
aebf22e17733 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   357
    ].
aebf22e17733 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   358
    newValue := methodGeneratorHolder value.
aebf22e17733 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   359
    oldValue ~~ newValue ifTrue:[
aebf22e17733 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   360
        self update:#value with:newValue from:methodGeneratorHolder.
aebf22e17733 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   361
    ].
aebf22e17733 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   362
!
aebf22e17733 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   363
aebf22e17733 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   364
progressHolder
aebf22e17733 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   365
    "return/create the 'progressHolder' value holder (automatically generated)"
aebf22e17733 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   366
aebf22e17733 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   367
    progressHolder isNil ifTrue:[
aebf22e17733 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   368
        progressHolder := ValueHolder new.
aebf22e17733 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   369
    ].
aebf22e17733 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   370
    ^ progressHolder
aebf22e17733 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   371
!
aebf22e17733 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   372
aebf22e17733 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   373
resultBackgroundColorAspect
aebf22e17733 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   374
    <resource: #uiAspect>
aebf22e17733 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   375
aebf22e17733 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   376
    resultBackgroundColorHolder isNil ifTrue:[
aebf22e17733 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   377
        resultBackgroundColorHolder := BlockValue
aebf22e17733 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   378
            with:
aebf22e17733 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   379
                [:result :running|
aebf22e17733 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   380
                running  
aebf22e17733 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   381
                    ifTrue:
aebf22e17733 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   382
                        [View defaultBackgroundColor]
aebf22e17733 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   383
                    ifFalse:
aebf22e17733 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   384
                        [result 
aebf22e17733 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   385
                            ifNil:[self class notRunColor]
aebf22e17733 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   386
                            ifNotNil:[result color]]]
aebf22e17733 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   387
            argument: self resultHolder
aebf22e17733 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   388
            argument: self runningHolder.
aebf22e17733 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   389
        resultBackgroundColorHolder onChangeEvaluate:
aebf22e17733 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   390
            [runnerPanel ifNotNil:[runnerPanel backgroundColor: resultBackgroundColorHolder value]].
aebf22e17733 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   391
    ].
aebf22e17733 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   392
    ^ resultBackgroundColorHolder.
aebf22e17733 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   393
aebf22e17733 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   394
    "Created: / 15-03-2010 / 15:22:56 / Jan Vrany <jan.vrany@fit.cvut.cz>"
aebf22e17733 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   395
    "Modified: / 15-03-2010 / 21:02:22 / Jan Vrany <jan.vrany@fit.cvut.cz>"
aebf22e17733 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   396
!
aebf22e17733 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   397
aebf22e17733 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   398
resultHolder
aebf22e17733 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   399
    "return/create the 'resultHolder' value holder (automatically generated)"
aebf22e17733 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   400
aebf22e17733 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   401
    resultHolder isNil ifTrue:[
aebf22e17733 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   402
        resultHolder := ValueHolder new.
aebf22e17733 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   403
    ].
aebf22e17733 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   404
    ^ resultHolder
aebf22e17733 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   405
!
aebf22e17733 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   406
aebf22e17733 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   407
resultInfoAspect
aebf22e17733 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   408
aebf22e17733 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   409
    ^BlockValue
aebf22e17733 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   410
        with: 
aebf22e17733 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   411
            [:model|
aebf22e17733 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   412
            model 
aebf22e17733 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   413
                ifNil:['']
aebf22e17733 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   414
                ifNotNil:[model info]]
aebf22e17733 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   415
        argument:
aebf22e17733 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   416
            self resultHolder
aebf22e17733 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   417
aebf22e17733 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   418
    "Created: / 15-03-2010 / 20:22:44 / Jan Vrany <jan.vrany@fit.cvut.cz>"
aebf22e17733 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   419
!
aebf22e17733 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   420
aebf22e17733 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   421
resultNameAspect
aebf22e17733 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   422
aebf22e17733 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   423
    ^BlockValue
aebf22e17733 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   424
        with: 
aebf22e17733 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   425
            [:model|
aebf22e17733 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   426
            model 
aebf22e17733 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   427
                ifNil:['Run the tests!!']
aebf22e17733 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   428
                ifNotNil:[model name]]
aebf22e17733 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   429
        argument:
aebf22e17733 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   430
            self resultHolder
aebf22e17733 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   431
aebf22e17733 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   432
    "Created: / 15-03-2010 / 14:57:10 / Jan Vrany <jan.vrany@fit.cvut.cz>"
aebf22e17733 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   433
    "Modified: / 15-03-2010 / 20:17:52 / Jan Vrany <jan.vrany@fit.cvut.cz>"
aebf22e17733 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   434
!
aebf22e17733 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   435
aebf22e17733 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   436
runAllEnabledHolder
aebf22e17733 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   437
aebf22e17733 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   438
    ^true
aebf22e17733 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   439
aebf22e17733 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   440
    "Created: / 07-09-2010 / 09:15:10 / Jan Vrany <jan.vrany@fit.cvut.cz>"
aebf22e17733 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   441
!
aebf22e17733 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   442
aebf22e17733 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   443
runEnabledHolder
aebf22e17733 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   444
aebf22e17733 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   445
    ^BlockValue
aebf22e17733 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   446
        with:
aebf22e17733 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   447
            [:resultHolder | | result | 
aebf22e17733 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   448
            (result := resultHolder value) notNil and:[result testCount > 0 ]]
aebf22e17733 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   449
        argument: self resultHolder
aebf22e17733 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   450
aebf22e17733 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   451
    "Created: / 07-09-2010 / 09:15:16 / Jan Vrany <jan.vrany@fit.cvut.cz>"
aebf22e17733 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   452
!
aebf22e17733 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   453
aebf22e17733 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   454
runningHolder
aebf22e17733 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   455
    "return/create the 'runningHolder' value holder (automatically generated)"
aebf22e17733 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   456
aebf22e17733 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   457
    runningHolder isNil ifTrue:[
aebf22e17733 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   458
        runningHolder := ValueHolder with: false.
aebf22e17733 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   459
    ].
aebf22e17733 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   460
    ^ runningHolder
aebf22e17733 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   461
aebf22e17733 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   462
    "Modified: / 15-03-2010 / 20:29:28 / Jan Vrany <jan.vrany@fit.cvut.cz>"
aebf22e17733 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   463
!
aebf22e17733 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   464
aebf22e17733 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   465
selectedClassesHolder
aebf22e17733 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   466
    "return/create the 'selectedClassesHolder' value holder (automatically generated)"
aebf22e17733 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   467
aebf22e17733 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   468
    selectedClassesHolder isNil ifTrue:[
aebf22e17733 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   469
        selectedClassesHolder := ValueHolder new.
aebf22e17733 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   470
        selectedClassesHolder addDependent:self.
aebf22e17733 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   471
    ].
aebf22e17733 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   472
    ^ selectedClassesHolder
aebf22e17733 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   473
!
aebf22e17733 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   474
aebf22e17733 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   475
selectedClassesHolder:something
aebf22e17733 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   476
    "set the 'selectedClassesHolder' value holder (automatically generated)"
aebf22e17733 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   477
aebf22e17733 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   478
    |oldValue newValue|
aebf22e17733 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   479
aebf22e17733 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   480
    selectedClassesHolder notNil ifTrue:[
aebf22e17733 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   481
        oldValue := selectedClassesHolder value.
aebf22e17733 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   482
        selectedClassesHolder removeDependent:self.
aebf22e17733 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   483
    ].
aebf22e17733 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   484
    selectedClassesHolder := something.
aebf22e17733 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   485
    selectedClassesHolder notNil ifTrue:[
aebf22e17733 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   486
        selectedClassesHolder addDependent:self.
aebf22e17733 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   487
    ].
aebf22e17733 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   488
    newValue := selectedClassesHolder value.
aebf22e17733 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   489
    oldValue ~~ newValue ifTrue:[
aebf22e17733 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   490
        self update:#value with:newValue from:selectedClassesHolder.
aebf22e17733 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   491
    ].
aebf22e17733 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   492
!
aebf22e17733 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   493
aebf22e17733 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   494
selectedMethodsHolder
aebf22e17733 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   495
    "return/create the 'selectedMethodsHolder' value holder (automatically generated)"
aebf22e17733 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   496
aebf22e17733 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   497
    selectedMethodsHolder isNil ifTrue:[
aebf22e17733 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   498
        selectedMethodsHolder := ValueHolder new.
aebf22e17733 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   499
        selectedMethodsHolder addDependent:self.
aebf22e17733 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   500
    ].
aebf22e17733 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   501
    ^ selectedMethodsHolder
aebf22e17733 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   502
!
aebf22e17733 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   503
aebf22e17733 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   504
selectedMethodsHolder:something
aebf22e17733 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   505
    "set the 'selectedMethodsHolder' value holder (automatically generated)"
aebf22e17733 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   506
aebf22e17733 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   507
    |oldValue newValue|
aebf22e17733 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   508
aebf22e17733 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   509
    selectedMethodsHolder notNil ifTrue:[
aebf22e17733 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   510
        oldValue := selectedMethodsHolder value.
aebf22e17733 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   511
        selectedMethodsHolder removeDependent:self.
aebf22e17733 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   512
    ].
aebf22e17733 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   513
    selectedMethodsHolder := something.
aebf22e17733 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   514
    selectedMethodsHolder notNil ifTrue:[
aebf22e17733 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   515
        selectedMethodsHolder addDependent:self.
aebf22e17733 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   516
    ].
aebf22e17733 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   517
    newValue := selectedMethodsHolder value.
aebf22e17733 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   518
    oldValue ~~ newValue ifTrue:[
aebf22e17733 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   519
        self update:#value with:newValue from:selectedMethodsHolder.
aebf22e17733 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   520
    ].
aebf22e17733 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   521
!
aebf22e17733 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   522
aebf22e17733 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   523
selectedProtocolsHolder
aebf22e17733 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   524
    "return/create the 'selectedProtocolsHolder' value holder (automatically generated)"
aebf22e17733 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   525
aebf22e17733 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   526
    selectedProtocolsHolder isNil ifTrue:[
aebf22e17733 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   527
        selectedProtocolsHolder := ValueHolder new.
aebf22e17733 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   528
        selectedProtocolsHolder addDependent:self.
aebf22e17733 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   529
    ].
aebf22e17733 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   530
    ^ selectedProtocolsHolder
aebf22e17733 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   531
!
aebf22e17733 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   532
aebf22e17733 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   533
selectedProtocolsHolder:something
aebf22e17733 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   534
    "set the 'selectedProtocolsHolder' value holder (automatically generated)"
aebf22e17733 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   535
aebf22e17733 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   536
    |oldValue newValue|
aebf22e17733 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   537
aebf22e17733 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   538
    selectedProtocolsHolder notNil ifTrue:[
aebf22e17733 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   539
        oldValue := selectedProtocolsHolder value.
aebf22e17733 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   540
        selectedProtocolsHolder removeDependent:self.
aebf22e17733 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   541
    ].
aebf22e17733 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   542
    selectedProtocolsHolder := something.
aebf22e17733 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   543
    selectedProtocolsHolder notNil ifTrue:[
aebf22e17733 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   544
        selectedProtocolsHolder addDependent:self.
aebf22e17733 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   545
    ].
aebf22e17733 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   546
    newValue := selectedProtocolsHolder value.
aebf22e17733 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   547
    oldValue ~~ newValue ifTrue:[
aebf22e17733 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   548
        self update:#value with:newValue from:selectedProtocolsHolder.
aebf22e17733 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   549
    ].
aebf22e17733 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   550
! !
aebf22e17733 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   551
aebf22e17733 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   552
!TestRunnerEmbedded methodsFor:'change & update'!
aebf22e17733 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   553
aebf22e17733 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   554
update:aspect with:param from: sender
aebf22e17733 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   555
    "Invoked when an object that I depend upon sends a change notification."
aebf22e17733 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   556
aebf22e17733 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   557
    sender == selectedClassesHolder ifTrue:[
aebf22e17733 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   558
        self 
aebf22e17733 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   559
            updateTestCases;
aebf22e17733 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   560
            updateTestSuiteAndResult;
aebf22e17733 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   561
            updateVisibility.
aebf22e17733 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   562
         ^ self.
aebf22e17733 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   563
    ].
aebf22e17733 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   564
    sender == selectedProtocolsHolder ifTrue:[
aebf22e17733 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   565
        self updateTestSuiteAndResult.
aebf22e17733 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   566
        ^self
aebf22e17733 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   567
    ].
aebf22e17733 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   568
aebf22e17733 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   569
    sender == selectedMethodsHolder ifTrue:[
aebf22e17733 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   570
        self updateTestSuiteAndResult.
aebf22e17733 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   571
        ^self
aebf22e17733 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   572
    ].
aebf22e17733 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   573
    sender == methodGeneratorHolder ifTrue:[
aebf22e17733 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   574
        self updateTestSuiteAndResult.
aebf22e17733 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   575
        ^self
aebf22e17733 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   576
    ].
aebf22e17733 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   577
aebf22e17733 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   578
aebf22e17733 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   579
aebf22e17733 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   580
    super update:aspect with:param from: sender
aebf22e17733 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   581
aebf22e17733 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   582
    "Modified: / 07-09-2010 / 08:18:11 / Jan Vrany <jan.vrany@fit.cvut.cz>"
aebf22e17733 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   583
!
aebf22e17733 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   584
aebf22e17733 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   585
updateTestCases
aebf22e17733 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   586
    selectedTestCases := (self selectedClassesHolder value 
aebf22e17733 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   587
                select:[:cls | self isTestCaseLike:cls ]).
aebf22e17733 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   588
    selectedTestCases := selectedTestCases isEmpty 
aebf22e17733 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   589
                ifTrue:[ nil ]
aebf22e17733 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   590
                ifFalse:[ selectedTestCases asArray ]
aebf22e17733 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   591
aebf22e17733 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   592
    "Created: / 11-03-2010 / 10:31:45 / Jan Vrany <jan.vrany@fit.cvut.cz>"
aebf22e17733 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   593
    "Modified: / 15-03-2010 / 20:53:20 / Jan Vrany <jan.vrany@fit.cvut.cz>"
aebf22e17733 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   594
!
aebf22e17733 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   595
aebf22e17733 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   596
updateTestSuiteAndResult
aebf22e17733 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   597
aebf22e17733 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   598
    | suite suiteAndResult |
aebf22e17733 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   599
    self runningHolder value ifTrue:[^self].
aebf22e17733 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   600
    selectedTestCases ifNil:[^self].
aebf22e17733 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   601
    suiteAndResult := SuiteAndResult
aebf22e17733 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   602
                        suite:  (suite := self suiteForRun)
aebf22e17733 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   603
                        result: (self resultForSuite: suite).
aebf22e17733 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   604
    self resultHolder value: suiteAndResult.
aebf22e17733 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   605
aebf22e17733 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   606
    "Created: / 15-03-2010 / 19:41:27 / Jan Vrany <jan.vrany@fit.cvut.cz>"
aebf22e17733 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   607
    "Modified: / 15-03-2010 / 20:55:32 / Jan Vrany <jan.vrany@fit.cvut.cz>"
aebf22e17733 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   608
!
aebf22e17733 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   609
aebf22e17733 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   610
updateVisibility
aebf22e17733 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   611
aebf22e17733 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   612
    self hasTestCaseSelected 
aebf22e17733 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   613
        ifTrue:[self show]
aebf22e17733 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   614
        ifFalse:[self hide]
aebf22e17733 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   615
aebf22e17733 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   616
    "Created: / 11-03-2010 / 09:02:40 / Jan Vrany <jan.vrany@fit.cvut.cz>"
aebf22e17733 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   617
! !
aebf22e17733 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   618
aebf22e17733 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   619
!TestRunnerEmbedded methodsFor:'hooks'!
aebf22e17733 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   620
aebf22e17733 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   621
postBuildRunnerPanel: aView
aebf22e17733 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   622
aebf22e17733 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   623
    runnerPanel := aView.
aebf22e17733 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   624
    runnerPanel backgroundColor: self resultBackgroundColorAspect value
aebf22e17733 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   625
aebf22e17733 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   626
    "Created: / 15-03-2010 / 14:26:15 / Jan Vrany <jan.vrany@fit.cvut.cz>"
aebf22e17733 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   627
! !
aebf22e17733 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   628
aebf22e17733 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   629
!TestRunnerEmbedded methodsFor:'private'!
aebf22e17733 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   630
aebf22e17733 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   631
hide
aebf22e17733 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   632
aebf22e17733 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   633
    self visibility: false height: 0
aebf22e17733 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   634
aebf22e17733 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   635
    "Created: / 11-03-2010 / 09:07:24 / Jan Vrany <jan.vrany@fit.cvut.cz>"
aebf22e17733 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   636
!
aebf22e17733 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   637
aebf22e17733 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   638
isTestCaseLike:cls 
aebf22e17733 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   639
aebf22e17733 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   640
    ^(super isTestCaseLike: cls) and:
aebf22e17733 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   641
        [(cls askFor: #isAbstract) not]
aebf22e17733 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   642
aebf22e17733 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   643
    "Modified: / 04-03-2011 / 06:54:13 / Jan Vrany <jan.vrany@fit.cvut.cz>"
aebf22e17733 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   644
!
aebf22e17733 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   645
aebf22e17733 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   646
show
aebf22e17733 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   647
aebf22e17733 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   648
    self visibility: true height: 50
aebf22e17733 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   649
aebf22e17733 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   650
    "Created: / 11-03-2010 / 09:07:24 / Jan Vrany <jan.vrany@fit.cvut.cz>"
aebf22e17733 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   651
!
aebf22e17733 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   652
aebf22e17733 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   653
visibility: visibility height: height
aebf22e17733 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   654
    | container list h |
aebf22e17733 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   655
    (container := self window container) ifNil:[^self].
aebf22e17733 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   656
    h := visibility ifFalse:[0] ifTrue:[height].
aebf22e17733 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   657
aebf22e17733 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   658
    container isVisible == visibility ifFalse:
aebf22e17733 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   659
        [container isVisible: visibility].
aebf22e17733 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   660
aebf22e17733 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   661
aebf22e17733 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   662
    list := container container subViews first.
aebf22e17733 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   663
aebf22e17733 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   664
    (list layout bottomOffset ~= height negated) ifTrue:
aebf22e17733 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   665
        [list layout:
aebf22e17733 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   666
            (list layout bottomOffset: height negated; yourself)].
aebf22e17733 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   667
aebf22e17733 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   668
    "Created: / 11-03-2010 / 09:51:26 / Jan Vrany <jan.vrany@fit.cvut.cz>"
aebf22e17733 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   669
! !
aebf22e17733 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   670
aebf22e17733 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   671
!TestRunnerEmbedded methodsFor:'queries'!
aebf22e17733 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   672
aebf22e17733 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   673
hasTestCaseSelected
aebf22e17733 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   674
aebf22e17733 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   675
    ^selectedTestCases isNilOrEmptyCollection not
aebf22e17733 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   676
aebf22e17733 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   677
    "Created: / 11-03-2010 / 09:06:01 / Jan Vrany <jan.vrany@fit.cvut.cz>"
aebf22e17733 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   678
    "Modified: / 15-03-2010 / 20:54:52 / Jan Vrany <jan.vrany@fit.cvut.cz>"
aebf22e17733 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   679
! !
aebf22e17733 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   680
aebf22e17733 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   681
!TestRunnerEmbedded methodsFor:'utilities'!
aebf22e17733 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   682
aebf22e17733 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   683
resultForSuite: suite
aebf22e17733 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   684
aebf22e17733 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   685
    | result |
aebf22e17733 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   686
    result := TestResult new.
aebf22e17733 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   687
    suite tests do:
aebf22e17733 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   688
        [:test|
aebf22e17733 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   689
        (test class testSelectorPassed: test selector)
aebf22e17733 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   690
            ifTrue:
aebf22e17733 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   691
                [result passed add: test]
aebf22e17733 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   692
            ifFalse:
aebf22e17733 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   693
                [(test class testSelectorError: test selector)
aebf22e17733 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   694
                    ifTrue:
aebf22e17733 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   695
                        [result errors add: test]
aebf22e17733 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   696
                    ifFalse:
aebf22e17733 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   697
                        [(test class testSelectorFailed: test selector)
aebf22e17733 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   698
                            ifTrue:
aebf22e17733 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   699
                                [result failures add: test]]]].
aebf22e17733 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   700
    ^result
aebf22e17733 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   701
aebf22e17733 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   702
    "Created: / 15-03-2010 / 19:46:26 / Jan Vrany <jan.vrany@fit.cvut.cz>"
aebf22e17733 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   703
!
aebf22e17733 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   704
aebf22e17733 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   705
suiteForRun
aebf22e17733 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   706
    | methods protocols suite |                                            
aebf22e17733 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   707
    (methods := selectedMethodsHolder value) isNilOrEmptyCollection ifFalse:
aebf22e17733 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   708
        [suite := TestSuite named: (self suiteNameFromMethods: methods).
aebf22e17733 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   709
        self selectedTestMethods do:
aebf22e17733 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   710
            [:mthd| | selector |
aebf22e17733 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   711
            suite addTest: (mthd mclass asTestCase selector: mthd selector)].
aebf22e17733 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   712
        ^suite].
aebf22e17733 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   713
    
aebf22e17733 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   714
    (protocols := selectedProtocolsHolder value) isNilOrEmptyCollection ifFalse:
aebf22e17733 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   715
        [suite := TestSuite named: (self suiteNameFromProtocols: protocols).
aebf22e17733 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   716
        (self selectedTestMethodsFromProtocols: protocols) do:
aebf22e17733 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   717
            [:mthd| | selector |
aebf22e17733 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   718
            suite addTest: (mthd mclass asTestCase selector: mthd selector)].
aebf22e17733 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   719
        ^suite].
aebf22e17733 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   720
    ^self suiteForRunAll
aebf22e17733 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   721
aebf22e17733 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   722
    "Created: / 15-03-2010 / 13:13:18 / Jan Vrany <jan.vrany@fit.cvut.cz>"
aebf22e17733 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   723
    "Modified: / 04-03-2011 / 08:24:17 / Jan Vrany <jan.vrany@fit.cvut.cz>"
aebf22e17733 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   724
!
aebf22e17733 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   725
aebf22e17733 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   726
suiteForRunAll
aebf22e17733 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   727
    |suite|
aebf22e17733 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   728
    suite := TestSuite named:(self suiteNameFromClasses: selectedTestCases).
aebf22e17733 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   729
    selectedTestCases 
aebf22e17733 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   730
        do:[:testCase | suite addTests:(self buildSuiteFromClass:testCase) tests].
aebf22e17733 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   731
    ^suite
aebf22e17733 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   732
aebf22e17733 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   733
    "Modified: / 04-03-2011 / 06:57:09 / Jan Vrany <jan.vrany@fit.cvut.cz>"
aebf22e17733 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   734
! !
aebf22e17733 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   735
aebf22e17733 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   736
!TestRunnerEmbedded::SuiteAndResult class methodsFor:'instance creation'!
aebf22e17733 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   737
aebf22e17733 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   738
suite: suite result: result
aebf22e17733 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   739
aebf22e17733 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   740
    ^self new
aebf22e17733 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   741
        suite: suite;
aebf22e17733 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   742
        result: result.
aebf22e17733 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   743
aebf22e17733 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   744
    "Modified: / 15-03-2010 / 15:27:06 / Jan Vrany <jan.vrany@fit.cvut.cz>"
aebf22e17733 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   745
! !
aebf22e17733 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   746
aebf22e17733 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   747
!TestRunnerEmbedded::SuiteAndResult methodsFor:'accessing'!
aebf22e17733 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   748
aebf22e17733 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   749
color
aebf22e17733 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   750
aebf22e17733 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   751
    self testCount == 0 ifTrue:
aebf22e17733 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   752
        [^TestRunnerEmbedded notRunColor].
aebf22e17733 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   753
aebf22e17733 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   754
    result ifNil:[^TestRunnerEmbedded notRunColor].
aebf22e17733 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   755
    self hasErrors ifTrue:[^TestRunnerEmbedded errorColor].
aebf22e17733 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   756
    self hasFailures ifTrue:[^TestRunnerEmbedded failedColor].
aebf22e17733 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   757
    self hasPassed ifTrue:[^TestRunnerEmbedded passedColor].
aebf22e17733 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   758
    ^TestRunnerEmbedded notRunColor
aebf22e17733 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   759
aebf22e17733 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   760
    "Created: / 15-03-2010 / 15:24:35 / Jan Vrany <jan.vrany@fit.cvut.cz>"
aebf22e17733 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   761
    "Modified: / 07-09-2010 / 08:25:08 / Jan Vrany <jan.vrany@fit.cvut.cz>"
aebf22e17733 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   762
!
aebf22e17733 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   763
aebf22e17733 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   764
info
aebf22e17733 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   765
aebf22e17733 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   766
    result ifNil:[^''].
aebf22e17733 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   767
    (result passedCount + result failureCount + result errorCount) = 1 ifTrue:[^''].
aebf22e17733 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   768
    ^'%1 tests, %2 passed, %3 failed, %4 errors'
aebf22e17733 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   769
        bindWith: suite tests size
aebf22e17733 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   770
            with: result passedCount        
aebf22e17733 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   771
            with: result failureCount 
aebf22e17733 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   772
            with: result errorCount
aebf22e17733 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   773
aebf22e17733 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   774
    "Created: / 15-03-2010 / 20:23:34 / Jan Vrany <jan.vrany@fit.cvut.cz>"
aebf22e17733 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   775
!
aebf22e17733 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   776
aebf22e17733 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   777
name
aebf22e17733 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   778
aebf22e17733 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   779
    ^suite name
aebf22e17733 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   780
aebf22e17733 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   781
    "Created: / 15-03-2010 / 15:12:17 / Jan Vrany <jan.vrany@fit.cvut.cz>"
aebf22e17733 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   782
!
aebf22e17733 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   783
aebf22e17733 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   784
result
aebf22e17733 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   785
    ^ result
aebf22e17733 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   786
!
aebf22e17733 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   787
aebf22e17733 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   788
result:aTestResult
aebf22e17733 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   789
    result := aTestResult.
aebf22e17733 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   790
!
aebf22e17733 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   791
aebf22e17733 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   792
suite
aebf22e17733 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   793
    ^ suite
aebf22e17733 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   794
!
aebf22e17733 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   795
aebf22e17733 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   796
suite:aTestSuite
aebf22e17733 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   797
    suite := aTestSuite.
aebf22e17733 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   798
!
aebf22e17733 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   799
aebf22e17733 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   800
testCount
aebf22e17733 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   801
aebf22e17733 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   802
    ^suite tests size
aebf22e17733 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   803
aebf22e17733 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   804
    "Created: / 15-03-2010 / 15:44:58 / Jan Vrany <jan.vrany@fit.cvut.cz>"
aebf22e17733 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   805
! !
aebf22e17733 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   806
aebf22e17733 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   807
!TestRunnerEmbedded::SuiteAndResult methodsFor:'queries'!
aebf22e17733 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   808
aebf22e17733 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   809
hasErrors
aebf22e17733 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   810
aebf22e17733 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   811
    ^result errorCount > 0
aebf22e17733 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   812
aebf22e17733 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   813
    "Created: / 15-03-2010 / 15:21:12 / Jan Vrany <jan.vrany@fit.cvut.cz>"
aebf22e17733 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   814
!
aebf22e17733 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   815
aebf22e17733 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   816
hasFailures
aebf22e17733 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   817
aebf22e17733 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   818
    ^result failureCount > 0
aebf22e17733 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   819
aebf22e17733 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   820
    "Created: / 15-03-2010 / 15:21:25 / Jan Vrany <jan.vrany@fit.cvut.cz>"
aebf22e17733 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   821
!
aebf22e17733 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   822
aebf22e17733 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   823
hasFailuresOrErrors
aebf22e17733 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   824
aebf22e17733 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   825
    ^self hasErrors or:[self hasFailures]
aebf22e17733 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   826
aebf22e17733 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   827
    "Created: / 15-03-2010 / 15:45:36 / Jan Vrany <jan.vrany@fit.cvut.cz>"
aebf22e17733 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   828
!
aebf22e17733 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   829
aebf22e17733 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   830
hasPassed
aebf22e17733 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   831
aebf22e17733 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   832
    ^result passedCount > 0
aebf22e17733 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   833
aebf22e17733 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   834
    "Created: / 15-03-2010 / 22:06:26 / Jan Vrany <jan.vrany@fit.cvut.cz>"
aebf22e17733 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   835
! !
aebf22e17733 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   836
aebf22e17733 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   837
!TestRunnerEmbedded class methodsFor:'documentation'!
aebf22e17733 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   838
aebf22e17733 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   839
version_CVS
9956
Claus Gittinger <cg@exept.de>
parents: 9954
diff changeset
   840
    ^ '$Header: /cvs/stx/stx/libtool/Tools__TestRunnerEmbedded.st,v 1.2 2011-06-30 19:53:48 cg Exp $'
9954
aebf22e17733 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   841
!
aebf22e17733 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   842
aebf22e17733 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   843
version_SVN
aebf22e17733 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   844
    ^ '§Id: Tools__TestRunnerEmbedded.st 7681 2011-03-04 11:30:02Z vranyj1 §'
aebf22e17733 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   845
! !