Оберон-клуб «ВЄДАsoft»

 
MODULE Запусктестов;
 
 IMPORT
  Kernel, Strings, Fonts, Ports, Stores, Models, Views, Controllers, Properties, Dialog, Controls, 
  TextModels, TextSetters, TextMappers, Services, StdLog, SYSTEM;
 
 VAR
  текущийТест-: PROCEDURE;
  имяТекущегоТеста-: POINTER TO ARRAY OF CHAR;
  выполненоТестов-: INTEGER;
  успехТекущегоТеста-: BOOLEAN;
  былоИсключениеВТекущемТестеЛи-: BOOLEAN;
  кодИсключенияВТекущемТесте-: INTEGER;
  ошибокВСессии-: INTEGER;
  показыватьВходВТестЛи*: BOOLEAN; 
  названиеСессии-: ARRAY 4096 OF CHAR;
 
 PROCEDURE дваЦелыхЧислаВСтрокуЧерезДробь*(ч1, ч2: LONGINT; VAR Рез: ARRAY OF CHAR);
  VAR одноЧисло: ARRAY 32 OF CHAR;
 BEGIN
  Strings.IntToString(ч1,Рез);
  Strings.IntToString(ч2, одноЧисло);
  Рез := Рез + "/" + одноЧисло END дваЦелыхЧислаВСтрокуЧерезДробь;
 
 PROCEDURE НачниСессиюТестирования*(IN названиеСессииБудет: ARRAY  OF CHAR);
 BEGIN
  названиеСессии := "" + названиеСессииБудет;
  StdLog.String("Запуск сессии тестирования " + названиеСессии);
  StdLog.Ln;
  выполненоТестов := 0; 
  ошибокВСессии := 0; END НачниСессиюТестирования;
 
 PROCEDURE ЗавершиСессиюТестирования*;
 BEGIN
  StdLog.String("Конец сессии тестирования " + названиеСессии); StdLog.Ln;
  StdLog.String("Ошибок/Тестов: "); 
  StdLog.Int(ошибокВСессии); StdLog.String("/");
  StdLog.Int(выполненоТестов); 
  StdLog.Ln; END ЗавершиСессиюТестирования;
 
 PROCEDURE ЗаметьЭтоИсключение;
 BEGIN
  былоИсключениеВТекущемТестеЛи := TRUE;
  кодИсключенияВТекущемТесте := Kernel.err END ЗаметьЭтоИсключение;
 
 PROCEDURE УзнайИмяПроцедуры*(з:PROCEDURE):POINTER TO ARRAY OF CHAR;
  (* По мотивам StdDebug.ShowStack *)
 VAR ref, end, a: INTEGER; mod: Kernel.Module; 
 modName, name: Kernel.Name;
 res: INTEGER; nn: Kernel.Utf8Name;
 Результат : POINTER TO ARRAY OF CHAR;
 длинаРезультата : INTEGER;
 BEGIN 
  длинаРезультата := 1 (* символ конца строки *);
  a := SYSTEM.VAL(INTEGER,з); 
  mod := Kernel.modList;
  WHILE (mod # NIL) & ((a < mod.code) OR (a >= mod.code + mod.csize)) DO mod := mod.next END;
   IF mod # NIL THEN
    DEC(a, mod.code);
    IF mod.refcnt >= 0 THEN
    Kernel.GetModName(mod, modName); 
    INC(длинаРезультата,LEN(modName$));
    ref := mod.refs;
    REPEAT Kernel.GetRefProc(ref, end, nn) UNTIL (end = 0) OR (a < end);
    IF a < end THEN
     Strings.Utf8ToString(nn, name, res);   
     INC(длинаРезультата, 1 (* точка *) + LEN(name$));
     NEW(Результат, длинаРезультата);
     Результат^ := modName + "." + name;
     RETURN Результат END END END; 
   NEW(Результат, длинаРезультата);
   Результат^ := "";
   RETURN Результат END УзнайИмяПроцедуры;
 
 PROCEDURE ВызовиТекущийТест(ненужно1,ненужно2,ненужно3:INTEGER);
 BEGIN текущийТест() END ВызовиТекущийТест;
 
 PROCEDURE подготовьсяКТестированию(тест: PROCEDURE);
 BEGIN
  текущийТест := тест;
  имяТекущегоТеста := УзнайИмяПроцедуры(текущийТест);
  успехТекущегоТеста := TRUE;
  былоИсключениеВТекущемТестеЛи := FALSE END подготовьсяКТестированию;
 
 PROCEDURE обработайПровалТеста(IN сбщ: ARRAY OF CHAR);
 BEGIN
  INC(ошибокВСессии);
  StdLog.String("!"+имяТекущегоТеста+" - провал теста"+сбщ);
  StdLog.Ln END обработайПровалТеста;
 
 PROCEDURE обработайРезультатыТеста(должноБытьИсключениеЛи: BOOLEAN; кодИсключенияДолженБыть: INTEGER);
  VAR сбщ: ARRAY 4096 OF CHAR; стр : ARRAY 64 OF CHAR;
 BEGIN
  INC(выполненоТестов);
  IF должноБытьИсключениеЛи THEN
  IF ~ былоИсключениеВТекущемТестеЛи THEN
   обработайПровалТеста(": ожидалось исключение");
  ELSIF кодИсключенияВТекущемТесте # кодИсключенияДолженБыть THEN
   сбщ := ": ожидался/получен код исключения: ";
   дваЦелыхЧислаВСтрокуЧерезДробь(
    кодИсключенияДолженБыть, кодИсключенияВТекущемТесте, стр );
   сбщ := сбщ + стр;
   обработайПровалТеста(сбщ) END 
  ELSIF былоИсключениеВТекущемТестеЛи THEN
   Strings.IntToString( кодИсключенияВТекущемТесте, стр);
   сбщ := ": неожиданное исключение с кодом "+стр;
   обработайПровалТеста(сбщ)
  ELSIF ~ успехТекущегоТеста THEN
   обработайПровалТеста("") END END обработайРезультатыТеста;
 
 (*** Запуск тестов *)
 
 (** зт == запусти тест *)
 PROCEDURE зтВнутр (тест: PROCEDURE
   ; должноБытьИсключениеЛи: BOOLEAN
   ; кодИсключенияДолженБыть: INTEGER);
  VAR сохранённыйПросмотровщикЛовушки: PROCEDURE;
 BEGIN
  подготовьсяКТестированию(тест);
  IF показыватьВходВТестЛи THEN
    StdLog.String("зт*: " + имяТекущегоТеста); StdLog.Ln END;
  (* Здесь понадобилось открыть Kernel.trapViewer *)
  сохранённыйПросмотровщикЛовушки := Kernel.trapViewer;
  Kernel.InstallTrapViewer(ЗаметьЭтоИсключение);
  Kernel.Try(ВызовиТекущийТест,0,0,0);
  Kernel.InstallTrapViewer(сохранённыйПросмотровщикЛовушки);
  обработайРезультатыТеста(должноБытьИсключениеЛи, кодИсключенияДолженБыть) END зтВнутр;
 
 (** зт == запусти тест *)
 PROCEDURE зт*(тест: PROCEDURE);
 BEGIN зтВнутр(тест,FALSE,0) END зт;
 
 (* зтои == запусти тест, ожидается исключение *)
 PROCEDURE зтои*(тест: PROCEDURE; кодИсключенияДолженБыть: INTEGER);
 BEGIN зтВнутр(тест,TRUE,кодИсключенияДолженБыть) END зтои;
 
(*** Проверки, которые вставляются внутрь теста *)
 
(* пп = провал проверки *)
PROCEDURE пп*;
BEGIN успехТекущегоТеста := FALSE END пп;
 
(* ппсс = провал проверки, с сообщением *)
PROCEDURE ппсс*(IN сбщ : ARRAY OF CHAR);
BEGIN
 IF сбщ # "" THEN 
  StdLog.String(" "+имяТекущегоТеста+": провал проверки: "+сбщ);
  StdLog.Ln END;
 успехТекущегоТеста := FALSE END ппсс;
 
(* дб = должно быть *)
PROCEDURE дб*( проверяемоеУсловие : BOOLEAN);
BEGIN
 IF ~ проверяемоеУсловие THEN успехТекущегоТеста := FALSE END END дб;
 
(* дбсс == должно быть, с сообщением *)
PROCEDURE дбсс*( проверяемоеУсловие: BOOLEAN; IN сбщ:ARRAY OF CHAR );
BEGIN
 IF ~ проверяемоеУсловие THEN
  ппсс(сбщ) END END дбсс;
 
(* дбцсс == должно быть (ожидаемое) целое число, с сообщением *)
PROCEDURE дбцсс*( ожидаемоеЧисло, полученноеЧисло: LONGINT; IN сбщ: ARRAY OF CHAR );
VAR стр : ARRAY 64 OF CHAR; сбщ2 : ARRAY 4096 OF CHAR;
BEGIN
 сбщ2 := "" + сбщ;
 IF ожидаемоеЧисло # полученноеЧисло THEN
  IF сбщ # "" THEN
   дваЦелыхЧислаВСтрокуЧерезДробь( ожидаемоеЧисло, полученноеЧисло, стр);
   сбщ2 := сбщ2 + стр END;
  ппсс(сбщ2) END END дбцсс;
 
(*** Демо *)
 
PROCEDURE ДемоНеудачныйТест;
BEGIN ппсс("почему-то не вышло") END ДемоНеудачныйТест;
 
PROCEDURE ДемоНеудачныйТест2;
BEGIN дбцсс(1,0,"") END ДемоНеудачныйТест2;
 
PROCEDURE ДемоНеудачныйТест3;
BEGIN дб(FALSE) END ДемоНеудачныйТест3;
 
PROCEDURE ДемоУдачныйТест; 
BEGIN дбцсс(1,1,"") END ДемоУдачныйТест;
 
PROCEDURE Рухни*;
VAR Ложжь: BOOLEAN;
BEGIN Ложжь := FALSE; ASSERT(Ложжь,20) END Рухни;
 
PROCEDURE Демо*;
BEGIN
 показыватьВходВТестЛи := FALSE;
 НачниСессиюТестирования("Демо-сессия");
 зт(ДемоНеудачныйТест);
 зт(ДемоНеудачныйТест2);
 зт(ДемоНеудачныйТест3);
 зт(ДемоУдачныйТест);
 зтои(Рухни,20);
 зт(Рухни);
 ЗавершиСессиюТестирования;
END Демо;
 
END Запусктестов.
 
^q "Запусктестов.Демо"