mirror of
https://gitlab.com/freepascal.org/fpc/source.git
synced 2025-04-23 03:29:41 +02:00
+ added allexec tests if executables compiled
don't return with an error code * some changes in test files for dos
This commit is contained in:
pierre
parent
e14a086c73
commit
aa82e1cb8c
@ -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
|
||||
|
||||
@ -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;
|
||||
|
||||
@ -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,4 +1,4 @@
|
||||
{
|
||||
{ $OPT=-Fu../rtl/utils
|
||||
$Id$
|
||||
|
||||
Program to test string functions and speed of the functions
|
||||
|
||||
Loading…
Reference in New Issue
Block a user