freepascal.compiler/tests/test/units/dos/tdos.pp

{
  $Id$

  Program to test DOS unit by Peter Vreman.
  Only main TP functions are tested (nothing with Interrupts/Break/Verify).
}
{$V-}
program tesidos;

uses dos;


{ These should be defined for each operating system to be tested  }
{ NOEXESUFFIX = No .EXE to prepend to prefix the file with to get }
{               a file executable.                                }

{$ifdef unix}
{$DEFINE NOEXESUFFIX}
{$endif}

{$ifdef amiga}
{$DEFINE NOEXESUFFIX}
{$endif}

const
  exedir : string = '';

procedure TestInfo;
var
  dt    : DateTime;
  ptime : longint;
  wday  : word;
  HSecs : word;
begin
  writeln;
  writeln('Info Functions');
  writeln('**************');
  writeln('Dosversion     : ',lo(DosVersion),'.',hi(DosVersion));
  GetDate(Dt.Year,Dt.Month,Dt.Day,wday);
  writeln('Current Date (MM-DD-YYYY)  : ',Dt.Month,'-',Dt.Day,'-',Dt.Year,' weekday ',wday);
  GetTime(Dt.Hour,Dt.Min,Dt.Sec,HSecs);
  writeln('Current Time (HH:MM:SS)  : ',Dt.Hour,':',Dt.Min,':',Dt.Sec,' hsecs ',HSecs);
  PackTime(Dt,ptime);
  writeln('Packed like dos: ',ptime);
  UnpackTime(ptime,DT);
  writeln('Unpacked again (MM-DD-YYYY) ',Dt.Month,'-',Dt.Day,'-',Dt.Year,'  ',Dt.Hour,':',Dt.Min,':',Dt.Sec);
  writeln;
end;


procedure TestEnvironment;
var
  i : longint;
begin
  writeln;
  writeln('Environment Functions');
  writeln('*********************');
  writeln('Amount of environment strings : ',EnvCount);
  writeln('GetEnv TERM : ',GetEnv('TERM'));
  writeln('GetEnv HOST : ',GetEnv('HOST'));
  writeln('GetEnv PATH : ',GetEnv('PATH'));
  writeln('GetEnv SHELL: ',GetEnv('SHELL'));
  write(' all Environment Strings using EnvStr()');
  for i:=1 to EnvCount do
   writeln(EnvStr(i));
end;


procedure TestExec;
begin
  writeln;
  writeln('Exec Functions');
  writeln('**************');
  write('Going to Exec of ''hello -good -day''');
{$ifndef FPC}
  SwapVectors;
{$endif FPC}
{$ifdef noexesuffix}
  Exec(exedir+'hello','-good -day');
{$else}
  Exec(exedir+'hello.exe','-good -day');
{$endif}
{$ifndef FPC}
  SwapVectors;
{$endif FPC}
  writeln('Exit should be 213 : ',DosExitCode);
  writeln('Error code should be 0 : ',DosError);
end;



procedure TestDisk;
var
  Dir : SearchRec;
  DT  : DateTime;
begin
  writeln;
  writeln('Disk Functions');
  writeln('**************');
  writeln('DiskFree 0 : ',DiskFree(0));
  writeln('DiskSize 0 : ',DiskSize(0));
  {writeln('DiskSize 1 : ',DiskSize(1)); this is a: on dos  ??! }
  writeln('DiskSize 3 : ',DiskSize(3)); { this is c: on dos }
{$IFDEF Unix}
  AddDisk('/fd0');
  writeln('DiskSize 4 : ',DiskSize(4));
{$ENDIF}
  write('FindFirst/FindNext Test');

  FindFirst('*.*',$20,Dir);
  while (DosError=0) do
   begin
     UnpackTime(dir.Time,DT);
     Writeln(dir.Name,' ',dir.Size,' ',DT.Year,'-',DT.Month,'-',DT.Day);
     FindNext(Dir);
   end;
end;



procedure TestFile;
var
  test,
  name,dir,ext : string;
begin
  writeln;
  writeln('File(name) Functions');
  writeln('********************');
{$ifdef unix }
  test:='/usr/local/bin/ppc.so';
  writeln('FSplit(',test,')');
  FSplit(test,dir,name,ext);
  writeln('dir: ',dir,' name: ',name,' ext: ',ext);
  test:='/usr/bin.1/ppc';
  writeln('FSplit(',test,')');
  FSplit(test,dir,name,ext);
  writeln('dir: ',dir,' name: ',name,' ext: ',ext);
  test:='mtools.tar.gz';
  writeln('FSplit(',test,')');
  FSplit(test,dir,name,ext);
  writeln('dir: ',dir,' name: ',name,' ext: ',ext);

  Writeln('Expanded dos.pp                 : ',FExpand('dos.pp'));
  Writeln('Expanded ../dos.pp              : ',FExpand('../dos.pp'));
  Writeln('Expanded /usr/local/dos.pp      : ',FExpand('/usr/local/dos.pp'));
  Writeln('Expanded ../dos/./../././dos.pp : ',FExpand('../dos/./../././dos.pp'));

  test:='../;/usr/;/usr/bin/;/usr/bin;/bin/;';
{$else not linux }
  test:='\usr\local\bin\ppc.so';
  writeln('FSplit(',test,')');
  FSplit(test,dir,name,ext);
  writeln('dir: ',dir,' name: ',name,' ext: ',ext);
  test:='\usr\bin.1\ppc';
  writeln('FSplit(',test,')');
  FSplit(test,dir,name,ext);
  writeln('dir: ',dir,' name: ',name,' ext: ',ext);
  test:='mtools.tar.gz';
  writeln('FSplit(',test,')');
  FSplit(test,dir,name,ext);
  writeln('dir: ',dir,' name: ',name,' ext: ',ext);

  Writeln('Expanded dos.pp                 : ',FExpand('dos.pp'));
  Writeln('Expanded ..\dos.pp              : ',FExpand('..\dos.pp'));
  Writeln('Expanded \usr\local\dos.pp      : ',FExpand('\usr\local\dos.pp'));
  Writeln('Expanded ..\dos\.\..\.\.\dos.pp : ',FExpand('..\dos\.\..\.\.\dos.pp'));

  test:='..\;\usr\;\usr\bin\;\usr\bin;\bin\;';
{$endif not linux}
  test:=test+getenv('PATH');
{$ifdef NOEXESUFFIX}
  Writeln('FSearch ls: ',FSearch('ls',test));
{$else not noexesuffix}
  Writeln('FSearch ls: ',FSearch('ls.exe',test));
{$endif not noexesuffix}

  Writeln('Empty FSearch (should return empty string):',FSearch('',test));

end;


var
  name,dir,ext : string;

begin
  FSplit(paramstr(0),dir,name,ext);
  exedir:=dir;
  TestInfo;
  TestEnvironment;
  TestExec;
  TestDisk;
  TestFile;
end.

{
  $Log$
  Revision 1.9  2003-05-15 20:35:57  florian
    * ifdef'd SwapVectors

  Revision 1.8  2002/11/18 09:49:49  pierre
   * tried to make as many as possible tests non interactive

  Revision 1.7  2002/10/20 11:47:39  carl
    * add format date to make test clearer

  Revision 1.6  2002/09/07 15:40:56  peter
    * old logs removed and tabs fixed

  Revision 1.5  2002/07/06 11:46:08  carl
  + fsearch testing added

  Revision 1.4  2002/06/01 19:08:52  marco
   * Renamefest

}