#1133. Работа с эталонами. Копируем файлы. Только код

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 )

 PROCEDURE Etalon
  ^ IN aLambda
  
  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
  script:FileName >>> l_FileName
  [ 
    l_FileName 
    if ( g_EtalonCount > 0 ) 
     ( '.' g_EtalonCount IntToStr ) 
    '.prn' 
  ] strings:Cat >>> l_FileName

  STRING VAR l_FileNameOut
  l_FileName >>> l_FileNameOut
  l_FileNameOut '.out' Cat >>> 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 ! ? (
    STRING VAR l_Compare
    [ 'q:\afc.cmd ' l_FileName ' ' l_FileNameOut ] strings:Cat >>> l_Compare
    l_Compare .
    l_Compare WinExec
    %REMARK 'Вызываем внешнюю утилиту сравнения файлов'
   )
  end // l_FileName sysutils:FileExists
  else
  begin
   STRING VAR l_OutPath
   l_FileName sysutils:ExtractFilePath >>> l_OutPath
   if ( l_OutPath IsNil ) then
   begin
    sysutils:GetCurrentDir >>> l_OutPath
    [ l_OutPath l_FileName ] '\' strings:CatSep >>> l_FileName
   end
   l_OutPath sysutils:ForceDirectories ?ASSURE [ 'Не удалось создать директорию ' l_OutPath ]
   $20 l_FileName l_FileNameOut CopyFile
  end // l_FileName sysutils:FileExists
  
  l_FileName DeleteEmptyFile
  l_FileNameOut DeleteEmptyFile

  Inc g_EtalonCount
 ; // Etalon

 Etalon script:FileName
 Etalon ( 1 3 + )
 Etalon 'Hello world'
 Etalon ()
 Etalon []
 Etalon 1
; // Etalon.ms.script.test

Etalon.ms.script.test