* ifdef'd SwapVectors

tests/test/units/dos/tdos.pp

@@ -1,208 +1,215 @@
 {
-  $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''');
+  $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.
-
-{
+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.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
-
-}
+  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
+
+}

tests/test/units/dos/tidos.pp

@@ -76,13 +76,17 @@ begin
   writeln('**************');
   write('Press Enter for an Exec of ''hello -good -day''');
   Readln;
+{$ifndef FPC}
   SwapVectors;
+{$endif FPC}
 {$ifdef noexesuffix}
   Exec('hello','-good -day');
 {$else}
   Exec('hello.exe','-good -day');
 {$endif}
+{$ifndef FPC}
   SwapVectors;
+{$endif FPC}
   writeln('Exit should be 213 : ',DosExitCode);
   writeln('Error code should be 0 : ',DosError);
   write('Press Enter');
@@ -197,7 +201,10 @@ end.
 
 {
   $Log$
-  Revision 1.1  2002-11-18 09:49:49  pierre
+  Revision 1.2  2003-05-15 20:35:57  florian
+    * ifdef'd SwapVectors
+
+  Revision 1.1  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