mirror of
https://gitlab.com/freepascal.org/fpc/source.git
synced 2025-04-14 10:20:21 +02:00
+ 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:
parent
1a9987cfe5
commit
b3867488fb
51
tests/getret.pp
Normal file
51
tests/getret.pp
Normal 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
102
tests/makefile
Normal 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
11
tests/tf000001.pp
Normal file
@ -0,0 +1,11 @@
|
||||
|
||||
type
|
||||
r=record
|
||||
a :longint;
|
||||
end;
|
||||
var
|
||||
w : ^r;
|
||||
begin
|
||||
if w^<>$1111 then
|
||||
writeln;
|
||||
end.
|
@ -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;
|
||||
|
@ -1,3 +1,5 @@
|
||||
{ $OPT=-S2
|
||||
}
|
||||
type
|
||||
tclass = class of tobject;
|
||||
|
||||
|
@ -1,4 +1,4 @@
|
||||
|
||||
{ $OPT=-S2 }
|
||||
|
||||
{
|
||||
$Id$
|
||||
@ -22,6 +22,8 @@
|
||||
|
||||
Unit Classes;
|
||||
|
||||
{$M+}
|
||||
|
||||
Interface
|
||||
|
||||
Type
|
||||
|
@ -1,3 +1,4 @@
|
||||
{ $OPT=-S2 }
|
||||
library test;
|
||||
|
||||
procedure exporttest;export;
|
||||
|
@ -1,3 +1,5 @@
|
||||
{ $OPT=-S2 }
|
||||
|
||||
type
|
||||
tobject2 = class
|
||||
constructor create;
|
||||
|
@ -1,3 +1,5 @@
|
||||
{ $OPT= -S2
|
||||
}
|
||||
var
|
||||
o : tobject;
|
||||
|
||||
|
@ -1,3 +1,5 @@
|
||||
{ $OPT=-S2
|
||||
}
|
||||
{ tests assignements and compare }
|
||||
|
||||
var
|
||||
|
Loading…
Reference in New Issue
Block a user