diff --git a/tests/Makefile b/tests/Makefile index b0ba95c80e..8bba69984f 100644 --- a/tests/Makefile +++ b/tests/Makefile @@ -1,8 +1,266 @@ # -# $Id$ +# Makefile generated by fpcmake v0.99.13 on 1999-12-02 18:33 # -# make all test -# and printout errors + +defaultrule: info + +##################################################################### +# Autodetect OS (Linux or Dos or Windows NT) +# define inlinux when running under linux +# define inWinNT when running under WinNT +##################################################################### + +# We need only / in the path +override PATH:=$(subst \,/,$(PATH)) + +# Search for PWD and determine also if we are under linux +PWD:=$(strip $(wildcard $(addsuffix /pwd.exe,$(subst ;, ,$(PATH))))) +ifeq ($(PWD),) +PWD:=$(strip $(wildcard $(addsuffix /pwd,$(subst :, ,$(PATH))))) +ifeq ($(PWD),) +nopwd: + @echo You need the GNU utils package to use this Makefile! + @echo Get ftp://ftp.freepascal.org/pub/fpc/dist/go32v2/utilgo32.zip + @exit +else +inlinux=1 +endif +else +PWD:=$(firstword $(PWD)) +endif + +# Detect NT - NT sets OS to Windows_NT +ifndef inlinux +ifeq ($(OS),Windows_NT) +inWinNT=1 +endif +endif + +# Detect OS/2 - OS/2 has OS2_SHELL defined +ifndef inlinux +ifndef inWinNT +ifdef OS2_SHELL +inOS2=1 +endif +endif +endif + +# The extension of executables +ifdef inlinux +EXEEXT= +else +EXEEXT=.exe +endif + +# The path which is search separated by spaces +ifdef inlinux +SEARCHPATH=$(subst :, ,$(PATH)) +else +SEARCHPATH=$(subst ;, ,$(PATH)) +endif + +##################################################################### +# FPC version/target Detection +##################################################################### + +# What compiler to use ? +ifndef FPC +ifdef inOS2 +export FPC=ppos2$(EXEEXT) +else +export FPC=ppc386$(EXEEXT) +endif +endif + +# Target OS +ifndef OS_TARGET +export OS_TARGET:=$(shell $(FPC) -iTO) +endif + +# Source OS +ifndef OS_SOURCE +export OS_SOURCE:=$(shell $(FPC) -iSO) +endif + +# Target CPU +ifndef CPU_TARGET +export CPU_TARGET:=$(shell $(FPC) -iTP) +endif + +# Source CPU +ifndef CPU_SOURCE +export CPU_SOURCE:=$(shell $(FPC) -iSP) +endif + +# FPC version +ifndef FPC_VERSION +export FPC_VERSION:=$(shell $(FPC) -iV) +endif + +##################################################################### +# Default Settings +##################################################################### + +# Release ? Then force OPT and don't use extra opts via commandline +ifndef REDIRFILE +REDIRFILE=log +endif + +ifdef RELEASE +override OPT:=-Xs -OG2p3 -n +endif + +# Verbose settings (warning,note,info) +ifdef VERBOSE +override OPT+=-vwni +endif + +ifdef REDIR +ifndef inlinux +override FPC=redir -eo $(FPC) +endif +# set the verbosity to max +override OPT+=-va +override REDIR:= >> $(REDIRFILE) +endif + +##################################################################### +# User Settings +##################################################################### + + +# Targets + + +# Clean + + +# Install + +ZIPTARGET=install + +# Defaults + + +# Directories + +ifndef PACKAGEDIR +PACKAGEDIR=$(FPCDIR)/packages +endif +ifndef COMPONENTDIR +COMPONENTDIR=$(FPCDIR)/components +endif + +# Packages + + +# Libraries + + +##################################################################### +# Default extensions +##################################################################### + +# Default needed extensions (Go32v2,Linux) +LOADEREXT=.as +PPLEXT=.ppl +PPUEXT=.ppu +OEXT=.o +ASMEXT=.s +SMARTEXT=.sl +STATICLIBEXT=.a +SHAREDLIBEXT=.so +PACKAGESUFFIX= + +# Go32v1 +ifeq ($(OS_TARGET),go32v1) +PPUEXT=.pp1 +OEXT=.o1 +ASMEXT=.s1 +SMARTEXT=.sl1 +STATICLIBEXT=.a1 +SHAREDLIBEXT=.so1 +PACKAGESUFFIX=v1 +endif + +# Go32v2 +ifeq ($(OS_TARGET),go32v2) +PACKAGESUFFIX=go32 +endif + +# Linux +ifeq ($(OS_TARGET),linux) +PACKAGESUFFIX=linux +endif + +# Win32 +ifeq ($(OS_TARGET),win32) +PPUEXT=.ppw +OEXT=.ow +ASMEXT=.sw +SMARTEXT=.slw +STATICLIBEXT=.aw +SHAREDLIBEXT=.dll +PACKAGESUFFIX=win32 +endif + +# OS/2 +ifeq ($(OS_TARGET),os2) +PPUEXT=.ppo +ASMEXT=.so2 +OEXT=.oo2 +SMARTEXT=.so +STATICLIBEXT=.ao2 +SHAREDLIBEXT=.dll +PACKAGESUFFIX=os2 +endif + +# library prefix +LIBPREFIX=lib +ifeq ($(OS_TARGET),go32v2) +LIBPREFIX= +endif +ifeq ($(OS_TARGET),go32v1) +LIBPREFIX= +endif + +# determine which .pas extension is used +ifndef PASEXT +ifdef EXEOBJECTS +override TESTPAS:=$(strip $(wildcard $(addsuffix .pas,$(firstword $(EXEOBJECTS))))) +else +override TESTPAS:=$(strip $(wildcard $(addsuffix .pas,$(firstword $(UNITOBJECTS))))) +endif +ifeq ($(TESTPAS),) +PASEXT=.pp +else +PASEXT=.pas +endif +endif + +##################################################################### +# Standard rules +##################################################################### + +##################################################################### +# Package depends +##################################################################### + +ifneq ($(wildcard $(RTLDIR)),) +ifeq ($(wildcard $(RTLDIR)/$(FPCMAKED)),) +override COMPILEPACKAGES+=rtl +rtl_package: + $(MAKE) -C $(RTLDIR) all +endif +endif + +.PHONY: rtl_package + +##################################################################### +# Users rules +##################################################################### + +DIRS=tf ts tbs tbf test tesi to all : info @@ -10,9 +268,7 @@ tests : clean all_compilations cont_tests : all_compilations -ifdef DJGPP - -EXEEXT=.exe +ifndef inlinux getreturncode : redir -ea $(FILE).log -oa $(FILE).log getret $(COMMAND) @@ -20,11 +276,11 @@ getreturncode : else -EXEEXT= getreturncode : getret $(COMMAND) > $(FILE).log 2>$(FILE).log cp retcode $(FILE).$(RESEXT) @echo "Return code of $(FILE) is $(cat retcode)" + endif @@ -81,7 +337,7 @@ testexec: ifdef NOREDIR getret $(FILE)$(EXEEXT) else -ifdef DJGPP +ifndef inlinux redir -e $(FILE).elg -o $(FILE).elg getret $(FILE)$(EXEEXT) else getret $(FILE)$(EXEEXT) > $(FILE).elg 2>$(FILE).elg @@ -91,9 +347,13 @@ endif $(MAKE) testexecsuccess 'FILE=$(FILE)' 'EXCFILE=$(FILE).exc' else testexec: +ifeq ($(wildcard $(FILE)$(PPUEXT)),$(FILE)$(PPUEXT)) + @echo "file is a unit $(FILE)$(PPUEXT)" +else @echo "No exefile $(FILE)$(EXEEXT)" @echo $(FILE) >> faillist endif +endif test_exc : @echo $(wildcard $(FILE).exc*) @@ -111,16 +371,6 @@ testfail: @echo $(FILE) >> tf_fail @echo $(FILE) >> faillist endif - -ifndef PP -PP=ppc386 -else -export PP -endif - -ifndef OPT -OPT= -endif ifdef FILE OPTFILE=$(wildcard $(FILE).opt) @@ -135,7 +385,8 @@ FILE=ts00001.pp endif testone : - $(MAKE) getreturncode 'COMMAND=$(PP) $(OPT) $(FILE).pp' 'RESEXT=$(RESEXT)' 'FILE=$(FILE)' + $(MAKE) getreturncode 'COMMAND=$(FPC) $(OPT) $(FILE).pp' 'RESEXT=$(RESEXT)' 'FILE=$(FILE)' + %.res : %.pp $(MAKE) testone 'FILE=$*' 'RESEXT=res' @@ -155,30 +406,25 @@ testone : %.eli : %.res $(MAKE) testexec 'FILE=$*' 'NOREDIR=YES' -allts : $(patsubst %.pp,%.res,$(wildcard ts*.pp)) +allts : $(patsubst %.pp,%.res,$(wildcard ts/ts*.pp)) -alltbs : $(patsubst %.pp,%.res,$(wildcard tbs*.pp)) +alltbs : $(patsubst %.pp,%.res,$(wildcard tbs/tbs*.pp)) tbs0to99 : $(patsubst %.pp,%.res,$(wildcard tbs00*.pp)) -tbs100to199 : $(patsubst %.pp,%.res,$(wildcard tbs01*.pp)) -tbs200to299 : $(patsubst %.pp,%.res,$(wildcard tbs02*.pp)) -tbs300to399 : $(patsubst %.pp,%.res,$(wildcard tbs03*.pp)) +tbs100to199 : $(patsubst %.pp,%.res,$(wildcard tbs/tbs01*.pp)) +tbs200to299 : $(patsubst %.pp,%.res,$(wildcard tbs/tbs02*.pp)) -alltest : $(patsubst %.pp,%.res,$(wildcard test*.pp)) +alltest : $(patsubst %.pp,%.res,$(wildcard test/test*.pp)) -alltbug : $(patsubst %.pp,%.res,$(wildcard tbug*.pp)) +alltesi : $(patsubst %.pp,%.res,$(wildcard tesi/tesi*.pp)) -alltbuf : $(patsubst %.pp,%.ref,$(wildcard tbuf*.pp)) +alltis : $(patsubst %.pp,%.res,$(wildcard tis/tis*.pp)) -alltesi : $(patsubst %.pp,%.res,$(wildcard tesi*.pp)) +alltf : $(patsubst %.pp,%.ref,$(wildcard tf/tf*.pp)) -alltis : $(patsubst %.pp,%.res,$(wildcard tis*.pp)) +alltbf : $(patsubst %.pp,%.ref,$(wildcard tbf/tbf*.pp)) -alltf : $(patsubst %.pp,%.ref,$(wildcard tf*.pp)) - -alltbf : $(patsubst %.pp,%.ref,$(wildcard tbf*.pp)) - -allto : $(patsubst %.pp,%.res,$(wildcard to*.pp)) +allto : $(patsubst %.pp,%.res,$(wildcard to/to*.pp)) ifndef TS_FAIL_LIST ifeq ($(wildcard ts_fail*),ts_fail) @@ -202,111 +448,51 @@ clean_fail : again : clean_fail $(addsuffix .res,$(TS_FAIL_LIST)) $(addsuffix .ref,$(TF_FAIL_LIST)) grep fails log -all_compilations : allts alltbs alltf alltbf alltbug alltbuf allto alltest alltesi alltis +all_compilations : allts alltbs alltf alltbf allto alltest alltesi alltis grep fails log -allexec : alltsexec alltbsexec alltbugexec alltestexec +allexec : alltsexec alltbsexec alltestexec grep "fails exec" log -alltestexec: $(patsubst %.pp,%.elg,$(wildcard test*.pp)) +alltestexec: $(patsubst %.pp,%.elg,$(wildcard test/test*.pp)) # these test are interactive # no redirection !!! -alltesiexec: $(patsubst %.pp,%.eli,$(wildcard test*.pp)) +alltesiexec: $(patsubst %.pp,%.eli,$(wildcard tesi/tesi*.pp)) -alltsexec: $(patsubst %.pp,%.elg,$(wildcard ts*.pp)) +alltsexec: $(patsubst %.pp,%.elg,$(wildcard ts/ts*.pp)) -alltbugexec : $(patsubst %.pp,%.elg,$(wilcard tbug*.pp)) +alltbsexec: $(patsubst %.pp,%.elg,$(wildcard tbs/tbs*.pp)) -alltbsexec: $(patsubst %.pp,%.elg,$(wildcard tbs*.pp)) +tbsexec0to99 : $(patsubst %.pp,%.elg,$(wildcard tbs/tbs00*.pp)) +tbsexec100to199 : $(patsubst %.pp,%.elg,$(wildcard tbs/tbs01*.pp)) +tbsexec200to299 : $(patsubst %.pp,%.elg,$(wildcard tbs/tbs02*.pp)) -tbsexec0to99 : $(patsubst %.pp,%.elg,$(wildcard tbs00*.pp)) -tbsexec100to199 : $(patsubst %.pp,%.elg,$(wildcard tbs01*.pp)) -tbsexec200to299 : $(patsubst %.pp,%.elg,$(wildcard tbs02*.pp)) -tbsexec300to399 : $(patsubst %.pp,%.elg,$(wildcard tbs03*.pp)) +alltisexec: $(patsubst %.pp,%.eli,$(wildcard tis/tis*.pp)) -alltisexec: $(patsubst %.pp,%.eli,$(wildcard tis*.pp)) - -clean : - -rm -f *.re* *.o *.ppu *.log *.elg *.exc t*.exe log faillist ts_fail tf_fail - -rm -f ppas.sh ppas.bat retcode -ifndef DJGPP - -rm -f $(patsubst %.pp,%,$(wildcard *.pp)) +clean: + -rm -f $(addsuffix /*.re*,$(DIRS)) + -rm -f $(addsuffix /*$(PPUEXT),$(DIRS)) + -rm -f $(addsuffix /*$(OEXT),$(DIRS)) + -rm -f $(addsuffix /*.log,$(DIRS)) + -rm -f $(addsuffix /*.elg,$(DIRS)) + -rm -f $(addsuffix /*.exc,$(DIRS)) +ifdef inlinux + -rm -f $(patsubst %.pp,%$(EXEEXT),$(wildcard $(addsuffix /t*.pp,$(DIRS)))) +else + -rm -f $(addsuffix /*$(EXEEXT),$(DIRS)) endif + -rm -f log faillist ts_fail tf_fail + -rm -f fpcmaked ppas.sh ppas.bat retcode 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 'tbs*.pp' are files from bugs directory that should compile and run - @echo 'tbf*.pp' are files from bugs directory that should not compile - @echo 'tbug*.pp' are files from web bug repository that should compile and run - @echo 'tbuf*.pp' are files from web bug repository that should not compile @echo 'to*.pp' files should also compile @echo simply run \'make tests\' 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 - -# -# $Log$ -# Revision 1.8 1999-12-02 13:37:37 pierre -# + latest bugs converted -# -# Revision 1.7 1999/12/02 00:12:31 pierre -# + splitted targets for Win95 selector bug -# -# Revision 1.6 1999/10/13 12:42:09 pierre -# * small fixes for win32 -# -# Revision 1.5 1999/09/19 11:48:18 peter -# * remove ppas and retcode -# -# Revision 1.4 1999/09/19 11:23:06 peter -# * clean also the executables under linux -# -# Revision 1.3 1999/06/01 13:27:27 peter -# * updates for linux -# -# Revision 1.2 1999/06/01 00:06:14 peter -# * linux fixes -# -# Revision 1.1 1999/01/25 20:23:04 peter -# * linux updates -# -# Revision 1.12 1999/01/19 18:01:43 pierre -# local change removed -# -# Revision 1.11 1999/01/19 17:34:01 pierre -# several modifications -# -# Revision 1.10 1999/01/15 17:41:58 pierre -# + new bugs converted -# -# Revision 1.9 1998/11/10 11:13:07 pierre -# * more tests -# -# 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 -# -# 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 -# * stupid error removing getret.exe each time -# -# Revision 1.3 1998/10/21 12:12:09 pierre -# Log inserted -# diff --git a/tests/Makefile.fpc b/tests/Makefile.fpc new file mode 100644 index 0000000000..14e81d2606 --- /dev/null +++ b/tests/Makefile.fpc @@ -0,0 +1,248 @@ +# +# Makefile.fpc for Free Pascal Tests directory +# + +[defaults] +defaultrule=info + +[sections] +none=1 +exts=1 + +[rules] +DIRS=tf ts tbs tbf test tesi to + +all : info + +tests : clean all_compilations + +cont_tests : all_compilations + +ifndef inlinux + +getreturncode : + redir -ea $(FILE).log -oa $(FILE).log getret $(COMMAND) + cp retcode $(FILE).$(RESEXT) + +else + +getreturncode : + getret $(COMMAND) > $(FILE).log 2>$(FILE).log + cp retcode $(FILE).$(RESEXT) + @echo "Return code of $(FILE) is $(cat retcode)" + +endif + + +# retcode should be between 0 and 255 +# 256 is for halt +# 512+doserror if doserror<>0 +# 1024 RESFILE does not exist +# 2048 RESFILE is not set +ifndef RESFILE +RETVAL=2048 +else +ifeq ($(wildcard $(RESFILE)*),$(RESFILE)) +RETVAL=$(shell cat $(RESFILE)) +else +RETVAL=1024 +endif +endif + +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) >> ts_fail + @echo $(FILE) >> faillist +endif + +ifdef EXCFILE +ifeq ($(wildcard $(EXCFILE)*),$(EXCFILE)) +EXERETVAL:=$(shell cat $(EXCFILE)) +else +EXERETVAL=$(EXCFILE) does not exist +endif +else +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 +else +testexecsuccess: + @echo "Test for exec $(FILE) fails exec error $(EXERETVAL)" + @echo "Test for exec $(FILE) fails exec error $(EXERETVAL)" >>log +endif + +ifeq ($(wildcard $(FILE)$(EXEEXT)),$(FILE)$(EXEEXT)) +testexec: + @echo "Testing $(FILE)$(EXEEXT)" +ifdef NOREDIR + getret $(FILE)$(EXEEXT) +else +ifndef inlinux + redir -e $(FILE).elg -o $(FILE).elg getret $(FILE)$(EXEEXT) +else + getret $(FILE)$(EXEEXT) > $(FILE).elg 2>$(FILE).elg +endif +endif + cp -f retcode $(FILE).exc + $(MAKE) testexecsuccess 'FILE=$(FILE)' 'EXCFILE=$(FILE).exc' +else +testexec: +ifeq ($(wildcard $(FILE)$(PPUEXT)),$(FILE)$(PPUEXT)) + @echo "file is a unit $(FILE)$(PPUEXT)" +else + @echo "No exefile $(FILE)$(EXEEXT)" + @echo $(FILE) >> faillist +endif +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 +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) >> tf_fail + @echo $(FILE) >> faillist +endif + +ifdef FILE +OPTFILE=$(wildcard $(FILE).opt) +endif + +ifdef OPTFILE +override OPT+=$(OPTFILE) +endif + +ifndef FILE +FILE=ts00001.pp +endif + +testone : + $(MAKE) getreturncode 'COMMAND=$(FPC) $(OPT) $(FILE).pp' 'RESEXT=$(RESEXT)' 'FILE=$(FILE)' + + +%.res : %.pp + $(MAKE) testone 'FILE=$*' 'RESEXT=res' + $(MAKE) testsuccess 'FILE=$*' 'RESFILE=$*.res' + +%.ref : %.pp + $(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=$*' + +%.eli : %.res + $(MAKE) testexec 'FILE=$*' 'NOREDIR=YES' + +allts : $(patsubst %.pp,%.res,$(wildcard ts/ts*.pp)) + +alltbs : $(patsubst %.pp,%.res,$(wildcard tbs/tbs*.pp)) + +tbs0to99 : $(patsubst %.pp,%.res,$(wildcard tbs00*.pp)) +tbs100to199 : $(patsubst %.pp,%.res,$(wildcard tbs/tbs01*.pp)) +tbs200to299 : $(patsubst %.pp,%.res,$(wildcard tbs/tbs02*.pp)) + +alltest : $(patsubst %.pp,%.res,$(wildcard test/test*.pp)) + +alltesi : $(patsubst %.pp,%.res,$(wildcard tesi/tesi*.pp)) + +alltis : $(patsubst %.pp,%.res,$(wildcard tis/tis*.pp)) + +alltf : $(patsubst %.pp,%.ref,$(wildcard tf/tf*.pp)) + +alltbf : $(patsubst %.pp,%.ref,$(wildcard tbf/tbf*.pp)) + +allto : $(patsubst %.pp,%.res,$(wildcard to/to*.pp)) + +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 -f $(addsuffix .res,$(TS_FAIL_LIST)) + -rm -f $(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 + grep "fails exec" log + +alltestexec: $(patsubst %.pp,%.elg,$(wildcard test/test*.pp)) + +# these test are interactive +# no redirection !!! +alltesiexec: $(patsubst %.pp,%.eli,$(wildcard tesi/tesi*.pp)) + +alltsexec: $(patsubst %.pp,%.elg,$(wildcard ts/ts*.pp)) + +alltbsexec: $(patsubst %.pp,%.elg,$(wildcard tbs/tbs*.pp)) + +tbsexec0to99 : $(patsubst %.pp,%.elg,$(wildcard tbs/tbs00*.pp)) +tbsexec100to199 : $(patsubst %.pp,%.elg,$(wildcard tbs/tbs01*.pp)) +tbsexec200to299 : $(patsubst %.pp,%.elg,$(wildcard tbs/tbs02*.pp)) + +alltisexec: $(patsubst %.pp,%.eli,$(wildcard tis/tis*.pp)) + +clean: + -rm -f $(addsuffix /*.re*,$(DIRS)) + -rm -f $(addsuffix /*$(PPUEXT),$(DIRS)) + -rm -f $(addsuffix /*$(OEXT),$(DIRS)) + -rm -f $(addsuffix /*.log,$(DIRS)) + -rm -f $(addsuffix /*.elg,$(DIRS)) + -rm -f $(addsuffix /*.exc,$(DIRS)) +ifdef inlinux + -rm -f $(patsubst %.pp,%$(EXEEXT),$(wildcard $(addsuffix /t*.pp,$(DIRS)))) +else + -rm -f $(addsuffix /*$(EXEEXT),$(DIRS)) +endif + -rm -f log faillist ts_fail tf_fail + -rm -f fpcmaked ppas.sh ppas.bat retcode + +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 tests\' 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 diff --git a/tests/tbf0008.pp b/tests/tbf/tbf0008.pp similarity index 100% rename from tests/tbf0008.pp rename to tests/tbf/tbf0008.pp diff --git a/tests/tbf0010.pp b/tests/tbf/tbf0010.pp similarity index 100% rename from tests/tbf0010.pp rename to tests/tbf/tbf0010.pp diff --git a/tests/tbf0029.pp b/tests/tbf/tbf0029.pp similarity index 73% rename from tests/tbf0029.pp rename to tests/tbf/tbf0029.pp index 8ef9909e07..c6d6a16d54 100644 --- a/tests/tbf0029.pp +++ b/tests/tbf/tbf0029.pp @@ -6,7 +6,7 @@ var P: Pointer; begin - { must fail on compilation because + { must fail on compilation because TA has no VMT } P := pointer(TypeOf(TA)); end. diff --git a/tests/tbf/tbf0036.pp b/tests/tbf/tbf0036.pp new file mode 100644 index 0000000000..bf4d7d754d --- /dev/null +++ b/tests/tbf/tbf0036.pp @@ -0,0 +1,9 @@ +program bug0036; + +{Discovered by Daniel Mantione.} + +var a:array[0..31] of char; + +begin + a:=' '; {Incorrect Pascal statement, but why a protection error?} +end. diff --git a/tests/tbf0049.pp b/tests/tbf/tbf0049.pp similarity index 100% rename from tests/tbf0049.pp rename to tests/tbf/tbf0049.pp diff --git a/tests/tbf0060.pp b/tests/tbf/tbf0060.pp similarity index 92% rename from tests/tbf0060.pp rename to tests/tbf/tbf0060.pp index 1986a38fd3..bf648bc12e 100644 --- a/tests/tbf0060.pp +++ b/tests/tbf/tbf0060.pp @@ -1,14 +1,14 @@ Program Test; -{ No errors -- problems is due to the fact that the rules for type -compatibility (p.47 language guide) -- are not respected, in other words +{ No errors -- problems is due to the fact that the rules for type +compatibility (p.47 language guide) -- are not respected, in other words in case statements there is no type checking whatsoever in fpc!! I think that these are separate cases: 1st case) s32bit,u32bit,u8bit,s8bit,s16bit,u16bit 2nd case) uchar 3rd case) bool8bit -These are not /should not be compatible with each other in a case -statement imho - CEC +These are not /should not be compatible with each other in a case +statement imho - CEC } var diff --git a/tests/tbf0061.pp b/tests/tbf/tbf0061.pp similarity index 100% rename from tests/tbf0061.pp rename to tests/tbf/tbf0061.pp diff --git a/tests/tbf0071.pp b/tests/tbf/tbf0071.pp similarity index 100% rename from tests/tbf0071.pp rename to tests/tbf/tbf0071.pp diff --git a/tests/tbf0075.pp b/tests/tbf/tbf0075.pp similarity index 100% rename from tests/tbf0075.pp rename to tests/tbf/tbf0075.pp diff --git a/tests/tbf0085.pp b/tests/tbf/tbf0085.pp similarity index 100% rename from tests/tbf0085.pp rename to tests/tbf/tbf0085.pp diff --git a/tests/tbf0086.pp b/tests/tbf/tbf0086.pp similarity index 82% rename from tests/tbf0086.pp rename to tests/tbf/tbf0086.pp index 31d584af7b..f4a5915514 100644 --- a/tests/tbf0086.pp +++ b/tests/tbf/tbf0086.pp @@ -6,7 +6,7 @@ var y: integer; type - zz: shortint = 255; + zz: shortint = 255; Begin y:=64000; z:=32767; diff --git a/tests/tbf0087.pp b/tests/tbf/tbf0087.pp similarity index 100% rename from tests/tbf0087.pp rename to tests/tbf/tbf0087.pp diff --git a/tests/tbf0088.pp b/tests/tbf/tbf0088.pp similarity index 100% rename from tests/tbf0088.pp rename to tests/tbf/tbf0088.pp diff --git a/tests/tbf0089.pp b/tests/tbf/tbf0089.pp similarity index 100% rename from tests/tbf0089.pp rename to tests/tbf/tbf0089.pp diff --git a/tests/tbf0094.pp b/tests/tbf/tbf0094.pp similarity index 100% rename from tests/tbf0094.pp rename to tests/tbf/tbf0094.pp diff --git a/tests/tbf0097.pp b/tests/tbf/tbf0097.pp similarity index 92% rename from tests/tbf0097.pp rename to tests/tbf/tbf0097.pp index d592c83973..789c524f92 100644 --- a/tests/tbf0097.pp +++ b/tests/tbf/tbf0097.pp @@ -9,7 +9,7 @@ type end; t2=object(t) - procedure p1(p : string); + procedure p1(p : string); end; procedure t2.p1(p : string); diff --git a/tests/tbf0100.pp b/tests/tbf/tbf0100.pp similarity index 100% rename from tests/tbf0100.pp rename to tests/tbf/tbf0100.pp diff --git a/tests/tbf0101.pp b/tests/tbf/tbf0101.pp similarity index 98% rename from tests/tbf0101.pp rename to tests/tbf/tbf0101.pp index 7bfae2a30b..d1d156c9d4 100644 --- a/tests/tbf0101.pp +++ b/tests/tbf/tbf0101.pp @@ -6,7 +6,7 @@ Interface Implementation - + Procedure MyProc(Y: Integer); Begin end; diff --git a/tests/tbf0108.pp b/tests/tbf/tbf0108.pp similarity index 73% rename from tests/tbf0108.pp rename to tests/tbf/tbf0108.pp index e3e3fec454..0ed4eec38c 100644 --- a/tests/tbf0108.pp +++ b/tests/tbf/tbf0108.pp @@ -1,5 +1,5 @@ -uses - dos, - ; -begin +uses + dos, + ; +begin end. \ No newline at end of file diff --git a/tests/tbf0109.pp b/tests/tbf/tbf0109.pp similarity index 100% rename from tests/tbf0109.pp rename to tests/tbf/tbf0109.pp diff --git a/tests/tbf0110.pp b/tests/tbf/tbf0110.pp similarity index 100% rename from tests/tbf0110.pp rename to tests/tbf/tbf0110.pp diff --git a/tests/tbf0117.pp b/tests/tbf/tbf0117.pp similarity index 100% rename from tests/tbf0117.pp rename to tests/tbf/tbf0117.pp diff --git a/tests/tbf0127.pp b/tests/tbf/tbf0127.pp similarity index 100% rename from tests/tbf0127.pp rename to tests/tbf/tbf0127.pp diff --git a/tests/tbf0136.pp b/tests/tbf/tbf0136.pp similarity index 100% rename from tests/tbf0136.pp rename to tests/tbf/tbf0136.pp diff --git a/tests/tbf0148.pp b/tests/tbf/tbf0148.pp similarity index 100% rename from tests/tbf0148.pp rename to tests/tbf/tbf0148.pp diff --git a/tests/tbf0151.pp b/tests/tbf/tbf0151.pp similarity index 90% rename from tests/tbf0151.pp rename to tests/tbf/tbf0151.pp index fc8678dfd0..c8ece53d38 100644 --- a/tests/tbf0151.pp +++ b/tests/tbf/tbf0151.pp @@ -1,7 +1,7 @@ type tr = record l1, l2: longint end; - + var r: tr; begin diff --git a/tests/tbf0153.pp b/tests/tbf/tbf0153.pp similarity index 100% rename from tests/tbf0153.pp rename to tests/tbf/tbf0153.pp diff --git a/tests/tbf0155.pp b/tests/tbf/tbf0155.pp similarity index 65% rename from tests/tbf0155.pp rename to tests/tbf/tbf0155.pp index c7a9cfeb0f..b46e41efe1 100644 --- a/tests/tbf0155.pp +++ b/tests/tbf/tbf0155.pp @@ -1,5 +1,5 @@ { this is not a real bug but rather a feature : - assembler function are only accepted for + assembler function are only accepted for simple return values i.e. either in register or FPU (PM) } @@ -7,9 +7,9 @@ function asmstr:string;assembler; asm - movl __RESULT,%edi - movl $0x4101,%al - stosw + movl __RESULT,%edi + movl $0x4101,%al + stosw end; begin diff --git a/tests/tbf0157.pp b/tests/tbf/tbf0157.pp similarity index 100% rename from tests/tbf0157.pp rename to tests/tbf/tbf0157.pp diff --git a/tests/tbf0158.pp b/tests/tbf/tbf0158.pp similarity index 100% rename from tests/tbf0158.pp rename to tests/tbf/tbf0158.pp diff --git a/tests/tbf0161.pp b/tests/tbf/tbf0161.pp similarity index 100% rename from tests/tbf0161.pp rename to tests/tbf/tbf0161.pp diff --git a/tests/tbf0164.pp b/tests/tbf/tbf0164.pp similarity index 88% rename from tests/tbf0164.pp rename to tests/tbf/tbf0164.pp index 5d428f040d..0dcee6ad4d 100644 --- a/tests/tbf0164.pp +++ b/tests/tbf/tbf0164.pp @@ -4,8 +4,8 @@ type t1r = record t2r = record l1, l2: Array[1..4] Of t1r; end; - - + + Var r: t2r; begin diff --git a/tests/tbf0166.pp b/tests/tbf/tbf0166.pp similarity index 94% rename from tests/tbf0166.pp rename to tests/tbf/tbf0166.pp index a4f0a4a6aa..2f47de2b42 100644 --- a/tests/tbf0166.pp +++ b/tests/tbf/tbf0166.pp @@ -1,6 +1,6 @@ type punknown=^unknown; - + t=object procedure p(i:unknown); end; diff --git a/tests/tbf0167.pp b/tests/tbf/tbf0167.pp similarity index 100% rename from tests/tbf0167.pp rename to tests/tbf/tbf0167.pp diff --git a/tests/tbf0168.pp b/tests/tbf/tbf0168.pp similarity index 100% rename from tests/tbf0168.pp rename to tests/tbf/tbf0168.pp diff --git a/tests/tbf0172.pp b/tests/tbf/tbf0172.pp similarity index 87% rename from tests/tbf0172.pp rename to tests/tbf/tbf0172.pp index be7d574e7a..24e6eac573 100644 --- a/tests/tbf0172.pp +++ b/tests/tbf/tbf0172.pp @@ -2,10 +2,10 @@ type rec=record a : longint; end; - + var r1 : rec absolute $40:$49; begin with r1 do a:=1; -end. +end. diff --git a/tests/tbf0173.pp b/tests/tbf/tbf0173.pp similarity index 100% rename from tests/tbf0173.pp rename to tests/tbf/tbf0173.pp diff --git a/tests/tbf0175.pp b/tests/tbf/tbf0175.pp similarity index 100% rename from tests/tbf0175.pp rename to tests/tbf/tbf0175.pp diff --git a/tests/tbf0186.pp b/tests/tbf/tbf0186.pp similarity index 88% rename from tests/tbf0186.pp rename to tests/tbf/tbf0186.pp index c6b09c573b..29332b7861 100644 --- a/tests/tbf0186.pp +++ b/tests/tbf/tbf0186.pp @@ -4,6 +4,6 @@ line:array [1..endline^] of ^char; begin new (endline); - endline^:=5; + endline^:=5; endline^:=10; end. diff --git a/tests/tbf0196.pp b/tests/tbf/tbf0196.pp similarity index 100% rename from tests/tbf0196.pp rename to tests/tbf/tbf0196.pp diff --git a/tests/tbf0197.pp b/tests/tbf/tbf0197.pp similarity index 100% rename from tests/tbf0197.pp rename to tests/tbf/tbf0197.pp diff --git a/tests/tbf0205.pp b/tests/tbf/tbf0205.pp similarity index 100% rename from tests/tbf0205.pp rename to tests/tbf/tbf0205.pp diff --git a/tests/tbf0208.pp b/tests/tbf/tbf0208.pp similarity index 100% rename from tests/tbf0208.pp rename to tests/tbf/tbf0208.pp diff --git a/tests/tbf0219.pp b/tests/tbf/tbf0219.pp similarity index 100% rename from tests/tbf0219.pp rename to tests/tbf/tbf0219.pp diff --git a/tests/tbf0230.pp b/tests/tbf/tbf0230.pp similarity index 100% rename from tests/tbf0230.pp rename to tests/tbf/tbf0230.pp diff --git a/tests/tbs0231.pp b/tests/tbf/tbf0231.pp similarity index 74% rename from tests/tbs0231.pp rename to tests/tbf/tbf0231.pp index 4354db59a3..25e903d461 100644 --- a/tests/tbs0231.pp +++ b/tests/tbf/tbf0231.pp @@ -2,9 +2,9 @@ {$undef dummy} {$ifdef DUMMY} - (* <= this should not be considered as a + (* <= this should not be considered as a higher comment level !! - + test {$endif dummy} diff --git a/tests/tbf0234.pp b/tests/tbf/tbf0234.pp similarity index 100% rename from tests/tbf0234.pp rename to tests/tbf/tbf0234.pp diff --git a/tests/tbf0242.pp b/tests/tbf/tbf0242.pp similarity index 100% rename from tests/tbf0242.pp rename to tests/tbf/tbf0242.pp diff --git a/tests/tbf0245.pp b/tests/tbf/tbf0245.pp similarity index 97% rename from tests/tbf0245.pp rename to tests/tbf/tbf0245.pp index 6bd598081b..52c061656e 100644 --- a/tests/tbf0245.pp +++ b/tests/tbf/tbf0245.pp @@ -8,7 +8,7 @@ type procedure ss; begin end; - + var p : pointer; pr : preal; @@ -23,4 +23,4 @@ var ps^:='test3'; Writeln('r=',r,' s=',s); end. - + diff --git a/tests/tbf0246.pp b/tests/tbf/tbf0246.pp similarity index 100% rename from tests/tbf0246.pp rename to tests/tbf/tbf0246.pp diff --git a/tests/tbf0248.pp b/tests/tbf/tbf0248.pp similarity index 100% rename from tests/tbf0248.pp rename to tests/tbf/tbf0248.pp diff --git a/tests/tbs0265.pp b/tests/tbf/tbf0265.pp similarity index 98% rename from tests/tbs0265.pp rename to tests/tbf/tbf0265.pp index e134b4952f..43ffa95c46 100644 --- a/tests/tbs0265.pp +++ b/tests/tbf/tbf0265.pp @@ -1,5 +1,5 @@ PROGRAM t9; - + PROCEDURE Eeep; VAR X: BYTE; @@ -14,7 +14,7 @@ END; BEGIN SubProc; END; - + BEGIN Eeep; END. diff --git a/tests/tbs0269.pp b/tests/tbf/tbf0269.pp similarity index 100% rename from tests/tbs0269.pp rename to tests/tbf/tbf0269.pp diff --git a/tests/tbf0272.pp b/tests/tbf/tbf0272.pp similarity index 100% rename from tests/tbf0272.pp rename to tests/tbf/tbf0272.pp diff --git a/tests/tbf0281.pp b/tests/tbf/tbf0281.pp similarity index 100% rename from tests/tbf0281.pp rename to tests/tbf/tbf0281.pp diff --git a/tests/tbf0284.pp b/tests/tbf/tbf0284.pp similarity index 100% rename from tests/tbf0284.pp rename to tests/tbf/tbf0284.pp diff --git a/tests/tbf0036.pp b/tests/tbf0036.pp deleted file mode 100644 index 2cba15426c..0000000000 --- a/tests/tbf0036.pp +++ /dev/null @@ -1,9 +0,0 @@ -program bug0036; - -{Discovered by Daniel Mantione.} - -var a:array[0..31] of char; - -begin - a:=' '; {Incorrect Pascal statement, but why a protection error?} -end. diff --git a/tests/tbs0001.pp b/tests/tbs/tbs0001.pp similarity index 78% rename from tests/tbs0001.pp rename to tests/tbs/tbs0001.pp index 97afab202c..5cb86787e9 100644 --- a/tests/tbs0001.pp +++ b/tests/tbs/tbs0001.pp @@ -5,5 +5,5 @@ begin writeln(teststr); teststr := 'gaga'; writeln(teststr); - if teststr<>'gaga' then halt(1); + if teststr<>'gaga' then halt(1); end. diff --git a/tests/tbs0002.pp b/tests/tbs/tbs0002.pp similarity index 95% rename from tests/tbs0002.pp rename to tests/tbs/tbs0002.pp index 95ca112708..8c7728dbd3 100644 --- a/tests/tbs0002.pp +++ b/tests/tbs/tbs0002.pp @@ -6,19 +6,19 @@ unit tbs0002; {$message starting hexstr} function hexstr(val : longint;cnt : byte) : string; - - const + + const hexval : string[16]=('0123456789ABCDEF'); - - var + + 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 + for i:=1 to cnt do begin l2:=(val and l1) shr (4*(cnt-i)); l1:=l1 shr 4; diff --git a/tests/tbs0003.pp b/tests/tbs/tbs0003.pp similarity index 100% rename from tests/tbs0003.pp rename to tests/tbs/tbs0003.pp diff --git a/tests/tbs0004.pp b/tests/tbs/tbs0004.pp similarity index 89% rename from tests/tbs0004.pp rename to tests/tbs/tbs0004.pp index 5cacec131b..4204d7c8f9 100644 --- a/tests/tbs0004.pp +++ b/tests/tbs/tbs0004.pp @@ -7,7 +7,7 @@ begin writeln('Hello'); continue; writeln('ohh'); - Halt(1); + Halt(1); end; end. diff --git a/tests/tbs0005.pp b/tests/tbs/tbs0005.pp similarity index 95% rename from tests/tbs0005.pp rename to tests/tbs/tbs0005.pp index 8bbbc29c29..2d6922a834 100644 --- a/tests/tbs0005.pp +++ b/tests/tbs/tbs0005.pp @@ -1,4 +1,4 @@ -uses +uses erroru; begin diff --git a/tests/tbs0006.pp b/tests/tbs/tbs0006.pp similarity index 100% rename from tests/tbs0006.pp rename to tests/tbs/tbs0006.pp diff --git a/tests/tbs0007.pp b/tests/tbs/tbs0007.pp similarity index 88% rename from tests/tbs0007.pp rename to tests/tbs/tbs0007.pp index 4cd07e15ed..78f2f01538 100644 --- a/tests/tbs0007.pp +++ b/tests/tbs/tbs0007.pp @@ -10,7 +10,7 @@ begin begin inc(test); writeln(count,'. loop'); - if test>127 then + if test>127 then Error; end; end. diff --git a/tests/tbs0009.pp b/tests/tbs/tbs0009.pp similarity index 100% rename from tests/tbs0009.pp rename to tests/tbs/tbs0009.pp diff --git a/tests/tbs0011.pp b/tests/tbs/tbs0011.pp similarity index 100% rename from tests/tbs0011.pp rename to tests/tbs/tbs0011.pp diff --git a/tests/tbs0012.pp b/tests/tbs/tbs0012.pp similarity index 88% rename from tests/tbs0012.pp rename to tests/tbs/tbs0012.pp index 1ecc0f5a91..58b0bd9c76 100644 --- a/tests/tbs0012.pp +++ b/tests/tbs/tbs0012.pp @@ -7,7 +7,7 @@ begin if byte(a>b)=byte(a1 then Halt(1); diff --git a/tests/tbs0018.pp b/tests/tbs/tbs0018.pp similarity index 100% rename from tests/tbs0018.pp rename to tests/tbs/tbs0018.pp diff --git a/tests/tbs0019.pp b/tests/tbs/tbs0019.pp similarity index 83% rename from tests/tbs0019.pp rename to tests/tbs/tbs0019.pp index 84e6f0f1f9..fe3813925a 100644 --- a/tests/tbs0019.pp +++ b/tests/tbs/tbs0019.pp @@ -9,5 +9,5 @@ var begin new(pb); pb^:=10; -end. - +end. + diff --git a/tests/tbs0021.pp b/tests/tbs/tbs0021.pp similarity index 100% rename from tests/tbs0021.pp rename to tests/tbs/tbs0021.pp diff --git a/tests/tbs0022.pp b/tests/tbs/tbs0022.pp similarity index 100% rename from tests/tbs0022.pp rename to tests/tbs/tbs0022.pp diff --git a/tests/tbs0023.pp b/tests/tbs/tbs0023.pp similarity index 100% rename from tests/tbs0023.pp rename to tests/tbs/tbs0023.pp diff --git a/tests/tbs0024.pp b/tests/tbs/tbs0024.pp similarity index 100% rename from tests/tbs0024.pp rename to tests/tbs/tbs0024.pp diff --git a/tests/tbs0025.pp b/tests/tbs/tbs0025.pp similarity index 100% rename from tests/tbs0025.pp rename to tests/tbs/tbs0025.pp diff --git a/tests/tbs0026.pp b/tests/tbs/tbs0026.pp similarity index 100% rename from tests/tbs0026.pp rename to tests/tbs/tbs0026.pp diff --git a/tests/tbs0027.pp b/tests/tbs/tbs0027.pp similarity index 100% rename from tests/tbs0027.pp rename to tests/tbs/tbs0027.pp diff --git a/tests/tbs0028.pp b/tests/tbs/tbs0028.pp similarity index 100% rename from tests/tbs0028.pp rename to tests/tbs/tbs0028.pp diff --git a/tests/tbs0029.pp b/tests/tbs/tbs0029.pp similarity index 100% rename from tests/tbs0029.pp rename to tests/tbs/tbs0029.pp diff --git a/tests/tbs0030.pp b/tests/tbs/tbs0030.pp similarity index 100% rename from tests/tbs0030.pp rename to tests/tbs/tbs0030.pp diff --git a/tests/tbs0031.pp b/tests/tbs/tbs0031.pp similarity index 100% rename from tests/tbs0031.pp rename to tests/tbs/tbs0031.pp diff --git a/tests/tbs0032.pp b/tests/tbs/tbs0032.pp similarity index 100% rename from tests/tbs0032.pp rename to tests/tbs/tbs0032.pp diff --git a/tests/tbs0033.pp b/tests/tbs/tbs0033.pp similarity index 100% rename from tests/tbs0033.pp rename to tests/tbs/tbs0033.pp diff --git a/tests/tbs0034.pp b/tests/tbs/tbs0034.pp similarity index 100% rename from tests/tbs0034.pp rename to tests/tbs/tbs0034.pp diff --git a/tests/tbs0035.pp b/tests/tbs/tbs0035.pp similarity index 66% rename from tests/tbs0035.pp rename to tests/tbs/tbs0035.pp index e306ad269d..9d3dc4ff51 100644 --- a/tests/tbs0035.pp +++ b/tests/tbs/tbs0035.pp @@ -4,12 +4,12 @@ program bug0035; {Discovered by Daniel Mantione.} -label hallo; +label hallo; begin writeln('Hello'); begin -hallo: {Error message: Incorrect expression.} +hallo: {Error message: Incorrect expression.} end; writeln('Hello again'); end. diff --git a/tests/tbs0037.pp b/tests/tbs/tbs0037.pp similarity index 100% rename from tests/tbs0037.pp rename to tests/tbs/tbs0037.pp diff --git a/tests/tbs0038.pp b/tests/tbs/tbs0038.pp similarity index 100% rename from tests/tbs0038.pp rename to tests/tbs/tbs0038.pp diff --git a/tests/tbs0039.pp b/tests/tbs/tbs0039.pp similarity index 100% rename from tests/tbs0039.pp rename to tests/tbs/tbs0039.pp diff --git a/tests/tbs0040.pp b/tests/tbs/tbs0040.pp similarity index 100% rename from tests/tbs0040.pp rename to tests/tbs/tbs0040.pp diff --git a/tests/tbs0041.pp b/tests/tbs/tbs0041.pp similarity index 100% rename from tests/tbs0041.pp rename to tests/tbs/tbs0041.pp diff --git a/tests/tbs0042.pp b/tests/tbs/tbs0042.pp similarity index 100% rename from tests/tbs0042.pp rename to tests/tbs/tbs0042.pp diff --git a/tests/tbs/tbs0043.pp b/tests/tbs/tbs0043.pp new file mode 100644 index 0000000000..92946ec303 --- /dev/null +++ b/tests/tbs/tbs0043.pp @@ -0,0 +1,32 @@ +{ THE OUTPUT is incorrect but the } +{ parsing is correct. } +{ under nasm output only. } +{ works correctly under tasm/gas } +{ other problems occur with other } +{ things in math.inc } +{ pp -TDOS -Ratt -Anasm bug0043.pp } + procedure frac; + + begin + asm + subl $16,%esp + fnstcw -4(%ebp) + fwait { unknown instruction } + movw -4(%ebp),%cx + orw $0x0c3f,%cx + movw %cx,-8(%ebp) + fldcw -8(%ebp) + fwait { unknown instruction } + fldl 8(%ebp) + frndint + fsubl 8(%ebp) + fabsl + fclex + fldcw -4(%ebp) + leave + ret $8 + end ['ECX']; + end; + +Begin +end. diff --git a/tests/tbs0044.pp b/tests/tbs/tbs0044.pp similarity index 80% rename from tests/tbs0044.pp rename to tests/tbs/tbs0044.pp index 5af309d2ec..5cbadb041b 100644 --- a/tests/tbs0044.pp +++ b/tests/tbs/tbs0044.pp @@ -1,7 +1,7 @@ - { Problem with nested comments -- as you can probably see } + { Problem with nested comments -- as you can probably see } { but it does give out kind of a funny error output :) } - + {$UNDEF VP} {$IFDEF Windows} ssss {$ENDIF} {No Syntax Error} diff --git a/tests/tbs0045.pp b/tests/tbs/tbs0045.pp similarity index 95% rename from tests/tbs0045.pp rename to tests/tbs/tbs0045.pp index a76647b7ad..9aea8bd961 100644 --- a/tests/tbs0045.pp +++ b/tests/tbs/tbs0045.pp @@ -5,7 +5,7 @@ TYPE constructor init; destructor done; virtual; private - procedure mytest;virtual; { syntax error --> should give only a + procedure mytest;virtual; { syntax error --> should give only a warning ? } end; @@ -23,4 +23,4 @@ warning ? } Begin end. - + diff --git a/tests/tbs0046.pp b/tests/tbs/tbs0046.pp similarity index 100% rename from tests/tbs0046.pp rename to tests/tbs/tbs0046.pp diff --git a/tests/tbs0047.pp b/tests/tbs/tbs0047.pp similarity index 100% rename from tests/tbs0047.pp rename to tests/tbs/tbs0047.pp diff --git a/tests/tbs0048.pp b/tests/tbs/tbs0048.pp similarity index 100% rename from tests/tbs0048.pp rename to tests/tbs/tbs0048.pp diff --git a/tests/tbs0050.pp b/tests/tbs/tbs0050.pp similarity index 95% rename from tests/tbs0050.pp rename to tests/tbs/tbs0050.pp index d75367cf54..b34224eac0 100644 --- a/tests/tbs0050.pp +++ b/tests/tbs/tbs0050.pp @@ -12,7 +12,7 @@ end; begin If not Append then - begin + begin Writeln('TBS0050 fails'); Halt(1); end; diff --git a/tests/tbs0051.pp b/tests/tbs/tbs0051.pp similarity index 91% rename from tests/tbs0051.pp rename to tests/tbs/tbs0051.pp index 6cc0193853..28294314eb 100644 --- a/tests/tbs0051.pp +++ b/tests/tbs/tbs0051.pp @@ -40,7 +40,7 @@ BEGIN if error<>0 then gm:=$111; end; - gd:=VESA; + gd:=detect; InitGraph(gd,gm,''); gError := graphResult; @@ -71,7 +71,11 @@ END. { $Log$ - Revision 1.5 1999-11-28 12:17:14 jonas + Revision 1.1 1999-12-02 17:37:38 peter + * moved *.pp into subdirs + * fpcmaked + + Revision 1.5 1999/11/28 12:17:14 jonas * changed the requested graphdriver from $FF to VESA (= 10), so the test program works again with the new graph unit * undefined has_colors_equal for go32v2, because it is not anymore diff --git a/tests/tbs0052.pp b/tests/tbs/tbs0052.pp similarity index 100% rename from tests/tbs0052.pp rename to tests/tbs/tbs0052.pp diff --git a/tests/tbs0053.pp b/tests/tbs/tbs0053.pp similarity index 97% rename from tests/tbs0053.pp rename to tests/tbs/tbs0053.pp index 140159378e..1e7ae3783f 100644 --- a/tests/tbs0053.pp +++ b/tests/tbs/tbs0053.pp @@ -12,4 +12,4 @@ begin writeln(c); // error: writeln(a); end. - + diff --git a/tests/tbs0054.pp b/tests/tbs/tbs0054.pp similarity index 100% rename from tests/tbs0054.pp rename to tests/tbs/tbs0054.pp diff --git a/tests/tbs0055.pp b/tests/tbs/tbs0055.pp similarity index 95% rename from tests/tbs0055.pp rename to tests/tbs/tbs0055.pp index 238a996567..e6fd4392ba 100644 --- a/tests/tbs0055.pp +++ b/tests/tbs/tbs0055.pp @@ -3,7 +3,7 @@ type procedure test(var a : tarraysingle); -var +var i,j,k : integer; begin diff --git a/tests/tbs0056.pp b/tests/tbs/tbs0056.pp similarity index 100% rename from tests/tbs0056.pp rename to tests/tbs/tbs0056.pp diff --git a/tests/tbs0057.pp b/tests/tbs/tbs0057.pp similarity index 100% rename from tests/tbs0057.pp rename to tests/tbs/tbs0057.pp diff --git a/tests/tbs0058.pp b/tests/tbs/tbs0058.pp similarity index 100% rename from tests/tbs0058.pp rename to tests/tbs/tbs0058.pp diff --git a/tests/tbs0059.pp b/tests/tbs/tbs0059.pp similarity index 100% rename from tests/tbs0059.pp rename to tests/tbs/tbs0059.pp diff --git a/tests/tbs0061.pp b/tests/tbs/tbs0061.pp similarity index 100% rename from tests/tbs0061.pp rename to tests/tbs/tbs0061.pp diff --git a/tests/tbs0062.pp b/tests/tbs/tbs0062.pp similarity index 100% rename from tests/tbs0062.pp rename to tests/tbs/tbs0062.pp diff --git a/tests/tbs0063.pp b/tests/tbs/tbs0063.pp similarity index 100% rename from tests/tbs0063.pp rename to tests/tbs/tbs0063.pp diff --git a/tests/tbs0064.pp b/tests/tbs/tbs0064.pp similarity index 100% rename from tests/tbs0064.pp rename to tests/tbs/tbs0064.pp diff --git a/tests/tbs0065.pp b/tests/tbs/tbs0065.pp similarity index 100% rename from tests/tbs0065.pp rename to tests/tbs/tbs0065.pp diff --git a/tests/tbs0066.pp b/tests/tbs/tbs0066.pp similarity index 100% rename from tests/tbs0066.pp rename to tests/tbs/tbs0066.pp diff --git a/tests/tbs0067.pp b/tests/tbs/tbs0067.pp similarity index 100% rename from tests/tbs0067.pp rename to tests/tbs/tbs0067.pp diff --git a/tests/tbs0067b.pp b/tests/tbs/tbs0067b.pp similarity index 87% rename from tests/tbs0067b.pp rename to tests/tbs/tbs0067b.pp index d4d137497d..ab297dd6c1 100644 --- a/tests/tbs0067b.pp +++ b/tests/tbs/tbs0067b.pp @@ -16,7 +16,7 @@ uses tbs0067; { the tlong parameter is taken from unit bug0067, and not from the interface part of this unit. - setting the uses clause in the interface part + setting the uses clause in the interface part removes the problem } procedure p(var l:tlong); diff --git a/tests/tbs0068.pp b/tests/tbs/tbs0068.pp similarity index 97% rename from tests/tbs0068.pp rename to tests/tbs/tbs0068.pp index a668880ddf..906c0db169 100644 --- a/tests/tbs0068.pp +++ b/tests/tbs/tbs0068.pp @@ -5,5 +5,5 @@ var l : longint; begin l:=Ofs(p); { Ofs returns a pointer type !? } - + end. diff --git a/tests/tbs0069.pp b/tests/tbs/tbs0069.pp similarity index 100% rename from tests/tbs0069.pp rename to tests/tbs/tbs0069.pp diff --git a/tests/tbs0070.pp b/tests/tbs/tbs0070.pp similarity index 100% rename from tests/tbs0070.pp rename to tests/tbs/tbs0070.pp diff --git a/tests/tbs0072.pp b/tests/tbs/tbs0072.pp similarity index 95% rename from tests/tbs0072.pp rename to tests/tbs/tbs0072.pp index 238a996567..e6fd4392ba 100644 --- a/tests/tbs0072.pp +++ b/tests/tbs/tbs0072.pp @@ -3,7 +3,7 @@ type procedure test(var a : tarraysingle); -var +var i,j,k : integer; begin diff --git a/tests/tbs0073.pp b/tests/tbs/tbs0073.pp similarity index 100% rename from tests/tbs0073.pp rename to tests/tbs/tbs0073.pp diff --git a/tests/tbs0074.pp b/tests/tbs/tbs0074.pp similarity index 100% rename from tests/tbs0074.pp rename to tests/tbs/tbs0074.pp diff --git a/tests/tbs0076.pp b/tests/tbs/tbs0076.pp similarity index 99% rename from tests/tbs0076.pp rename to tests/tbs/tbs0076.pp index bded18ade7..3b182210da 100644 --- a/tests/tbs0076.pp +++ b/tests/tbs/tbs0076.pp @@ -3,7 +3,7 @@ program bug0076; {Generates wrong code when compiled with output set to intel asm. Reported from mailinglist by Vtech Kavan. - + 15 Januari 1998, Daniel Mantione} type TVtx2D = record x,y:longint end; diff --git a/tests/tbs0077.pp b/tests/tbs/tbs0077.pp similarity index 100% rename from tests/tbs0077.pp rename to tests/tbs/tbs0077.pp diff --git a/tests/tbs0077b.pp b/tests/tbs/tbs0077b.pp similarity index 100% rename from tests/tbs0077b.pp rename to tests/tbs/tbs0077b.pp diff --git a/tests/tbs0078.pp b/tests/tbs/tbs0078.pp similarity index 80% rename from tests/tbs0078.pp rename to tests/tbs/tbs0078.pp index 96466fd413..ca6dec3bc2 100644 --- a/tests/tbs0078.pp +++ b/tests/tbs/tbs0078.pp @@ -2,7 +2,7 @@ { shows error with asm_size_mismatch } Begin asm - mov eax, 2147483647 + mov eax, 2147483647 mov eax, 2000000000 end; end. diff --git a/tests/tbs0079.pp b/tests/tbs/tbs0079.pp similarity index 100% rename from tests/tbs0079.pp rename to tests/tbs/tbs0079.pp diff --git a/tests/tbs0080.pp b/tests/tbs/tbs0080.pp similarity index 88% rename from tests/tbs0080.pp rename to tests/tbs/tbs0080.pp index e4258a4c0e..e4885fd8e3 100644 --- a/tests/tbs0080.pp +++ b/tests/tbs/tbs0080.pp @@ -1,6 +1,6 @@ program bug0080; -type +type tHugeArray = array [ 1 .. High(Word) ] of byte; diff --git a/tests/tbs0081.pp b/tests/tbs/tbs0081.pp similarity index 95% rename from tests/tbs0081.pp rename to tests/tbs/tbs0081.pp index f0762f8eb1..55a82d9fd4 100644 --- a/tests/tbs0081.pp +++ b/tests/tbs/tbs0081.pp @@ -2,6 +2,6 @@ program bug0081; const EOL : array [1..2] of char = #13 + #10; - + begin end. diff --git a/tests/tbs0082.pp b/tests/tbs/tbs0082.pp similarity index 93% rename from tests/tbs0082.pp rename to tests/tbs/tbs0082.pp index a53bc71189..f6c6a6256d 100644 --- a/tests/tbs0082.pp +++ b/tests/tbs/tbs0082.pp @@ -7,9 +7,9 @@ Type T = OBject Destructor Free; virtual; Destructor Destroy; virtual; end; - + implementation - + constructor T.INit; begin diff --git a/tests/tbs0083.pp b/tests/tbs/tbs0083.pp similarity index 100% rename from tests/tbs0083.pp rename to tests/tbs/tbs0083.pp diff --git a/tests/tbs0084.pp b/tests/tbs/tbs0084.pp similarity index 100% rename from tests/tbs0084.pp rename to tests/tbs/tbs0084.pp diff --git a/tests/tbs0090.pp b/tests/tbs/tbs0090.pp similarity index 100% rename from tests/tbs0090.pp rename to tests/tbs/tbs0090.pp diff --git a/tests/tbs0091.pp b/tests/tbs/tbs0091.pp similarity index 100% rename from tests/tbs0091.pp rename to tests/tbs/tbs0091.pp diff --git a/tests/tbs0092.pp b/tests/tbs/tbs0092.pp similarity index 100% rename from tests/tbs0092.pp rename to tests/tbs/tbs0092.pp diff --git a/tests/tbs/tbs0093.pp b/tests/tbs/tbs0093.pp new file mode 100644 index 0000000000..f0a3c64b1c --- /dev/null +++ b/tests/tbs/tbs0093.pp @@ -0,0 +1,18 @@ +{ Two cardinal type bugs } +var + c : cardinal; + l : longint; + b : byte; + s : shortint; + w : word; +begin + b:=123; + w:=s; + l:=b; + c:=b; {generates movzbl %eax,%edx instead of movzbl %al,%edx} + + c:=123; + writeln(c); {Shows '0' outline right! instead of '123' outlined left} + c:=$7fffffff; + writeln(c); {Shows '0' outline right! instead of '123' outlined left} +end. diff --git a/tests/tbs0095.pp b/tests/tbs/tbs0095.pp similarity index 100% rename from tests/tbs0095.pp rename to tests/tbs/tbs0095.pp diff --git a/tests/tbs0096.pp b/tests/tbs/tbs0096.pp similarity index 100% rename from tests/tbs0096.pp rename to tests/tbs/tbs0096.pp diff --git a/tests/tbs0098.pp b/tests/tbs/tbs0098.pp similarity index 100% rename from tests/tbs0098.pp rename to tests/tbs/tbs0098.pp diff --git a/tests/tbs0099.pp b/tests/tbs/tbs0099.pp similarity index 100% rename from tests/tbs0099.pp rename to tests/tbs/tbs0099.pp diff --git a/tests/tbs0102.pp b/tests/tbs/tbs0102.pp similarity index 100% rename from tests/tbs0102.pp rename to tests/tbs/tbs0102.pp diff --git a/tests/tbs0103.pp b/tests/tbs/tbs0103.pp similarity index 100% rename from tests/tbs0103.pp rename to tests/tbs/tbs0103.pp diff --git a/tests/tbs0104.pp b/tests/tbs/tbs0104.pp similarity index 100% rename from tests/tbs0104.pp rename to tests/tbs/tbs0104.pp diff --git a/tests/tbs0105.pp b/tests/tbs/tbs0105.pp similarity index 100% rename from tests/tbs0105.pp rename to tests/tbs/tbs0105.pp diff --git a/tests/tbs0106.pp b/tests/tbs/tbs0106.pp similarity index 100% rename from tests/tbs0106.pp rename to tests/tbs/tbs0106.pp diff --git a/tests/tbs0107.pp b/tests/tbs/tbs0107.pp similarity index 100% rename from tests/tbs0107.pp rename to tests/tbs/tbs0107.pp diff --git a/tests/tbs0109.pp b/tests/tbs/tbs0109.pp similarity index 100% rename from tests/tbs0109.pp rename to tests/tbs/tbs0109.pp diff --git a/tests/tbs0111.pp b/tests/tbs/tbs0111.pp similarity index 93% rename from tests/tbs0111.pp rename to tests/tbs/tbs0111.pp index f9286a358c..ba3c496779 100644 --- a/tests/tbs0111.pp +++ b/tests/tbs/tbs0111.pp @@ -1,13 +1,13 @@ -var - f : file of word; - i : word; - buf : string; -begin - assign(f,'test'); - reset(f); - blockread(f,buf[1],sizeof(buf),i); { This is not allowed in BP7 } - buf[0]:=chr(i); - close(f); - writeln(i); - writeln(buf); +var + f : file of word; + i : word; + buf : string; +begin + assign(f,'test'); + reset(f); + blockread(f,buf[1],sizeof(buf),i); { This is not allowed in BP7 } + buf[0]:=chr(i); + close(f); + writeln(i); + writeln(buf); end. \ No newline at end of file diff --git a/tests/tbs0112.pp b/tests/tbs/tbs0112.pp similarity index 95% rename from tests/tbs0112.pp rename to tests/tbs/tbs0112.pp index e297a5b5b4..6b55c64e00 100644 --- a/tests/tbs0112.pp +++ b/tests/tbs/tbs0112.pp @@ -1,21 +1,21 @@ -type - TextBuf=array[0..127] of char; - TextRec=record - BufPtr : ^textbuf; - BufPos : word; - end; - -Function ReadNumeric(var f:TextRec;var s:string;base:longint):Boolean; -{ - Read Numeric Input, if buffer is empty then return True -} -begin - while ((base>=10) and (f.BufPtr^[f.BufPos] in ['0'..'9'])) or - ((base=16) and (f.BufPtr^[f.BufPos] in ['A'..'F'])) or - ((base=2) and (f.BufPtr^[f.BufPos] in ['0'..'1'])) do - Begin - End; -end; - -begin -end. +type + TextBuf=array[0..127] of char; + TextRec=record + BufPtr : ^textbuf; + BufPos : word; + end; + +Function ReadNumeric(var f:TextRec;var s:string;base:longint):Boolean; +{ + Read Numeric Input, if buffer is empty then return True +} +begin + while ((base>=10) and (f.BufPtr^[f.BufPos] in ['0'..'9'])) or + ((base=16) and (f.BufPtr^[f.BufPos] in ['A'..'F'])) or + ((base=2) and (f.BufPtr^[f.BufPos] in ['0'..'1'])) do + Begin + End; +end; + +begin +end. diff --git a/tests/tbs0113.pp b/tests/tbs/tbs0113.pp similarity index 100% rename from tests/tbs0113.pp rename to tests/tbs/tbs0113.pp diff --git a/tests/tbs0114.pp b/tests/tbs/tbs0114.pp similarity index 100% rename from tests/tbs0114.pp rename to tests/tbs/tbs0114.pp diff --git a/tests/tbs0115.pp b/tests/tbs/tbs0115.pp similarity index 96% rename from tests/tbs0115.pp rename to tests/tbs/tbs0115.pp index 82a4ef4e72..a75854e3e5 100644 --- a/tests/tbs0115.pp +++ b/tests/tbs/tbs0115.pp @@ -8,4 +8,4 @@ begin c:=-258674; writeln(c); end. - + diff --git a/tests/tbs0116.pp b/tests/tbs/tbs0116.pp similarity index 100% rename from tests/tbs0116.pp rename to tests/tbs/tbs0116.pp diff --git a/tests/tbs0118.pp b/tests/tbs/tbs0118.pp similarity index 100% rename from tests/tbs0118.pp rename to tests/tbs/tbs0118.pp diff --git a/tests/tbs0119.pp b/tests/tbs/tbs0119.pp similarity index 100% rename from tests/tbs0119.pp rename to tests/tbs/tbs0119.pp diff --git a/tests/tbs0120.pp b/tests/tbs/tbs0120.pp similarity index 100% rename from tests/tbs0120.pp rename to tests/tbs/tbs0120.pp diff --git a/tests/tbs0121.pp b/tests/tbs/tbs0121.pp similarity index 100% rename from tests/tbs0121.pp rename to tests/tbs/tbs0121.pp diff --git a/tests/tbs0122.pp b/tests/tbs/tbs0122.pp similarity index 100% rename from tests/tbs0122.pp rename to tests/tbs/tbs0122.pp diff --git a/tests/tbs0123.pp b/tests/tbs/tbs0123.pp similarity index 100% rename from tests/tbs0123.pp rename to tests/tbs/tbs0123.pp diff --git a/tests/tbs0124.pp b/tests/tbs/tbs0124.pp similarity index 85% rename from tests/tbs0124.pp rename to tests/tbs/tbs0124.pp index d708e63ebc..e124ebdca6 100644 --- a/tests/tbs0124.pp +++ b/tests/tbs/tbs0124.pp @@ -1,8 +1,8 @@ { $OPT= -Aas } -{ this problem comes from the fact that +{ this problem comes from the fact that L is a static variable, not a local one !! but the static variable symtable is the localst of the - main procedure (PM) + main procedure (PM) It must be checked if we are at main level or not !! } var @@ -25,7 +25,7 @@ begin movl l,%eax addl $2,%eax movl %eax,l - end; + end; if l<>7 then error; {$asmmode intel} { problem here is that l is replaced by BP-offset } @@ -36,6 +36,6 @@ begin add eax,5 mov l,eax end; - if l<>12 then error; - Writeln('tbs0124 OK'); + if l<>12 then error; + Writeln('tbs0124 OK'); end. diff --git a/tests/tbs0124b.pp b/tests/tbs/tbs0124b.pp similarity index 99% rename from tests/tbs0124b.pp rename to tests/tbs/tbs0124b.pp index a6aa060be6..e051b7bb6f 100644 --- a/tests/tbs0124b.pp +++ b/tests/tbs/tbs0124b.pp @@ -6,7 +6,7 @@ begin { problem here is that l is replaced by BP-offset } { relative to stack, and the parser thinks all wrong } { because of this. } - + for i:=0 to 7 do l[i]:=35; asm diff --git a/tests/tbs0125.pp b/tests/tbs/tbs0125.pp similarity index 100% rename from tests/tbs0125.pp rename to tests/tbs/tbs0125.pp diff --git a/tests/tbs0126.pp b/tests/tbs/tbs0126.pp similarity index 100% rename from tests/tbs0126.pp rename to tests/tbs/tbs0126.pp diff --git a/tests/tbs0128.pp b/tests/tbs/tbs0128.pp similarity index 100% rename from tests/tbs0128.pp rename to tests/tbs/tbs0128.pp diff --git a/tests/tbs0129.pp b/tests/tbs/tbs0129.pp similarity index 100% rename from tests/tbs0129.pp rename to tests/tbs/tbs0129.pp diff --git a/tests/tbs0130.pp b/tests/tbs/tbs0130.pp similarity index 100% rename from tests/tbs0130.pp rename to tests/tbs/tbs0130.pp diff --git a/tests/tbs0131.pp b/tests/tbs/tbs0131.pp similarity index 100% rename from tests/tbs0131.pp rename to tests/tbs/tbs0131.pp diff --git a/tests/tbs0132.pp b/tests/tbs/tbs0132.pp similarity index 77% rename from tests/tbs0132.pp rename to tests/tbs/tbs0132.pp index dd7db6d311..13740020cf 100644 --- a/tests/tbs0132.pp +++ b/tests/tbs/tbs0132.pp @@ -7,6 +7,6 @@ type a2:p2; begin - a:=@a2; + a:=@a2; a:=a2^; end. \ No newline at end of file diff --git a/tests/tbs0133.pp b/tests/tbs/tbs0133.pp similarity index 100% rename from tests/tbs0133.pp rename to tests/tbs/tbs0133.pp diff --git a/tests/tbs0134.pp b/tests/tbs/tbs0134.pp similarity index 100% rename from tests/tbs0134.pp rename to tests/tbs/tbs0134.pp diff --git a/tests/tbs0135.pp b/tests/tbs/tbs0135.pp similarity index 100% rename from tests/tbs0135.pp rename to tests/tbs/tbs0135.pp diff --git a/tests/tbs0137.pp b/tests/tbs/tbs0137.pp similarity index 98% rename from tests/tbs0137.pp rename to tests/tbs/tbs0137.pp index 321e78bf1b..c9650b8651 100644 --- a/tests/tbs0137.pp +++ b/tests/tbs/tbs0137.pp @@ -40,6 +40,6 @@ Begin Writeln; S.Laufen; Writeln; - V := S; + V := S; V.Gehen; End. diff --git a/tests/tbs0138.pp b/tests/tbs/tbs0138.pp similarity index 100% rename from tests/tbs0138.pp rename to tests/tbs/tbs0138.pp diff --git a/tests/tbs0139.pp b/tests/tbs/tbs0139.pp similarity index 100% rename from tests/tbs0139.pp rename to tests/tbs/tbs0139.pp diff --git a/tests/tbs0139a.pp b/tests/tbs/tbs0139a.pp similarity index 100% rename from tests/tbs0139a.pp rename to tests/tbs/tbs0139a.pp diff --git a/tests/tbs0140.pp b/tests/tbs/tbs0140.pp similarity index 88% rename from tests/tbs0140.pp rename to tests/tbs/tbs0140.pp index 7e86bfeecd..e5e696ee95 100644 --- a/tests/tbs0140.pp +++ b/tests/tbs/tbs0140.pp @@ -1,7 +1,7 @@ unit tbs0140; -{ - The first compilation runs fine. +{ + The first compilation runs fine. A second compilation (i.e; .ppu files exist already) crashes the compiler !! } diff --git a/tests/tbs0140a.pp b/tests/tbs/tbs0140a.pp similarity index 100% rename from tests/tbs0140a.pp rename to tests/tbs/tbs0140a.pp diff --git a/tests/tbs0141.pp b/tests/tbs/tbs0141.pp similarity index 100% rename from tests/tbs0141.pp rename to tests/tbs/tbs0141.pp diff --git a/tests/tbs0142.pp b/tests/tbs/tbs0142.pp similarity index 100% rename from tests/tbs0142.pp rename to tests/tbs/tbs0142.pp diff --git a/tests/tbs0143.pp b/tests/tbs/tbs0143.pp similarity index 100% rename from tests/tbs0143.pp rename to tests/tbs/tbs0143.pp diff --git a/tests/tbs0144.pp b/tests/tbs/tbs0144.pp similarity index 100% rename from tests/tbs0144.pp rename to tests/tbs/tbs0144.pp diff --git a/tests/tbs0145.pp b/tests/tbs/tbs0145.pp similarity index 100% rename from tests/tbs0145.pp rename to tests/tbs/tbs0145.pp diff --git a/tests/tbs0146.pp b/tests/tbs/tbs0146.pp similarity index 100% rename from tests/tbs0146.pp rename to tests/tbs/tbs0146.pp diff --git a/tests/tbs0147.pp b/tests/tbs/tbs0147.pp similarity index 100% rename from tests/tbs0147.pp rename to tests/tbs/tbs0147.pp diff --git a/tests/tbs0149a.pp b/tests/tbs/tbs0149a.pp similarity index 100% rename from tests/tbs0149a.pp rename to tests/tbs/tbs0149a.pp diff --git a/tests/tbs0149b.pp b/tests/tbs/tbs0149b.pp similarity index 100% rename from tests/tbs0149b.pp rename to tests/tbs/tbs0149b.pp diff --git a/tests/tbs0150.pp b/tests/tbs/tbs0150.pp similarity index 99% rename from tests/tbs0150.pp rename to tests/tbs/tbs0150.pp index 4a77ad06d0..9eac064419 100644 --- a/tests/tbs0150.pp +++ b/tests/tbs/tbs0150.pp @@ -5,7 +5,7 @@ program bug0150; var B : boolean; i : integer; - + begin b:=true; i:=0; diff --git a/tests/tbs0152.pp b/tests/tbs/tbs0152.pp similarity index 89% rename from tests/tbs0152.pp rename to tests/tbs/tbs0152.pp index a32c795d8e..044647a3b7 100644 --- a/tests/tbs0152.pp +++ b/tests/tbs/tbs0152.pp @@ -7,9 +7,9 @@ Program tbs0152; } PROCEDURE LGrow(VAR S : String;C:CHAR;Count:WORD); - + VAR I,J :WORD; - + BEGIN I:=ORD(S[0]); { Keeping length in local data eases optimalisations} IF I'1111111abcedfghij' then begin diff --git a/tests/tbs0154.pp b/tests/tbs/tbs0154.pp similarity index 100% rename from tests/tbs0154.pp rename to tests/tbs/tbs0154.pp diff --git a/tests/tbs0156a.pp b/tests/tbs/tbs0156a.pp similarity index 100% rename from tests/tbs0156a.pp rename to tests/tbs/tbs0156a.pp diff --git a/tests/tbs0156b.pp b/tests/tbs/tbs0156b.pp similarity index 91% rename from tests/tbs0156b.pp rename to tests/tbs/tbs0156b.pp index 025abb6d58..b43a908aa8 100644 --- a/tests/tbs0156b.pp +++ b/tests/tbs/tbs0156b.pp @@ -6,7 +6,7 @@ type _parent : ^WINDOW; end; WINDOW = _win_st; - + implementation end. \ No newline at end of file diff --git a/tests/tbs0157.pp b/tests/tbs/tbs0157.pp similarity index 100% rename from tests/tbs0157.pp rename to tests/tbs/tbs0157.pp diff --git a/tests/tbs0159.pp b/tests/tbs/tbs0159.pp similarity index 100% rename from tests/tbs0159.pp rename to tests/tbs/tbs0159.pp diff --git a/tests/tbs0160.pp b/tests/tbs/tbs0160.pp similarity index 100% rename from tests/tbs0160.pp rename to tests/tbs/tbs0160.pp diff --git a/tests/tbs0162.pp b/tests/tbs/tbs0162.pp similarity index 90% rename from tests/tbs0162.pp rename to tests/tbs/tbs0162.pp index 57b857b3ca..f192e48ea6 100644 --- a/tests/tbs0162.pp +++ b/tests/tbs/tbs0162.pp @@ -7,4 +7,4 @@ begin continue; until i=1; end. - + diff --git a/tests/tbs0163.pp b/tests/tbs/tbs0163.pp similarity index 90% rename from tests/tbs0163.pp rename to tests/tbs/tbs0163.pp index f7655b2b2c..87b94ec0ee 100644 --- a/tests/tbs0163.pp +++ b/tests/tbs/tbs0163.pp @@ -4,10 +4,10 @@ Program test; Type Days = (Monday,tuesday,wednesday,thursday,friday,saturday,sunday); - -Var + +Var FreeDays,Weekend : set of days; - + begin Weekend := [saturday, sunday]; FreeDays := [friday, saturday, sunday]; diff --git a/tests/tbs0164.pp b/tests/tbs/tbs0164.pp similarity index 90% rename from tests/tbs0164.pp rename to tests/tbs/tbs0164.pp index 754622264f..17a2ee7a01 100644 --- a/tests/tbs0164.pp +++ b/tests/tbs/tbs0164.pp @@ -4,8 +4,8 @@ type t1r = record t2r = record l1, l2: Array[1..4] Of t1r; end; - - + + Var r: t2r; counter : byte; diff --git a/tests/tbs0165.pp b/tests/tbs/tbs0165.pp similarity index 100% rename from tests/tbs0165.pp rename to tests/tbs/tbs0165.pp diff --git a/tests/tbs0169.pp b/tests/tbs/tbs0169.pp similarity index 100% rename from tests/tbs0169.pp rename to tests/tbs/tbs0169.pp diff --git a/tests/tbs0170.pp b/tests/tbs/tbs0170.pp similarity index 100% rename from tests/tbs0170.pp rename to tests/tbs/tbs0170.pp diff --git a/tests/tbs0171.pp b/tests/tbs/tbs0171.pp similarity index 100% rename from tests/tbs0171.pp rename to tests/tbs/tbs0171.pp diff --git a/tests/tbs0174.pp b/tests/tbs/tbs0174.pp similarity index 94% rename from tests/tbs0174.pp rename to tests/tbs/tbs0174.pp index 272eb8a6e3..1f6a298fda 100644 --- a/tests/tbs0174.pp +++ b/tests/tbs/tbs0174.pp @@ -9,7 +9,7 @@ var procedure kl;assembler; asm - movl tobj.l,%eax // tobj.l should return the offset of l in tobj + movl tobj.l,%eax // tobj.l should return the offset of l in tobj end; diff --git a/tests/tbs0175.pp b/tests/tbs/tbs0175.pp similarity index 100% rename from tests/tbs0175.pp rename to tests/tbs/tbs0175.pp diff --git a/tests/tbs0176.pp b/tests/tbs/tbs0176.pp similarity index 94% rename from tests/tbs0176.pp rename to tests/tbs/tbs0176.pp index 6b379f9d68..b54d30fe93 100644 --- a/tests/tbs0176.pp +++ b/tests/tbs/tbs0176.pp @@ -10,7 +10,7 @@ implementation var l2 : longint; - + begin bug0176.l1:=1; bug0176.l2:=1; diff --git a/tests/tbs0177.pp b/tests/tbs/tbs0177.pp similarity index 100% rename from tests/tbs0177.pp rename to tests/tbs/tbs0177.pp diff --git a/tests/tbs0178.pp b/tests/tbs/tbs0178.pp similarity index 100% rename from tests/tbs0178.pp rename to tests/tbs/tbs0178.pp diff --git a/tests/tbs0179.pp b/tests/tbs/tbs0179.pp similarity index 100% rename from tests/tbs0179.pp rename to tests/tbs/tbs0179.pp diff --git a/tests/tbs0180.pp b/tests/tbs/tbs0180.pp similarity index 88% rename from tests/tbs0180.pp rename to tests/tbs/tbs0180.pp index b7d8bd17fe..035535722a 100644 --- a/tests/tbs0180.pp +++ b/tests/tbs/tbs0180.pp @@ -2,7 +2,7 @@ { this name should be accepted with -Un option !! } UNIT bug0180; INTERFACE - uses + uses tbs0180a; procedure dummy; @@ -10,6 +10,6 @@ IMPLEMENTATION procedure dummy; begin { Unit_with_strange_name.dummy; should this work ?? } - tbs0180a.dummy; + tbs0180a.dummy; end; END. diff --git a/tests/tbs0180a.pp b/tests/tbs/tbs0180a.pp similarity index 100% rename from tests/tbs0180a.pp rename to tests/tbs/tbs0180a.pp diff --git a/tests/tbs0181.pp b/tests/tbs/tbs0181.pp similarity index 100% rename from tests/tbs0181.pp rename to tests/tbs/tbs0181.pp diff --git a/tests/tbs0181a.pp b/tests/tbs/tbs0181a.pp similarity index 100% rename from tests/tbs0181a.pp rename to tests/tbs/tbs0181a.pp diff --git a/tests/tbs0182.pp b/tests/tbs/tbs0182.pp similarity index 97% rename from tests/tbs0182.pp rename to tests/tbs/tbs0182.pp index 434e2fcbd0..c170ffc4f1 100644 --- a/tests/tbs0182.pp +++ b/tests/tbs/tbs0182.pp @@ -2,7 +2,7 @@ TYPE Rec = RECORD x:WORD; y:WORD; END; - + Rec1 = Record x,y : longint; end; @@ -11,11 +11,11 @@ TYPE Rec = RECORD z : word; end; plongint = ^longint; - + VAR s:WORD; r:Rec; rr : Rec2; - + CONST p1:POINTER = @s; { Works fine } p2:POINTER = @R.y; { illegal expression } p3:pointer = @rr.s.y; diff --git a/tests/tbs0183.pp b/tests/tbs/tbs0183.pp similarity index 97% rename from tests/tbs0183.pp rename to tests/tbs/tbs0183.pp index eb20788d3f..408ac2bddb 100644 --- a/tests/tbs0183.pp +++ b/tests/tbs/tbs0183.pp @@ -1,19 +1,19 @@ program Internal_Error_10; - + type PBug = ^TBug; TBug = array[1..1] of boolean; - + var Left : PBug; test : longint; - + begin New(left); test := 1; - + { following shows internal error 10 only if the - + array index is a var on both sides ( if either is a constant then it compiles fine, error only occurs if the not is in the statement ) @@ -21,7 +21,7 @@ begin if using TBug, and no pointers it compiles fine with PBug the error appears } - + Left^[test] := not Left^[test]; end. diff --git a/tests/tbs0184.pp b/tests/tbs/tbs0184.pp similarity index 100% rename from tests/tbs0184.pp rename to tests/tbs/tbs0184.pp diff --git a/tests/tbs0185.pp b/tests/tbs/tbs0185.pp similarity index 100% rename from tests/tbs0185.pp rename to tests/tbs/tbs0185.pp diff --git a/tests/tbs0187.pp b/tests/tbs/tbs0187.pp similarity index 100% rename from tests/tbs0187.pp rename to tests/tbs/tbs0187.pp diff --git a/tests/tbs0188.pp b/tests/tbs/tbs0188.pp similarity index 93% rename from tests/tbs0188.pp rename to tests/tbs/tbs0188.pp index fc72d4cbaa..7c32128041 100644 --- a/tests/tbs0188.pp +++ b/tests/tbs/tbs0188.pp @@ -1,4 +1,4 @@ -{ this are no bugs, just wrong +{ this are no bugs, just wrong understanding of FPC syntax } type testfunc = function:longint; @@ -18,7 +18,7 @@ begin test is the function itself and write does not know how to output a function ! to call test you must use test() !! } - writeln(test()); + writeln(test()); end; { proc. sound } var i : longint; @@ -36,7 +36,7 @@ begin but the correct syntax would be } sound(@test_temp); { imagine if a function would return its own type !! } - + { for f var this is correct also ! } sound(f); end. diff --git a/tests/tbs0189.pp b/tests/tbs/tbs0189.pp similarity index 100% rename from tests/tbs0189.pp rename to tests/tbs/tbs0189.pp diff --git a/tests/tbs0190.pp b/tests/tbs/tbs0190.pp similarity index 100% rename from tests/tbs0190.pp rename to tests/tbs/tbs0190.pp diff --git a/tests/tbs0191.pp b/tests/tbs/tbs0191.pp similarity index 92% rename from tests/tbs0191.pp rename to tests/tbs/tbs0191.pp index 97198f142a..7d42d01866 100644 --- a/tests/tbs0191.pp +++ b/tests/tbs/tbs0191.pp @@ -19,7 +19,7 @@ const begin Writeln(' l^ = ',l^); - Writeln('pc[0] = ',pc[0]); + Writeln('pc[0] = ',pc[0]); if (l^<>2) or (pc[0]<>'t') then Begin Writeln('Wrong code generated'); diff --git a/tests/tbs0192.pp b/tests/tbs/tbs0192.pp similarity index 100% rename from tests/tbs0192.pp rename to tests/tbs/tbs0192.pp diff --git a/tests/tbs0193.pp b/tests/tbs/tbs0193.pp similarity index 100% rename from tests/tbs0193.pp rename to tests/tbs/tbs0193.pp diff --git a/tests/tbs0194.pp b/tests/tbs/tbs0194.pp similarity index 96% rename from tests/tbs0194.pp rename to tests/tbs/tbs0194.pp index 0ab09f00b7..fccdce47b5 100644 --- a/tests/tbs0194.pp +++ b/tests/tbs/tbs0194.pp @@ -28,7 +28,7 @@ Begin Wrong('@f returns value of f !'); if longint(f)=longint(@f) then Wrong('longint(@f)=longint(f) !!!!'); - if f<>@dummy then + if f<>@dummy then Wrong('f does not return the address of dummy'); if longint(@f)=longint(@dummy) then Wrong('longint(@f) returns address of dummy instead of address of f'); @@ -36,7 +36,7 @@ Begin if longint(@f)=longint(@fa[0]) then Wrong('arrays of procvar also wrong'); if longint(f)<>longint(fa[0]) then - Wrong('arrays of procvar and procvars are handled differently !!'); + Wrong('arrays of procvar and procvars are handled differently !!'); if prog_has_errors then Halt(1); End. diff --git a/tests/tbs0195.pp b/tests/tbs/tbs0195.pp similarity index 100% rename from tests/tbs0195.pp rename to tests/tbs/tbs0195.pp diff --git a/tests/tbs0196.pp b/tests/tbs/tbs0196.pp similarity index 100% rename from tests/tbs0196.pp rename to tests/tbs/tbs0196.pp diff --git a/tests/tbs0198.pp b/tests/tbs/tbs0198.pp similarity index 100% rename from tests/tbs0198.pp rename to tests/tbs/tbs0198.pp diff --git a/tests/tbs0199.pp b/tests/tbs/tbs0199.pp similarity index 85% rename from tests/tbs0199.pp rename to tests/tbs/tbs0199.pp index 8ab3a2c9fb..2d81c239dc 100644 --- a/tests/tbs0199.pp +++ b/tests/tbs/tbs0199.pp @@ -17,7 +17,7 @@ BEGIN WriteLn(pR1^.D:16,pR2^.D:16); pR1^.D := 1; - pR2^.D := pR1^.D*2; { THE BUG IS HERE } + pR2^.D := pR1^.D*2; { THE BUG IS HERE } WriteLn(pR1^.D:16,pR2^.D:16); if (pR1^.D<>1) or (pR2^.D<>2) then Halt(1); diff --git a/tests/tbs0201.pp b/tests/tbs/tbs0201.pp similarity index 95% rename from tests/tbs0201.pp rename to tests/tbs/tbs0201.pp index d66efa6dbf..9168909054 100644 --- a/tests/tbs0201.pp +++ b/tests/tbs/tbs0201.pp @@ -7,7 +7,7 @@ type rec = record b : Word; end; -{ this is really for tests but +{ this is really for tests but this should be coded with const r1 and r2 !! } function x(r1 : rec; r2 : rec; var r3 : rec) : integer; assembler; diff --git a/tests/tbs0202.pp b/tests/tbs/tbs0202.pp similarity index 100% rename from tests/tbs0202.pp rename to tests/tbs/tbs0202.pp diff --git a/tests/tbs0203.pp b/tests/tbs/tbs0203.pp similarity index 100% rename from tests/tbs0203.pp rename to tests/tbs/tbs0203.pp diff --git a/tests/tbs0203a.pp b/tests/tbs/tbs0203a.pp similarity index 100% rename from tests/tbs0203a.pp rename to tests/tbs/tbs0203a.pp diff --git a/tests/tbs0204.pp b/tests/tbs/tbs0204.pp similarity index 100% rename from tests/tbs0204.pp rename to tests/tbs/tbs0204.pp diff --git a/tests/tbs0206.pp b/tests/tbs/tbs0206.pp similarity index 100% rename from tests/tbs0206.pp rename to tests/tbs/tbs0206.pp diff --git a/tests/tbs0207.pp b/tests/tbs/tbs0207.pp similarity index 100% rename from tests/tbs0207.pp rename to tests/tbs/tbs0207.pp diff --git a/tests/tbs0209.pp b/tests/tbs/tbs0209.pp similarity index 100% rename from tests/tbs0209.pp rename to tests/tbs/tbs0209.pp diff --git a/tests/tbs0210.pp b/tests/tbs/tbs0210.pp similarity index 100% rename from tests/tbs0210.pp rename to tests/tbs/tbs0210.pp diff --git a/tests/tbs0211.pp b/tests/tbs/tbs0211.pp similarity index 99% rename from tests/tbs0211.pp rename to tests/tbs/tbs0211.pp index d745bacff9..905ce1eee0 100644 --- a/tests/tbs0211.pp +++ b/tests/tbs/tbs0211.pp @@ -26,4 +26,4 @@ begin Writeln('boolean(256) =',a); end. - + diff --git a/tests/tbs0212.pp b/tests/tbs/tbs0212.pp similarity index 100% rename from tests/tbs0212.pp rename to tests/tbs/tbs0212.pp diff --git a/tests/tbs0213.pp b/tests/tbs/tbs0213.pp similarity index 100% rename from tests/tbs0213.pp rename to tests/tbs/tbs0213.pp diff --git a/tests/tbs0213a.pp b/tests/tbs/tbs0213a.pp similarity index 96% rename from tests/tbs0213a.pp rename to tests/tbs/tbs0213a.pp index 2dcf2f8f23..83d19e6d9f 100644 --- a/tests/tbs0213a.pp +++ b/tests/tbs/tbs0213a.pp @@ -1,4 +1,4 @@ -{ different tests for the problem of local +{ different tests for the problem of local functions having the same name } unit tbs0213a; diff --git a/tests/tbs0214.pp b/tests/tbs/tbs0214.pp similarity index 98% rename from tests/tbs0214.pp rename to tests/tbs/tbs0214.pp index 40eee0ba1e..ce5c252c1c 100644 --- a/tests/tbs0214.pp +++ b/tests/tbs/tbs0214.pp @@ -11,15 +11,15 @@ Type Procedure Setup; static; Procedure Weird; static; End; - + Procedure TObjectType1.Setup; Begin End; - + Procedure TObjectType1.Weird; Begin End; - + Begin TObjectType1.Setup; TObjectType1.Weird; diff --git a/tests/tbs0215.pp b/tests/tbs/tbs0215.pp similarity index 100% rename from tests/tbs0215.pp rename to tests/tbs/tbs0215.pp diff --git a/tests/tbs0216.pp b/tests/tbs/tbs0216.pp similarity index 100% rename from tests/tbs0216.pp rename to tests/tbs/tbs0216.pp diff --git a/tests/tbs0217.pp b/tests/tbs/tbs0217.pp similarity index 100% rename from tests/tbs0217.pp rename to tests/tbs/tbs0217.pp diff --git a/tests/tbs0218.pp b/tests/tbs/tbs0218.pp similarity index 100% rename from tests/tbs0218.pp rename to tests/tbs/tbs0218.pp diff --git a/tests/tbs0220.pp b/tests/tbs/tbs0220.pp similarity index 100% rename from tests/tbs0220.pp rename to tests/tbs/tbs0220.pp diff --git a/tests/tbs0221.pp b/tests/tbs/tbs0221.pp similarity index 100% rename from tests/tbs0221.pp rename to tests/tbs/tbs0221.pp diff --git a/tests/tbs/tbs0222.pp b/tests/tbs/tbs0222.pp new file mode 100644 index 0000000000..7a53bec82f --- /dev/null +++ b/tests/tbs/tbs0222.pp @@ -0,0 +1,11 @@ + +type TStruct = record + x,y: Integer; + end; + +var i: TStruct; + +begin + for i.x:=1 to 10 do + writeln(i.x); +end. diff --git a/tests/tbs0223.pp b/tests/tbs/tbs0223.pp similarity index 97% rename from tests/tbs0223.pp rename to tests/tbs/tbs0223.pp index c053e94bf4..73e3df65c0 100644 --- a/tests/tbs0223.pp +++ b/tests/tbs/tbs0223.pp @@ -1,5 +1,5 @@ -uses +uses erroru; var a:string; diff --git a/tests/tbs0224.pp b/tests/tbs/tbs0224.pp similarity index 100% rename from tests/tbs0224.pp rename to tests/tbs/tbs0224.pp diff --git a/tests/tbs0225.pp b/tests/tbs/tbs0225.pp similarity index 100% rename from tests/tbs0225.pp rename to tests/tbs/tbs0225.pp diff --git a/tests/tbs0226.pp b/tests/tbs/tbs0226.pp similarity index 100% rename from tests/tbs0226.pp rename to tests/tbs/tbs0226.pp diff --git a/tests/tbs0227.pp b/tests/tbs/tbs0227.pp similarity index 100% rename from tests/tbs0227.pp rename to tests/tbs/tbs0227.pp diff --git a/tests/tbs0228.pp b/tests/tbs/tbs0228.pp similarity index 100% rename from tests/tbs0228.pp rename to tests/tbs/tbs0228.pp diff --git a/tests/tbs0229.pp b/tests/tbs/tbs0229.pp similarity index 100% rename from tests/tbs0229.pp rename to tests/tbs/tbs0229.pp diff --git a/tests/tbs0232.pp b/tests/tbs/tbs0232.pp similarity index 100% rename from tests/tbs0232.pp rename to tests/tbs/tbs0232.pp diff --git a/tests/tbs0233.pp b/tests/tbs/tbs0233.pp similarity index 98% rename from tests/tbs0233.pp rename to tests/tbs/tbs0233.pp index b51782e7e6..fbb595217e 100644 --- a/tests/tbs0233.pp +++ b/tests/tbs/tbs0233.pp @@ -2,7 +2,7 @@ program except_test; type byteset = set of byte; enumset = set of (zero,one,two,three); - + function test(s : byteset) : boolean; begin test:=false; diff --git a/tests/tbs0234.pp b/tests/tbs/tbs0234.pp similarity index 100% rename from tests/tbs0234.pp rename to tests/tbs/tbs0234.pp diff --git a/tests/tbs0235.pp b/tests/tbs/tbs0235.pp similarity index 100% rename from tests/tbs0235.pp rename to tests/tbs/tbs0235.pp diff --git a/tests/tbs0236.pp b/tests/tbs/tbs0236.pp similarity index 98% rename from tests/tbs0236.pp rename to tests/tbs/tbs0236.pp index 927875d2b0..8e15fecad4 100644 --- a/tests/tbs0236.pp +++ b/tests/tbs/tbs0236.pp @@ -9,7 +9,7 @@ uses sub_enum = one..three; prec = ^trec; - + trec = record dummy : longint; en : enum; @@ -23,7 +23,7 @@ procedure test; var hp : prec; t : sub_enum; - + begin new(hp); hp^.en:=zero; diff --git a/tests/tbs0237.pp b/tests/tbs/tbs0237.pp similarity index 100% rename from tests/tbs0237.pp rename to tests/tbs/tbs0237.pp diff --git a/tests/tbs0238.pp b/tests/tbs/tbs0238.pp similarity index 100% rename from tests/tbs0238.pp rename to tests/tbs/tbs0238.pp diff --git a/tests/tbs0239.pp b/tests/tbs/tbs0239.pp similarity index 100% rename from tests/tbs0239.pp rename to tests/tbs/tbs0239.pp diff --git a/tests/tbs0240.pp b/tests/tbs/tbs0240.pp similarity index 100% rename from tests/tbs0240.pp rename to tests/tbs/tbs0240.pp diff --git a/tests/tbs0241.pp b/tests/tbs/tbs0241.pp similarity index 100% rename from tests/tbs0241.pp rename to tests/tbs/tbs0241.pp diff --git a/tests/tbs0242b.pp b/tests/tbs/tbs0242b.pp similarity index 98% rename from tests/tbs0242b.pp rename to tests/tbs/tbs0242b.pp index f7f76c0238..27e550de70 100644 --- a/tests/tbs0242b.pp +++ b/tests/tbs/tbs0242b.pp @@ -6,7 +6,7 @@ const begin writeln(s,' is ',longint(x)); end; - + procedure change(var x); begin inc(longint(x)); diff --git a/tests/tbs0243.pp b/tests/tbs/tbs0243.pp similarity index 94% rename from tests/tbs0243.pp rename to tests/tbs/tbs0243.pp index dcd26bed34..dbe4804fe5 100644 --- a/tests/tbs0243.pp +++ b/tests/tbs/tbs0243.pp @@ -24,9 +24,9 @@ var i : longint; end; begin -{ this could give +{ this could give first arg is 1 - second arg is 2 + second arg is 2 but FPC parses the second arg before the first one ! } test(_next,_next); writeln('third arg is ',_next); diff --git a/tests/tbs0244.pp b/tests/tbs/tbs0244.pp similarity index 100% rename from tests/tbs0244.pp rename to tests/tbs/tbs0244.pp diff --git a/tests/tbs0247.pp b/tests/tbs/tbs0247.pp similarity index 72% rename from tests/tbs0247.pp rename to tests/tbs/tbs0247.pp index 1acd7c2d2e..69a76f2eed 100644 --- a/tests/tbs0247.pp +++ b/tests/tbs/tbs0247.pp @@ -1,15 +1,15 @@ {$mode delphi} -var +var x : integer = 34; { this is the way Delphi creates initialized vars - ++ its much more logical then BP - typed const !! + ++ its much more logical then BP + typed const !! -- its incompatible with BP !! (PM) } y : array[0..2] of real = (0.0,1.23,2.56); -{ these are true const in Delphi mode and thus +{ these are true const in Delphi mode and thus it should not be possible to change ! } const diff --git a/tests/tbs0249.pp b/tests/tbs/tbs0249.pp similarity index 100% rename from tests/tbs0249.pp rename to tests/tbs/tbs0249.pp diff --git a/tests/tbs0250.pp b/tests/tbs/tbs0250.pp similarity index 94% rename from tests/tbs0250.pp rename to tests/tbs/tbs0250.pp index ff8e0766a7..b39f6964c7 100644 --- a/tests/tbs0250.pp +++ b/tests/tbs/tbs0250.pp @@ -8,7 +8,7 @@ uses erroru; var A : String; P : PChar; I : longint; - + begin P := 'Some sample testchar'; A := Ansistring(P); @@ -18,7 +18,7 @@ begin A:='Some small test'; A:=A+' ansistring'; Writeln ('A : ',A); - If A<>'' then + If A<>'' then Writeln ('All is fine') else begin diff --git a/tests/tbs0251.pp b/tests/tbs/tbs0251.pp similarity index 100% rename from tests/tbs0251.pp rename to tests/tbs/tbs0251.pp diff --git a/tests/tbs0252.pp b/tests/tbs/tbs0252.pp similarity index 100% rename from tests/tbs0252.pp rename to tests/tbs/tbs0252.pp diff --git a/tests/tbs0253.pp b/tests/tbs/tbs0253.pp similarity index 100% rename from tests/tbs0253.pp rename to tests/tbs/tbs0253.pp diff --git a/tests/tbs0254.pp b/tests/tbs/tbs0254.pp similarity index 100% rename from tests/tbs0254.pp rename to tests/tbs/tbs0254.pp diff --git a/tests/tbs0255.pp b/tests/tbs/tbs0255.pp similarity index 100% rename from tests/tbs0255.pp rename to tests/tbs/tbs0255.pp diff --git a/tests/tbs0256.pp b/tests/tbs/tbs0256.pp similarity index 97% rename from tests/tbs0256.pp rename to tests/tbs/tbs0256.pp index 1ee2882082..a0a5ab3bf7 100644 --- a/tests/tbs0256.pp +++ b/tests/tbs/tbs0256.pp @@ -1,7 +1,7 @@ {$mode tp} {$undef dummy } - + {$ifdef dummy} procedure test; begin diff --git a/tests/tbs0257.pp b/tests/tbs/tbs0257.pp similarity index 100% rename from tests/tbs0257.pp rename to tests/tbs/tbs0257.pp diff --git a/tests/tbs0258.pp b/tests/tbs/tbs0258.pp similarity index 100% rename from tests/tbs0258.pp rename to tests/tbs/tbs0258.pp diff --git a/tests/tbs0259.pp b/tests/tbs/tbs0259.pp similarity index 100% rename from tests/tbs0259.pp rename to tests/tbs/tbs0259.pp diff --git a/tests/tbs0260.pp b/tests/tbs/tbs0260.pp similarity index 94% rename from tests/tbs0260.pp rename to tests/tbs/tbs0260.pp index 9e8745316b..3aec046d23 100644 --- a/tests/tbs0260.pp +++ b/tests/tbs/tbs0260.pp @@ -14,7 +14,7 @@ program test; obj3 = object(obj2) l : longint; end; - + constructor obj1.init; begin end; @@ -22,11 +22,11 @@ program test; procedure obj1.writeit; begin end; - + procedure obj2.writeit; begin end; - + begin end. diff --git a/tests/tbs0261.pp b/tests/tbs/tbs0261.pp similarity index 100% rename from tests/tbs0261.pp rename to tests/tbs/tbs0261.pp diff --git a/tests/tbs0261a.pp b/tests/tbs/tbs0261a.pp similarity index 100% rename from tests/tbs0261a.pp rename to tests/tbs/tbs0261a.pp diff --git a/tests/tbs0262.pp b/tests/tbs/tbs0262.pp similarity index 95% rename from tests/tbs0262.pp rename to tests/tbs/tbs0262.pp index e4829ee386..42eee03bfc 100644 --- a/tests/tbs0262.pp +++ b/tests/tbs/tbs0262.pp @@ -17,18 +17,18 @@ program test; procedure writeit(l : longint);virtual; procedure writeit(st : string);virtual; end; - + obj4 = object(obj3) procedure writeit;virtual; procedure writeit(st : string);virtual; end; - + obj5 = object(obj4) procedure writeit;virtual; procedure writeit(st : string); procedure writeit(l : longint);virtual; end; - + constructor obj1.init; begin end; @@ -37,42 +37,42 @@ program test; begin Writeln('Obj1 writeit'); end; - + procedure obj1.writeit(st : string); begin Writeln('Obj1 writeit(string) ',st); end; - + procedure obj2.writeit; begin Writeln('Obj2 writeit'); end; - + procedure obj3.writeit(st : string); begin Writeln('Obj3 writeit(string) ',st); end; - + procedure obj3.writeit(l : longint); begin Writeln('Obj2 writeit(longint) ',l); end; - + procedure obj4.writeit; begin Writeln('Obj4 writeit'); end; - + procedure obj4.writeit(st : string); begin Writeln('Obj4 writeit(string) ',st); end; - + procedure obj5.writeit; begin Writeln('Obj5 writeit'); end; - + procedure obj5.writeit(st : string); begin Writeln('Obj5 writeit(string) ',st); @@ -82,7 +82,7 @@ program test; begin Writeln('Obj5 writeit(longint) ',l); end; - + var o1 : obj1; o2 : obj2; diff --git a/tests/tbs0263.pp b/tests/tbs/tbs0263.pp similarity index 65% rename from tests/tbs0263.pp rename to tests/tbs/tbs0263.pp index 80b5687cea..5bf7dc825f 100644 --- a/tests/tbs0263.pp +++ b/tests/tbs/tbs0263.pp @@ -1,4 +1,4 @@ -{ $OPT=-Twin32 } +{$if linux or win32} library tbs0263; { @@ -6,10 +6,15 @@ library tbs0263; from the 16bit model, just like near and far. } -procedure p; +procedure testp; begin end; exports - p name 'p'; + testp name 'testp'; + end. +{$else} +begin +end. +{$endif} diff --git a/tests/tbs0264.pp b/tests/tbs/tbs0264.pp similarity index 100% rename from tests/tbs0264.pp rename to tests/tbs/tbs0264.pp diff --git a/tests/tbs/tbs0266.pp b/tests/tbs/tbs0266.pp new file mode 100644 index 0000000000..7788f2f708 --- /dev/null +++ b/tests/tbs/tbs0266.pp @@ -0,0 +1,16 @@ +PROGRAM t10; + +USES CRT; + +VAR S: STRING; + X: BYTE; + + + BEGIN + S := ''; + FOR X := 1 TO 253 DO S:=S+'-'; + S := S+'_!'; + WRITE(S); + WRITE('*',S); + END. + \ No newline at end of file diff --git a/tests/tbs0267.pp b/tests/tbs/tbs0267.pp similarity index 100% rename from tests/tbs0267.pp rename to tests/tbs/tbs0267.pp diff --git a/tests/tbs0268.pp b/tests/tbs/tbs0268.pp similarity index 100% rename from tests/tbs0268.pp rename to tests/tbs/tbs0268.pp diff --git a/tests/tbs0270.pp b/tests/tbs/tbs0270.pp similarity index 100% rename from tests/tbs0270.pp rename to tests/tbs/tbs0270.pp diff --git a/tests/tbs0271.pp b/tests/tbs/tbs0271.pp similarity index 100% rename from tests/tbs0271.pp rename to tests/tbs/tbs0271.pp diff --git a/tests/tbs0272.pp b/tests/tbs/tbs0272.pp similarity index 100% rename from tests/tbs0272.pp rename to tests/tbs/tbs0272.pp diff --git a/tests/tbs0273.pp b/tests/tbs/tbs0273.pp similarity index 100% rename from tests/tbs0273.pp rename to tests/tbs/tbs0273.pp diff --git a/tests/tbs0274.pp b/tests/tbs/tbs0274.pp similarity index 88% rename from tests/tbs0274.pp rename to tests/tbs/tbs0274.pp index e2eabffb6d..98fdbb90ea 100644 --- a/tests/tbs0274.pp +++ b/tests/tbs/tbs0274.pp @@ -6,7 +6,7 @@ begin end; var - p : proc; + p : proc; begin p:=@prc; p:=@(prc); { should this be allowed ? } diff --git a/tests/tbs0275.pp b/tests/tbs/tbs0275.pp similarity index 100% rename from tests/tbs0275.pp rename to tests/tbs/tbs0275.pp diff --git a/tests/tbs0276.pp b/tests/tbs/tbs0276.pp similarity index 100% rename from tests/tbs0276.pp rename to tests/tbs/tbs0276.pp diff --git a/tests/tbs0277.pp b/tests/tbs/tbs0277.pp similarity index 100% rename from tests/tbs0277.pp rename to tests/tbs/tbs0277.pp diff --git a/tests/tbs0278.pp b/tests/tbs/tbs0278.pp similarity index 100% rename from tests/tbs0278.pp rename to tests/tbs/tbs0278.pp diff --git a/tests/tbs0279.pp b/tests/tbs/tbs0279.pp similarity index 100% rename from tests/tbs0279.pp rename to tests/tbs/tbs0279.pp diff --git a/tests/tbs0280.pp b/tests/tbs/tbs0280.pp similarity index 100% rename from tests/tbs0280.pp rename to tests/tbs/tbs0280.pp diff --git a/tests/tbs0282.pp b/tests/tbs/tbs0282.pp similarity index 100% rename from tests/tbs0282.pp rename to tests/tbs/tbs0282.pp diff --git a/tests/tbs0283.pp b/tests/tbs/tbs0283.pp similarity index 100% rename from tests/tbs0283.pp rename to tests/tbs/tbs0283.pp diff --git a/tests/tbs0284b.pp b/tests/tbs/tbs0284b.pp similarity index 100% rename from tests/tbs0284b.pp rename to tests/tbs/tbs0284b.pp diff --git a/tests/tbs0285.pp b/tests/tbs/tbs0285.pp similarity index 100% rename from tests/tbs0285.pp rename to tests/tbs/tbs0285.pp diff --git a/tests/tbs0286.pp b/tests/tbs/tbs0286.pp similarity index 100% rename from tests/tbs0286.pp rename to tests/tbs/tbs0286.pp diff --git a/tests/tbs0287.pp b/tests/tbs/tbs0287.pp similarity index 100% rename from tests/tbs0287.pp rename to tests/tbs/tbs0287.pp diff --git a/tests/tbs0288.pp b/tests/tbs/tbs0288.pp similarity index 100% rename from tests/tbs0288.pp rename to tests/tbs/tbs0288.pp diff --git a/tests/tbs0289.pp b/tests/tbs/tbs0289.pp similarity index 100% rename from tests/tbs0289.pp rename to tests/tbs/tbs0289.pp diff --git a/tests/tbs0290.pp b/tests/tbs/tbs0290.pp similarity index 100% rename from tests/tbs0290.pp rename to tests/tbs/tbs0290.pp diff --git a/tests/tbs0043.pp b/tests/tbs0043.pp deleted file mode 100644 index 4e42ad408b..0000000000 --- a/tests/tbs0043.pp +++ /dev/null @@ -1,32 +0,0 @@ -{ THE OUTPUT is incorrect but the } -{ parsing is correct. } -{ under nasm output only. } -{ works correctly under tasm/gas } -{ other problems occur with other } -{ things in math.inc } -{ pp -TDOS -Ratt -Anasm bug0043.pp } - procedure frac; - - begin - asm - subl $16,%esp - fnstcw -4(%ebp) - fwait { unknown instruction } - movw -4(%ebp),%cx - orw $0x0c3f,%cx - movw %cx,-8(%ebp) - fldcw -8(%ebp) - fwait { unknown instruction } - fldl 8(%ebp) - frndint - fsubl 8(%ebp) - fabsl - fclex - fldcw -4(%ebp) - leave - ret $8 - end ['ECX']; - end; - -Begin -end. diff --git a/tests/tbs0093.pp b/tests/tbs0093.pp deleted file mode 100644 index 7faf66927f..0000000000 --- a/tests/tbs0093.pp +++ /dev/null @@ -1,18 +0,0 @@ -{ Two cardinal type bugs } -var - c : cardinal; - l : longint; - b : byte; - s : shortint; - w : word; -begin - b:=123; - w:=s; - l:=b; - c:=b; {generates movzbl %eax,%edx instead of movzbl %al,%edx} - - c:=123; - writeln(c); {Shows '0' outline right! instead of '123' outlined left} - c:=$7fffffff; - writeln(c); {Shows '0' outline right! instead of '123' outlined left} -end. diff --git a/tests/tbs0222.pp b/tests/tbs0222.pp deleted file mode 100644 index 869af738fd..0000000000 --- a/tests/tbs0222.pp +++ /dev/null @@ -1,11 +0,0 @@ - -type TStruct = record - x,y: Integer; - end; - -var i: TStruct; - -begin - for i.x:=1 to 10 do - writeln(i.x); -end. diff --git a/tests/tbs0230.pp b/tests/tbs0230.pp deleted file mode 100644 index 12f21bb9c1..0000000000 --- a/tests/tbs0230.pp +++ /dev/null @@ -1,14 +0,0 @@ -{$ifdef go32v2} -uses - dpmiexcp; -{$endif} - -var - e : extended; - -begin - writeln('ln(0) = ',ln(0)); - writeln(' zero ^ one = ',power(0,1.0)); - e:=563545; - writeln('exp(',e,') = ',exp(e)); -end . diff --git a/tests/tbs0266.pp b/tests/tbs0266.pp deleted file mode 100644 index 0e8763570c..0000000000 --- a/tests/tbs0266.pp +++ /dev/null @@ -1,16 +0,0 @@ -PROGRAM t10; - -USES CRT; - -VAR S: STRING; - X: BYTE; - - - BEGIN - S := ''; - FOR X := 1 TO 253 DO S:=S+'-'; - S := S+'_!'; - WRITE(S); - WRITE('*',S); - END. - \ No newline at end of file diff --git a/tests/template1.bat b/tests/template1.bat deleted file mode 100644 index 2dc895c5e0..0000000000 --- a/tests/template1.bat +++ /dev/null @@ -1,18 +0,0 @@ -@echo off -rem -rem Batch file to compile and run NAME -rem -echo Compiling NAME... -ppc386 NAME >nul -if errorlevel 1 goto comfailed -echo compilation of NAME : PASSED -NAME >nul -if errorlevel 0 goto runpassed -echo execution of NAME : FAILED -goto end -:runpassed -echo execution of NAME : PASSED -goto end -:comfailed -echo Compilation of NAME : FAILED -:end diff --git a/tests/template2.bat b/tests/template2.bat deleted file mode 100644 index 9f5ad53d29..0000000000 --- a/tests/template2.bat +++ /dev/null @@ -1,15 +0,0 @@ -@echo off -rem -rem Batch file to compile NAME. If compilation fails, the test passed. -rem -echo Compiling NAME... -ppc386 NAME >nul -if errorlevel 1 goto compassed -echo Error compilation of NAME : FAILED -goto end -:compassed -echo Error compilation of NAME : PASSED -:end - - - diff --git a/tests/tesicrt.pp b/tests/tesi/tesicrt.pp similarity index 99% rename from tests/tesicrt.pp rename to tests/tesi/tesicrt.pp index 1b3b514527..4a77f168a7 100644 --- a/tests/tesicrt.pp +++ b/tests/tesi/tesicrt.pp @@ -1,6 +1,6 @@ { $Id$ - + Program to test CRT unit by Mark May. Only standard TP functions are tested (except WhereX, WhereY). } diff --git a/tests/tesidos.pp b/tests/tesi/tesidos.pp similarity index 100% rename from tests/tesidos.pp rename to tests/tesi/tesidos.pp diff --git a/tests/tesirand.pp b/tests/tesi/tesirand.pp similarity index 95% rename from tests/tesirand.pp rename to tests/tesi/tesirand.pp index 6462e91bd9..c098f87098 100644 --- a/tests/tesirand.pp +++ b/tests/tesi/tesirand.pp @@ -130,7 +130,11 @@ end. { $Log$ - Revision 1.3 1999-01-25 20:23:13 peter + Revision 1.1 1999-12-02 17:37:44 peter + * moved *.pp into subdirs + * fpcmaked + + Revision 1.3 1999/01/25 20:23:13 peter * linux updates Revision 1.2 1998/11/23 23:44:52 pierre diff --git a/tests/testansi.pp b/tests/test/testansi.pp similarity index 94% rename from tests/testansi.pp rename to tests/test/testansi.pp index fde6fe1a52..2e8984824d 100644 --- a/tests/testansi.pp +++ b/tests/test/testansi.pp @@ -31,8 +31,8 @@ Type PLongint = ^Longint; begin If P=Nil then Writeln ('(Ref : Empty string)') - else -{$ifdef fpc} + else +{$ifdef fpc} Writeln (' (Ref: ',Plongint(Longint(P)-4)^,',Len: ',PLongint(Longint(P)-8)^,')'); {$else} Writeln (' (Ref: ',Plongint(Longint(P)-8)^,',Len: ',PLongint(Longint(P)-4)^,')'); @@ -52,20 +52,20 @@ Type ARec = record AnArray = Array [1..10] of AnsiString; -Var +Var S : AnsiString; - AR : Arec; + AR : Arec; AAR : AnArray; I : longint; - + Begin S:='This is an ansistring!'; - If Pointer(AR.FirstNAme)<>Nil then + If Pointer(AR.FirstNAme)<>Nil then Writeln ('AR.FirstName not OK'); - If Pointer(AR.LastName)<>Nil then + If Pointer(AR.LastName)<>Nil then Writeln ('AR.LastName not OK'); - for I:=1 to 10 do - If Pointer(AAR[I])<>Nil then + for I:=1 to 10 do + If Pointer(AAR[I])<>Nil then Writeln ('Array (',I,') NOT ok'); AR.FirstName:='Napoleon'; AR.LastName:='Bonaparte'; @@ -91,7 +91,7 @@ begin DoRef(Pointer(Sv)); Sv:='This is a var parameter ansistring'; Write ('S Changed to : ',Sv); - DoRef (Pointer(Sv)); + DoRef (Pointer(Sv)); Ls:=Sv; Write ('Assigned to local var: "',ls,'"'); DoRef (Pointer(Sv)); @@ -104,7 +104,7 @@ Var LS : AnsiString; begin Write ('TestValParam : Got S="',S,'"'); S:='This is a value parameter ansistring'; - Write ('S Changed to : ',S); + Write ('S Changed to : ',S); DoRef(Pointer(S)); Ls:=S; Write ('Assigned to local var: "',ls,'"'); @@ -127,10 +127,10 @@ Procedure TestParams; Var S : AnsiString; Mem : Longint; - + begin Mem:=MemAvail; - S :='This is another ansistring'; + S :='This is another ansistring'; Writeln ('Calling testvalparam with "',s,'"'); testvalparam (s); DoMem(Mem); @@ -154,10 +154,10 @@ Const S1 : AnsiString = 'Teststring 1'; S3 : AnsiString = 'Teststring 2'; S4 : AnsiString = ''; PC : Pchar = 'Teststring 1'; - + Var S,T : AnsiString; - ss : Shortstring; - + ss : Shortstring; + begin If S1=S2 then writeln ('S1 and S2 are the same'); If S4='' then Writeln ('S4 is empty. OK'); @@ -174,11 +174,11 @@ begin Write ('Assigned S to T. ');Doref(Pointer(T)); If S=T then Writeln ('S=T, OK'); SS:='Teststring 1'; - If SS=S then + If SS=S then Writeln ('Shortstring and AnsiString are the same. OK') else Writeln ('Shortstring and AnsiString NOT equal. PROBLEM !'); - If S=PC then + If S=PC then Writeln ('Pchar and AnsiString are the same. OK') else Writeln ('Pchar and AnsiString NOT equal. PROBLEM !'); @@ -202,18 +202,18 @@ Var Pstr : Pchar; Astr : AnsiString; Const PC : Pchar = 'A PCHAR constant string'; - + begin - Writeln ('Astr empty : "',Astr,'"'); + Writeln ('Astr empty : "',Astr,'"'); Pstr:=PChar(Astr); Writeln ('AnsiString Assigned to Pchar : "',Pstr,'"'); DoPchar(Pchar(Astr)); Astr:='An Ansistring'; - Writeln ('Astr: "',Astr,'"'); + Writeln ('Astr: "',Astr,'"'); Pstr:=PChar(Astr); Writeln ('AnsiString Assigned to Pchar : "',Pstr,'"'); DoPchar(Pchar(Astr)); - SStr:='A ShortString'; + SStr:='A ShortString'; Writeln ('Shortstring : "',Sstr,'"'); Astr:=Sstr; Write ('ShortString assigned to AnsiString : "',Astr,'"'); @@ -287,7 +287,7 @@ Procedure testIndex; Var S,T : AnsiString; I,Len : longint; - + begin S:='ABCDEFGHIJKLMNOPQRSTUVWXYZ'; Write ('S = "',S,'" ');doref(pointer(S)); @@ -296,14 +296,14 @@ begin For I:=1 to Len do Write(S[i]); write ('" ');Doref(pointer(S)); Write ('Inverting S, '); - For I:=1 to Len do + For I:=1 to Len do S[i]:='A'; // Asc(Ord('Z')+1-i); Write ('S = "',S,'" ');doref(pointer(S)); T:=S; Write ('Assigned S to T '); Doref(Pointer(S)); Write ('Again inverting S. '); - For I:=1 to Len do + For I:=1 to Len do S[i]:='B'; Write ('S = "',S,'" ');doref(pointer(S)); Write ('T = "',T,'" ');doref(pointer(T)); @@ -327,7 +327,7 @@ Var I : Integer; begin mem:=memavail; S3 := 'ABCDEF'; - Write ('S1+S2=S3 :'); + Write ('S1+S2=S3 :'); If S1+S2=S3 then writeln (ok) else writeln (nok); Write ('S1+S2=ABCDEF'); If S1+S2='ABCDEF' then writeln (ok) else writeln (nok); @@ -356,7 +356,7 @@ Procedure TestStdFunc; Var S,T : AnsiString; SS : ShortString; C : Char; - Ca : Cardinal; + Ca : Cardinal; L : longint; I : Integer; W : Word; @@ -366,9 +366,9 @@ Var S,T : AnsiString; E : Extended; Si : Single; Co : Comp; - TempMem:Longint; + TempMem:Longint; begin - TempMem:=Memavail; + TempMem:=Memavail; S:='ABCDEF'; Write ('S = "',S,'"');Doref(Pointer(S)); T:=Copy(S,1,3); @@ -379,7 +379,7 @@ begin Write ('T : "',T,'"');DoRef(Pointer(T)); Writeln ('Inserting "123" in S at pos 4'); Insert ('123',S,4); - Write ('S = "',S,'"');DoRef(Pointer(S)); + Write ('S = "',S,'"');DoRef(Pointer(S)); Writeln ('Deleting 3 characters From S starting Pos 4'); Delete (S,4,3); Write ('S = "',S,'"');Doref(Pointer(S)); diff --git a/tests/testaoc.pp b/tests/test/testaoc.pp similarity index 100% rename from tests/testaoc.pp rename to tests/test/testaoc.pp diff --git a/tests/testexc.pp b/tests/test/testexc.pp similarity index 100% rename from tests/testexc.pp rename to tests/test/testexc.pp diff --git a/tests/testfail.pp b/tests/test/testfail.pp similarity index 76% rename from tests/testfail.pp rename to tests/test/testfail.pp index ac2c25c91c..3ae4fbdb76 100644 --- a/tests/testfail.pp +++ b/tests/test/testfail.pp @@ -77,9 +77,9 @@ program test_fail; writeln('After successful pa1:=new(pbigarrayobj,good_init), memory used = ',availmem - memavail); pa2:=new(pbigarrayobj,wrong_init); writeln('After unsuccessful pa2:=new(pbigarrayobj,wrong_init), memory used = ',availmem - memavail); - writeln('pa1 = ',longint(pa1),' pa2 = ',longint(pa2)); - writeln('Call to pa1^.test after successful init'); - pa1^.test; + writeln('pa1 = ',longint(pa1),' pa2 = ',longint(pa2)); + writeln('Call to pa1^.test after successful init'); + pa1^.test; ta1.init(false); writeln('Call to ta1.test after successful init'); ta1.test; diff --git a/tests/testheap.pp b/tests/test/testheap.pp similarity index 100% rename from tests/testheap.pp rename to tests/test/testheap.pp diff --git a/tests/test/testi642.pp b/tests/test/testi642.pp new file mode 100644 index 0000000000..1bc089866b --- /dev/null +++ b/tests/test/testi642.pp @@ -0,0 +1,1118 @@ +{$mode objfpc} +uses + sysutils +{$ifdef go32v2} + ,dpmiexcp +{$endif go32v2} + ; + +type + tqwordrec = packed record + low,high : dword; + end; + +procedure dumpqword(q : qword); + + begin + write('$',hexstr(tqwordrec(q).high,8),' ',hexstr(tqwordrec(q).low,8)); + end; + +procedure dumpqwordln(q : qword); + + begin + dumpqword(q); + writeln; + end; + +procedure assignqword(h,l : dword;var q : qword); + + begin + tqwordrec(q).high:=h; + tqwordrec(q).low:=l; + end; + +procedure do_error(l : longint); + + begin + writeln('Error near number ',l); + halt(1); + end; + +procedure do_error; + + begin + do_error(0); + end; + +procedure simpletestcmpqword; + + var + q1,q2,q3,q4 : qword; + + begin + assignqword(0,5,q1); + assignqword(6,0,q2); + assignqword(6,1,q3); + assignqword(6,5,q4); + { first test the code generation of the operators } + if q1<>q1 then + do_error(0); + if q2<>q2 then + do_error(0); + if q3<>q3 then + do_error(0); + if not(q1=q1) then + do_error(0); + if not(q2=q2) then + do_error(0); + if not(q3=q3) then + do_error(0); + writeln(' <>,= succesfully tested'); + + if q1>q2 then + do_error(1100); + if q2>q3 then + do_error(1101); + if q2 succesfully tested'); + + if q1>=q2 then + do_error(1104); + if q2>=q3 then + do_error(1105); + if q2<=q1 then + do_error(1106); + if q3<=q2 then + do_error(1107); + writeln(' >=,<= succesfully tested'); + + if q1=q2 then + do_error(1108); + if q2=q3 then + do_error(1109); + if q3=q1 then + do_error(1111); + + if q1=q4 then + do_error(1112); + if q2=q4 then + do_error(1113); + if q3=q4 then + do_error(1114); + writeln(' More comparisations successful tested'); + end; + +procedure testaddqword; + + var + q1,q2,q3,q4,q5,q6 : qword; + + begin + { without overflow between 32 bit } + assignqword(0,5,q1); + assignqword(0,6,q2); + assignqword(0,1,q3); + assignqword(0,11,q4); + assignqword(0,1,q5); + if q1+q2<>q4 then + do_error(1200); + if q1+q3+q1<>q4 then + do_error(1201); + if q1+(q3+q1)<>q4 then + do_error(1202); + if (q1+q3)+q1<>q4 then + do_error(1203); + { a more complex expression } + if ((((q5+q3)+(q3+q5))+((q5+q3)+(q3+q5)))+q5+q3+q5)<>q4 then + do_error(1204); + { with overflow between 32 bit } + assignqword(0,$ffffffff,q1); + assignqword(1,3,q2); + assignqword(0,4,q3); + assignqword(1,4,q4); + assignqword(0,1,q5); + assignqword(1,$fffffffe,q6); + if q1+q3<>q2 then + do_error(1205); + if q3+q1<>q2 then + do_error(1206); + if q1+(q3+q5)<>q4 then + do_error(1207); + if (q1+q3)+q5<>q4 then + do_error(1208); + if (q1+q1)<>q6 then + do_error(1209); + end; + +procedure testcmpqword; + + var + q1,q2,q3,q4,q5,q6 : qword; + + begin + assignqword(0,$ffffffff,q1); + assignqword(0,$ffffffff,q2); + assignqword(1,$fffffffe,q3); + assignqword(0,2,q4); + assignqword(1,$fffffffc,q5); + if (q1+q2)<>q3 then + do_error(1300); + if not(q3=(q1+q2)) then + do_error(1301); + if (q1+q2)>q3 then + do_error(1302); + if (q1+q2)=(q1+q2)) then + do_error(1305); + + if (q1+q2)<>(q4+q5) then + do_error(1306); + if not((q4+q5)=(q1+q2)) then + do_error(1307); + if (q1+q2)>(q4+q5) then + do_error(1308); + if (q1+q2)<(q4+q5) then + do_error(1309); + if not((q4+q5)<=(q1+q2)) then + do_error(1310); + if not((q4+q5)>=(q1+q2)) then + do_error(1311); + end; + +procedure testlogqword; + + var + q0,q1,q2,q3,q4,q5,q6 : qword; + + begin + assignqword(0,0,q0); + assignqword($ffffffff,$ffffffff,q1); + assignqword(0,$ffffffff,q2); + assignqword($ffffffff,0,q3); + assignqword($a0a0a0a0,$50505050,q4); + assignqword(0,$50505050,q5); + assignqword($a0a0a0a0,0,q6); + + { here we don't need to test all cases of locations, } + { this is already done by the addtion test } + if (q2 or q3)<>q1 then + do_error(1400); + if (q5 or q6)<>q4 then + do_error(1401); + + if (q2 and q3)<>q0 then + do_error(1402); + if (q5 and q6)<>q0 then + do_error(1403); + + if (q2 xor q3)<>q1 then + do_error(1404); + if (q5 xor q6)<>q4 then + do_error(1405); + { the test before could be also passed by the or operator! } + if (q4 xor q4)<>q0 then + do_error(1406); + end; + +procedure testshlshrqword; + + var + q0,q1,q2,q3,q4,q5 : qword; + l1,l2 : longint; + + begin + assignqword(0,0,q0); + assignqword($ffff,$ffff0000,q1); + assignqword(0,$ffffffff,q2); + assignqword($ffffffff,0,q3); + assignqword(0,1,q4); + assignqword($80000000,0,q5); + + l1:=16; + l2:=0; + if (q1 shl 16)<>q3 then + do_error(1500); + if (q1 shl 48)<>q0 then + do_error(1501); + if (q1 shl 47)<>q5 then + do_error(1501); + if ((q1+q0) shl 16)<>q3 then + do_error(1502); + if ((q1+q0) shl 48)<>q0 then + do_error(1503); + if ((q1+q0) shl 47)<>q5 then + do_error(15031); + + if (q1 shl l1)<>q3 then + do_error(1504); + if (q1 shl (3*l1))<>q0 then + do_error(1505); + if ((q1+q0) shl l1)<>q3 then + do_error(1506); + if ((q1+q0) shl (3*l1))<>q0 then + do_error(1507); + if ((q1+q0) shl (3*l1-1))<>q5 then + do_error(15071); + + if (q1 shl (l1+l2))<>q3 then + do_error(1508); + if ((q1+q0) shl (l1+l2))<>q3 then + do_error(1509); + + if (q1 shr 16)<>q2 then + do_error(1510); + if (q1 shr 48)<>q0 then + do_error(1511); + if (q1 shr 47)<>q4 then + do_error(15111); + + if ((q1+q0) shr 16)<>q2 then + do_error(1512); + if ((q1+q0) shr 48)<>q0 then + do_error(1513); + if (q1 shr l1)<>q2 then + do_error(1514); + if (q1 shr (3*l1))<>q0 then + do_error(1515); + if (q1 shr (3*l1-1))<>q4 then + do_error(15151); + + if ((q1+q0) shr l1)<>q2 then + do_error(1516); + if ((q1+q0) shr (3*l1))<>q0 then + do_error(1517); + if ((q1+q0) shr (3*l1-1))<>q4 then + do_error(15171); + + if (q1 shr (l1+l2))<>q2 then + do_error(1518); + if ((q1+q0) shr (l1+l2))<>q2 then + do_error(1519); + end; + +procedure testsubqword; + + var + q0,q1,q2,q3,q4,q5,q6 : qword; + + begin + { without overflow between 32 bit } + assignqword(0,0,q0); + assignqword(0,6,q1); + assignqword(0,5,q2); + assignqword(0,1,q3); + assignqword(0,11,q4); + assignqword(0,1,q5); + if q1-q2<>q3 then + do_error(1600); + if q1-q0-q1<>q0 then + do_error(1601); + if q1-(q0-q1)<>q1+q1 then + do_error(1602); + if (q1-q0)-q1<>q0 then + do_error(1603); + + { a more complex expression } + if ((((q5-q3)-(q3-q5))-((q5-q3)-(q3-q5))))<>q0 then + do_error(1604); + + { with overflow between 32 bit } + assignqword(1,0,q1); + assignqword(0,$ffffffff,q2); + assignqword(0,1,q3); + assignqword(1,$ffffffff,q4); + + if q1-q2<>q3 then + do_error(1605); + if q1-q0-q2<>q3 then + do_error(1606); + if q1-(q0-q2)<>q4 then + do_error(1607); + if (q1-q0)-q1<>q0 then + do_error(1608); + + assignqword(1,$ffffffff,q5); + assignqword(1,$ffffffff,q4); + + { a more complex expression } + if ((((q5-q3)-(q3-q5))-((q5-q3)-(q3-q5))))<>q0 then + do_error(1609); + end; + +procedure testnotqword; + + var + q0,q1,q2,q3,q4 : qword; + + begin + assignqword($f0f0f0f0,$f0f0f0f0,q1); + assignqword($f0f0f0f,$f0f0f0f,q2); + assignqword($f0f0f0f0,0,q3); + assignqword(0,$f0f0f0f0,q4); + if not(q1)<>q2 then + do_error(1700); + if not(q3 or q4)<>q2 then + do_error(1701); + + { do a more complex expression to stress the register saving } + if not(q3 or q4)<>not(q3 or q4) then + do_error(1702); + end; + +procedure testmulqword; + + var + q0,q1,q2,q3,q4,q5,q6 : qword; + i : longint; + + begin + assignqword(0,0,q0); + assignqword(0,1,q1); + assignqword(0,4,q2); + assignqword(2,0,q3); + assignqword(8,0,q4); + assignqword(0,1,q5); + assignqword($ffff,$12344321,q6); + { to some trivial tests } + { to test the code generation } + if q1*q2<>q2 then + do_error(1800); + if q1*q2*q3<>q4 then + do_error(1801); + if q1*(q2*q3)<>q4 then + do_error(1802); + if (q1*q2)*q3<>q4 then + do_error(1803); + if (q6*q5)*(q1*q2)<>q1*q2*q5*q6 then + do_error(1804); + + { a more complex expression } + if ((((q1*q5)*(q1*q5))*((q5*q1)*(q1*q5)))*q5*q1*q5)<>q1 then + do_error(1805); + + { now test the multiplication procedure with random bit patterns } + writeln('Doing some random multiplications, takes a few seconds'); + writeln('.....................................100%'); + for i:=1 to 1000000 do + begin + tqwordrec(q1).high:=0; + tqwordrec(q1).low:=random($7ffffffe); + tqwordrec(q2).high:=0; + tqwordrec(q2).low:=random($7ffffffe); + if q1*q2<>q2*q1 then + begin + write('Multiplication of '); + dumpqword(q1); + write(' and '); + dumpqword(q2); + writeln(' failed'); + do_error(1806); + end; + if i mod 50000=0 then + write('.'); + end; + for i:=1 to 1000000 do + begin + tqwordrec(q1).high:=0; + tqwordrec(q1).low:=random($7ffffffe); + q1:=q1 shl 16; + tqwordrec(q2).high:=0; + tqwordrec(q2).low:=random($fffe); + if q1*q2<>q2*q1 then + begin + write('Multiplication of '); + dumpqword(q1); + write(' and '); + dumpqword(q2); + writeln(' failed'); + do_error(1806); + end; + if i mod 50000=0 then + write('.'); + end; + writeln(' OK'); + end; + +procedure testdivqword; + + var + q0,q1,q2,q3,q4,q5,q6 : qword; + i : longint; + + begin + assignqword(0,0,q0); + assignqword(0,1,q1); + assignqword(0,4,q2); + assignqword(2,0,q3); + assignqword(8,0,q4); + assignqword(0,1,q5); + assignqword($ffff,$12344321,q6); + { to some trivial tests } + { to test the code generation } + if q2 div q1<>q2 then + do_error(1900); + if q2 div q1 div q1<>q2 then + do_error(1901); + if q2 div (q4 div q3)<>q1 then + do_error(1902); + if (q4 div q3) div q2<>q1 then + do_error(1903); + + { a more complex expression } + if (q4 div q3) div (q2 div q1)<>(q2 div q1) div (q4 div q3) then + do_error(1904); + + { now test the division procedure with random bit patterns } + writeln('Doing some random divisions, takes a few seconds'); + writeln('.................100%'); + for i:=1 to 100000 do + begin + tqwordrec(q1).high:=random($7ffffffe); + tqwordrec(q1).low:=random($7ffffffe); + tqwordrec(q2).high:=random($7ffffffe); + tqwordrec(q2).low:=random($7ffffffe); + { avoid division by zero } + if (tqwordrec(q2).low or tqwordrec(q2).high)=0 then + tqwordrec(q2).low:=1; + q3:=q1 div q2; + { get a restless division } + q1:=q2*q3; + q3:=q1 div q2; + if q3*q2<>q1 then + begin + write('Division of '); + dumpqword(q1); + write(' by '); + dumpqword(q2); + writeln(' failed'); + do_error(1906); + end; + if i mod 10000=0 then + write('.'); + end; + for i:=1 to 100000 do + begin + tqwordrec(q1).high:=0; + tqwordrec(q1).low:=random($7ffffffe); + tqwordrec(q2).high:=0; + tqwordrec(q2).low:=random($7ffffffe); + { avoid division by zero } + if tqwordrec(q2).low=0 then + tqwordrec(q2).low:=1; + { get a restless division } + q3:=q1*q2; + q3:=q3 div q2; + if q3<>q1 then + begin + write('Division of '); + dumpqword(q1); + write(' by '); + dumpqword(q2); + writeln(' failed'); + do_error(1907); + end; + if i mod 10000=0 then + write('.'); + end; + writeln(' OK'); + end; + +function testf : qword; + + var + q : qword; + + begin + assignqword($ffffffff,$a0a0a0a0,q); + testf:=q; + end; + +procedure testfuncqword; + + var + q : qword; + + begin + assignqword($ffffffff,$a0a0a0a0,q); + if testf<>q then + do_error(1900); + if q<>testf then + do_error(1901); + end; + +procedure testtypecastqword; + + var + s1,s2 : shortint; + b1,b2 : byte; + w1,w2 : word; + i1,i2 : integer; + l1,l2 : longint; + d1,d2 : dword; + q1,q2 : qword; + d1,d2 : double; + + begin + { shortint } + s1:=75; + s2:=0; + q1:=s1; + { mix up the processor a little bit } + q2:=q1; + if q2<>75 then + begin + dumpqword(q2); + do_error(2006); + end; + s2:=q2; + if s1<>s2 then + do_error(2000); + + { byte } + b1:=$ca; + b2:=0; + q1:=b1; + { mix up the processor a little bit } + q2:=q1; + if q2<>$ca then + do_error(2007); + b2:=q2; + if b1<>b2 then + do_error(2001); + + { integer } + i1:=12345; + i2:=0; + q1:=i1; + { mix up the processor a little bit } + q2:=q1; + if q2<>12345 then + do_error(2008); + i2:=q2; + if i1<>i2 then + do_error(2002); + + { word } + w1:=$a0ff; + w2:=0; + q1:=w1; + { mix up the processor a little bit } + q2:=q1; + if q2<>$a0ff then + do_error(2009); + w2:=q2; + if w1<>w2 then + do_error(2003); + + { longint } + l1:=12341234; + l2:=0; + q1:=l1; + { mix up the processor a little bit } + q2:=q1; + if q2<>12341234 then + do_error(2010); + l2:=q2; + if l1<>l2 then + do_error(2004); + + { dword } + d1:=$5bcdef01; + b2:=0; + q1:=d1; + { mix up the processor a little bit } + q2:=q1; + if q2<>$5bcdef01 then + do_error(2011); + d2:=q2; + if d1<>d2 then + do_error(2005); + + { real } + { memory location } + q1:=12; + d1:=q1; + d2:=12; + if d1<>d2 then + do_error(2012); + + { register location } + q1:=12; + d1:=q1+1; + d2:=13; + if d1<>d2 then + do_error(2013); + + // a constant which can't be loaded with fild + q1:=$80000000; + q1:=q1 shl 32; + d1:=q1; + d2:=$80000000; + if d1<>d2*d2*2.0 then + do_error(20); + // register location + d1:=q1+1; + if d1<>d2*d2*2.0+1 then + do_error(2014); + end; + +procedure testioqword; + + var + t : text; + q1,q2 : qword; + i : longint; + + begin + assignqword($ffffffff,$a0a0a0a0,q1); + assign(t,'testi642.tmp'); + rewrite(t); + writeln(t,q1); + close(t); + reset(t); + readln(t,q2); + close(t); + if q1<>q2 then + do_error(2100); + { do some random tests } + for i:=1 to 100 do + begin + tqwordrec(q1).high:=random($7ffffffe); + tqwordrec(q1).low:=random($7ffffffe); + rewrite(t); + writeln(t,q1); + close(t); + reset(t); + readln(t,q2); + close(t); + if q1<>q2 then + begin + write('I/O of ');dumpqword(q1);writeln(' failed'); + do_error(2101); + end; + end; + end; + +procedure teststringqword; + + var + q1,q2 : qword; + s : string; + l : longint; + a : ansistring; + + begin + { testing str: shortstring } + // simple tests + q1:=1; + str(q1,s); + if s<>'1' then + do_error(2200); + // simple tests + q1:=0; + str(q1,s); + if s<>'0' then + do_error(2201); + + // more complex tests + q1:=4321; + str(q1,s); + if s<>'4321' then + do_error(2202); + str(q1:6,s); + if s<>' 4321' then + do_error(2203); + + // create a big qword: + q2:=1234; + l:=1000000000; + q2:=q2*l; + l:=54321; + q2:=q2+l; + str(q2,s); + if s<>'1234000054321' then + do_error(2204); + + { testing str: ansistring } + // more complex tests + q1:=4321; + str(q1,a); + if a<>'4321' then + do_error(2205); + str(q1:6,a); + if a<>' 4321' then + do_error(2206); + + // create a big qword: + q2:=1234; + l:=1000000000; + q2:=q2*l; + l:=54321; + q2:=q2+l; + str(q2,a); + if a<>'1234000054321' then + do_error(2207); + + { testing val } + { !!!!!!! } + end; + +procedure testmodqword; + + var + q0,q1,q2,q3,q4,q5,q6 : qword; + i : longint; + + begin + assignqword(0,0,q0); + assignqword(0,3,q1); + assignqword(0,5,q2); + assignqword(0,2,q3); + assignqword(0,4,q4); + assignqword(0,1,q5); + assignqword($ffff,$12344321,q6); + { to some trivial tests } + { to test the code generation } + if q2 mod q1<>q3 then + do_error(2300); + if q2 mod q1 mod q3<>q0 then + do_error(2301); + if q2 mod (q1 mod q3)<>q0 then + do_error(2302); + if (q1 mod q3) mod q2<>q5 then + do_error(2303); + + { a more complex expression } + if (q2 mod q4) mod (q1 mod q3)<>(q1 mod q3) mod (q2 mod q4) then + do_error(2304); + + { now test the modulo division procedure with random bit patterns } + writeln('Doing some random module divisions, takes a few seconds'); + writeln('.................100%'); + for i:=1 to 100000 do + begin + tqwordrec(q1).high:=random($7ffffffe); + tqwordrec(q1).low:=random($7ffffffe); + tqwordrec(q2).high:=random($7ffffffe); + tqwordrec(q2).low:=random($7ffffffe); + { avoid division by zero } + if (tqwordrec(q2).low or tqwordrec(q2).high)=0 then + tqwordrec(q2).low:=1; + q3:=q1 mod q2; + if (q1-q3) mod q2<>q0 then + begin + write('Modulo division of '); + dumpqword(q1); + write(' by '); + dumpqword(q2); + writeln(' failed'); + do_error(2306); + end; + if i mod 10000=0 then + write('.'); + end; + for i:=1 to 100000 do + begin + tqwordrec(q1).high:=random($7ffffffe); + tqwordrec(q1).low:=random($7ffffffe); + tqwordrec(q2).high:=0; + tqwordrec(q2).low:=random($7ffffffe); + { avoid division by zero } + if tqwordrec(q2).low=0 then + tqwordrec(q2).low:=1; + { get a restless division } + q3:=q1 mod q2; + if (q1-q3) mod q2<>q0 then + begin + write('Modulo division of '); + dumpqword(q1); + write(' by '); + dumpqword(q2); + writeln(' failed'); + do_error(2307); + end; + if i mod 10000=0 then + write('.'); + end; + writeln(' OK'); + end; + +const + constqword : qword = 131975; + +procedure testconstassignqword; + + var + q1,q2,q3 : qword; + + begin + // constant assignments + assignqword(0,5,q2); + q1:=5; + if q1<>q2 then + do_error(2400); + + // constants in expressions + q1:=1234; + if q1<>1234 then + do_error(2401); + + // typed constants + assignqword(0,131975,q1); + q2:=131975; + if q1<>q2 then + do_error(2402); + + //!!!!! large constants are still missed + end; + +{$Q+} +procedure testreqword; + + var + q0,q1,q2,q3 : qword; + + begin + q0:=0; + assignqword($ffffffff,$ffffffff,q1); + q2:=1; + + // addition + try + // expect an exception + q3:=q1+q2; + do_error(2500); + except + on eintoverflow do + ; + else + do_error(2501); + end; + // subtraction + try + q3:=q0-q2; + do_error(2502); + except + on eintoverflow do + ; + else + do_error(2503); + end; + + // multiplication + q2:=2; + try + q3:=q2*q1; + do_error(2504); + except + on eintoverflow do + ; + else + do_error(2505); + end; + + // division + try + q3:=q1 div q0; + do_error(2506); + except + on edivbyzero do + ; + else + do_error(2507); + end; + + // modulo division + try + q3:=q1 mod q0; + do_error(2508); + except + on edivbyzero do + ; + else + do_error(2509); + end; +{$Q-} + + // now we do the same operations but without overflow + // checking -> we should get no exceptions + q2:=1; + + // addition + try + q3:=q1+q2; + except + do_error(2510); + end; + // subtraction + try + q3:=q0-q2; + except + do_error(2511); + end; + + // multiplication + q2:=2; + try + q3:=q2*q1; + except + do_error(2512); + end; + + end; + +procedure testintqword; + + var + q1,q2,q3 : qword; + + begin + // lo/hi + assignqword($fafafafa,$03030303,q1); + if lo(q1)<>$03030303 then + do_error(2600); + if hi(q1)<>$fafafafa then + do_error(2601); + if lo(q1+1)<>$03030304 then + do_error(2602); + if hi(q1+$f0000000)<>$fafafafa then + do_error(2603); + + // swap + assignqword($03030303,$fafafafa,q2); + if swap(q1)<>q2 then + do_error(2604); + + // succ/pred + assignqword(0,$1,q1); + q3:=q1; + q1:=succ(q1); + q1:=succ(q1+1); + q2:=pred(q1-1); + q2:=pred(q2); + if q3<>q2 then + do_error(2605); + assignqword(0,$ffffffff,q1); + q3:=q1; + q1:=succ(q1); + q1:=succ(q1+1); + q2:=pred(q1-1); + q2:=pred(q2); + if q3<>q2 then + do_error(2606); + end; + +var + q : qword; + +begin + randomize; + writeln('------------------------------------------------------'); + writeln(' QWord test '); + writeln('------------------------------------------------------'); + writeln; + + writeln('Testing assignqword and dumpqword ... '); + assignqword($12345678,$9ABCDEF0,q); + dumpqword(q); + writeln; + writeln('The output should be:'); + writeln('$12345678 9ABCDEF0'); + writeln; + + writeln('Testing simple QWord comparisations'); + simpletestcmpqword; + writeln('Testing simple QWord comparisations was successful'); + writeln; + + writeln('Testing QWord additions'); + testaddqword; + writeln('Testing QWord additions was successful'); + writeln; + + writeln('Testing more QWord comparisations'); + testcmpqword; + writeln('Testing more QWord comparisations was successful'); + writeln; + + writeln('Testing QWord subtraction'); + testsubqword; + writeln('Testing QWord subtraction was successful'); + writeln; + + writeln('Testing QWord constants'); + testconstassignqword; + writeln('Testing QWord constants was successful'); + writeln; + + writeln('Testing QWord logical operators (or,xor,and)'); + testlogqword; + writeln('Testing QWord logical operators (or,xor,and) was successful'); + writeln; + + writeln('Testing QWord logical not operator'); + testnotqword; + writeln('Testing QWord logical not operator was successful'); + writeln; + + writeln('Testing QWord logical shift operators (shr,shr)'); + testshlshrqword; + writeln('Testing QWord logical shift operators (shr,shr) was successful'); + writeln; + + writeln('Testing QWord function results'); + testfuncqword; + writeln('Testing QWord function results was successful'); + writeln; + + writeln('Testing QWord type casts'); + testtypecastqword; + writeln('Testing QWord type casts was successful'); + writeln; + + writeln('Testing QWord internal procedures'); + testintqword; + writeln('Testing QWord internal procedures was successful'); + writeln; + + writeln('Testing QWord multiplications'); + testmulqword; + writeln('Testing QWord multiplications was successful'); + writeln; + + writeln('Testing QWord division'); + testdivqword; + writeln('Testing QWord division was successful'); + writeln; + + writeln('Testing QWord modulo division'); + testmodqword; + writeln('Testing QWord modulo division was successful'); + writeln; + + writeln('Testing QWord runtime errors'); + testreqword; + writeln('Testing QWord runtime errors was successful'); + writeln; + + writeln('Testing QWord string conversion'); + teststringqword; + writeln('Testing QWord string conversion was successful'); + writeln; + + writeln('Testing QWord input/output'); + testioqword; + writeln('Testing QWord input/output was successful'); + writeln; + + writeln('------------------------------------------------------'); + writeln(' QWord test successful'); + writeln('------------------------------------------------------'); + halt(0); +end. diff --git a/tests/testin64.pp b/tests/test/testin64.pp similarity index 98% rename from tests/testin64.pp rename to tests/test/testin64.pp index f9122e1740..0eea1006b7 100644 --- a/tests/testin64.pp +++ b/tests/test/testin64.pp @@ -24,7 +24,7 @@ function f2 : int64; end; var - q1,q2,q3,q4 : qword; + q1,q3,q4 : qword; begin if (q4 div q3) div (q2 div q1)<>(q2 div q1) div (q4 div q3) then diff --git a/tests/testpvar.pp b/tests/test/testpvar.pp similarity index 94% rename from tests/testpvar.pp rename to tests/test/testpvar.pp index 7f047525d9..4aa0b931e4 100644 --- a/tests/testpvar.pp +++ b/tests/test/testpvar.pp @@ -119,7 +119,11 @@ begin end. { $Log$ - Revision 1.2 1999-11-29 22:55:25 florian + Revision 1.1 1999-12-02 17:37:45 peter + * moved *.pp into subdirs + * fpcmaked + + Revision 1.2 1999/11/29 22:55:25 florian * small update Revision 1.1 1999/09/11 19:45:33 florian diff --git a/tests/testrtti.pp b/tests/test/testrtti.pp similarity index 93% rename from tests/testrtti.pp rename to tests/test/testrtti.pp index 89c9e349a5..14a1b0c8af 100644 --- a/tests/testrtti.pp +++ b/tests/test/testrtti.pp @@ -9,7 +9,7 @@ dpmiexcp, {$endif} Typinfo; -Const TypeNames : Array [TTYpeKind] of string[15] = +Const TypeNames : Array [TTYpeKind] of string[15] = ('Unknown','Integer','Char','Enumeration', 'Float','Set','Method','ShortString','LongString', 'AnsiString','WideString','Variant','Array','Record', @@ -81,28 +81,28 @@ Type Function GetVirtualStored : Boolean;virtual; Public Constructor Create; - Destructor Destroy;override; + Destructor Destroy;override; Published Property BooleanField : Boolean Read FBoolean Write FBoolean; - Property ByteField : Byte Read FByte Write FByte; - Property CharField : Char Read FChar Write FChar; - Property WordField : Word Read FWord Write FWord; - Property IntegerField : Integer Read FInteger Write FInteger; - Property LongintField : Longint Read FLongint Write FLongint; - Property CardinalField : Cardinal Read FCardinal Write FCardinal; - Property RealField : Real Read FReal Write FReal; - Property ExtendedField : Extended Read FExtended Write FExtended; - Property AnsiStringField : AnsiString Read FAnsiString Write FAnsiString; + Property ByteField : Byte Read FByte Write FByte; + Property CharField : Char Read FChar Write FChar; + Property WordField : Word Read FWord Write FWord; + Property IntegerField : Integer Read FInteger Write FInteger; + Property LongintField : Longint Read FLongint Write FLongint; + Property CardinalField : Cardinal Read FCardinal Write FCardinal; + Property RealField : Real Read FReal Write FReal; + Property ExtendedField : Extended Read FExtended Write FExtended; + Property AnsiStringField : AnsiString Read FAnsiString Write FAnsiString; Property MyEnumField : TMyEnum Read FMyEnum Write FMyEnum; Property BooleanMethod : Boolean Read GetBoolean Write SetBoolean; - Property ByteMethod : Byte Read GetByte Write SetByte; - Property CharMethod : Char Read GetChar Write SetChar; - Property WordMethod : Word Read GetWord Write SetWord; - Property IntegerMethod : Integer Read GetInteger Write SetInteger; + Property ByteMethod : Byte Read GetByte Write SetByte; + Property CharMethod : Char Read GetChar Write SetChar; + Property WordMethod : Word Read GetWord Write SetWord; + Property IntegerMethod : Integer Read GetInteger Write SetInteger; Property LongintMethod : Longint Read GetLongint Write SetLongint; - Property CardinalMethod : Cardinal Read GetCardinal Write SetCardinal; - Property RealMethod : Real Read GetReal Write SetReal; - Property ExtendedMethod : Extended Read GetExtended Write SetExtended; + Property CardinalMethod : Cardinal Read GetCardinal Write SetCardinal; + Property RealMethod : Real Read GetReal Write SetReal; + Property ExtendedMethod : Extended Read GetExtended Write SetExtended; Property AnsiStringMethod : AnsiString Read GetAnsiString Write SetAnsiString; Property MyEnumMethod : TMyEnum Read GetMyEnum Write SetMyEnum; Property BooleanVirtualMethod : Boolean Read GetVirtualBoolean Write SetVirtualBoolean; @@ -397,7 +397,7 @@ begin Write(' ',CHar(PL^)) else Write (PL^:3); - Write (' '); + Write (' '); inc(pl); end; writeln; @@ -423,7 +423,7 @@ Var PI : PTypeInfo; I,J : Longint; PP : PPropList; - + begin PI:=O.ClassInfo; Writeln ('Type kind : ',TypeNames[PI^.Kind]); @@ -432,7 +432,7 @@ begin //DumpMem(PByte(PI)); If PT^.ParentInfo=Nil then Writeln ('Object has no parent info') - else + else Writeln ('Object has parent info'); Writeln ('Property Count : ',PT^.PropCount); Writeln ('Unit name : ',PT^.UnitName); @@ -472,7 +472,7 @@ begin Writeln ('Property IntegerField : ',IntegerField); Writeln ('Property LongintField : ',LongintField); Writeln ('Property CardinalField : ',CardinalField); - Writeln ('Property RealField : ',RealField); + Writeln ('Property RealField : ',RealField); Writeln ('Property ExtendedField : ',ExtendedFIeld); Writeln ('Property AnsiStringField : ',AnsiStringField); Writeln ('Property MyEnumField : ',ord(MyEnumField)); @@ -484,7 +484,7 @@ begin Writeln ('Property IntegerMethod : ',IntegerMethod); Writeln ('Property LongintMethod : ',LongintMethod); Writeln ('Property CardinalMethod : ',CardinalMethod); - Writeln ('Property RealMethod : ',RealMethod); + Writeln ('Property RealMethod : ',RealMethod); Writeln ('Property ExtendedMethod : ',ExtendedMethod); Writeln ('Property AnsiStringMethod : ',AnsiStringMethod); Writeln ('Property MyEnumMethod : ',ord(MyEnumMethod)); @@ -496,7 +496,7 @@ begin Writeln ('Property IntegerVirtualMethod : ',IntegerVirtualMethod); Writeln ('Property LongintVirtualMethod : ',LongintVirtualMethod); Writeln ('Property CardinalVirtualMethod : ',CardinalVirtualMethod); - Writeln ('Property RealVirtualMethod : ',RealVirtualMethod); + Writeln ('Property RealVirtualMethod : ',RealVirtualMethod); Writeln ('Property ExtendedVirtualMethod : ',ExtendedVirtualMethod); Writeln ('Property AnsiStringVirtualMethod : ',AnsiStringVirtualMethod); Writeln ('Property MyEnumVirtualMethod : ',ord(MyEnumVirtualMethod)); @@ -510,8 +510,8 @@ Var PI : PTypeInfo; I,J : Longint; PP : PPropList; - prI : PPropInfo; - + prI : PPropInfo; + begin PI:=O.ClassInfo; Writeln ('Type kind : ',TypeNames[PI^.Kind]); @@ -519,7 +519,7 @@ begin PT:=GetTypeData(PI); If PT^.ParentInfo=Nil then Writeln ('Object has no parent info') - else + else Writeln ('Object has parent info'); Writeln ('Property Count : ',PT^.PropCount); Writeln ('Unit name : ',PT^.UnitName); @@ -538,7 +538,7 @@ begin If PropType^.Kind=tkenumeration then Write ('(=',GetEnumName(Proptype,J),')') end - else + else Case pri^.proptype^.kind of tkfloat : begin Write ('Value : '); @@ -550,9 +550,9 @@ begin flush (output); Write(GetStrProp(O,Pri)); end; - else + else Write ('Untested type:',ord(pri^.proptype^.kind)); - end; + end; Writeln (')'); end; end; diff --git a/tests/testset.pp b/tests/test/testset.pp similarity index 99% rename from tests/testset.pp rename to tests/test/testset.pp index a71992a272..43a7720da5 100644 --- a/tests/testset.pp +++ b/tests/test/testset.pp @@ -1,6 +1,6 @@ { $Id$ - + Program to test set functions } diff --git a/tests/teststr.pp b/tests/test/teststr.pp similarity index 100% rename from tests/teststr.pp rename to tests/test/teststr.pp diff --git a/tests/testall.bat b/tests/testall.bat deleted file mode 100644 index c96b396eca..0000000000 --- a/tests/testall.bat +++ /dev/null @@ -1,11 +0,0 @@ -@echo off -rem This batch script should compile all tests. -rem All tests which should run and be ok. -for %%f in ( ts*.bat ) do command /c %%f -rem All tests which crash the compiler. -for %%f in ( tf*.bat ) do command /c %%f - - - - - \ No newline at end of file diff --git a/tests/tf000001.pp b/tests/tf/tf000001.pp similarity index 100% rename from tests/tf000001.pp rename to tests/tf/tf000001.pp diff --git a/tests/tf000002.pp b/tests/tf/tf000002.pp similarity index 100% rename from tests/tf000002.pp rename to tests/tf/tf000002.pp diff --git a/tests/th010018.pp b/tests/th010018.pp deleted file mode 100644 index aa00b2ac20..0000000000 --- a/tests/th010018.pp +++ /dev/null @@ -1,14 +0,0 @@ -unit th010018; - -interface -type - rec=object - i : longint; - nrs : (one,two,three); - end; -var - brec : rec; - -implementation - -end. \ No newline at end of file diff --git a/tests/to000000.pp b/tests/to/to000000.pp similarity index 100% rename from tests/to000000.pp rename to tests/to/to000000.pp diff --git a/tests/ts010000.pp b/tests/ts/ts010000.pp similarity index 100% rename from tests/ts010000.pp rename to tests/ts/ts010000.pp diff --git a/tests/ts010001.pp b/tests/ts/ts010001.pp similarity index 100% rename from tests/ts010001.pp rename to tests/ts/ts010001.pp diff --git a/tests/ts010002.pp b/tests/ts/ts010002.pp similarity index 100% rename from tests/ts010002.pp rename to tests/ts/ts010002.pp diff --git a/tests/ts010003.pp b/tests/ts/ts010003.pp similarity index 99% rename from tests/ts010003.pp rename to tests/ts/ts010003.pp index 71cc383e20..48c05b5e4c 100644 --- a/tests/ts010003.pp +++ b/tests/ts/ts010003.pp @@ -46,7 +46,7 @@ begin textcolor(white); writeln('white'); - + textcolor(white+blink); writeln('white blinking'); diff --git a/tests/ts010004.pp b/tests/ts/ts010004.pp similarity index 100% rename from tests/ts010004.pp rename to tests/ts/ts010004.pp diff --git a/tests/ts010005.pp b/tests/ts/ts010005.pp similarity index 100% rename from tests/ts010005.pp rename to tests/ts/ts010005.pp diff --git a/tests/ts010006.pp b/tests/ts/ts010006.pp similarity index 100% rename from tests/ts010006.pp rename to tests/ts/ts010006.pp diff --git a/tests/ts010007.pp b/tests/ts/ts010007.pp similarity index 94% rename from tests/ts010007.pp rename to tests/ts/ts010007.pp index 61d703a12c..9151c6833e 100644 --- a/tests/ts010007.pp +++ b/tests/ts/ts010007.pp @@ -17,7 +17,7 @@ type procedure tobject2.y; begin - Writeln('Procedure y called'); + Writeln('Procedure y called'); end; class procedure tobject2.v; diff --git a/tests/ts010008.pp b/tests/ts/ts010008.pp similarity index 100% rename from tests/ts010008.pp rename to tests/ts/ts010008.pp diff --git a/tests/ts010009.pp b/tests/ts/ts010009.pp similarity index 100% rename from tests/ts010009.pp rename to tests/ts/ts010009.pp diff --git a/tests/ts010010.pp b/tests/ts/ts010010.pp similarity index 100% rename from tests/ts010010.pp rename to tests/ts/ts010010.pp diff --git a/tests/ts010014.pp b/tests/ts/ts010014.pp similarity index 98% rename from tests/ts010014.pp rename to tests/ts/ts010014.pp index 46e30f2a5e..e3dd5788bd 100644 --- a/tests/ts010014.pp +++ b/tests/ts/ts010014.pp @@ -39,7 +39,7 @@ var errorcode:=0; writeln('Object valid VMT check works'); runerror(0); - end + end else halt(1); end; diff --git a/tests/ts010015.pp b/tests/ts/ts010015.pp similarity index 89% rename from tests/ts010015.pp rename to tests/ts/ts010015.pp index d009ba3980..e0e010c267 100644 --- a/tests/ts010015.pp +++ b/tests/ts/ts010015.pp @@ -1,22 +1,22 @@ program ttyped; -Type +Type TRec = record X,Y : longint; end; - + TRecFile = File of TRec; - + var TF : TRecFile; LF : File of longint; i,j,k,l : longint; t : Trec; - + begin Write ('Writing files...'); assign (LF,'longint.dat'); rewrite (LF); - for i:=1 to 10 do + for i:=1 to 10 do write (LF,i); close (LF); Assign (TF,'TRec.dat'); @@ -51,8 +51,8 @@ begin begin k:=random(10); seek (lf,k); - read (lf,j); - if j<>k+1 then + read (lf,j); + if j<>k+1 then Writeln ('Failed random read of longint at pos ',k,' : ',j); end; For i:=1 to 10 do @@ -61,8 +61,8 @@ begin k:=random(10); l:=random(10); seek (tf,k*10+l); - read (tf,t); - if (t.x<>k+1) or (t.y<>l+1) then + read (tf,t); + if (t.x<>k+1) or (t.y<>l+1) then Writeln ('Failed random read of longint at pos ',k,',',l,' : ',t.x,',',t.y); end; Writeln ('Done.'); @@ -70,5 +70,5 @@ begin close (TF); erase (lf); erase (tf); - + end. \ No newline at end of file diff --git a/tests/ts010016.pp b/tests/ts/ts010016.pp similarity index 94% rename from tests/ts010016.pp rename to tests/ts/ts010016.pp index 1ad0d8866f..7aec067fc1 100644 --- a/tests/ts010016.pp +++ b/tests/ts/ts010016.pp @@ -1,4 +1,4 @@ -{ problem of conversion between +{ problem of conversion between smallsets and long sets } type diff --git a/tests/ts010017.pp b/tests/ts/ts010017.pp similarity index 98% rename from tests/ts010017.pp rename to tests/ts/ts010017.pp index f43d6b38f1..8c99967d9e 100644 --- a/tests/ts010017.pp +++ b/tests/ts/ts010017.pp @@ -7,7 +7,7 @@ program getret; uses dos; - var + var ppfile : file; begin diff --git a/tests/ts010018.pp b/tests/ts/ts010018.pp similarity index 100% rename from tests/ts010018.pp rename to tests/ts/ts010018.pp diff --git a/tests/ts010019.pp b/tests/ts/ts010019.pp similarity index 91% rename from tests/ts010019.pp rename to tests/ts/ts010019.pp index 60f21c0805..7f33a31637 100644 --- a/tests/ts010019.pp +++ b/tests/ts/ts010019.pp @@ -1,5 +1,5 @@ -{ this program shows a possible problem +{ this program shows a possible problem of name mangling in FPC (PM) } procedure test; @@ -25,7 +25,7 @@ end; type a = word; - + function test_(b : a) : longint; begin test_:=b; diff --git a/tests/ts010020.pp b/tests/ts/ts010020.pp similarity index 100% rename from tests/ts010020.pp rename to tests/ts/ts010020.pp diff --git a/tests/ts010021.pp b/tests/ts/ts010021.pp similarity index 86% rename from tests/ts010021.pp rename to tests/ts/ts010021.pp index ff07b01542..2f053c346f 100644 --- a/tests/ts010021.pp +++ b/tests/ts/ts010021.pp @@ -8,9 +8,9 @@ var i : longint; type very_very_very_long_integer = longint; - function ugly(a,b,c,d,e,f,g,h,i,j,k,l,m,n,o,p : + function ugly(a,b,c,d,e,f,g,h,i,j,k,l,m,n,o,p : very_very_very_long_integer) : longint; - + begin ugly:=0; end; diff --git a/tests/ts010022.pp b/tests/ts/ts010022.pp similarity index 99% rename from tests/ts010022.pp rename to tests/ts/ts010022.pp index 158138ce12..c3264d4671 100644 --- a/tests/ts010022.pp +++ b/tests/ts/ts010022.pp @@ -25,7 +25,7 @@ const single_pchar : pchar = 'Alone test'; const filename = 'ts010022.hlp'; - + var en : pchar; f : text; st : string; diff --git a/tests/ts010023.pp b/tests/ts/ts010023.pp similarity index 100% rename from tests/ts010023.pp rename to tests/ts/ts010023.pp diff --git a/tests/ts010024.pp b/tests/ts/ts010024.pp similarity index 100% rename from tests/ts010024.pp rename to tests/ts/ts010024.pp diff --git a/tests/ts010025.pp b/tests/ts/ts010025.pp similarity index 100% rename from tests/ts010025.pp rename to tests/ts/ts010025.pp diff --git a/tests/ts010026.pp b/tests/ts/ts010026.pp similarity index 95% rename from tests/ts010026.pp rename to tests/ts/ts010026.pp index 5d7f2823bb..04136f33d8 100644 --- a/tests/ts010026.pp +++ b/tests/ts/ts010026.pp @@ -20,7 +20,7 @@ procedure p2; begin for i:=0 to high(a) do a[i]:=0; - end; + end; procedure p3; @@ -31,7 +31,7 @@ procedure p3; begin for i:=0 to high(a) do a[i]:=0; - end; + end; var @@ -42,4 +42,4 @@ begin p2; p3; end. - + diff --git a/tests/ts010100.pp b/tests/ts/ts010100.pp similarity index 100% rename from tests/ts010100.pp rename to tests/ts/ts010100.pp diff --git a/tests/ts010101.pp b/tests/ts/ts010101.pp similarity index 100% rename from tests/ts010101.pp rename to tests/ts/ts010101.pp