Browse Source

+ added allexec tests if executables compiled
don't return with an error code
* some changes in test files for dos

pierre 27 years ago
parent
commit
aa82e1cb8c
4 changed files with 118 additions and 15 deletions
  1. 61 7
      tests/makefile
  2. 43 7
      tests/testdos.pp
  3. 13 0
      tests/testset.pp
  4. 1 1
      tests/teststr.pp

+ 61 - 7
tests/makefile

@@ -4,7 +4,7 @@
 # make all test
 # and printout errors
 
-all : clean allts alltf allto
+all : clean allts alltf allto alltest
 	grep -n -i fails log
 
 # returns the error code 
@@ -12,11 +12,18 @@ all : clean allts alltf allto
 # in file retcode
 
 ifdef DJGPP
+
+EXEEXT=.exe
+
 getreturncode : 
 	redir -e $(FILE).log -o $(FILE).log getret $(COMMAND)
+	cp retcode $(FILE).$(RESEXT)
 else
+
+EXEEXT=
 getreturncode : 
 	getret $(COMMAND) !> $(FILE).log !2>$(FILE).log
+	cp retcode $(FILE).$(RESEXT)
 endif
 	
 
@@ -49,6 +56,39 @@ testsuccess:
 	echo $(FILE) >> faillist
 endif
 	
+ifdef FILE
+ifneq ($wildcard $(FILE).exc),)
+EXERETVAL:=$(shell cat $(FILE).exc)
+else
+EXERETVAL=-1
+endif
+else
+EXERETVAL=-2
+endif
+
+ifeq ($(EXERETVAL),0)
+testexecsuccess:
+	echo Test for exec $(FILE) success (runs without error)
+	echo Test for $(FILE) success (runs without error) >>log
+else
+testexecsuccess:
+	echo Test for exec $(FILE) fails exec error $(RETVAL)
+	echo Test for exec $(FILE) fails exec error $(RETVAL)>>log
+	echo $(FILE) >> faillist
+endif
+	
+ifneq ($(wildcard $(FILE)$(EXEEXT)),)
+testexec:
+	redir -e $(FILE).elg -o$(FILE).elg getret $(FILE)$(EXEEXT)
+	cp retcode $(FILE).exc
+	make testexecsuccess 'FILE=$(FILE)' 
+else
+testexec:
+	echo No exefile $(FILE)$(EXEEXT)
+	make testexecsuccess 'FILE=$(FILE)' 
+	true
+endif
+	
 ifneq ($(RETVAL),0)
 testfail:
 	echo Test for $(FILE) success (does not compile) error $(RETVAL)
@@ -83,30 +123,44 @@ FILE=ts00001.pp
 endif
 
 testone :
-	make getreturncode 'COMMAND=$(PP) $(OPT) $(FILE).pp'
+	make getreturncode 'COMMAND=$(PP) $(OPT) $(FILE).pp' 'RESEXT=$(RESEXT)'
 	make printretcode 'FILE=$(FILE)'
 
 %.res : %.pp
-	make testone 'FILE=$*'
-	cat retcode > $*.res
+	make testone 'FILE=$*' 'RESEXT=res'
 	make testsuccess 'FILE=$*' 'RESFILE=$*.res'
 
 %.ref : %.pp
-	make testone 'FILE=$*'
-	cat retcode > $*.ref
+	make testone 'FILE=$*' 'RESEXT=ref'
 	make testfail 'FILE=$*' 'RESFILE=$*.ref'
 
+# exec log files
+# creates two files
+# *.elg log file
+# *.exc exicode of program
+%.elg : %.res
+	make testexec 'FILE=$*'
+	
 allts : $(patsubst %.pp,%.res,$(wildcard ts*.pp))
 
+alltest : $(patsubst %.pp,%.res,$(wildcard test*.pp))
+
 alltf : $(patsubst %.pp,%.ref,$(wildcard tf*.pp))
 
 allto : $(patsubst %.pp,%.res,$(wildcard to*.pp))
 
+allexec: $(patsubst %.pp,%.elg,$(wildcard test*.pp)) $(patsubst %.pp,%.elg,$(wildcard ts*.pp)) 
+
 clean :
 	-rm *.re* *.o *.ppu ts*.exe tf*.exe log faillist
 
 # $Log$
-# Revision 1.5  1998-10-21 16:24:16  pierre
+# Revision 1.6  1998-10-22 14:35:40  pierre
+#   + added allexec tests if executables compiled
+#     don't return with an error code
+#   * some changes in test files for dos
+#
+# Revision 1.5  1998/10/21 16:24:16  pierre
 #  + tests to check if filename exists
 #
 # Revision 1.4  1998/10/21 12:14:30  pierre

+ 43 - 7
tests/testdos.pp

@@ -1,9 +1,10 @@
 {
   $Id$
-  
+
   Program to test DOS unit by Peter Vreman.
   Only main TP functions are tested (nothing with Interrupts/Break/Verify).
 }
+{$V-}
 program testdos;
 uses dos;
 
@@ -11,8 +12,8 @@ procedure TestInfo;
 var
   dt    : DateTime;
   ptime : longint;
-  wday,
-  HSecs : integer;
+  wday  : word;
+  HSecs : word;
 begin
   writeln;
   writeln('Info Functions');
@@ -42,10 +43,11 @@ begin
   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('Press Enter for all Environment Strings using EnvStr()');
   Readln;
-  for i:=1to EnvCount do
+  for i:=1 to EnvCount do
    writeln(EnvStr(i));
   write('Press Enter');
   Readln;
@@ -59,7 +61,13 @@ begin
   writeln('**************');
   write('Press Enter for an Exec of ''ls -la''');
   Readln;
-  Exec('pine','');
+{$ifdef linux }
+  Exec('ls','-la');
+{$else not linux }
+  SwapVectors;
+  Exec('ls','-la');
+  SwapVectors;
+{$endif not linux }
   write('Press Enter');
   Readln;
 end;
@@ -75,7 +83,8 @@ begin
   writeln('**************');
   writeln('DiskFree 0 : ',DiskFree(0));
   writeln('DiskSize 0 : ',DiskSize(0));
-  writeln('DiskSize 1 : ',DiskSize(1));
+  {writeln('DiskSize 1 : ',DiskSize(1)); this is a: on dos  ??! }
+  writeln('DiskSize 1 : ',DiskSize(3)); { this is c: on dos }
 {$IFDEF LINUX}
   AddDisk('/fd0');
   writeln('DiskSize 4 : ',DiskSize(4));
@@ -103,6 +112,7 @@ begin
   writeln;
   writeln('File(name) Functions');
   writeln('********************');
+{$ifdef linux }
   test:='/usr/local/bin/ppc.so';
   writeln('FSplit(',test,')');
   FSplit(test,dir,name,ext);
@@ -121,8 +131,34 @@ begin
   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/';
+  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 linux}
   Writeln('FSearch ls: ',FSearch('ls',test));
+{$else not linux}
+  Writeln('FSearch ls: ',FSearch('ls.exe',test));
+{$endif not linux}
 
   write('Press Enter');
   Readln;

+ 13 - 0
tests/testset.pp

@@ -3,6 +3,9 @@
   
   Program to test set functions
 }
+
+{ $define FPC_HAS_SET_INEQUALITIES
+  <,> <= and >= are not implemented yet (PM) }
 program TestSet;
 
 Procedure InitMSTimer;
@@ -57,7 +60,11 @@ begin
       Set2 := Set2 + [Box2 [L]] + [];
    end;
 
+{$ifdef FPC_HAS_SET_INEQUALITIES }
    if (Set1 <> Set2) OR (NOT (Set1 <= Set2)) OR (NOT (Set1 >= Set2)) then begin
+{$else FPC_HAS_SET_INEQUALITIES }
+   if (Set1 <> Set2) then begin
+{$endif FPC_HAS_SET_INEQUALITIES }
       WriteLn ('error in relational operators 1');
       Halt;
       end;
@@ -103,14 +110,20 @@ begin
          Low := Random (256);
          Hi  := Random (256);
          Set2:= Set1 + [Low..Hi];
+{$ifdef FPC_HAS_SET_INEQUALITIES }
          if (Set1 >= Set2) AND (Set1 <> Set2) then begin
+{$else FPC_HAS_SET_INEQUALITIES }
+         if (Set1 <> Set2) then begin
+{$endif FPC_HAS_SET_INEQUALITIES }
             WriteLn ('error in relational operators 2');
             Halt;
             end;
+{$ifdef FPC_HAS_SET_INEQUALITIES }
          if NOT (Set1 <= Set2) then begin
             WriteLn ('error in relational operators 3');
             Halt;
             end;
+{$endif FPC_HAS_SET_INEQUALITIES }
          Set1 := Set2;
 
       end;

+ 1 - 1
tests/teststr.pp

@@ -1,4 +1,4 @@
-{
+{ $OPT=-Fu../rtl/utils
   $Id$
   
   Program to test string functions and speed of the functions