* see readme.txt

tests/makefile

@@ -4,12 +4,7 @@
 # make all test
 # and printout errors
 
-all : clean allts alltf allto alltest
-	grep -n -i fails log
-
-# returns the error code 
-# of the command line
-# in file retcode
+all : clean all_compilations
 
 ifdef DJGPP
 
@@ -18,86 +13,95 @@ 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)
+	@echo Return code of $(FILE) is $(cat retcode)
 endif
 	
 
-RETCODE=$(wildcard retcode*)
-
 # retcode should be between 0 and 255
 # 256 is for halt
 # 512+doserror if doserror<>0
-ifdef RESFILE
-RETVAL=$(shell cat $(RESFILE))
+# 1024 RESFILE does not exist
+# 2048 RESFILE is not set
+ifndef RESFILE
+RETVAL=2048
 else
-ifdef RETCODE
-RETVAL=$(shell cat retcode)
+ifeq ($(wildcard $(RESFILE)*),$(RESFILE))
+RETVAL=$(shell cat $(RESFILE))
 else
 RETVAL=1024
 endif
 endif
 
-printretcode:
-	echo Return code of $(FILE) is $(RETVAL)
-
 ifeq ($(RETVAL),0)
 testsuccess:
-	echo Test for $(FILE) success (compiles)
-	echo Test for $(FILE) success (compiles) >>log
+	@echo Test for $(FILE) success (compiles)
+	@echo Test for $(FILE) success (compiles) >>log
 else
 testsuccess:
-	echo Test for $(FILE) fails (does not compile) error $(RETVAL)
-	echo Test for $(FILE) fails (does not compile) error $(RETVAL)>>log
-	echo $(FILE) >> faillist
+	@echo Test for $(FILE) fails (does not compile) error $(RETVAL)
+	@echo Test for $(FILE) fails (does not compile) error $(RETVAL)>>log
+	@echo $(FILE) >> ts_list
+	@echo $(FILE) >> faillist
 endif
 	
-ifdef FILE
-ifneq ($wildcard $(FILE).exc),)
-EXERETVAL:=$(shell cat $(FILE).exc)
+ifdef EXCFILE
+ifeq ($(wildcard $(EXCFILE)*),$(EXCFILE))
+EXERETVAL:=$(shell cat $(EXCFILE))
 else
-EXERETVAL=-1
+EXERETVAL=$(EXCFILE) does not exist
 endif
 else
-EXERETVAL=-2
+EXERETVAL=No EXCFILE variable defined
 endif
 
 ifeq ($(EXERETVAL),0)
 testexecsuccess:
-	echo Test for exec $(FILE) success (runs without error)
-	echo Test for $(FILE) success (runs without error) >>log
+	@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
+	@echo Test for exec $(FILE) fails exec error $(EXERETVAL)
+	@echo Test for exec $(FILE) fails exec error $(EXERETVAL)>>log
 endif
 	
-ifneq ($(wildcard $(FILE)$(EXEEXT)),)
+ifeq ($(wildcard $(FILE)$(EXEEXT)*),$(FILE)$(EXEEXT))
 testexec:
-	redir -e $(FILE).elg -o$(FILE).elg getret $(FILE)$(EXEEXT)
-	cp retcode $(FILE).exc
-	make testexecsuccess 'FILE=$(FILE)' 
+	@echo Testing $(FILE)$(EXEEXT)
+ifdef NOREDIR
+	getret $(FILE)$(EXEEXT)
+else
+	redir -e $(FILE).elg -o $(FILE).elg getret $(FILE)$(EXEEXT)
+endif
+	cp -f retcode $(FILE).exc
+	$(MAKE) testexecsuccess 'FILE=$(FILE)' 'EXCFILE=$(FILE).exc'
 else
 testexec:
-	echo No exefile $(FILE)$(EXEEXT)
-	make testexecsuccess 'FILE=$(FILE)' 
-	true
+	@echo No exefile $(FILE)$(EXEEXT)
+	@echo $(FILE) >> faillist
 endif
+
+test_exc :
+	@echo $(wildcard $(FILE).exc*)
+	@echo xx$(wildcard $(EXCFILE)*)xx xx$(EXCFILE)xx
+	cat $(FILE).exc
 	
 ifneq ($(RETVAL),0)
 testfail:
-	echo Test for $(FILE) success (does not compile) error $(RETVAL)
-	echo Test for $(FILE) success (does not compile) error $(RETVAL)>> log
+	@echo Test for $(FILE) success (does not compile) error $(RETVAL)
+	@echo Test for $(FILE) success (does not compile) error $(RETVAL)>> log
 else
 testfail:
-	echo Test for $(FILE) fails (does compile and should not)
-	echo Test for $(FILE) fails (does compile and should not) >> log
-	echo $(FILE) >> faillist
+	@echo Test for $(FILE) fails (does compile and should not)
+	@echo Test for $(FILE) fails (does compile and should not) >> log
+	@echo $(FILE) >> tf_list
+	@echo $(FILE) >> faillist
 endif
 	
 ifndef PP
@@ -123,43 +127,104 @@ FILE=ts00001.pp
 endif
 
 testone :
-	make getreturncode 'COMMAND=$(PP) $(OPT) $(FILE).pp' 'RESEXT=$(RESEXT)'
-	make printretcode 'FILE=$(FILE)'
+	$(MAKE) getreturncode 'COMMAND=$(PP) $(OPT) $(FILE).pp' 'RESEXT=$(RESEXT)' 'FILE=$(FILE)'
 
 %.res : %.pp
-	make testone 'FILE=$*' 'RESEXT=res'
-	make testsuccess 'FILE=$*' 'RESFILE=$*.res'
+	$(MAKE) testone 'FILE=$*' 'RESEXT=res'
+	$(MAKE) testsuccess 'FILE=$*' 'RESFILE=$*.res'
 
 %.ref : %.pp
-	make testone 'FILE=$*' 'RESEXT=ref'
-	make testfail 'FILE=$*' 'RESFILE=$*.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=$*'
+	$(MAKE) testexec 'FILE=$*'
+	
+%.eli : %.res
+	$(MAKE) testexec 'FILE=$*' 'NOREDIR=YES'
 	
 allts : $(patsubst %.pp,%.res,$(wildcard ts*.pp))
 
+alltbs : $(patsubst %.pp,%.res,$(wildcard tbs*.pp))
+
 alltest : $(patsubst %.pp,%.res,$(wildcard test*.pp))
 
+alltesi : $(patsubst %.pp,%.res,$(wildcard tesi*.pp))
+
+alltis : $(patsubst %.pp,%.res,$(wildcard tis*.pp))
+
 alltf : $(patsubst %.pp,%.ref,$(wildcard tf*.pp))
 
+alltbf : $(patsubst %.pp,%.ref,$(wildcard tbf*.pp))
+
 allto : $(patsubst %.pp,%.res,$(wildcard to*.pp))
 
-allexec : alltsexec alltestexec
+ifndef TS_FAIL_LIST
+ifeq ($(wildcard ts_fail*),ts_fail)
+TS_FAIL_LIST=$(shell cat ts_fail)
+export TS_FAIL_LIST
+endif
+endif
+
+ifndef TF_FAIL_LIST
+ifeq ($(wildcard tf_fail*),tf_fail)
+TF_FAIL_LIST=$(shell cat tf_fail)
+export TF_FAIL_LIST
+endif
+endif
+
+clean_fail :
+	-rm $(addsuffix .res,$(TS_FAIL_LIST)) 
+	-rm $(addsuffix .ref,$(TF_FAIL_LIST)) 
+	-rm log
+
+again : clean_fail $(addsuffix .res,$(TS_FAIL_LIST)) \
+	$(addsuffix .ref,$(TF_FAIL_LIST)) 
+	grep fails log
+
+all_compilations : allts alltbs alltf alltbf allto alltest alltesi alltis
+	grep fails log
+
+allexec : alltsexec alltbsexec alltestexec
 
 alltestexec: $(patsubst %.pp,%.elg,$(wildcard test*.pp)) 
 
+# these test are interactive
+# no redirection !!!
+alltesiexec: $(patsubst %.pp,%.eli,$(wildcard test*.pp)) 
+
 alltsexec: $(patsubst %.pp,%.elg,$(wildcard ts*.pp)) 
 
-clean :
-	-rm *.re* *.o *.ppu ts*.exe tf*.exe log faillist
+alltbsexec: $(patsubst %.pp,%.elg,$(wildcard tbs*.pp)) 
 
+alltisexec: $(patsubst %.pp,%.eli,$(wildcard tis*.pp)) 
+
+clean :
+	-rm *.re* *.o *.ppu *.elg ts*.exe tf*.exe log faillist ts_fail tf_fail
+
+info :
+	@echo This Makefile allows to test the compiler
+	@echo compilation of 'ts*.pp' should succeed
+	@echo compilation of 'tf*.pp' should fail
+	@echo compilation of 'test*.pp' should succeed
+	@echo 'to*.pp' files should also compile
+	@echo simply run \'make\' to test all compilation
+	@echo run \'make allexec\' to test also if the executables
+	@echo created behave like the should
+	@echo run \'make tesiexec\' to test executables 
+	@echo that require interactive mode
+	@echo To add a test file
+	@echo for 'ts*.pp' the created program should call halt or runerror
+	@echo if the code is wrong
 # $Log$
-# Revision 1.7  1998-10-22 16:41:11  pierre
+# Revision 1.8  1998-10-28 09:52:26  pierre
+#  * see readme.txt
+#
+# Revision 1.7  1998/10/22 16:41:11  pierre
 #   * added two small tests
 #     iocheck inside iocheck
 #     enums inside objects

tests/readme.txt

@@ -0,0 +1,54 @@
+  TESTS directory for FPC :
+
+  several test programs for FPC 
+  with compilation and execution tests.
+
+  Standard way :
+  'make all' will try to compile all the sources
+   will printout a list of errors
+  - programs that do not compile but should
+  - programs that do compile when they should create an error !
+
+  'make allexec' will try to run all non interactive executables
+  'make alltesiexec' will try to run all interactive executables
+
+  source files are separated in different pattern :
+
+   ts*.pp 
+   files that should compile and run without error (if programs !)
+   
+target 'allts' compiles all these files
+    ts*.log contains the output of  the compiler
+    ts*.res contains the return code (should be zero !)
+
+target 'alltsexec' runs all these files
+   they are run non interactively without arguments
+   ts*.exc contains the return code should be zero
+   (I basically added some halt(1) if the 
+   execution is faulty !)
+   ts*.elg contains the output of the program 
+
+  tf*.pp 
+  files that should fail on compilation
+  target 'alltf' tries to compile all these files
+  tf*.res should have a non zero value !!
+
+  to*.pp special case for optimization
+(treated like ts*.pp)
+
+  test*.pp are treated like ts*.pp
+but with targets 'alltest' and 'alltestexec'
+
+  tesi*.pp are special cases of programs that require interactive
+handling (readln or keypressed ...)
+ these are only executed with tagert 'alltesiexec'
+
+  Lastly :
+
+   tbs*.pp are like ts*.pp 
+but are translations from the bugs directory
+(i.e. tests that the bug has been removed !!)
+
+  tbf*.pp are like tf*.pp
+  tis*.pp are like tesi*.pp 
+

tests/tbs0001.pp

@@ -0,0 +1,9 @@
+program smalltest;
+  const
+      teststr : string = ' '#9#255#0;
+begin
+      writeln(teststr);
+      teststr := 'gaga';
+      writeln(teststr);
+      if teststr<>'gaga' then halt(1);	
+end.

tests/tbs0002.pp

@@ -0,0 +1,83 @@
+unit tbs0002;
+
+  interface
+
+  implementation
+
+{$message starting hexstr}
+    function hexstr(val : longint;cnt : byte) : string;
+    
+      const 
+         hexval : string[16]=('0123456789ABCDEF');
+         
+      var 
+         s : string;
+         l2,i : integer;
+         l1 : longInt;
+         
+      begin
+         s[0]:=char(cnt);
+         l1:=longint($f) shl (4*(cnt-1));
+         for i:=1 to cnt do 
+           begin
+              l2:=(val and l1) shr (4*(cnt-i));
+              l1:=l1 shr 4;
+              s[i]:=hexval[l2+1];
+           end;
+         hexstr:=s;
+      end;
+
+{$message starting dump_stack}
+
+    procedure dump_stack(bp : longint);
+
+{$message starting get_next_frame}
+
+      function get_next_frame(bp : longint) : longint;
+
+        begin
+           asm
+              movl bp,%eax
+              movl (%eax),%eax
+              movl %eax,__RESULT
+           end ['EAX'];
+        end;
+
+      procedure dump_frame(addr : longint);
+
+        begin
+           { to be used by symify }
+           writeln('  0x',HexStr(addr,8));
+        end;
+
+{$message starting get_addr}
+
+      function get_addr(BP : longint) : longint;
+
+        begin
+           asm
+              movl BP,%eax
+              movl 4(%eax),%eax
+              movl %eax,__RESULT
+           end ['EAX'];
+        end;
+
+{$message starting main}
+
+      var
+         i,prevbp : longint;
+
+      begin
+         prevbp:=bp-1;
+         i:=0;
+         while bp > prevbp do
+           begin
+              dump_frame(get_addr(bp));
+              i:=i+1;
+              if i>max_frame_dump then exit;
+              prevbp:=bp;
+              bp:=get_next_frame(bp);
+           end;
+      end;
+
+end.

tests/tbs0003.pp

@@ -0,0 +1,18 @@
+unit tbs0003;
+
+  interface
+
+  implementation
+
+
+    procedure dump_stack(bp : longint);
+
+      function get_next_frame(bp : longint) : longint;
+
+        begin
+        end;
+
+      begin
+      end;
+
+end.

tests/testcrt.pp → tests/tesicrt.pp

@@ -4,7 +4,7 @@
   Program to test CRT unit by Mark May.
   Only standard TP functions are tested (except WhereX, WhereY).
 }
-program testcrt;
+program tesicrt;
 
 uses crt;
 var

tests/testdos.pp → tests/tesidos.pp

@@ -5,7 +5,7 @@
   Only main TP functions are tested (nothing with Interrupts/Break/Verify).
 }
 {$V-}
-program testdos;
+program tesidos;
 uses dos;
 
 procedure TestInfo;

tests/ts010002.pp

@@ -1,4 +1,4 @@
-{ $OPT=-S2 }
+{ $OPT=-S2 -al -s }
 
 {
     $Id$

tests/ts010006.pp

@@ -1,4 +1,4 @@
-{ $OPT=-S2 }
+{ $OPT=-S2 -Tos2 }
 library test;
 
   procedure exporttest;export;

tests/ts010007.pp

@@ -1,3 +1,8 @@
+{ needed to intercept  GPF (PM) }
+{$ifdef go32v2}
+  uses dpmiexcp;
+{$endif go32v2}
+
 type
    tobject2 = class
       i : longint;
@@ -10,6 +15,7 @@ type
   procedure tobject2.y;
 
     begin
+	Writeln('Procedure y called');
     end;
 
   class procedure tobject2.v;
@@ -36,6 +42,7 @@ type
      object2 : tobject2;
 
 begin
+   a:=tobject2;
    a.x;
    tobject2.x;
    object2:=tobject2.create;

tests/ts010008.pp

@@ -35,6 +35,7 @@ begin
    o2.name:='1234';
    writeln(o2.name);
    o2.destroy;
+   c2:=tobject2;
    o2:=c2.create;
-   c2.destroy;
+   o2.destroy;
 end.