93 initialize |
93 initialize |
94 "/ Verbose := true. |
94 "/ Verbose := true. |
95 Verbose := false. |
95 Verbose := false. |
96 ! ! |
96 ! ! |
97 |
97 |
|
98 !StandaloneStartup class methodsFor:'debugging support'! |
|
99 |
|
100 dumpCoverageInformation |
|
101 "if the --coverage argument was given, dump that information now. |
|
102 This is invoked via an exit block, when smalltalk terminates" |
|
103 |
|
104 Stderr nextPutLine:'coverage info...'. |
|
105 |
|
106 "Created: / 24-05-2011 / 17:08:46 / cg" |
|
107 ! |
|
108 |
|
109 handleCoverageMeasurementOptionsFromArguments:argv |
|
110 "handle the coverage measurement command line argument: |
|
111 --coverage |
|
112 [+/-]package: <package-pattern> ... do / do not measure in package (regex match) |
|
113 [+/-]class: <class-pattern> ... do / do not measure in class (regex match, including nameSpace) |
|
114 [+/-]method: <className>#<methodName> ... do / do not measure in method |
|
115 |
|
116 adds instrumentation code to all selected methods. |
|
117 " |
|
118 |
|
119 |idx nextArg done doAdd addNames addMethodNames |
|
120 anyItem anyMethodInstrumented checkClass checkMethod coverageAction |
|
121 includedPackageNames excludedPackageNames |
|
122 includedClassNames excludedClassNames |
|
123 includedMethodNames excludedMethodNames| |
|
124 |
|
125 " |
|
126 self handleCoverageMeasurementOptionsFromArguments:#('foo' '--coverage' '--foo' '+package:' 'expeccoNET:*') |
|
127 self handleCoverageMeasurementOptionsFromArguments:#('foo' '--coverage' '+package:' 'stx:*') |
|
128 self handleCoverageMeasurementOptionsFromArguments:#('foo' '--coverage' '+package:' 'stx:libtool*') |
|
129 self handleCoverageMeasurementOptionsFromArguments:#('foo' '--coverage' '+class:' 'Tools::*' '-class:' 'Tools::StringSearchTool' ) |
|
130 self handleCoverageMeasurementOptionsFromArguments:#('foo' '--coverage' '+class:' 'Tools::*Browser*' ) |
|
131 self handleCoverageMeasurementOptionsFromArguments:#('foo' '--coverage' '+method:' 'String#at:put:' 'String#at:') |
|
132 " |
|
133 includedPackageNames := Set new. |
|
134 excludedPackageNames := Set new. |
|
135 includedClassNames := Set new. |
|
136 excludedClassNames := Set new. |
|
137 includedMethodNames := Dictionary new. |
|
138 excludedMethodNames := Dictionary new. |
|
139 |
|
140 (self allowCoverageMeasurementOption) ifFalse:[^ self]. |
|
141 idx := argv indexOfAny:#('--coverage'). |
|
142 idx == 0 ifTrue:[^ self ]. |
|
143 |
|
144 addNames := [:collection | |
|
145 [ |
|
146 nextArg := argv at:idx ifAbsent:nil. |
|
147 nextArg notNil |
|
148 and:[ ((nextArg startsWith:'+') or:[(nextArg startsWith:'-')]) not |
|
149 and:[ (nextArg endsWith:':') not ]] |
|
150 ] whileTrue:[ |
|
151 collection add:nextArg. |
|
152 anyItem := true. |
|
153 idx := idx + 1. |
|
154 ]. |
|
155 ]. |
|
156 |
|
157 addMethodNames := [:collection | |
|
158 |idx2 className selector| |
|
159 |
|
160 [ |
|
161 nextArg := argv at:idx ifAbsent:nil. |
|
162 nextArg notNil |
|
163 and:[ ((nextArg startsWith:'+') or:[(nextArg startsWith:'-')]) not] |
|
164 ] whileTrue:[ |
|
165 idx2 := nextArg indexOf:$#. |
|
166 className := nextArg copyTo:idx2-1. |
|
167 selector := nextArg copyFrom:idx2+1. |
|
168 (collection at:className ifAbsentPut:[Set new]) add:selector. |
|
169 anyItem := true. |
|
170 idx := idx + 1. |
|
171 ]. |
|
172 ]. |
|
173 |
|
174 idx := idx + 1. |
|
175 done := false. |
|
176 |
|
177 [ |
|
178 nextArg := argv at:idx ifAbsent:nil. |
|
179 done not |
|
180 and:[ nextArg notNil |
|
181 and:[ ((nextArg startsWith:'+') or:[(nextArg startsWith:'-')]) ]] |
|
182 ] whileTrue:[ |
|
183 idx := idx + 1. |
|
184 doAdd := nextArg first == $+. |
|
185 nextArg := nextArg copyFrom:2. |
|
186 nextArg = 'package:' ifTrue:[ |
|
187 addNames value:(doAdd ifTrue:includedPackageNames ifFalse:excludedPackageNames). |
|
188 ] ifFalse:[ |
|
189 nextArg = 'class:' ifTrue:[ |
|
190 addNames value:(doAdd ifTrue:includedClassNames ifFalse:excludedClassNames). |
|
191 ] ifFalse:[ |
|
192 nextArg = 'method:' ifTrue:[ |
|
193 addMethodNames value:(doAdd ifTrue:includedMethodNames ifFalse:excludedMethodNames). |
|
194 ] ifFalse:[ |
|
195 done := true |
|
196 ] |
|
197 ]. |
|
198 ]. |
|
199 ]. |
|
200 |
|
201 anyItem ifFalse:[ ^ self ]. |
|
202 anyMethodInstrumented := false. |
|
203 |
|
204 coverageAction := [:aMethod | |
|
205 ((aMethod sends:#subclassResponsibility) not |
|
206 and:[ aMethod hasPrimitiveCode not ]) ifTrue:[ |
|
207 Transcript show:'instrumenting '; showCR:aMethod. |
|
208 aMethod mclass recompile:aMethod selector usingCompilerClass:InstrumentingCompiler. |
|
209 anyMethodInstrumented := true. |
|
210 ] ifFalse:[ |
|
211 Transcript show:'skipped '; showCR:aMethod. |
|
212 ]. |
|
213 ]. |
|
214 |
|
215 checkMethod := [:someMethod | |
|
216 ((excludedMethodNames at:someMethod mclass name ifAbsent:#()) includes:someMethod selector) ifFalse:[ |
|
217 coverageAction value:someMethod |
|
218 ]. |
|
219 ]. |
|
220 |
|
221 checkClass := [:someClass | |
|
222 someClass instAndClassSelectorsAndMethodsDo:[:sel :mthd | |
|
223 checkMethod value:mthd |
|
224 ] |
|
225 ]. |
|
226 |
|
227 Smalltalk allClassesDo:[:eachClass | |
|
228 (includedPackageNames contains:[:somePackagePattern| somePackagePattern match:(eachClass package)]) ifTrue:[ |
|
229 (excludedPackageNames contains:[:somePackagePattern| somePackagePattern match:(eachClass package)]) ifFalse:[ |
|
230 (excludedClassNames contains:[:someClassPattern| someClassPattern match:(eachClass name)]) ifFalse:[ |
|
231 checkClass value:eachClass |
|
232 ] |
|
233 ] |
|
234 ] ifFalse:[ |
|
235 (includedClassNames contains:[:someClassPattern| someClassPattern match:(eachClass name)]) ifTrue:[ |
|
236 (excludedClassNames contains:[:someClassPattern| someClassPattern match:(eachClass name)]) ifFalse:[ |
|
237 checkClass value:eachClass |
|
238 ] |
|
239 ] ifFalse:[ |
|
240 (Array with:eachClass theMetaclass with:eachClass) do:[:clsOrMeta | |
|
241 |selectors| |
|
242 |
|
243 selectors := includedMethodNames at:clsOrMeta name ifAbsent:nil. |
|
244 selectors notEmptyOrNil ifTrue:[ |
|
245 selectors do:[:eachSelector | |
|
246 coverageAction value:(clsOrMeta compiledMethodAt:eachSelector asSymbol). |
|
247 ]. |
|
248 ]. |
|
249 ]. |
|
250 ]. |
|
251 ]. |
|
252 ]. |
|
253 |
|
254 anyMethodInstrumented ifTrue:[ |
|
255 Smalltalk addExitBlock:[ self dumpCoverageInformation ]. |
|
256 ]. |
|
257 |
|
258 "Created: / 24-05-2011 / 16:30:54 / cg" |
|
259 ! ! |
|
260 |
98 !StandaloneStartup class methodsFor:'defaults'! |
261 !StandaloneStartup class methodsFor:'defaults'! |
|
262 |
|
263 allowCoverageMeasurementOption |
|
264 "enable/disable the --measureCoverage startup options. |
|
265 The default is false, so standAlone apps do not support coverage measurements by default. |
|
266 Can be redefined in subclasses to enable it |
|
267 (but will need the libcomp and possibly the programming/oom packages to be present)" |
|
268 |
|
269 "/ ^ true. |
|
270 ^ false |
|
271 |
|
272 "Created: / 24-05-2011 / 16:16:15 / cg" |
|
273 "Modified: / 24-05-2011 / 17:25:00 / cg" |
|
274 ! |
99 |
275 |
100 allowDebugOption |
276 allowDebugOption |
101 "enable/disable the --debug startup option. |
277 "enable/disable the --debug startup option. |
102 The default is now false, so standAlone apps are closed by default. |
278 The default is now false, so standAlone apps are closed by default. |
103 Can be redefined in subclasses to enable it" |
279 Can be redefined in subclasses to enable it" |
448 "Created: / 19-09-2006 / 16:38:28 / cg" |
624 "Created: / 19-09-2006 / 16:38:28 / cg" |
449 ! ! |
625 ! ! |
450 |
626 |
451 !StandaloneStartup class methodsFor:'startup'! |
627 !StandaloneStartup class methodsFor:'startup'! |
452 |
628 |
|
629 handleRCFileOptionsFromArguments:argv |
|
630 "handle rc-file command line arguments: |
|
631 --rcFileName ......... define a startup rc-file |
|
632 " |
|
633 |
|
634 |idx nextArg rcFilename| |
|
635 |
|
636 idx := argv indexOf:'--rcFileName'. |
|
637 idx ~~ 0 ifTrue:[ |
|
638 nextArg := argv at:(idx + 1) ifAbsent:nil. |
|
639 (nextArg notNil and:[ (nextArg startsWith:'-') not ]) ifTrue:[ |
|
640 rcFilename := nextArg. |
|
641 argv removeAtIndex:idx+1; removeAtIndex:idx. |
|
642 ] |
|
643 ]. |
|
644 |
|
645 rcFilename isNil ifTrue:[ |
|
646 rcFilename := self startupFilename. |
|
647 ]. |
|
648 rcFilename asFilename exists ifTrue:[ |
|
649 self verboseInfo:('reading ',rcFilename,'...'). |
|
650 rcFilename isAbsolute ifFalse:[ |
|
651 rcFilename := OperatingSystem pathOfSTXExecutable asFilename directory constructString:rcFilename. |
|
652 ]. |
|
653 Smalltalk secureFileIn:rcFilename |
|
654 ]. |
|
655 |
|
656 "Created: / 24-05-2011 / 16:13:34 / cg" |
|
657 ! |
|
658 |
|
659 handleScriptingOptionsFromArguments:argv |
|
660 "handle scripting command line argument: |
|
661 --scripting portNr ... start a scripting server |
|
662 --allowHost host ..... add host to the allowed scripting hosts |
|
663 " |
|
664 |
|
665 |scripting idx nextArg portNr allowedScriptingHosts| |
|
666 |
|
667 scripting := false. |
|
668 (self allowScriptingOption) ifTrue:[ |
|
669 idx := argv indexOfAny:#('--scripting'). |
|
670 idx ~~ 0 ifTrue:[ |
|
671 nextArg := argv at:(idx + 1) ifAbsent:nil. |
|
672 (nextArg notNil and:[ (nextArg startsWith:'-') not ]) ifTrue:[ |
|
673 portNr := nextArg asInteger. |
|
674 argv removeAtIndex:idx+1. |
|
675 ]. |
|
676 argv removeAtIndex:idx. |
|
677 |
|
678 scripting := true |
|
679 ]. |
|
680 |
|
681 allowedScriptingHosts := OrderedCollection new. |
|
682 |
|
683 idx := argv indexOfAny:#('--allowHost'). |
|
684 [idx ~~ 0] whileTrue:[ |
|
685 nextArg := argv at:(idx + 1) ifAbsent:nil. |
|
686 nextArg isNil ifTrue:[ |
|
687 self usage. |
|
688 AbortOperationRequest raise. |
|
689 ]. |
|
690 allowedScriptingHosts add:nextArg. |
|
691 idx := argv indexOfAny:#('--allowHost'). |
|
692 ]. |
|
693 ]. |
|
694 |
|
695 scripting ifTrue:[ |
|
696 self verboseInfo:('scripting on'). |
|
697 STXScriptingServer notNil ifTrue:[ |
|
698 allowedScriptingHosts do:[:eachHost | STXScriptingServer allowHost:eachHost ]. |
|
699 |
|
700 "/ scripting on port/stdin_out/8008 |
|
701 self verboseInfo:('start scripting'). |
|
702 STXScriptingServer startAt:portNr |
|
703 ] ifFalse:[ |
|
704 self verboseInfo:('missing STXScriptingServer class'). |
|
705 ]. |
|
706 ]. |
|
707 |
|
708 "Created: / 24-05-2011 / 16:12:02 / cg" |
|
709 ! |
|
710 |
453 loadPatch:fileName |
711 loadPatch:fileName |
454 self verboseInfo:('loading patch: ',fileName baseName). |
712 self verboseInfo:('loading patch: ',fileName baseName). |
455 Smalltalk silentFileIn:fileName pathName. |
713 Smalltalk silentFileIn:fileName pathName. |
456 ! |
714 ! |
457 |
715 |
560 self setupToolsForDebug. |
818 self setupToolsForDebug. |
561 ] ifFalse:[ |
819 ] ifFalse:[ |
562 self setupToolsForNoDebug. |
820 self setupToolsForNoDebug. |
563 ]. |
821 ]. |
564 |
822 |
565 self suppressRCFileReading ifFalse:[ |
823 (self suppressRCFileReading) ifFalse:[ |
566 idx := argv indexOf:'--rcFileName'. |
824 self handleRCFileOptionsFromArguments:argv. |
567 idx ~~ 0 ifTrue:[ |
825 ]. |
568 nextArg := argv at:(idx + 1) ifAbsent:nil. |
|
569 (nextArg notNil and:[ (nextArg startsWith:'-') not ]) ifTrue:[ |
|
570 rcFilename := nextArg. |
|
571 argv removeAtIndex:idx+1; removeAtIndex:idx. |
|
572 ] |
|
573 ]. |
|
574 |
|
575 rcFilename isNil ifTrue:[ |
|
576 rcFilename := self startupFilename. |
|
577 ]. |
|
578 rcFilename asFilename exists ifTrue:[ |
|
579 self verboseInfo:('reading ',rcFilename,'...'). |
|
580 rcFilename isAbsolute ifFalse:[ |
|
581 rcFilename := OperatingSystem pathOfSTXExecutable asFilename directory constructString:rcFilename. |
|
582 ]. |
|
583 Smalltalk secureFileIn:rcFilename |
|
584 ]. |
|
585 ]. |
|
586 |
|
587 scripting := false. |
|
588 (self allowScriptingOption) ifTrue:[ |
826 (self allowScriptingOption) ifTrue:[ |
589 idx := argv indexOfAny:#('--scripting'). |
827 self handleScriptingOptionsFromArguments:argv. |
590 idx ~~ 0 ifTrue:[ |
828 ]. |
591 nextArg := argv at:(idx + 1) ifAbsent:nil. |
829 (self allowCoverageMeasurementOption) ifTrue:[ |
592 (nextArg notNil and:[ (nextArg startsWith:'-') not ]) ifTrue:[ |
830 self handleCoverageMeasurementOptionsFromArguments:argv. |
593 portNr := nextArg asInteger. |
|
594 argv removeAtIndex:idx+1. |
|
595 ]. |
|
596 argv removeAtIndex:idx. |
|
597 |
|
598 scripting := true |
|
599 ]. |
|
600 |
|
601 allowedScriptingHosts := OrderedCollection new. |
|
602 |
|
603 idx := argv indexOfAny:#('--allowHost'). |
|
604 [idx ~~ 0] whileTrue:[ |
|
605 nextArg := argv at:(idx + 1) ifAbsent:nil. |
|
606 nextArg isNil ifTrue:[ |
|
607 self usage. |
|
608 AbortOperationRequest raise. |
|
609 ]. |
|
610 allowedScriptingHosts add:nextArg. |
|
611 idx := argv indexOfAny:#('--allowHost'). |
|
612 ]. |
|
613 ]. |
|
614 |
|
615 scripting ifTrue:[ |
|
616 self verboseInfo:('scripting on'). |
|
617 STXScriptingServer notNil ifTrue:[ |
|
618 allowedScriptingHosts do:[:eachHost | STXScriptingServer allowHost:eachHost ]. |
|
619 |
|
620 "/ scripting on port/stdin_out/8008 |
|
621 self verboseInfo:('start scripting'). |
|
622 STXScriptingServer startAt:portNr |
|
623 ] ifFalse:[ |
|
624 self verboseInfo:('missing STXScriptingServer class'). |
|
625 ]. |
|
626 ]. |
831 ]. |
627 |
832 |
628 ^ true |
833 ^ true |
629 |
834 |
630 "Modified: / 15-11-2010 / 14:17:34 / cg" |
835 "Modified: / 24-05-2011 / 16:14:45 / cg" |
631 ! |
836 ! |
632 |
837 |
633 setupToolsForDebug |
838 setupToolsForDebug |
634 Debugger := DebugView ? MiniDebugger. |
839 Debugger := DebugView ? MiniDebugger. |
635 Inspector := InspectorView ? MiniInspector. |
840 Inspector := InspectorView ? MiniInspector. |
733 Stderr nextPutLine:' --scripting portNr ...... enable scripting via port (or stdin/stdOut, if 0)'. |
938 Stderr nextPutLine:' --scripting portNr ...... enable scripting via port (or stdin/stdOut, if 0)'. |
734 ]. |
939 ]. |
735 self allowDebugOption ifTrue:[ |
940 self allowDebugOption ifTrue:[ |
736 Stderr nextPutLine:' --debug ................. enable Debugger'. |
941 Stderr nextPutLine:' --debug ................. enable Debugger'. |
737 ]. |
942 ]. |
|
943 self allowCoverageMeasurementOption ifTrue:[ |
|
944 Stderr nextPutLine:' --coverage .............. turn on coverage measurement'. |
|
945 Stderr nextPutLine:' [+/-]package: pattern ... - include/exclude packages'. |
|
946 Stderr nextPutLine:' [+/-]class: pattern ... - include/exclude classes'. |
|
947 Stderr nextPutLine:' [+/-]method: cls#sel ... - include/exclude methods'. |
|
948 ]. |
738 self suppressRCFileReading ifFalse:[ |
949 self suppressRCFileReading ifFalse:[ |
739 Stderr nextPutLine:' --rcFileName file ....... execute code from file on startup (default: ',self startupFilename,')'. |
950 Stderr nextPutLine:' --rcFileName file ....... execute code from file on startup (default: ',self startupFilename,')'. |
740 ]. |
951 ]. |
741 |
952 |
742 "Created: / 19-09-2006 / 16:37:55 / cg" |
953 "Created: / 19-09-2006 / 16:37:55 / cg" |
743 "Modified: / 06-10-2010 / 09:52:18 / cg" |
954 "Modified: / 24-05-2011 / 17:23:18 / cg" |
744 ! ! |
955 ! ! |
745 |
956 |
746 !StandaloneStartup class methodsFor:'startup-to be redefined'! |
957 !StandaloneStartup class methodsFor:'startup-to be redefined'! |
747 |
958 |
748 additionalArgumentsFromRegistry |
959 additionalArgumentsFromRegistry |