#1135. Работа с эталонами. Подтачиваем. Только код

PROGRAM Etalon.ms.script

USES
 axiom_push.ms.dict
;

USES
 io.ms.dict
;

USES
 DumpStack.ms.dict
;

USES
 SaveVarAndDo.ms.dict
;

USES
 Testing.ms.dict
;

USES
 CompileTimeVar.ms.dict
;

FILE CompileTime-VAR g_OutFile nil
%REMARK 'Текущий файл'

Test&Dump Etalon.ms.script.test
 
 INTEGER VAR g_EtalonCount
 ( 0 >>> g_EtalonCount )

 CONST cCompareUtilCmd 'q:\afc.cmd'
 %REMARK 'Путь к утилите сравнения'

 PROCEDURE Etalon
  ^ IN aLambda

  CONST cPathSep '\'
  
  PROCEDURE DeleteEmptyFile
    STRING IN aFileName
   aFileName FileSize 0 == ? (
    aFileName sysutils:FileExists ? (
     aFileName DeleteFile DROP
    ) // aFileName sysutils:FileExists
   ) // aFileName FileSize 0 ==
  ; // DeleteEmptyFile

  PROCEDURE Out
    IN aValue
   g_OutFile IsNil ?FAIL 'Файл для вывода не открыт'
   aValue ToPrintable g_OutFile File:WriteLn
  ; // Out

  STRING VAR l_FileName
  STRING VAR l_CurrentDir
  script:FileName sysutils:ExtractFilePath >>> l_CurrentDir
  script:FileName sysutils:ExtractFileName >>> l_FileName

  if ( l_CurrentDir IsNil ) then
  begin
   sysutils:GetCurrentDir >>> l_CurrentDir
  end // l_CurrentDir IsNil

  [ 
    l_FileName 
    if ( g_EtalonCount > 0 ) 
     ( '.' g_EtalonCount IntToStr ) 
    '.prn' 
  ] strings:Cat >>> l_FileName

  STRING VAR l_FileNameOut
  l_FileName >>> l_FileNameOut
  l_FileNameOut '.etalon' Cat >>> l_FileNameOut

  [ l_CurrentDir 'Etalons' l_FileName ] cPathSep strings:CatSep >>> l_FileName

  STRING VAR l_OutDir
  [ l_CurrentDir 'Out' ] cPathSep strings:CatSep >>> l_OutDir
  l_OutDir sysutils:ForceDirectories ?ASSURE [ 'Не удалось создать директорию ' l_OutDir ]
  [ l_OutDir l_FileNameOut ] cPathSep strings:CatSep >>> l_FileNameOut

  TF g_OutFile (
   l_FileNameOut File:OpenWrite >>> g_OutFile
   DumpStackTo (
    aLambda DO 
   ) Out
  ) // TF g_OutFile

  if ( l_FileName sysutils:FileExists ) then
  begin
   '' l_FileName l_FileNameOut CompareFiles ! ? (
    cCompareUtilCmd sysutils:FileExists ?ASSURE [ 'Не найдена утилита сравнения: ' cCompareUtilCmd ]
    STRING VAR l_Compare
    [ cCompareUtilCmd ' ' l_FileName ' ' l_FileNameOut ] strings:Cat >>> l_Compare
    l_Compare WinExec
    %REMARK 'Вызываем внешнюю утилиту сравнения файлов'
   )
  end // l_FileName sysutils:FileExists
  else
  begin
   $20 l_FileName l_FileNameOut CopyFile
  end // l_FileName sysutils:FileExists
  
  l_FileName DeleteEmptyFile
  l_FileNameOut DeleteEmptyFile

  Inc g_EtalonCount
 ; // Etalon

 Etalon ( script:FileName sysutils:ExtractFileName )
 Etalon ( 1 2 + )
 Etalon 'Hello world'
 Etalon ()
 Etalon []
 Etalon 1
 Etalon 'Another string'
; // Etalon.ms.script.test

Etalon.ms.script.test