diff --git a/tests/getret.pp b/tests/getret.pp new file mode 100644 index 0000000000..a38d10ced5 --- /dev/null +++ b/tests/getret.pp @@ -0,0 +1,51 @@ + +{ return the error code of the compiled file } +{ checks also if first line of source contains + $OPT= command line options needed } +program getret; + + uses dos; + + var com,args : string; + filename,firstline : string; + i : byte; + ppfile, retfile : text; + +begin + assign(retfile,'retcode'); + rewrite(retfile); + args:=''; + if paramcount>1 then + begin + filename:=paramstr(paramcount); + if pos('.',filename)=0 then + filename:=filename+'.pp'; + assign(ppfile,filename); + reset(ppfile); + readln(ppfile,firstline); + if pos('$OPT=',firstline)>0 then + args:=copy(Firstline,pos('=',Firstline)+1,255); + if pos('}',args)>0 then + args:=copy(args,1,pos('}',args)-1); + close(ppfile); + end; + for i:=2 to paramcount do + args:=args+' '+paramstr(i); + com:=paramstr(1); +{$ifndef linux} + if pos('.',com)=0 then + com:=com+'.exe'; +{$endif not linux} + + com:=fsearch(com,getenv('PATH')); + Writeln('Executing "',com,' ',args,'"'); + Flush(output); + swapvectors; + exec(com,args); + swapvectors; + if doserror<>0 then + write(retfile,512+doserror) + else + write(retfile,dosexitcode); + close(retfile); +end. diff --git a/tests/makefile b/tests/makefile new file mode 100644 index 0000000000..38d99e84ec --- /dev/null +++ b/tests/makefile @@ -0,0 +1,102 @@ + +# make all test +# and printout errors + +all : clean allts alltf allto + grep -n -i fails log + +# returns the error code +# of the command line +# in file retcode + +ifdef DJGPP +getreturncode : + redir -e $(FILE).log -o $(FILE).log getret $(COMMAND) +else +getreturncode : + getret $(COMMAND) !> $(FILE).log !2>$(FILE).log +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)) +else +ifdef RETCODE +RETVAL=$(shell cat retcode) +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 +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 +endif + +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 +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 +endif + +ifndef PP +PP=ppc386 +endif + +ifndef OPT +OPT= +endif + +ifdef FILE +OPTFILE=$(wildcard $(FILE).opt) +endif + +ifdef OPTFILE +override OPT+=$(OPTFILE) +endif + +ifndef FILE +FILE=ts00001.pp +endif + +testone : + make getreturncode 'COMMAND=$(PP) $(OPT) $(FILE).pp' + make printretcode 'FILE=$(FILE)' + +%.res : %.pp + make testone 'FILE=$*' + cat retcode > $*.res + make testsuccess 'FILE=$*' 'RESFILE=$*.res' + +%.ref : %.pp + make testone 'FILE=$*' + cat retcode > $*.ref + make testfail 'FILE=$*' 'RESFILE=$*.ref' + +allts : $(patsubst %.pp,%.res,$(wildcard ts*.pp)) + +alltf : $(patsubst %.pp,%.ref,$(wildcard tf*.pp)) + +allto : $(patsubst %.pp,%.res,$(wildcard to*.pp)) + +clean : + -rm *.re* log faillist diff --git a/tests/tf000001.pp b/tests/tf000001.pp new file mode 100644 index 0000000000..227e351a77 --- /dev/null +++ b/tests/tf000001.pp @@ -0,0 +1,11 @@ + +type + r=record + a :longint; + end; +var + w : ^r; +begin + if w^<>$1111 then + writeln; +end. \ No newline at end of file diff --git a/tests/ts010000.pp b/tests/ts010000.pp index b240c6ba6a..cf3adfc675 100644 --- a/tests/ts010000.pp +++ b/tests/ts010000.pp @@ -2,18 +2,18 @@ type tobject1 = class readl : longint; function readl2 : longint; - procedure writel(l : longint); - procedure writel2(l : longint); + procedure writel(ll : longint); + procedure writel2(ll : longint); property l : longint read readl write writel; property l2 : longint read readl2 write writel2; end; -procedure tobject1.writel(l : longint); +procedure tobject1.writel(ll : longint); begin end; -procedure tobject1.writel2(l : longint); +procedure tobject1.writel2(ll : longint); begin end; diff --git a/tests/ts010001.pp b/tests/ts010001.pp index 9c5501d3fc..d0392d2a82 100644 --- a/tests/ts010001.pp +++ b/tests/ts010001.pp @@ -1,3 +1,5 @@ +{ $OPT=-S2 +} type tclass = class of tobject; diff --git a/tests/ts010002.pp b/tests/ts010002.pp index d951911c11..4d6be73fae 100644 --- a/tests/ts010002.pp +++ b/tests/ts010002.pp @@ -1,4 +1,4 @@ - +{ $OPT=-S2 } { $Id$ @@ -22,6 +22,8 @@ Unit Classes; +{$M+} + Interface Type diff --git a/tests/ts010006.pp b/tests/ts010006.pp index b5adc2b112..92e30f5045 100644 --- a/tests/ts010006.pp +++ b/tests/ts010006.pp @@ -1,3 +1,4 @@ +{ $OPT=-S2 } library test; procedure exporttest;export; diff --git a/tests/ts010008.pp b/tests/ts010008.pp index 431cbfb4f9..c0e5637fb4 100644 --- a/tests/ts010008.pp +++ b/tests/ts010008.pp @@ -1,3 +1,5 @@ +{ $OPT=-S2 } + type tobject2 = class constructor create; diff --git a/tests/ts010100.pp b/tests/ts010100.pp index 95993ffd40..4bb9a168b0 100644 --- a/tests/ts010100.pp +++ b/tests/ts010100.pp @@ -1,3 +1,5 @@ +{ $OPT= -S2 +} var o : tobject; diff --git a/tests/ts010101.pp b/tests/ts010101.pp index 88be3b6843..eef7424f0c 100644 --- a/tests/ts010101.pp +++ b/tests/ts010101.pp @@ -1,3 +1,5 @@ +{ $OPT=-S2 +} { tests assignements and compare } var