+ added a makefile for tests

+ uses getref  for extracting error code
  + required command lines args can be place in the first line of
    source code
    following $OPT=
This commit is contained in:
pierre 1998-10-21 11:33:26 +00:00
parent 1a9987cfe5
commit b3867488fb
10 changed files with 180 additions and 5 deletions

51
tests/getret.pp Normal file
View File

@ -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.

102
tests/makefile Normal file
View File

@ -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

11
tests/tf000001.pp Normal file
View File

@ -0,0 +1,11 @@
type
r=record
a :longint;
end;
var
w : ^r;
begin
if w^<>$1111 then
writeln;
end.

View File

@ -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;

View File

@ -1,3 +1,5 @@
{ $OPT=-S2
}
type
tclass = class of tobject;

View File

@ -1,4 +1,4 @@
{ $OPT=-S2 }
{
$Id$
@ -22,6 +22,8 @@
Unit Classes;
{$M+}
Interface
Type

View File

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

View File

@ -1,3 +1,5 @@
{ $OPT=-S2 }
type
tobject2 = class
constructor create;

View File

@ -1,3 +1,5 @@
{ $OPT= -S2
}
var
o : tobject;

View File

@ -1,3 +1,5 @@
{ $OPT=-S2
}
{ tests assignements and compare }
var