First commit for a test runner in Helios

src/Helios-SUnit.js

@@ -2,7 +2,105 @@ define("amber_core/Helios-SUnit", ["amber_vm/smalltalk", "amber_vm/nil", "amber_
 smalltalk.addPackage('Helios-SUnit');
 smalltalk.packages["Helios-SUnit"].transport = {"type":"amd","amdNamespace":"amber_core"};
 
-smalltalk.addClass('HLSUnit', globals.HLWidget, [], 'Helios-SUnit');
+smalltalk.addClass('HLSUnit', globals.HLWidget, ['model', 'packagesListWidget', 'resultWidget'], 'Helios-SUnit');
+globals.HLSUnit.comment="I am the main widget for running unit tests in Helios.\x0a\x0aI provide the ability to select set of tests to run per package, and a detailed result log with passed tests, failed tests and errors.";
+smalltalk.addMethod(
+smalltalk.method({
+selector: "model",
+protocol: 'accessing',
+fn: function (){
+var self=this;
+function $HLSUnitModel(){return globals.HLSUnitModel||(typeof HLSUnitModel=="undefined"?nil:HLSUnitModel)}
+return smalltalk.withContext(function($ctx1) { 
+var $2,$1;
+$2=self["@model"];
+if(($receiver = $2) == nil || $receiver == null){
+self["@model"]=_st($HLSUnitModel())._new();
+$1=self["@model"];
+} else {
+$1=$2;
+};
+return $1;
+}, function($ctx1) {$ctx1.fill(self,"model",{},globals.HLSUnit)})},
+args: [],
+source: "model\x0a\x09^ model ifNil: [ model := HLSUnitModel new ]",
+messageSends: ["ifNil:", "new"],
+referencedClasses: ["HLSUnitModel"]
+}),
+globals.HLSUnit);
+
+smalltalk.addMethod(
+smalltalk.method({
+selector: "packagesListWidget",
+protocol: 'widgets',
+fn: function (){
+var self=this;
+function $HLSUnitPackagesListWidget(){return globals.HLSUnitPackagesListWidget||(typeof HLSUnitPackagesListWidget=="undefined"?nil:HLSUnitPackagesListWidget)}
+return smalltalk.withContext(function($ctx1) { 
+var $2,$1;
+$2=self["@packagesListWidget"];
+if(($receiver = $2) == nil || $receiver == null){
+self["@packagesListWidget"]=_st($HLSUnitPackagesListWidget())._on_(self._model());
+$1=self["@packagesListWidget"];
+} else {
+$1=$2;
+};
+return $1;
+}, function($ctx1) {$ctx1.fill(self,"packagesListWidget",{},globals.HLSUnit)})},
+args: [],
+source: "packagesListWidget\x0a\x09^ packagesListWidget ifNil: [ \x0a\x09\x09packagesListWidget := HLSUnitPackagesListWidget on: self model ]",
+messageSends: ["ifNil:", "on:", "model"],
+referencedClasses: ["HLSUnitPackagesListWidget"]
+}),
+globals.HLSUnit);
+
+smalltalk.addMethod(
+smalltalk.method({
+selector: "renderContentOn:",
+protocol: 'rendering',
+fn: function (html){
+var self=this;
+function $HLVerticalSplitter(){return globals.HLVerticalSplitter||(typeof HLVerticalSplitter=="undefined"?nil:HLVerticalSplitter)}
+return smalltalk.withContext(function($ctx1) { 
+var $2,$1;
+$2=self._packagesListWidget();
+$ctx1.sendIdx["packagesListWidget"]=1;
+$1=_st($HLVerticalSplitter())._with_with_($2,self._resultWidget());
+_st(html)._with_($1);
+_st(self._packagesListWidget())._focus();
+return self}, function($ctx1) {$ctx1.fill(self,"renderContentOn:",{html:html},globals.HLSUnit)})},
+args: ["html"],
+source: "renderContentOn: html\x0a\x09html with: (HLVerticalSplitter\x0a        with: self packagesListWidget \x0a        with: self resultWidget).\x0a\x09\x0a\x09self packagesListWidget focus",
+messageSends: ["with:", "with:with:", "packagesListWidget", "resultWidget", "focus"],
+referencedClasses: ["HLVerticalSplitter"]
+}),
+globals.HLSUnit);
+
+smalltalk.addMethod(
+smalltalk.method({
+selector: "resultWidget",
+protocol: 'widgets',
+fn: function (){
+var self=this;
+function $HLWidget(){return globals.HLWidget||(typeof HLWidget=="undefined"?nil:HLWidget)}
+return smalltalk.withContext(function($ctx1) { 
+var $2,$1;
+$2=self["@resultWidget"];
+if(($receiver = $2) == nil || $receiver == null){
+self["@resultWidget"]=_st($HLWidget())._new();
+$1=self["@resultWidget"];
+} else {
+$1=$2;
+};
+return $1;
+}, function($ctx1) {$ctx1.fill(self,"resultWidget",{},globals.HLSUnit)})},
+args: [],
+source: "resultWidget\x0a\x09^ resultWidget ifNil: [\x0a\x09\x09resultWidget := HLWidget new ]",
+messageSends: ["ifNil:", "new"],
+referencedClasses: ["HLWidget"]
+}),
+globals.HLSUnit);
+
 
 smalltalk.addMethod(
 smalltalk.method({
@@ -64,4 +162,143 @@ referencedClasses: []
 }),
 globals.HLSUnit.klass);
 
+
+smalltalk.addClass('HLSUnitModel', globals.HLModel, ['selectedPackages'], 'Helios-SUnit');
+smalltalk.addMethod(
+smalltalk.method({
+selector: "selectPackage:",
+protocol: 'actions',
+fn: function (aPackage){
+var self=this;
+return smalltalk.withContext(function($ctx1) { 
+_st(self._packages())._add_(aPackage);
+return self}, function($ctx1) {$ctx1.fill(self,"selectPackage:",{aPackage:aPackage},globals.HLSUnitModel)})},
+args: ["aPackage"],
+source: "selectPackage: aPackage\x0a\x09self packages add: aPackage",
+messageSends: ["add:", "packages"],
+referencedClasses: []
+}),
+globals.HLSUnitModel);
+
+smalltalk.addMethod(
+smalltalk.method({
+selector: "selectedPackages",
+protocol: 'accessing',
+fn: function (){
+var self=this;
+function $Set(){return globals.Set||(typeof Set=="undefined"?nil:Set)}
+return smalltalk.withContext(function($ctx1) { 
+var $2,$1;
+$2=self["@selectedPackages"];
+if(($receiver = $2) == nil || $receiver == null){
+self["@selectedPackages"]=_st($Set())._new();
+$1=self["@selectedPackages"];
+} else {
+$1=$2;
+};
+return $1;
+}, function($ctx1) {$ctx1.fill(self,"selectedPackages",{},globals.HLSUnitModel)})},
+args: [],
+source: "selectedPackages\x0a\x09^ selectedPackages ifNil: [ selectedPackages := Set new ]",
+messageSends: ["ifNil:", "new"],
+referencedClasses: ["Set"]
+}),
+globals.HLSUnitModel);
+
+smalltalk.addMethod(
+smalltalk.method({
+selector: "testPackages",
+protocol: 'accessing',
+fn: function (){
+var self=this;
+return smalltalk.withContext(function($ctx1) { 
+var $1;
+$1=_st(_st(self._environment())._packages())._select_((function(each){
+return smalltalk.withContext(function($ctx2) {
+return _st(each)._isTestPackage();
+}, function($ctx2) {$ctx2.fillBlock({each:each},$ctx1,1)})}));
+return $1;
+}, function($ctx1) {$ctx1.fill(self,"testPackages",{},globals.HLSUnitModel)})},
+args: [],
+source: "testPackages\x0a\x09\x22Answer all packages containing concrete subclasses of TestCase\x22\x0a\x09\x0a\x09^ self environment packages \x0a\x09\x09select: [ :each | each isTestPackage ]",
+messageSends: ["select:", "packages", "environment", "isTestPackage"],
+referencedClasses: []
+}),
+globals.HLSUnitModel);
+
+smalltalk.addMethod(
+smalltalk.method({
+selector: "unselectPackage:",
+protocol: 'actions',
+fn: function (aPackage){
+var self=this;
+return smalltalk.withContext(function($ctx1) { 
+_st(self._packages())._remove_ifAbsent_(aPackage,(function(){
+}));
+return self}, function($ctx1) {$ctx1.fill(self,"unselectPackage:",{aPackage:aPackage},globals.HLSUnitModel)})},
+args: ["aPackage"],
+source: "unselectPackage: aPackage\x0a\x09self packages remove: aPackage ifAbsent: []",
+messageSends: ["remove:ifAbsent:", "packages"],
+referencedClasses: []
+}),
+globals.HLSUnitModel);
+
+
+
+smalltalk.addClass('HLSUnitPackagesListWidget', globals.HLWidget, ['model'], 'Helios-SUnit');
+globals.HLSUnitPackagesListWidget.comment="I display a list of packages for which unit tests are associated (packages containing subclasses of `TestCase`).";
+smalltalk.addMethod(
+smalltalk.method({
+selector: "model",
+protocol: 'accessing',
+fn: function (){
+var self=this;
+var $1;
+$1=self["@model"];
+return $1;
+},
+args: [],
+source: "model\x0a\x09^ model",
+messageSends: [],
+referencedClasses: []
+}),
+globals.HLSUnitPackagesListWidget);
+
+smalltalk.addMethod(
+smalltalk.method({
+selector: "model:",
+protocol: 'accessing',
+fn: function (anObject){
+var self=this;
+self["@model"]=anObject;
+return self},
+args: ["anObject"],
+source: "model: anObject\x0a\x09model := anObject",
+messageSends: [],
+referencedClasses: []
+}),
+globals.HLSUnitPackagesListWidget);
+
+
+smalltalk.addMethod(
+smalltalk.method({
+selector: "on:",
+protocol: 'instance creation',
+fn: function (aSUnitModel){
+var self=this;
+return smalltalk.withContext(function($ctx1) { 
+var $2,$3,$1;
+$2=self._new();
+_st($2)._model_(aSUnitModel);
+$3=_st($2)._yourself();
+$1=$3;
+return $1;
+}, function($ctx1) {$ctx1.fill(self,"on:",{aSUnitModel:aSUnitModel},globals.HLSUnitPackagesListWidget.klass)})},
+args: ["aSUnitModel"],
+source: "on: aSUnitModel\x0a\x09^ self new\x0a\x09\x09model: aSUnitModel;\x0a\x09\x09yourself",
+messageSends: ["model:", "new", "yourself"],
+referencedClasses: []
+}),
+globals.HLSUnitPackagesListWidget.klass);
+
 });

src/Helios-SUnit.st

@@ -1,7 +1,39 @@
 Smalltalk createPackage: 'Helios-SUnit'!
 HLWidget subclass: #HLSUnit
-	instanceVariableNames: ''
+	instanceVariableNames: 'model packagesListWidget resultWidget'
 	package: 'Helios-SUnit'!
+!HLSUnit commentStamp!
+I am the main widget for running unit tests in Helios.
+
+I provide the ability to select set of tests to run per package, and a detailed result log with passed tests, failed tests and errors.!
+
+!HLSUnit methodsFor: 'accessing'!
+
+model
+	^ model ifNil: [ model := HLSUnitModel new ]
+! !
+
+!HLSUnit methodsFor: 'rendering'!
+
+renderContentOn: html
+	html with: (HLVerticalSplitter
+        with: self packagesListWidget 
+        with: self resultWidget).
+	
+	self packagesListWidget focus
+! !
+
+!HLSUnit methodsFor: 'widgets'!
+
+packagesListWidget
+	^ packagesListWidget ifNil: [ 
+		packagesListWidget := HLSUnitPackagesListWidget on: self model ]
+!
+
+resultWidget
+	^ resultWidget ifNil: [
+		resultWidget := HLWidget new ]
+! !
 
 !HLSUnit class methodsFor: 'accessing'!
 
@@ -23,3 +55,54 @@ canBeOpenAsTab
 	^ true
 ! !
 
+HLModel subclass: #HLSUnitModel
+	instanceVariableNames: 'selectedPackages'
+	package: 'Helios-SUnit'!
+
+!HLSUnitModel methodsFor: 'accessing'!
+
+selectedPackages
+	^ selectedPackages ifNil: [ selectedPackages := Set new ]
+!
+
+testPackages
+	"Answer all packages containing concrete subclasses of TestCase"
+	
+	^ self environment packages 
+		select: [ :each | each isTestPackage ]
+! !
+
+!HLSUnitModel methodsFor: 'actions'!
+
+selectPackage: aPackage
+	self packages add: aPackage
+!
+
+unselectPackage: aPackage
+	self packages remove: aPackage ifAbsent: []
+! !
+
+HLWidget subclass: #HLSUnitPackagesListWidget
+	instanceVariableNames: 'model'
+	package: 'Helios-SUnit'!
+!HLSUnitPackagesListWidget commentStamp!
+I display a list of packages for which unit tests are associated (packages containing subclasses of `TestCase`).!
+
+!HLSUnitPackagesListWidget methodsFor: 'accessing'!
+
+model
+	^ model
+!
+
+model: anObject
+	model := anObject
+! !
+
+!HLSUnitPackagesListWidget class methodsFor: 'instance creation'!
+
+on: aSUnitModel
+	^ self new
+		model: aSUnitModel;
+		yourself
+! !
+

src/Kernel-Infrastructure.js

@@ -1606,6 +1606,31 @@ referencedClasses: []
 }),
 globals.Package);
 
+smalltalk.addMethod(
+smalltalk.method({
+selector: "isTestPackage",
+protocol: 'testing',
+fn: function (){
+var self=this;
+function $TestCase(){return globals.TestCase||(typeof TestCase=="undefined"?nil:TestCase)}
+return smalltalk.withContext(function($ctx1) { 
+var $1;
+$1=_st(self._classes())._anySatisfy_((function(each){
+return smalltalk.withContext(function($ctx2) {
+return _st(_st(each)._includesBehavior_($TestCase()))._and_((function(){
+return smalltalk.withContext(function($ctx3) {
+return _st(_st(each)._isAbstract())._not();
+}, function($ctx3) {$ctx3.fillBlock({},$ctx2,2)})}));
+}, function($ctx2) {$ctx2.fillBlock({each:each},$ctx1,1)})}));
+return $1;
+}, function($ctx1) {$ctx1.fill(self,"isTestPackage",{},globals.Package)})},
+args: [],
+source: "isTestPackage\x0a\x09^ self classes anySatisfy: [ :each |\x0a\x09\x09(each includesBehavior: TestCase) and: [ \x0a\x09\x09\x09each isAbstract not ] ]",
+messageSends: ["anySatisfy:", "classes", "and:", "includesBehavior:", "not", "isAbstract"],
+referencedClasses: ["TestCase"]
+}),
+globals.Package);
+
 smalltalk.addMethod(
 smalltalk.method({
 selector: "loadDependencies",

src/Kernel-Infrastructure.st

@@ -671,6 +671,12 @@ printOn: aStream
 
 isPackage
 	^ true
+!
+
+isTestPackage
+	^ self classes anySatisfy: [ :each |
+		(each includesBehavior: TestCase) and: [ 
+			each isAbstract not ] ]
 ! !
 
 Package class instanceVariableNames: 'defaultCommitPathJs defaultCommitPathSt'!