paweld/fpc
1
0
Fork 0
mirror of https://gitlab.com/freepascal.org/fpc/source.git synced 2025-08-16 04:09:15 +02:00
Code Issues Packages Projects Releases Wiki Activity

* moved to oldtests module

Browse Source
This commit is contained in:
peter 2000-11-29 23:09:09 +00:00
parent f2ba7392fc
commit d8d3c08e63
661 changed files with 7 additions and 25654 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

16
compiler/Makefile
View File

@ -1,5 +1,5 @@
#
# Makefile generated by fpcmake v1.00 [2000/10/12]
# Makefile generated by fpcmake v1.00 [2000/10/27]
#
defaultrule: all
@ -354,7 +354,7 @@ endif
# To install files
ifndef INSTALL
ifdef inUnix
INSTALL:=install -m 644
INSTALL:=install -c -m 644
else
INSTALL:=$(COPY)
endif
@ -363,7 +363,7 @@ endif
# To install programs
ifndef INSTALLEXE
ifdef inUnix
INSTALLEXE:=install -m 755
INSTALLEXE:=install -c -m 755
else
INSTALLEXE:=$(COPY)
endif
@ -1212,7 +1212,7 @@ else
$(MAKE) $(ZIPTARGET) PREFIXINSTALLDIR=$(PACKDIR)
ifdef USETAR
$(DEL) $(DESTZIPDIR)/$(ZIPNAME)$(TAREXT)
cd $(PACKDIR) ; $(TARPROG) c$(TAROPT) --file $(DESTZIPDIR)/$(ZIPNAME)$(TAREXT) * ; cd $(BASEDIR)
cd $(PACKDIR) ; $(TARPROG) cf$(TAROPT) $(DESTZIPDIR)/$(ZIPNAME)$(TAREXT) * ; cd $(BASEDIR)
else
$(DEL) $(DESTZIPDIR)/$(ZIPNAME)$(ZIPEXT)
cd $(PACKDIR) ; $(ZIPPROG) -Dr $(ZIPOPT) $(DESTZIPDIR)/$(ZIPNAME)$(ZIPEXT) * ; cd $(BASEDIR)
@ -1583,15 +1583,12 @@ override PPEXEFILE:=$(wildcard $(EXENAME))
# This will only install the ppc386.exe, not the message files etc.
quickinstall:
$(MKDIR) $(BININSTALLDIR)
ifdef UPXPROG
-$(UPXPROG) $(EXENAME)
endif
# Install fpc.exe
ifneq ($(FPCEXEFILE),)
ifdef UPXPROG
-$(UPXPROG) $(FPCEXEFILE)
endif
$(MKDIR) $(BININSTALLDIR)
$(INSTALLEXE) $(FPCEXEFILE) $(BININSTALLDIR)
endif
# Install ppc386.exe
@ -1603,6 +1600,7 @@ ifdef UNIXINSTALLDIR
$(MKDIR) $(BASEINSTALLDIR)
$(INSTALLEXE) $(EXENAME) $(BASEINSTALLDIR)
else
$(MKDIR) $(BININSTALLDIR)
$(INSTALLEXE) $(EXENAME) $(BININSTALLDIR)
endif
endif
@ -1647,4 +1645,4 @@ localmake:=$(strip $(wildcard makefile.loc))
ifdef localmake
include ./$(localmake)
endif
endif

1
compiler/Makefile.fpc
View File

@ -334,7 +334,6 @@ override PPEXEFILE:=$(wildcard $(EXENAME))
# This will only install the ppc386.exe, not the message files etc.
quickinstall:
$(MKDIR) $(BININSTALLDIR)
# Install fpc.exe
ifneq ($(FPCEXEFILE),)
ifdef UPXPROG

742
tests/Makefile
View File

@ -1,742 +0,0 @@
#
# Makefile generated by fpcmake v1.00 [2000/10/27]
#
defaultrule: info
#####################################################################
# Autodetect OS (Linux or Dos or Windows NT)
# define inUnix when running under Unix (Linux,FreeBSD)
# 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
inUnix=1
endif
else
PWD:=$(firstword $(PWD))
endif
# Detect NT - NT sets OS to Windows_NT
# Detect OS/2 - OS/2 has OS2_SHELL defined
ifndef inUnix
ifeq ($(OS),Windows_NT)
inWinNT=1
else
ifdef OS2_SHELL
inOS2=1
endif
endif
endif
# The extension of executables
ifdef inUnix
SRCEXEEXT=
else
SRCEXEEXT=.exe
endif
# The path which is searched separated by spaces
ifdef inUnix
SEARCHPATH=$(subst :, ,$(PATH))
else
SEARCHPATH=$(subst ;, ,$(PATH))
endif
# Base dir
ifdef PWD
BASEDIR:=$(shell $(PWD))
else
BASEDIR=.
endif
#####################################################################
# FPC version/target Detection
#####################################################################
# What compiler to use ?
ifndef FPC
# Compatibility with old makefiles
ifdef PP
FPC=$(PP)
else
FPC=ppc386
endif
endif
override FPC:=$(subst $(SRCEXEEXT),,$(FPC))
override FPC:=$(subst \,/,$(FPC))$(SRCEXEEXT)
# Target OS
ifndef OS_TARGET
OS_TARGET:=$(shell $(FPC) -iTO)
endif
# Source OS
ifndef OS_SOURCE
OS_SOURCE:=$(shell $(FPC) -iSO)
endif
# Target CPU
ifndef CPU_TARGET
CPU_TARGET:=$(shell $(FPC) -iTP)
endif
# Source CPU
ifndef CPU_SOURCE
CPU_SOURCE:=$(shell $(FPC) -iSP)
endif
# FPC version
ifndef FPC_VERSION
FPC_VERSION:=$(shell $(FPC) -iV)
endif
export FPC OS_TARGET OS_SOURCE CPU_TARGET CPU_SOURCE FPC_VERSION
#####################################################################
# FPCDIR Setting
#####################################################################
# Test FPCDIR to look if the RTL dir exists
ifdef FPCDIR
override FPCDIR:=$(subst \,/,$(FPCDIR))
ifeq ($(wildcard $(FPCDIR)/rtl),)
ifeq ($(wildcard $(FPCDIR)/units),)
override FPCDIR=wrong
endif
endif
else
override FPCDIR=wrong
endif
# Detect FPCDIR
ifeq ($(FPCDIR),wrong)
ifdef inUnix
override FPCDIR=/usr/local/lib/fpc/$(FPC_VERSION)
ifeq ($(wildcard $(FPCDIR)/units),)
override FPCDIR=/usr/lib/fpc/$(FPC_VERSION)
endif
else
override FPCDIR:=$(subst /$(FPC),,$(firstword $(strip $(wildcard $(addsuffix /$(FPC),$(SEARCHPATH))))))
override FPCDIR:=$(FPCDIR)/..
ifeq ($(wildcard $(FPCDIR)/rtl),)
ifeq ($(wildcard $(FPCDIR)/units),)
override FPCDIR:=$(FPCDIR)/..
ifeq ($(wildcard $(FPCDIR)/rtl),)
ifeq ($(wildcard $(FPCDIR)/units),)
override FPCDIR=c:/pp
endif
endif
endif
endif
endif
endif
#####################################################################
# User Settings
#####################################################################
# Targets
# Clean
# Install
ZIPTARGET=install
# Defaults
# Directories
# Packages
# Libraries
#####################################################################
# Default extensions
#####################################################################
# Default needed extensions (Go32v2,Linux)
LOADEREXT=.as
EXEEXT=.exe
PPLEXT=.ppl
PPUEXT=.ppu
OEXT=.o
ASMEXT=.s
SMARTEXT=.sl
STATICLIBEXT=.a
SHAREDLIBEXT=.so
RSTEXT=.rst
FPCMADE=fpcmade
# Go32v1
ifeq ($(OS_TARGET),go32v1)
PPUEXT=.pp1
OEXT=.o1
ASMEXT=.s1
SMARTEXT=.sl1
STATICLIBEXT=.a1
SHAREDLIBEXT=.so1
FPCMADE=fpcmade.v1
endif
# Go32v2
ifeq ($(OS_TARGET),go32v2)
FPCMADE=fpcmade.dos
endif
# Linux
ifeq ($(OS_TARGET),linux)
EXEEXT=
HASSHAREDLIB=1
FPCMADE=fpcmade.lnx
endif
# Linux
ifeq ($(OS_TARGET),freebsd)
EXEEXT=
HASSHAREDLIB=1
FPCMADE=fpcmade.freebsd
endif
# Win32
ifeq ($(OS_TARGET),win32)
PPUEXT=.ppw
OEXT=.ow
ASMEXT=.sw
SMARTEXT=.slw
STATICLIBEXT=.aw
SHAREDLIBEXT=.dll
FPCMADE=fpcmade.w32
endif
# OS/2
ifeq ($(OS_TARGET),os2)
PPUEXT=.ppo
ASMEXT=.so2
OEXT=.oo2
SMARTEXT=.so
STATICLIBEXT=.ao2
SHAREDLIBEXT=.dll
FPCMADE=fpcmade.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
#####################################################################
# Default Directories
#####################################################################
# Linux and freebsd use unix dirs with /usr/bin, /usr/lib
# When zipping use the target as default, when normal install then
# use the source os as default
ifdef ZIPNAME
# Zipinstall
ifeq ($(OS_TARGET),linux)
UNIXINSTALLDIR=1
endif
ifeq ($(OS_TARGET),freebsd)
UNIXINSTALLDIR=1
endif
else
# Normal install
ifeq ($(OS_SOURCE),linux)
UNIXINSTALLDIR=1
endif
ifeq ($(OS_SOURCE),freebsd)
UNIXINSTALLDIR=1
endif
endif
# set the prefix directory where to install everything
ifndef PREFIXINSTALLDIR
ifdef UNIXINSTALLDIR
PREFIXINSTALLDIR=/usr
else
PREFIXINSTALLDIR=/pp
endif
endif
export PREFIXINSTALLDIR
# Where to place the resulting zip files
ifndef DESTZIPDIR
DESTZIPDIR:=$(BASEDIR)
endif
export DESTZIPDIR
#####################################################################
# Redirection
#####################################################################
ifndef REDIRFILE
REDIRFILE=log
endif
ifdef REDIR
ifndef inUnix
override FPC=redir -eo $(FPC)
endif
# set the verbosity to max
override FPCOPT+=-va
override REDIR:= >> $(REDIRFILE)
endif
#####################################################################
# Standard rules
#####################################################################
#####################################################################
# Local Makefile
#####################################################################
ifneq ($(wildcard fpcmake.loc),)
include fpcmake.loc
endif
#####################################################################
# Users rules
#####################################################################
.PHONY: all units tests cont_tests
# Unix like OS ?
ifeq ($(OS_TARGET),linux)
INUNIX=1
endif
ifeq ($(OS_TARGET),freebsd)
INUNIX=1
endif
# For linux by default no graph tests
ifdef INUNIX
NOGRAPH=1
endif
DIRS=tf ts tbs tbf test tesi to webtbs webtbf
# defining
# NOGRAPH excludes tests using the graph unit, defining
# GRAPH includes those tests.
ifdef NOGRAPH
include graph.lst
endif
ifdef GRAPH
graphlst=
endif
all : info
units :
$(MAKE) -C units
tests : clean all_compilations
cont_tests : all_compilations
setdate :
$(FPC) setdate.pp
setdate$(EXEEXT)
call setdate.bat
.PHONY : setdate
getret$(EXEEXT) : getret.pp
$(FPC) getret
getreturncode : getret$(EXEEXT)
ifndef INUNIX
redir -ea $(FILE).log -oa $(FILE).log getret $(COMMAND)
cp retcode $(FILE).$(RESEXT)
else
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)
ifdef LONGLOG
@echo ">>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>" >> $(LONGLOG)
@echo "Test for $(FILE) fails (does not compile) error $(RETVAL)" >> $(LONGLOG)
@echo "" >> $(LONGLOG)
cat $(FILE).log >> $(LONGLOG)
@echo "" >> $(LONGLOG)
endif
@echo $(FILE) does not compile >> ts_fail
@echo $(FILE) does not compile error $(RETVAL) >> 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
ifdef REEFILE
ifeq ($(wildcard $(REEFILE)*),$(REEFILE))
export EXPECTEDRETVAL:=$(strip $(shell cat $(REEFILE)))
else
export EXPECTEDRETVAL=0
endif
endif
ifdef FILE
ifneq ($(CFGFILE),$(FILE).cfg)
ifneq ($(wildcard $(FILE).cfg),)
export CFGFILE:=$(FILE).cfg
export COMPILEROPT:=$(filter-out COMPILEROPT=,$(shell grep COMPILEROPT= $(CFGFILE)))
export RUNARGS:=$(filter-out RUNARGS=,$(shell grep RUNARGS= $(CFGFILE)))
export POSTPROCESS:=$(filter-out POSTPROCESS=,$(shell grep POSTPROCESS= $(CFGFILE)))
else
CFGFILE=
COMPILEROPT=
RUNARGS=
POSTPROCESS=
endif
endif
endif
ifeq ($(EXERETVAL),$(EXPECTEDRETVAL))
ifeq ($(EXPECTEDRETVAL),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) success (gives correct error $(EXERETVAL))"
@echo "Test for $(FILE) success (gives correct error $(EXERETVAL))" >> $(LOG)
endif
else
ifeq ($(EXPECTEDRETVAL),0)
testexecsuccess:
@echo "Test for exec $(FILE) fails exec error $(EXERETVAL)"
@echo "Test for exec $(FILE) fails exec error $(EXERETVAL)" >> $(LOG)
@echo "Running $(FILE) fails with error $(EXERETVAL)" >> faillist
ifdef LONGLOG
@echo ">>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>" >> $(LONGLOG)
@echo "Test for exec $(FILE) fails exec error $(EXERETVAL)" >> $(LONGLOG)
@echo "" >> $(LONGLOG)
cat $(FILE).elg >> $(LONGLOG)
@echo $(FILE) >> ex_fail
endif
else
testexecsuccess:
@echo "Test for exec $(FILE) fails exec error $(EXERETVAL) ($(EXPECTEDRETVAL) expected)"
@echo "Test for exec $(FILE) fails exec error $(EXERETVAL) ($(EXPECTEDRETVAL) expected)" >> $(LOG)
@echo "Running $(FILE) fails with error $(EXERETVAL) ($(EXPECTEDRETVAL) expected)" >> faillist
ifdef LONGLOG
@echo ">>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>" >> $(LONGLOG)
@echo "Test for exec $(FILE) fails exec error $(EXERETVAL) ($(EXPECTEDRETVAL) expected)" >> $(LONGLOG)
@echo "" >> $(LONGLOG)
cat $(FILE).elg >> $(LONGLOG)
@echo $(FILE) >> ex_fail
endif
endif
endif
ifeq ($(wildcard $(FILE)$(EXEEXT)),$(FILE)$(EXEEXT))
testexec:
@echo "Testing $(FILE)$(EXEEXT)"
ifdef NOREDIR
getret $(FILE)$(EXEEXT)
@echo CFGFILE is $(CFGFILE)
ifdef POSTPROCESS
echo Running post process
-$(POSTPROCESS)
endif
else
ifndef INUNIX
redir -e $(FILE).elg -o $(FILE).elg getret $(FILE)$(EXEEXT) $(RUNARGS)
@echo CFGFILE is $(CFGFILE)
ifdef POSTPROCESS
@echo Running post process
-redir -ea $(FILE).elg -oa $(FILE).elg $(POSTPROCESS)
endif
else
getret $(FILE)$(EXEEXT) $(RUNARGS) > $(FILE).elg 2>$(FILE).elg
@echo CFGFILE is $(CFGFILE)
ifdef POSTPROCESS
echo Running post process
-$(POSTPROCESS) >> $(FILE).elg 2>> $(FILE).elg
endif
endif
endif
cp -f retcode $(FILE).exc
$(MAKE) testexecsuccess 'FILE=$(FILE)' 'EXCFILE=$(FILE).exc' 'REEFILE=$(FILE).ree'
else
testexec:
ifeq ($(wildcard $(FILE)$(PPUEXT)),$(FILE)$(PPUEXT))
@echo "file is a unit $(FILE)$(PPUEXT)"
@echo "unit" > $(FILE).elg
else
ifeq ($(wildcard $(FILE).dll),$(FILE).dll)
@echo "file is a DLL $(FILE)$(PPUEXT)"
@echo "DLL" > $(FILE).elg
else
@echo "No exefile $(FILE)$(EXEEXT)"
ifdef LONGLOG
@echo "No exefile $(FILE)$(EXEEXT) was generated" >> $(LONGLOG)
endif
endif
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)
ifdef LONGLOG
@echo "Test for $(FILE) fails (does compile and should not)" >> $(LONGLOG)
endif
@echo $(FILE) >> tf_fail
@echo $(FILE) compiles >> faillist
endif
ifndef LONGLOG
export LONGLOG:=longlog
endif
ifndef LOG
export LOG:=log
endif
listcfg :
@echo CFGFILE is "$(CFGFILE)"
@echo COMPILEROPT is "$(COMPILEROPT)"
@echo RUNARGS is "$(RUNARGS)"
@echo EXPECTEDRETVAL is "$(EXPECTEDRETVAL)"
@echo POSTPROCESS is "$(POSTPROCESS)"
ifdef FILE
OPTFILE=$(wildcard $(FILE).opt)
endif
ifdef OPTFILE
override OPT+=$(OPTFILE)
endif
ifndef FILE
FILE=ts/ts00001.pp
endif
testone :
$(MAKE) getreturncode 'COMMAND=$(FPC) $(OPT) $(COMPILEROPT) $(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,$(filter-out $(graphlst),$(wildcard ts/ts*.pp)))
alltbs : $(patsubst %.pp,%.res,$(filter-out $(graphlst),$(wildcard tbs/tbs*.pp)))
allwebtbs : $(patsubst %.pp,%.res,$(filter-out $(graphlst),$(wildcard webtbs/tbug*.pp)))
tbs0to99 : $(patsubst %.pp,%.res,$(filter-out $(graphlst),$(wildcard tbs/tbs00*.pp)))
tbs100to199 : $(patsubst %.pp,%.res,$(filter-out $(graphlst),$(wildcard tbs/tbs01*.pp)))
tbs200to299 : $(patsubst %.pp,%.res,$(filter-out $(graphlst),$(wildcard tbs/tbs02*.pp)))
tbs300to399 : $(patsubst %.pp,%.res,$(filter-out $(graphlst),$(wildcard tbs/tbs03*.pp)))
alltest : $(patsubst %.pp,%.res,$(filter-out $(graphlst),$(wildcard test/test*.pp)))
alltesi : $(patsubst %.pp,%.res,$(filter-out $(graphlst),$(wildcard tesi/tesi*.pp)))
alltis : $(patsubst %.pp,%.res,$(filter-out $(graphlst),$(wildcard tis/tis*.pp)))
alltf : $(patsubst %.pp,%.ref,$(filter-out $(graphlst),$(wildcard tf/tf*.pp)))
alltbf : $(patsubst %.pp,%.ref,$(filter-out $(graphlst),$(wildcard tbf/tbf*.pp)))
allwebtbf : $(patsubst %.pp,%.ref,$(filter-out $(graphlst),$(wildcard webtbf/tbug*.pp)))
allto : $(patsubst %.pp,%.res,$(filter-out $(graphlst),$(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
ifndef EXEC_FAIL_LIST
ifeq ($(wildcard ex_fail*),ex_fail)
EXEC_FAIL_LIST=$(shell cat ex_fail)
export EXEC_FAIL_LIST
endif
endif
clean_fail :
-rm -f $(addsuffix .res,$(TS_FAIL_LIST))
-rm -f $(addsuffix .ref,$(TF_FAIL_LIST))
-rm -f $(addsuffix .res,$(EXEC_FAIL_LIST))
-rm -f $(addsuffix .elg,$(EXEC_FAIL_LIST))
# Test all failure of last time
# don't forget to try to run them again
again :
$(MAKE) internal_again LOG=again.log LONGLOG=again.llg
internal_again : clean_fail $(addsuffix .res,$(TS_FAIL_LIST)) \
$(addsuffix .ref,$(TF_FAIL_LIST)) \
$(addsuffix .elg,$(EXEC_FAIL_LIST) $(TS_FAIL_LIST))
grep fails $(LOG)
all_compilations : allts alltbs allwebtbs alltf alltbf allwebtbf allto alltest alltesi alltis
grep fails $(LOG)
allexec : alltsexec alltbsexec allwebtbsexec alltestexec
grep fails $(LOG)
alltestexec: $(patsubst %.pp,%.elg,$(wildcard test/test*.pp))
allfails :
grep fails $(LOG) > fails.log
# these test are interactive
# no redirection !!!
alltesiexec: $(patsubst %.pp,%.eli,$(filter-out $(graphlst),$(wildcard tesi/tesi*.pp)))
alltsexec: $(patsubst %.pp,%.elg,$(filter-out $(graphlst),$(wildcard ts/ts*.pp)))
alltbsexec: $(patsubst %.pp,%.elg,$(filter-out $(graphlst),$(wildcard tbs/tbs*.pp)))
allwebtbsexec: $(patsubst %.pp,%.elg,$(filter-out $(graphlst),$(wildcard webtbs/tbug*.pp)))
tbsexec0to99 : $(patsubst %.pp,%.elg,$(filter-out $(graphlst),$(wildcard tbs/tbs00*.pp)))
tbsexec100to199 : $(patsubst %.pp,%.elg,$(filter-out $(graphlst),$(wildcard tbs/tbs01*.pp)))
tbsexec200to299 : $(patsubst %.pp,%.elg,$(filter-out $(graphlst),$(wildcard tbs/tbs02*.pp)))
tbsexec300to399 : $(patsubst %.pp,%.elg,$(filter-out $(graphlst),$(wildcard tbs/tbs03*.pp)))
alltisexec: $(patsubst %.pp,%.eli,$(filter-out $(graphlst),$(wildcard tis/tis*.pp)))
clean:
-rm -f $(addsuffix /*.ref,$(DIRS))
-rm -f $(addsuffix /*.res,$(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 INUNIX
-rm -f $(patsubst %.pp,%$(EXEEXT),$(wildcard $(addsuffix /t*.pp,$(DIRS))))
else
-rm -f $(addsuffix /*$(EXEEXT),$(DIRS))
endif
-rm -f *.tmp
-rm -f $(LOG) $(LONGLOG) faillist ts_fail tf_fail ex_fail
-rm -f fpcmaked ppas.sh ppas.bat retcode
full : clean all_compilations allexec
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

413
tests/Makefile.fpc
View File

@ -1,413 +0,0 @@
#
# Makefile.fpc for Free Pascal Tests directory
#
[defaults]
defaultrule=info
[sections]
none=1
exts=1
[rules]
.PHONY: all units tests cont_tests
# Unix like OS ?
ifeq ($(OS_TARGET),linux)
INUNIX=1
endif
ifeq ($(OS_TARGET),freebsd)
INUNIX=1
endif
# For linux by default no graph tests
ifdef INUNIX
NOGRAPH=1
endif
DIRS=tf ts tbs tbf test tesi to webtbs webtbf
# defining
# NOGRAPH excludes tests using the graph unit, defining
# GRAPH includes those tests.
ifdef NOGRAPH
include graph.lst
endif
ifdef GRAPH
graphlst=
endif
all : info
units :
$(MAKE) -C units
tests : clean all_compilations
cont_tests : all_compilations
setdate :
$(FPC) setdate.pp
setdate$(EXEEXT)
call setdate.bat
.PHONY : setdate
getret$(EXEEXT) : getret.pp
$(FPC) getret
getreturncode : getret$(EXEEXT)
ifndef INUNIX
redir -ea $(FILE).log -oa $(FILE).log getret $(COMMAND)
cp retcode $(FILE).$(RESEXT)
else
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)
ifdef LONGLOG
@echo ">>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>" >> $(LONGLOG)
@echo "Test for $(FILE) fails (does not compile) error $(RETVAL)" >> $(LONGLOG)
@echo "" >> $(LONGLOG)
cat $(FILE).log >> $(LONGLOG)
@echo "" >> $(LONGLOG)
endif
@echo $(FILE) does not compile >> ts_fail
@echo $(FILE) does not compile error $(RETVAL) >> 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
ifdef REEFILE
ifeq ($(wildcard $(REEFILE)*),$(REEFILE))
export EXPECTEDRETVAL:=$(strip $(shell cat $(REEFILE)))
else
export EXPECTEDRETVAL=0
endif
endif
ifdef FILE
ifneq ($(CFGFILE),$(FILE).cfg)
ifneq ($(wildcard $(FILE).cfg),)
export CFGFILE:=$(FILE).cfg
export COMPILEROPT:=$(filter-out COMPILEROPT=,$(shell grep COMPILEROPT= $(CFGFILE)))
export RUNARGS:=$(filter-out RUNARGS=,$(shell grep RUNARGS= $(CFGFILE)))
export POSTPROCESS:=$(filter-out POSTPROCESS=,$(shell grep POSTPROCESS= $(CFGFILE)))
else
CFGFILE=
COMPILEROPT=
RUNARGS=
POSTPROCESS=
endif
endif
endif
ifeq ($(EXERETVAL),$(EXPECTEDRETVAL))
ifeq ($(EXPECTEDRETVAL),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) success (gives correct error $(EXERETVAL))"
@echo "Test for $(FILE) success (gives correct error $(EXERETVAL))" >> $(LOG)
endif
else
ifeq ($(EXPECTEDRETVAL),0)
testexecsuccess:
@echo "Test for exec $(FILE) fails exec error $(EXERETVAL)"
@echo "Test for exec $(FILE) fails exec error $(EXERETVAL)" >> $(LOG)
@echo "Running $(FILE) fails with error $(EXERETVAL)" >> faillist
ifdef LONGLOG
@echo ">>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>" >> $(LONGLOG)
@echo "Test for exec $(FILE) fails exec error $(EXERETVAL)" >> $(LONGLOG)
@echo "" >> $(LONGLOG)
cat $(FILE).elg >> $(LONGLOG)
@echo $(FILE) >> ex_fail
endif
else
testexecsuccess:
@echo "Test for exec $(FILE) fails exec error $(EXERETVAL) ($(EXPECTEDRETVAL) expected)"
@echo "Test for exec $(FILE) fails exec error $(EXERETVAL) ($(EXPECTEDRETVAL) expected)" >> $(LOG)
@echo "Running $(FILE) fails with error $(EXERETVAL) ($(EXPECTEDRETVAL) expected)" >> faillist
ifdef LONGLOG
@echo ">>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>" >> $(LONGLOG)
@echo "Test for exec $(FILE) fails exec error $(EXERETVAL) ($(EXPECTEDRETVAL) expected)" >> $(LONGLOG)
@echo "" >> $(LONGLOG)
cat $(FILE).elg >> $(LONGLOG)
@echo $(FILE) >> ex_fail
endif
endif
endif
ifeq ($(wildcard $(FILE)$(EXEEXT)),$(FILE)$(EXEEXT))
testexec:
@echo "Testing $(FILE)$(EXEEXT)"
ifdef NOREDIR
getret $(FILE)$(EXEEXT)
@echo CFGFILE is $(CFGFILE)
ifdef POSTPROCESS
echo Running post process
-$(POSTPROCESS)
endif
else
ifndef INUNIX
redir -e $(FILE).elg -o $(FILE).elg getret $(FILE)$(EXEEXT) $(RUNARGS)
@echo CFGFILE is $(CFGFILE)
ifdef POSTPROCESS
@echo Running post process
-redir -ea $(FILE).elg -oa $(FILE).elg $(POSTPROCESS)
endif
else
getret $(FILE)$(EXEEXT) $(RUNARGS) > $(FILE).elg 2>$(FILE).elg
@echo CFGFILE is $(CFGFILE)
ifdef POSTPROCESS
echo Running post process
-$(POSTPROCESS) >> $(FILE).elg 2>> $(FILE).elg
endif
endif
endif
cp -f retcode $(FILE).exc
$(MAKE) testexecsuccess 'FILE=$(FILE)' 'EXCFILE=$(FILE).exc' 'REEFILE=$(FILE).ree'
else
testexec:
ifeq ($(wildcard $(FILE)$(PPUEXT)),$(FILE)$(PPUEXT))
@echo "file is a unit $(FILE)$(PPUEXT)"
@echo "unit" > $(FILE).elg
else
ifeq ($(wildcard $(FILE).dll),$(FILE).dll)
@echo "file is a DLL $(FILE)$(PPUEXT)"
@echo "DLL" > $(FILE).elg
else
@echo "No exefile $(FILE)$(EXEEXT)"
ifdef LONGLOG
@echo "No exefile $(FILE)$(EXEEXT) was generated" >> $(LONGLOG)
endif
endif
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)
ifdef LONGLOG
@echo "Test for $(FILE) fails (does compile and should not)" >> $(LONGLOG)
endif
@echo $(FILE) >> tf_fail
@echo $(FILE) compiles >> faillist
endif
ifndef LONGLOG
export LONGLOG:=longlog
endif
ifndef LOG
export LOG:=log
endif
listcfg :
@echo CFGFILE is "$(CFGFILE)"
@echo COMPILEROPT is "$(COMPILEROPT)"
@echo RUNARGS is "$(RUNARGS)"
@echo EXPECTEDRETVAL is "$(EXPECTEDRETVAL)"
@echo POSTPROCESS is "$(POSTPROCESS)"
ifdef FILE
OPTFILE=$(wildcard $(FILE).opt)
endif
ifdef OPTFILE
override OPT+=$(OPTFILE)
endif
ifndef FILE
FILE=ts/ts00001.pp
endif
testone :
$(MAKE) getreturncode 'COMMAND=$(FPC) $(OPT) $(COMPILEROPT) $(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,$(filter-out $(graphlst),$(wildcard ts/ts*.pp)))
alltbs : $(patsubst %.pp,%.res,$(filter-out $(graphlst),$(wildcard tbs/tbs*.pp)))
allwebtbs : $(patsubst %.pp,%.res,$(filter-out $(graphlst),$(wildcard webtbs/tbug*.pp)))
tbs0to99 : $(patsubst %.pp,%.res,$(filter-out $(graphlst),$(wildcard tbs/tbs00*.pp)))
tbs100to199 : $(patsubst %.pp,%.res,$(filter-out $(graphlst),$(wildcard tbs/tbs01*.pp)))
tbs200to299 : $(patsubst %.pp,%.res,$(filter-out $(graphlst),$(wildcard tbs/tbs02*.pp)))
tbs300to399 : $(patsubst %.pp,%.res,$(filter-out $(graphlst),$(wildcard tbs/tbs03*.pp)))
alltest : $(patsubst %.pp,%.res,$(filter-out $(graphlst),$(wildcard test/test*.pp)))
alltesi : $(patsubst %.pp,%.res,$(filter-out $(graphlst),$(wildcard tesi/tesi*.pp)))
alltis : $(patsubst %.pp,%.res,$(filter-out $(graphlst),$(wildcard tis/tis*.pp)))
alltf : $(patsubst %.pp,%.ref,$(filter-out $(graphlst),$(wildcard tf/tf*.pp)))
alltbf : $(patsubst %.pp,%.ref,$(filter-out $(graphlst),$(wildcard tbf/tbf*.pp)))
allwebtbf : $(patsubst %.pp,%.ref,$(filter-out $(graphlst),$(wildcard webtbf/tbug*.pp)))
allto : $(patsubst %.pp,%.res,$(filter-out $(graphlst),$(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
ifndef EXEC_FAIL_LIST
ifeq ($(wildcard ex_fail*),ex_fail)
EXEC_FAIL_LIST=$(shell cat ex_fail)
export EXEC_FAIL_LIST
endif
endif
clean_fail :
-rm -f $(addsuffix .res,$(TS_FAIL_LIST))
-rm -f $(addsuffix .ref,$(TF_FAIL_LIST))
-rm -f $(addsuffix .res,$(EXEC_FAIL_LIST))
-rm -f $(addsuffix .elg,$(EXEC_FAIL_LIST))
# Test all failure of last time
# don't forget to try to run them again
again :
$(MAKE) internal_again LOG=again.log LONGLOG=again.llg
internal_again : clean_fail $(addsuffix .res,$(TS_FAIL_LIST)) \
$(addsuffix .ref,$(TF_FAIL_LIST)) \
$(addsuffix .elg,$(EXEC_FAIL_LIST) $(TS_FAIL_LIST))
grep fails $(LOG)
all_compilations : allts alltbs allwebtbs alltf alltbf allwebtbf allto alltest alltesi alltis
grep fails $(LOG)
allexec : alltsexec alltbsexec allwebtbsexec alltestexec
grep fails $(LOG)
alltestexec: $(patsubst %.pp,%.elg,$(wildcard test/test*.pp))
allfails :
grep fails $(LOG) > fails.log
# these test are interactive
# no redirection !!!
alltesiexec: $(patsubst %.pp,%.eli,$(filter-out $(graphlst),$(wildcard tesi/tesi*.pp)))
alltsexec: $(patsubst %.pp,%.elg,$(filter-out $(graphlst),$(wildcard ts/ts*.pp)))
alltbsexec: $(patsubst %.pp,%.elg,$(filter-out $(graphlst),$(wildcard tbs/tbs*.pp)))
allwebtbsexec: $(patsubst %.pp,%.elg,$(filter-out $(graphlst),$(wildcard webtbs/tbug*.pp)))
tbsexec0to99 : $(patsubst %.pp,%.elg,$(filter-out $(graphlst),$(wildcard tbs/tbs00*.pp)))
tbsexec100to199 : $(patsubst %.pp,%.elg,$(filter-out $(graphlst),$(wildcard tbs/tbs01*.pp)))
tbsexec200to299 : $(patsubst %.pp,%.elg,$(filter-out $(graphlst),$(wildcard tbs/tbs02*.pp)))
tbsexec300to399 : $(patsubst %.pp,%.elg,$(filter-out $(graphlst),$(wildcard tbs/tbs03*.pp)))
alltisexec: $(patsubst %.pp,%.eli,$(filter-out $(graphlst),$(wildcard tis/tis*.pp)))
clean:
-rm -f $(addsuffix /*.ref,$(DIRS))
-rm -f $(addsuffix /*.res,$(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 INUNIX
-rm -f $(patsubst %.pp,%$(EXEEXT),$(wildcard $(addsuffix /t*.pp,$(DIRS))))
else
-rm -f $(addsuffix /*$(EXEEXT),$(DIRS))
endif
-rm -f *.tmp
-rm -f $(LOG) $(LONGLOG) faillist ts_fail tf_fail ex_fail
-rm -f fpcmaked ppas.sh ppas.bat retcode
full : clean all_compilations allexec
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

58
tests/README
View File

@ -1,58 +0,0 @@
This directory contains a testsuite for the Free Pascal Compiler.
Tests starting with 'ts' have to compile and execute.
Tests starting with 'tf' will throw an error when compiling.
You can use the batch files to do all tests. testall.bat will compile all
tests.
template1.bat is a template for compiling tests that have to run and
execute.
template2.bat is a template for compiling tests that should crash the
compiler. The test is considered passed if the compiler reports
an error (crashes aren't allowed).
Test files
----------
ts010000.pp tests properties
ts010001.pp tests class references (class of)
ts010002.pp common Delphi object model test
ts010003.pp tests the crt unit colors
ts010004.pp tests forward classes
ts010005.pp tests method overriding
ts010006.pp tests libraries
ts010015.pp tests typed files.
ts010016.pp tests conversion of smallsets in normsets in consts
ts010017.pp tests the problem of iocheck inside iocheck routines
ts010018.pp tests the problem of enums inside objects
ts010019.pp tests problems of name mangling
ts010020.pp tests for const strings problems if const is a single char.
ts010021.pp test for long mangled names (they are strings, ie no longer then
255 chars (but they have to be allways shorten the same way !!)
ts010022.pp tests a problem of writing pchar in files
ts010023.pp tests set of char parameter passing
ts010024.pp tests att asm reference parsing
ts010025.pp tests intel asm reference parsing
-
ts10100.pp tests for delphi object model
ts101xx.pp
tf000001.pp stupid example that creates a GPF sometimes
tf000002.pp tests that use of a type as a member of an expression is not possible
to000000.pp shows when uncertain optimizations can cause wrong code
testcrt.pp test crt unit functions
testdos.pp test dos unit functions
testset.pp test set functions
testheap.pp test heap functions
teststr.pp test string functions and speed
testaoc.pp test Array of construct.
testansi.pp test ansistrings
testrtti.pp test RTTI generation and typinfo unit.
testexc.pp test exceptions.
testi642.pp test int64/qword
testpvar.pp test procedure variables
testgoto.pp test goto (very simple)

404
tests/bugs.txt
View File

@ -1,404 +0,0 @@
This directory contains test files for various FPC bugs.
The most files are very simple and it's neccessary to check the assembler
output.
The first coloumn contains the file name. If the file name is indended,
the bug is fixed and the last coloumn contains the version where
the bug is fixed.
In future, please add also your name short cut, when fixing a bug.
Fixed bugs:
-----------
1.pp produces a linker error under win32/linux, sorry for the filename
but the filename is the bug :) OK 0.99.11 (PFV)
bug0001.pp tests a bug in the .ascii output (#0 and too long) OK 0.9.2
bug0002.pp tests for the endless bug in the optimizer OK 0.9.2
bug0003.pp dito OK 0.9.2
bug0004.pp tests the continue instruction in the for loop OK 0.9.2
bug0005.pp tests the if 1=1 then ... bug OK 0.9.2
bug0006.pp tests the wrong floating point code generation OK 0.9.2
bug0007.pp tests the infinity loop when using byte counter OK 0.9.2
bug0008.pp tests the crash when decrementing constants OK 0.9.2
bug0009.pp tests comperations in function calls a(c<0); OK 0.9.2
bug0010.pp tests string constants exceeding lines OK 0.9.2
bug0011.pp tests div/mod bug, where edx is scrambled, if
a called procedure does a div/mod OK 0.9.2
bug0012.pp tests type conversation byte(a>b) OK 0.9.9 (FK)
bug0015.pp tests for wrong allocated register for return result
of floating function (allocates int register) OK 0.9.2
bug0018.pp tests for the possibility to declare all types
using pointers "forward" : type p = ^x; x=byte; OK 0.9.3
bug0021.pp tests compatibility of empty sets with other set
and the evalution of constant sets OK 0.9.3
bug0022.pp tests getting the address of a method OK 0.9.3
bug0023.pp tests handling of self pointer in nested methods OK 0.9.3
bug0025.pp tests for a wrong uninit. var. warning OK 0.9.3
bug0026.pp tests for a wrong unused. var. warning OK 0.9.4
bug0027.pp tests
type
enumtype = (One, two, three, forty:=40, fifty); OK 0.9.5
bug0028.pp type enumtype = (a); writeln(ord(a));
bug0029.pp tests typeof(object type) OK 0.99.1 (FK)
bug0030.pp tests type conversations in typed consts OK 0.9.6
bug0031.pp tests array[boolean] of .... OK 0.9.8
bug0032.pp tests for a bug with the stack OK 0.9.9
bug0033.pp tests var p : pchar; begin p:='c'; end. OK 0.9.9
bug0034.pp shows wrong line numbering when asmbler is parsed OK 0.9.9
in direct mode.
bug0035.pp label at end of block gives error OK 0.9.9 (FK)
bug0036.pp assigning a single character to array of char ?OK 0.9.9
gives a protection error
--------- cgi386.pas gives out gpf's when compiling the system OK 0.9.9 (FK)
unit.
bug0037.pp tests missing graph.setgraphmode OK RTL (FK)
bug0038.pp tests const ps : ^string = nil; OK 0.9.9 (FK)
bug0039.pp shows the else-else problem OK 0.9.9 (FK)
bug0040.pp shows the if b1 xor b2 problem where b1,b2 :boolean OK 0.9.9 (FK)
bug0041.pp shows the if then end. problem OK 0.9.9 (FK)
bug0042.pp shows assembler double operator expression problem OK 0.99.7 (PFV)
bug0043.pp shows assembler nasm output fpu opcodes problem OK 0.99.6 (PFV)
bug0044.pp shows $ifdef and comment nesting/directive problem OK 0.99.1 (PFV)
bug0045.pp shows problem with virtual private methods OK 0.9.9 (FK)
(might not be a true bug but more of an incompatiblity?)
the compiler warns now if there is a private and virtual
method
bug0046.pp problems with sets with values over 128 due to OK 0.99.1 (FK)
sign extension
(already fixed ) but also for SET_IN_BYTE
bug0047.pp compiling with -So crashes the compiler OK 0.99.1 (CEC)
bug0048.pp shows a problem with putimage on some computers OK 0.99.13 (JM)
bug0049.pp shows an error while defining subrange types OK 0.99.7 (PFV)
bug0050.pp can't set a function result in a nested procedure of a function OK 0.99.7 (PM)
bug0051.pp Graph, shows a problem with putpixel OK 0.99.9 (PM)
bug0052.pp Graph, collects missing graph unit routines OK 0.99.9 (PM)
bug0053.pp shows a problem with open arrays OK 0.99.1 (FK)
(crashes a win95-DOS box :) )
bug0054.pp wordbool and longbool types are missed OK 0.99.6 (PFV)
bug0055.pp internal error 10 (means too few registers OK 0.99.1 (FK)
- i386 ONLY)
bug0056.pp shows a _very_ simple expression which generates OK 0.99.1 (FK)
wrong assembler
bug0057.pp Graph, shows a crash with switch graph/text/graph OK 0.99.9 (PM)
bug0058.pp causes an internal error 10 (problem with getregisterOK 0.99.1 (FK)
in secondsmaller - i386 ONLY)
bug0059.pp shows the problem with syntax error with ordinal OK 0.99.1 (FK)
constants
bug0060.pp shows missing type checking for case statements OK 0.99.1 (CEC)
bug0061.pp shows wrong errors when compiling (NOT A BUG) OK 0.99.1
bug0062.pp shows illegal type conversion for boolean OK 0.99.6 (PFV)
bug0063.pp shows problem with ranges in sets for variables OK 0.99.7 (PFV)
bug0064.pp shows other types of problems with case statements OK 0.99.1 (FK)
bug0065.pp shows that frac() doesn't work correctly. OK 0.99.1 (PFV)
bug0066.pp shows that Round doesn't work correctly. (NOT A BUG) OK 0.99.1
bug0067.pp and bug0067b.pp (Work together) OK 0.99.1
Shows incorrect symbol resolution when using uses in implementation
More info can be found in file bug0067b.pp.
bug0068.pp Shows incorrect type of ofs() OK 0.99.1 (PFV and FK)
bug0069.pp Shows problem with far qualifier in units OK 0.99.1 (CEC)
bug0070.pp shows missing include and exclude from rtl OK 0.99.6 (MVC)
bug0071.pp shows that an unterminated constant string in a OK 0.99.1 (PFV)
writeln() statement crashes the compiler.
bug0072.pp causes an internal error 10 ( i386 ONLY ) OK 0.99.1 (FK)
bug0073.pp shows incompatiblity with bp for distance qualifiers OK 0.99.6 (PFV)
bug0074.pp shows MAJOR bug when trying to compile valid code OK 0.99.1 (PM/CEC)
bug0075.pp shows invalid pchar output to console OK 0.99.1
---------- compiling pp -Us -di386 -Sg system.pp gives GPF OK 0.99.1
bug0076.pp Bug in intel asm generator. was already fixed OK 0.99.1 (FK)
bug0077.pp shows a bug with absolute in interface part of unit OK 0.99.1 (FK)
bug0077b.pp used by unit bug0077.pp
bug0078.pp Shows problems with longint constant in intel asm OK 0.99.1 (CEC)
parsers
bug0079.pp Shows problems with stackframe with assembler keyword OK 0.99.1 (CEC)
bug0080.pp Shows Missing High() (internal) function. OK 0.99.6 (MVC)
bug0081.pp Shows incompatibility with borland's 'array of char'. OK 0.99.1 (FK)
bug0082.pp Shows incompatibility with BP : Multiple destructors. OK 0.99.1 (FK)
bug0083.pp shows missing "dynamic" set constructor OK 0.99.7 (PFV)
bug0084.pp no more pascal type checking OK 0.99.1 (FK)
bug0085.pp shows runerror 216 OK 0.99.1 (CEC)
bug0086.pp shows runerror 216 OK 0.99.1 (CEC)
bug0087.pp shows internal error 12 - no more SegFaults OK 0.99.1 (FK)
bug0088.pp internal error 12 or Runerror 216 OK 0.99.1 (FK)
bug0089.pp internal error 12 or Runerror 216 OK 0.99.1 (FK)
bug0090.pp shows PChar comparison problem OK 0.99.7 (PFV)
bug0091.pp missing standard functions in constant expressions OK 0.99.7 (PFV)
bug0092.pp The unfixable bug. Maybe we find a solution one day. OK 0.99.6 (FK)
bug0093.pp Two Cardinal type bugs 0K 0.99.1 (FK/MvC)
bug0094.pp internal error when recordtype not found with case OK 0.99.1
bug0095.pp case with ranges starting with #0 bugs OK 0.99.1 (FK)
bug0096.pp problem with objects as parameters OK 0.99.6 (PM)
bug0097.pp two errors in bp7 but not in FPC OK 0.99.6 (FK)
bug0098.pp File type casts are not allowed (works in TP7) OK 0.99.1 (FK)
bug0099.pp wrong assembler code is genereatoed for range check OK 0.99.1 (?)
(at least under 0.99.0)
bug0100.pp a unit may only occure once in uses OK 0.99.6 (PM)
bug0101.pp no type checking for routines in interfance and OK 0.99.1 (CEC)
implementation
bug0102.pp page fault when trying to compile under ppcm68k OK 0.99.1
bug0103.pp problems with boolean typecasts (other type) OK 0.99.6 (PFV)
bug0104.pp cardinal greater than $7fffffff aren't written OK 0.99.1 (FK)
correct
bug0105.pp typecasts are now ignored problem (NOT A BUG) OK 0.99.1
bug0106.pp typecasts are now ignored problem (NOT A BUG) OK 0.99.1
bug0107.pp shows page fault problem (run in TRUE DOS mode) OK ??.??
bug0108.pp gives wrong error message OK 0.99.1 (PFV)
bug0109.pp syntax error not detected when using a set as pointer OK 0.99.1 (FK)
bug0110.pp SigSegv when using undeclared var in Case OK 0.99.6 (PFV)
bug0112.pp still generates an internal error 10 OK 0.99.1 (FK)
bug0113.pp point initialization problems OK 0.99.1 (PM/FK)
bug0114.pp writeln problem (by Pavel Ozerski) OK 0.99.1 (PFV)
bug0115.pp missing writeln for comp data type OK 0.99.6 (FK)
bug0116.pp when local variable size is > $ffff, enter can't be OK 0.99.1 (FK)
used to create the stack frame, but it is with -Og
bug0117.pp internalerror 17 (and why is there an automatic float OK 0.99.6 (FK)
conversion?)
bug0118.pp Procedural vars cannot be assigned nil ? OK 0.99.6 (FK)
bug0119.pp problem with methods OK 0.99.6 (FK)
bug0120.pp inc/dec(enumeration) doesn't work OK 0.99.6 (MVC)
bug0121.pp cardinal -> byte conversion not work (and crashes) OK 0.99.6 (FK)
bug0122.pp exit() gives a warning that the result is not set OK 0.99.6 (FK)
bug0123.pp Asm, problem with intel assembler (shrd) OK 0.99.11 (PM)
bug0124.pp Asm, problem with -Rintel switch and indexing OK 0.99.11 (PM/PFV)
bug0125.pp wrong colors with DOS CRT unit OK 0.99.6 (PFV)
bug0126.pp packed array isn't allowed OK 0.99.6 (FK)
bug0127.pp problem with cdecl in implementation part OK 0.99.7 (PFV)
bug0128.pp problem with ^[ OK 0.99.6 (PFV)
bug0129.pp endless loop with while/continue OK 0.99.6 (FK)
bug0130.pp in [..#255] problem OK 0.99.6 (PFV)
bug0131.pp internal error 10 with highdimension arrays OK 0.99.6 (MVC)
bug0132.pp segmentation fault with type loop OK 0.99.7 (FK)
bug0134.pp 'continue' keyword is buggy. OK 0.99.6 (FK)
bug0135.pp Unsupported subrange type construction. OK 0.99.6
bug0136.pp No types necessary in the procedure header OK 0.99.6 (PFV)
bug0137.pp Cannot assign child object variable to parent objcet type variable OK 0.99.6
bug0138.pp with problem, %esi can be crushed and is not restored OK 0.99.6 (PM)
bug0139.pp Cannot access protected method of ancestor class from other unit. OK 0.99.6
bug0140.pp Shows that interdependent units still are not OK. OK 0.99.6 (PFV)
bug0141.pp Wrong Class sizes when using forwardly defined classes. OK 0.99.6
bug0142.pp sizeof(object) is not tp7 compatible when no constructor is used OK 0.99.9 (PM)
bug0143.pp cannot concat string and array of char in $X+ mode OK 0.99.7 (PFV)
bug0144.pp problem with 'with object do' OK 0.99.7 (PFV)
bug0145.pp typed files with huges records (needs filerec.size:longint) OK 0.99.7 (PFV)
bug0146.pp no sizeof() for var arrays and the size is pushed incorrect OK 0.99.7 (PFV)
bug0147.pp function b; is not allowed in implementation OK 0.99.7 (PFV)
bug0148.pp crash when setting function result of a declared but not yet OK 0.99.7 (PFV)
implemented function in another function
bug0149.pp (a, b) compile bug0149b twice and you'll get a crash OK 0.99.7 (PFV)
bug0150.pp Shows that the assert() macro is missing under Delphi OK 0.99.9 (PFV)
bug0151.pp crash when using undeclared variable in withstatement OK 0.99.7 (PFV)
bug0152.pp End value of loop variable must be calculated before loop
variable is initialized. OK 0.99.11 (PM)
bug0153.pp Asm, indexing a local/para var should produce an error like tp7 OK 0.99.9 (PFV)
bug0154.pp Subrange types give type mismatch when assigning to OK 0.99.7 (PFV)
bug0156.pp (a,b) forward type def in record crashes when loading ppu OK 0.99.7 (PM/PFV)
bug0155.pp Asm, Missing string return for asm functions
(this is a feature rather than a bug : OK 0.99.11 (FK)
complex return values are not allowed for assembler
functions (PM) Why not (FK)? )
bug0157.pp Invalid compilation and also crashes OK 0.99.7 (PFV)
bug0158.pp Invalid boolean typecast OK 0.99.7 (PFV)
bug0159.pp Invalid virtual functions - should compile OK 0.99.7 (FK)
bug0160.pp Incompatibility with BP: Self shouldn't be a reserved word. OK 0.99.9 (PM)
bug0161.pp internal error when trying to create a set with another OK 0.99.9 (PFV)
bug0162.pp continue in repeat ... until loop doesn't work correct OK 0.99.8 (PFV)
bug0163.pp missing <= and >= operators for sets. OK 0.99.11 (JM)
bug0164.pp crash when using undeclared array index in with statement OK 0.99.8 (PFV)
bug0165.pp missing range check code for enumerated types. OK 0.99.9 (PFV)
bug0166.pp forward type used in declaration crashes instead of error OK 0.99.9 (PFV)
bug0167.pp crash when declaring a procedure with same name as object OK 0.99.9 (PFV)
bug0168.pp set:=set+element is allowed (should be: set:=set+[element]) OK 0.99.9 (PFV)
bug0169.pp missing new(type) support for not object/class OK 0.99.9 (PM)
bug0170.pp Asm, {$ifdef} is seen as a separator OK 0.99.9 (PFV)
bug0171.pp missing typecasting in constant expressions
solved for pointers OK 0.99.11 (PM)
bug0172.pp with with absolute seg:ofs should not be possible OK 0.99.9 (PM)
bug0173.pp secondbug is parsed as asm, but should be normal pascalcode OK 0.99.9 (PFV)
bug0174.pp Asm, offsets of fields are not possible yet OK 0.99.9 (PFV)
bug0175.pp Asm, mov word,%eax should not be allowed without casting
emits a warning (or error with range checking enabled) OK 0.99.11 (PM)
bug0176.pp unit.symbol not allowed for implementation vars OK 0.99.9 (PM)
bug0177.pp program.symbol not allowed (almost the same as bug 176) OK 0.99.9 (PM)
bug0178.pp problems with undefined labels and fail outside constructor OK 0.99.9 (PM)
bug0179.pp show a problem for -So mode OK 0.99.9 (PM)
bug0180.pp problem for units with names different from file name
should be accepted with -Un !!
Solved, but you still need to use the file name from other
units OK 0.99.9 (PM)
bug0181.pp shows a problem with name mangling OK 0.99.9 (PM)
bug0182.pp @record.field doesn't work in constant expr OK 0.99.9 (PM)
bug0183.pp internal error 10 in secondnot OK 0.99.11 (PM)
bug0184.pp multiple copies of the same constant set are stored in executable OK 0.99.9 (PFV)
bug0185.pp missing range checking for Val and subrange types OK 0.99.11 (JM/PFV)
bug0186.pp Erroneous array syntax is accepted. OK 0.99.9 (PFV)
bug0187.pp constructor in a WIth statement isn't called correct.
(works at lest in the case stated) OK 0.99.11 (PM)
bug0188.pp can't print function result of procedural var that returns a
function. Not a bug : wrong syntax !! See source (PM)
bug0189.pp cant compare adresses of function variables !!
As bug0188 FPC syntax problem see source (PM)
bug0190.pp can't have typecast for var params ?? OK 0.99.11 (PM)
bug0191.pp missing vecn constant evaluation OK 0.99.11 (PM)
bug0192.pp can't compare boolean result with true/false, because the
boolean result is already in the flags OK 0.99.11 (PFV)
bug0194.pp @procedure var returns value in it instead of address !! OK 0.99.11 (PM)
bug0195.pp Problem with Getimage, crash of DOS box, even with dpmiexcp!! (PFV)
Not a bug, you must use p^.
bug0196.pp "function a;" is accepted (should require result type) OK 0.99.1 (PM)
bug0197.pp should produce an error: problem with c1:=c2<c3 where c? is OK 0.99.11 (PM)
a comp type
bug0198.pp calling specifications aren't allowed in class declarations,
this should be allowed OK 0.99.11 (PM)
bug0199.pp bug in mul code OK 0.99.11 (FK)
bug0200.pp array of char overloading problem with strings OK 0.99.11 (PFV)
bug0201.pp problem with record var-parameters and assembler OK 0.99.11 (PFV)
bug0202.pp flag results not supported with case OK 0.99.11 (PFV)
bug0203.pp problem with changed mangledname of procedures after use
Generates an error now OK 0.99.11 (PM)
bug0204.pp can typecast the result var in an assignment OK 0.99.11 (PM)
bug0205.pp and parsing bug, generates wrong code (tp7 gives parser error) OK 0.99.11 (PM)
bug0206.pp sets with variable ranges doesn't work OK 0.99.11 (PFV)
bug0207.pp a class destructor doesn't release the memory OK 0.99.11 (FK)
bug0208.pp implicit conversion from boolean to longint should not be allowed
(this is the reason of bug0205 !) OK 0.99.11 (PM)
bug0209.pp problem with boolean expressions of different store sizes
(problem created while solving bug205 ! PM) OK 0.99.11 (PM)
bug0210.pp fillchar should accept boolean value also !! OK 0.99.11 (PM)
bug0211.pp a and not a is true !!! (if a:=boolean(5)) OK 0.99.11 (PM)
bug0212.pp problem with properties OK 0.99.11 (PFV)
bug0213.pp name mangling problem with nested procedures in overloaded
procedure OK 0.99.11 (PM)
bug0214.pp bug for static methods OK 0.99.11 (PM)
bug0215.pp more bugs with static methods OK 0.99.11 (PM)
bug0216.pp problem with with fields as function args OK 0.99.11 (PM)
bug0217.pp in tp mode can't use the procvar in writeln OK 0.99.11 (PFV)
bug0218.pp rounding errors with write/str (the bug is fixed, OK 0.99.11 (FK)
but there is still some rounding error left when
writing the extended value PFV;
this is also fixed now by using integer constants
in str and val FK)
bug0219.pp wrong error message OK 0.99.11 (PFV)
bug0220.pp array of char overloading problem with strings OK 0.99.11 (PFV)
bug0221.pp syntax parsing incompatibilities with tp7 OK 0.99.11 (PFV)
bug0222.pp an record field can't be the counter index (compiles with TP) OK 0.99.11 (PFV)
bug0223.pp wrong boolean evaluation in writeln OK 0.99.11 (PFV)
bug0224.pp I/O-Error generation in readln can't be switched off OK 0.99.11 (PFV)
bug0225.pp Sigsegv when run with range checks on open arrays OK 0.99.11 (PFV)
bug0226.pp Asm, offset of var is not allowed as constant OK 0.99.11 (PFV)
bug0227.pp external var does strange things when declared in localsymtable OK 0.99.11 (PFV)
bug0228.pp Asm, wrong warning for size OK 0.99.11 (PFV)
bug0229.pp consts > 255 are truncated (should work in -S2,-Sd) OK 0.99.11 (PFV)
bug0230.pp several strange happen on the ln function: ln(0): no
FPE and writeln can't write non numeric values
Gives out an exception on compiling because of zero div OK 0.99.11 (PM)
bug0231.pp Problem with comments OK 0.99.11 (PFV)
bug0232.pp const. procedure variables need a special syntax OK 0.99.13 (PFV)
if they use calling specification modifiers
bug0233.pp Problem with enum sets in args OK 0.99.11 (PFV)
bug0234.pp New with void pointer OK 0.99.11 (PM)
bug0235.pp Val(cardinal) bug OK 0.99.11 (JM)
bug0236.pp Problem with range check of subsets !! compile with -Cr OK 0.99.11 (PFV)
bug0237.pp Can't have sub procedures with names defined in interface OK 0.99.13 (PM)
bug0238.pp Internal error 432645 (from Frank MCCormick, mailinglist 24/2) OK 0.99.11 (PM)
bug0239.pp No warning for uninitialized class in IS statements OK 0.99.11 (PM)
bug0240.pp Problems with larges value is case statements OK 0.99.11 (FK)
bug0241.pp Problem with importing function from a DLL with .drv suffix ! OK 0.99.11 (PM)
bug0242.pp Crash when passing a procedure to formal parameter OK 0.99.11 (PM)
bug0244.pp nested procedures can't have same name as global ones (same as bug0237) OK 0.99.13 (PM)
bug0245.pp assigning pointers to address of consts is allowed (refused by BP !) OK 0.99.13 (PFV)
bug0246.pp const para can be changed without error OK 0.99.13 (PFV)
bug0247.pp var with initial value not supprted (Delphi var x : integer = 5;)
allowed in -Sd mode OK 0.99.11 (PM)
bug0248.pp Asm, Wrong assembler code accepted by new assembler reader OK 0.99.11 (PFV)
bug0249.pp procedure of object cannot be assigned to property. OK 0.99.11 (PFV)
bug0250.pp error with Ansistrings and loops. OK 0.99.11 (PFV)
bug0251.pp typed const are not aligned correctly OK 0.99.11 (PM)
bug0252.pp typecasting not possible within typed const OK 0.99.13 (PFV)
bug0253.pp problem with overloaded procedures and forward OK 0.99.11 (PFV)
bug0254.pp problem of endless loop if string at end of main
file without new line. OK 0.99.11 (PM)
bug0255.pp internal error 10 with in and function calls OK 0.99.12 (FK)
bug0256.pp problem with conditionnals in TP mode OK 0.99.11 (PM)
bug0257.pp problem with procvars in tp mode OK 0.99.11 (PM)
bug0258.pp bug in small const set extension to large sets OK 0.99.12 (PM)
bug0259.pp problem with optimizer for real math (use -O1) OK 0.99.12 (PM)
bug0260.pp problem with VMT generation if non virtual
method has a virtual overload OK 0.99.12 (PM)
bug0261.pp problems for assignment overloading OK 0.99.12a (PM)
bug0263.pp export directive is not necessary in delphi anymore OK 0.99.13 (PFV)
bug0264.pp methodpointer bugs OK 0.99.12b (FK)
bug0265.pp nested proc with for-counter in other lex level OK 0.99.13 (PFV)
bug0266.pp linux crt write cuts 256 char OK 0.99.13 (PFV)
bug0267.pp parameters after methodpointer are wrong OK 0.99.12b (FK)
bug0268.pp crash with exceptions OK 0.99.13 (FK)
bug0269.pp wrong linenumber for repeat until when type mismatch OK 0.99.12b (PM)
bug0270.pp unexpected eof in tp mode with (* and directives OK 0.99.13 (PFV)
bug0271.pp abstract methods can't be assigned to methodpointers OK 0.99.13 (??)
bug0272.pp No error issued if wrong parameter in function inside a second function OK 0.99.13 (PFV)
bug0273.pp small array pushing to array of char procedure is wrong OK 0.99.13 (PFV)
bug0274.pp @(proc) is not allowed OK 0.99.13 (PFV)
bug0276.pp Asm, intel reference parsing incompatibility OK 0.99.13 (PFV)
bug0277.pp typecasting with const not possible OK 0.99.13 (PFV)
bug0278.pp (* in conditional code is handled wrong for tp,delphi OK 0.99.13 (PFV)
bug0279.pp crash with ansistring and new(^ansistring) OK 0.99.13 (PFV)
bug0280.pp problem with object finalization. OK 0.99.13 (FK)
bug0282.pp long mangledname problem with -Aas OK 0.99.13 (PFV)
bug0283.pp bug in constant char comparison evaluation OK 0.99.13 (PFV)
bug0284.pp wrong file position with dup id in other unit OK 0.99.13 (PFV)
bug0285.pp Asm, TYPE not support in intel mode OK 0.99.13 (PFV)
bug0286.pp #$08d not allowed as Char constant OK 0.99.13 (PFV)
bug0287.pp (true > false) not supported OK 0.99.13 (PFV)
bug0288.pp crash with virtual method in except part OK 0.99.13 (PFV)
bug0289.pp no hint/note for unused types : implemented with -vnh OK 0.99.13 (PM)
bug0291.pp @procvar in tp mode bugs OK 0.99.13 (PFV)
bug0292.pp objects not finalized when disposed OK 0.99.13 (FK)
bug0295.pp forward type definition is resolved wrong OK 0.99.13 (PFV)
bug0296.pp exit(string) does not work (web form bug 613) OK 0.99.13 (PM)
bug0297.pp calling of interrupt procedure allowed but wrong code generated OK 0.99.13 (PM)
bug0298.pp l1+l2:=l1+l2 gives no error OK 0.99.13 (PFV)
bug0299.pp passing Array[0..1] of char by value to proc leads to problems OK 0.99.13 (PM)
bug0300.pp crash if method on non existing object is parsed (form bug 651) OK 0.99.13 (PFV)
bug0301.pp crash if destructor without object name is parsed OK 0.99.13 (PFV)
bug0302.pp inherited property generates wrong assembler OK 0.99.13 (PFV)
bug0303.pp One more InternalError(10) out of register ! OK 0.99.13 (FK)
bug0304.pp Label redefined when inlining assembler OK 0.99.13 (PFV)
bug0306.pp Address is not popped with exit in try...except block OK 0.99.13 (PFV)
bug0307.pp "with object_type" doesn't work correctly! OK 0.99.13 (?)
bug0308a.pp problem with objects that don't have VMT nor variable fields OK 0.99.13 (FK)
bug0309.pp problem with ATT assembler written by bin writer OK 0.99.14 (PFV)
bug0310.pp local and para dup are not detected OK 0.99.15 (FK)
bug0311.pp No dup id checking in variant records OK 0.99.15 (FK)
Unproducable bugs:
------------------
Unfixed not important bugs (mostly incompatibilities):
------------------------------------------------------
bug0111.pp blockread(typedfile,...) is not allowed in TP7
bug0133.pp object type declaration not 100% compatibile with TP7
bug0193.pp overflow checking for 8 and 16 bit operations wrong
overflow are just special range checks so
as all operations are done on 32 bit integers in FPC
overflow checking will only trap 32 bit overflow
you have to use range checks for byte or 16 bit integers
bug0243.pp Arguments of functions are computed from right to left this
is against pascal convention
but only BP respects this convention Delphi and GPC also
use right to left pushing !!
bug0281.pp dup id checking with property is wrong
bug0290.pp problem with storing hex numbers in integers
bug0294.pp parameter with the same name as function is allowed in tp7/delphi
Yes, but in BP this leads to being unable to set the return value !
Wishlist bugs:
--------------
bug0275.pp too many warnings
Unfixed bugs:
-------------
bug0262.pp problems with virtual and overloaded methods
bug0293.pp no error with variable name = type name
bug0299.pp passing Array[0..1] of char by value to proc leads to problems
bug0305.pp Finally is not handled correctly after inputting 0
bug0312.pp Again the problem of local procs inside methods

20
tests/dotest.pp
View File

@ -1,20 +0,0 @@
unit dotest;
interface
{$ifdef go32v2}
uses
dpmiexcp,lineinfo;
{$endif go32v2}
procedure do_error(l : longint);
implementation
procedure do_error(l : longint);
begin
writeln('Error near: ',l);
halt(100);
end;
end.

77
tests/erroru.pp
View File

@ -1,77 +0,0 @@
unit erroru;
interface
procedure error;
procedure accept_error(num : longint);
procedure require_error(num : longint);
implementation
const program_has_error : boolean = false;
procedure error;
begin
Writeln('Error in ',paramstr(0));
program_has_error:=true;
end;
const
store_exitproc : pointer = nil;
accepted_error_num : longint = 0;
required_error_num : longint = 0;
procedure accept_error(num : longint);
begin
accepted_error_num:=num;
end;
procedure require_error(num : longint);
begin
required_error_num:=num;
accepted_error_num:=num;
end;
procedure error_unit_exit;
begin
exitproc:=store_exitproc;
if exitcode<>0 then
begin
if (required_error_num<>0) and (exitcode<>required_error_num) then
begin
Write('Program ',paramstr(0));
Write(' exited with error ',exitcode,' whereas error ');
Writeln(required_error_num,' was expected');
Halt(1);
end
else if exitcode<>accepted_error_num then
begin
Write('Program ',paramstr(0));
Write(' exited with error ',exitcode,' whereas only error ');
Writeln(accepted_error_num,' was expected');
Halt(1);
end;
end
else if required_error_num<>0 then
begin
Write('Program ',paramstr(0));
Write(' exited without error whereas error ');
Writeln(required_error_num,' was expected');
Halt(1);
end;
if program_has_error then
Halt(1)
else
begin
exitcode:=0;
erroraddr:=nil;
end;
end;
begin
store_exitproc:=exitproc;
exitproc:=@error_unit_exit;
end.

74
tests/getret.pp
View File

@ -1,74 +0,0 @@
{ return the error code of the compiled file }
{ checks also if first line of source contains
$OPT= command line options needed }
program getret;
uses dos;
var com,args : string;
filename,firstline : string;
i : byte;
ppfile, retfile : text;
exefile : file;
begin
assign(retfile,'retcode');
rewrite(retfile);
args:='';
if paramcount>1 then
begin
filename:=paramstr(paramcount);
if pos('.',filename)=0 then
filename:=filename+'.pp';
assign(ppfile,filename);
{$I-}
reset(ppfile);
if ioresult=0 then
begin
{$I+}
readln(ppfile,firstline);
if pos('$OPT=',firstline)>0 then
args:=copy(Firstline,pos('=',Firstline)+1,255);
if pos('}',args)>0 then
args:=copy(args,1,pos('}',args)-1);
close(ppfile);
end;
end;
for i:=2 to paramcount do
args:=args+' '+paramstr(i);
com:=paramstr(1);
{$ifndef linux}
if pos('.',com)=0 then
com:=com+'.exe';
{$endif not linux}
assign(exefile,com);
{$I-}
Writeln('testing ',com);
reset(exefile,1);
if ioresult<>0 then
begin
com:=fsearch(com,getenv('PATH'));
end
else
close(exefile);
{$I+}
Writeln('Executing "',com,' ',args,'"');
Flush(output);
swapvectors;
exec(com,args);
swapvectors;
if doserror<>0 then
write(retfile,512+doserror)
else
write(retfile,dosexitcode);
close(retfile);
{$ifdef CPU86}
{ reset the FPU to avoid crashing make }
{$asmmode att}
asm
fninit
end;
{$endif CPU86}
end.

13
tests/graph.lst
View File

@ -1,13 +0,0 @@
# This file lists all the examples which need the graph unit
graphlst= \
tbs/tbs0037.pp \
tbs/tbs0048.pp \
tbs/tbs0051.pp \
tbs/tbs0052.pp \
tbs/tbs0057.pp \
tbs/tbs0195.pp \
webtbs/tbug711.pp \
webtbs/tbug816.pp

54
tests/readme.txt
View File

@ -1,54 +0,0 @@
TESTS directory for FPC :
several test programs for FPC
with compilation and execution tests.
Standard way :
'make tests' will try to compile all the sources
will printout a list of errors
- programs that do not compile but should
- programs that do compile when they should create an error !
'make allexec' will try to run all non interactive executables
'make alltesiexec' will try to run all interactive executables
source files are separated in different pattern :
ts*.pp
files that should compile and run without error (if programs !)
target 'allts' compiles all these files
ts*.log contains the output of the compiler
ts*.res contains the return code (should be zero !)
target 'alltsexec' runs all these files
they are run non interactively without arguments
ts*.exc contains the return code should be zero
(I basically added some halt(1) if the
execution is faulty !)
ts*.elg contains the output of the program
tf*.pp
files that should fail on compilation
target 'alltf' tries to compile all these files
tf*.res should have a non zero value !!
to*.pp special case for optimization
(treated like ts*.pp)
test*.pp are treated like ts*.pp
but with targets 'alltest' and 'alltestexec'
tesi*.pp are special cases of programs that require interactive
handling (readln or keypressed ...)
these are only executed with tagert 'alltesiexec'
Lastly :
tbs*.pp are like ts*.pp
but are translations from the bugs directory
(i.e. tests that the bug has been removed !!)
tbf*.pp are like tf*.pp
tis*.pp are like tesi*.pp

6
tests/tbf/tbf0008.pp
View File

@ -1,6 +0,0 @@
const
compilerconst=1;
begin
dec(compilerconst);
end.

6
tests/tbf/tbf0010.pp
View File

@ -1,6 +0,0 @@
program hello;
begin
writeln('Hello);
end.

12
tests/tbf/tbf0029.pp
View File

@ -1,12 +0,0 @@
type
TA = object
end;
var
P: Pointer;
begin
{ must fail on compilation because
TA has no VMT }
P := pointer(TypeOf(TA));
end.

9
tests/tbf/tbf0036.pp
View File

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

11
tests/tbf/tbf0049.pp
View File

@ -1,11 +0,0 @@
type
days = (Mon,Tue,Wed,Thu,Fri,Sat,Sun);
weekend = Sat..Sun;
var
w : weekend;
begin
w:=5;
{$message the line before should produce an error }
end.

21
tests/tbf/tbf0060.pp
View File

@ -1,21 +0,0 @@
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
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
}
var
myvar:char;
Begin
case myvar of
1: ;
#2: ;
end;
end.

3
tests/tbf/tbf0061.pp
View File

@ -1,3 +0,0 @@
Begin
55ms;
end.

5
tests/tbf/tbf0071.pp
View File

@ -1,5 +0,0 @@
program tbf0071;
begin
writeln ('
end.

31
tests/tbf/tbf0075.pp
View File

@ -1,31 +0,0 @@
Unit tbs0075;
Interface
Procedure MyTest;Far; { IMPLEMENTATION expected error. }
{ Further information: NEAR IS NOT ALLOWED IN BORLAND PASCAL }
{ Therefore the bugfix should only be for the FAR keyword. }
Procedure MySecondTest;
Implementation
{ near and far are not allowed here, but maybe we don't care since they are ignored by }
{ FPC. }
Procedure MyTest;
Begin
end;
Procedure MySecondTest;Far;Forward;
Procedure MySecondTest;Far;
Begin
end;
end.

3
tests/tbf/tbf0085.pp
View File

@ -1,3 +0,0 @@
Begin
writeln(l);
end.

15
tests/tbf/tbf0086.pp
View File

@ -1,15 +0,0 @@
var
v: word;
w: shortint;
z: byte;
y: integer;
type
zz: shortint = 255;
Begin
y:=64000;
z:=32767;
w:=64000;
v:=-1;
end.

15
tests/tbf/tbf0087.pp
View File

@ -1,15 +0,0 @@
{
BP Error message is 'Pointer variable Expected'
}
type
tobj=object
l : longint;
constructor init;
end;
var
o : tobj;
begin
new(o); {This will create a internal error 9999}
new(o,init); {This will create a Segfault and Core Dump under linux}
end.

3
tests/tbf/tbf0088.pp
View File

@ -1,3 +0,0 @@
Begin
typeof(x1); { Gives out an internal error -- better then 9999 though }
end.

3
tests/tbf/tbf0089.pp
View File

@ -1,3 +0,0 @@
Begin
sizeof(x);
end.

5
tests/tbf/tbf0094.pp
View File

@ -1,5 +0,0 @@
begin
case textrec(l).mode of
1 ;
end;
end.

39
tests/tbf/tbf0097.pp
View File

@ -1,39 +0,0 @@
{
This compiles fine with FPC, but not with Bp7 see 2 comments
}
type
t=object
s : string; { No ; needed ? }
procedure p;
end;
t2=object(t)
procedure p1(p : string);
end;
procedure t2.p1(p : string);
begin
end;
procedure t.p;
var
s : longint; { Not allowed with BP7 }
x : longint;
procedure nested;
var
s : longint;
begin
end;
begin
end;
begin
end.

7
tests/tbf/tbf0100.pp
View File

@ -1,7 +0,0 @@
unit tbs0100;
interface
uses dos;
implementation
uses dos; { Not Allowed in BP7}
end.

18
tests/tbf/tbf0101.pp
View File

@ -1,18 +0,0 @@
Unit tbs0101;
Interface
Procedure MyProc(V: Integer);
Implementation
Procedure MyProc(Y: Integer);
Begin
end;
end.

5
tests/tbf/tbf0108.pp
View File

@ -1,5 +0,0 @@
uses
dos,
;
begin
end.

9
tests/tbf/tbf0109.pp
View File

@ -1,9 +0,0 @@
Type T = (aa,bb,cc,dd,ee,ff,gg,hh);
Tset = set of t;
Var a: Tset;
Begin
If (aa in a^) Then begin end;
{it seems that correct code is generated, but the syntax is wrong}
End.

9
tests/tbf/tbf0110.pp
View File

@ -1,9 +0,0 @@
{ $OPT= -Fu../compiler }
uses aasm;
Begin
Case Pai(hp1)^.typ Of
ait_instruction:
End
End.

21
tests/tbf/tbf0117.pp
View File

@ -1,21 +0,0 @@
var
i: word;
j: integer;
Begin
i:=65530;
i:=i+1; { CF check }
i:=i-1;
i:=i*5;
i:=i/5;
i:=i shl 5;
i:=i shr 5;
Inc(i); { no check }
j:=32765; { OV check }
j:=j+1;
inc(j);
j:=j-1;
j:=j*5;
j:=j div 5;
j:=j shl 5;
j:=j shr 5;
end.

17
tests/tbf/tbf0127.pp
View File

@ -1,17 +0,0 @@
unit tbf0127;
interface
procedure x(l : longint);
implementation
procedure crash;
begin
x(1234); { called with pascal calling conventions }
end;
procedure x(l : longint);external;cdecl;
end.

9
tests/tbf/tbf0136.pp
View File

@ -1,9 +0,0 @@
{
No type declaration necessary ????
}
procedure p(handle1,handle2);
begin
end;
begin
end.

20
tests/tbf/tbf0148.pp
View File

@ -1,20 +0,0 @@
unit test;
interface
Function t(a: Byte): byte;
Function DoT(b: byte): Byte;
implementation
Function t(a: Byte): Byte;
var f: byte;
Begin
DoT := f;
End;
Function DoT(b: byte): Byte;
Begin
End;
end.

10
tests/tbf/tbf0151.pp
View File

@ -1,10 +0,0 @@
type tr = record
l1, l2: longint
end;
var r: tr;
begin
with r do
inc(l)
end.

17
tests/tbf/tbf0153.pp
View File

@ -1,17 +0,0 @@
{$asmmode att}
procedure asmfunc(p:pointer);assembler;
asm
{
this is changed into movl %eax,(%ebx+8) which is not correct, and tp7
also doesn't allow 'mov p[bx],ax' or 'mov p+bx,ax'
Solution: for parameters and locals the index must be turned off
Don't forget to check the intel assembler also
}
movl %eax,p(%ebx)
end;
begin
end.

17
tests/tbf/tbf0155.pp
View File

@ -1,17 +0,0 @@
{ this is not a real bug but rather a feature :
assembler function are only accepted for
simple return values
i.e. either in register or FPU (PM) }
{ so for the moment this is rejected code ! }
function asmstr:string;assembler;
asm
movl __RESULT,%edi
movl $0x4101,%al
stosw
end;
begin
writeln(asmstr);
end;

17
tests/tbf/tbf0157.pp
View File

@ -1,17 +0,0 @@
{ this should be rejected because we only accept integer args }
program write_it;
var x,y:real;
i : longint;
s : string;
begin
x:=5.6;
y:=45.789;
write(y:2:3,' ',x:3:4);
write(i:5);
s:='short';
write(s:11);
write(i:5:2);
write(s:25:3);
write(x:5.2);
end.

8
tests/tbf/tbf0158.pp
View File

@ -1,8 +0,0 @@
program tmp;
var
Molo :Boolean;
begin
Molo := 1; { This should give out a Type mismatch error ! }
end.

11
tests/tbf/tbf0161.pp
View File

@ -1,11 +0,0 @@
Program tbs0161;
{the following program should give a syntax error, but causes an internal error}
const s = [1,2,3,4,5];
var b: Byte;
Begin
If b in [s] then;
End.

14
tests/tbf/tbf0164.pp
View File

@ -1,14 +0,0 @@
type t1r = record
a, b: Byte;
end;
t2r = record
l1, l2: Array[1..4] Of t1r;
end;
Var r: t2r;
begin
with r.l1[counter] Do
Inc(a)
end.

10
tests/tbf/tbf0166.pp
View File

@ -1,10 +0,0 @@
type
punknown=^unknown;
t=object
procedure p(i:unknown);
end;
begin
end.

9
tests/tbf/tbf0167.pp
View File

@ -1,9 +0,0 @@
type ObjTest = Object
End;
Procedure ObjTest;
Begin
end;
Begin
end.

6
tests/tbf/tbf0168.pp
View File

@ -1,6 +0,0 @@
var bset: set of 0..31;
b: byte;
Begin
bset := bset + b;
End.

11
tests/tbf/tbf0172.pp
View File

@ -1,11 +0,0 @@
type
rec=record
a : longint;
end;
var
r1 : rec absolute $40:$49;
begin
with r1 do
a:=1;
end.

9
tests/tbf/tbf0173.pp
View File

@ -1,9 +0,0 @@
var
secondbug : word;
procedure p;assembler;
begin
if secondbug=0 then;
end;
begin
end.

10
tests/tbf/tbf0175.pp
View File

@ -1,10 +0,0 @@
{ this will just give out an error }
{$asmmode att}
{$R+}
var
w : word;
begin
asm
movl w,%ecx
end;
end.

9
tests/tbf/tbf0186.pp
View File

@ -1,9 +0,0 @@
program bug0186;
var
endline:^integer;
line:array [1..endline^] of ^char;
begin
new (endline);
endline^:=5;
endline^:=10;
end.

9
tests/tbf/tbf0196.pp
View File

@ -1,9 +0,0 @@
Program bug0195;
function a;
begin
end;
begin
a
end.

13
tests/tbf/tbf0197.pp
View File

@ -1,13 +0,0 @@
var i : DWord;
c1, c2 : comp;
begin
c1 := 20000; c2 := 100;
i := 0;
repeat
inc(i);
c1 := (abs(3*c1)-c2) < c2; { notice this !!! :) :) }
until (i > 1000);
Writeln(c1);
end.

31
tests/tbf/tbf0205.pp
View File

@ -1,31 +0,0 @@
program bug_show;
{ By PAV (pavsoft@usa.net) }
function bad_uppercase(s:string):string;
var i:integer;
begin
for i:=1 to length(s) do
if (ord(s[i])>=97 and ord(s[i])<=122) then s[i]:=chr(ord(s[i])-97+65);
bad_uppercase:=s;
end;
function good_uppercase(s:string):string;
var i:integer;
begin
for i:=1 to length(s) do
if (ord(s[i])>=97) and (ord(s[i])<=122) then s[i]:=chr(ord(s[i])-97+65);
good_uppercase:=s;
end;
const cadena='Free Paskal Compiler 0.99.8 !!! (bug)';
begin
writeln('This is the original string before convert it');
writeln(cadena);
writeln();
writeln('This is a bad result, using "if ( and )"');
writeln(bad_uppercase(cadena));
writeln();
writeln('This is a good result, using "if () and ()"');
writeln(good_uppercase(cadena));
writeln();
end.

11
tests/tbf/tbf0208.pp
View File

@ -1,11 +0,0 @@
program tbf0208;
{ implicit boolean to integer conversion should not be
allowed }
var
b : boolean;
i : longint;
begin
b:=true;
i:=b;
end.

13
tests/tbf/tbf0219.pp
View File

@ -1,13 +0,0 @@
{ Should give '(' expected in line 6 }
const
replaces=4;
replacetab : array[1..replaces,1..2] of string[32]=(
':',' or colon',
'mem8','mem or bits8',
'mem16','mem or bits16',
'mem32','mem or bits32'
)
begin
end.

14
tests/tbf/tbf0230.pp
View File

@ -1,14 +0,0 @@
{$ifdef go32v2}
uses
dpmiexcp;
{$endif}
var
e : extended;
begin
e:=-1.0;
writeln(ln(0));
writeln(power(0,1.0));
writeln(ln(e));
end .

17
tests/tbf/tbf0231.pp
View File

@ -1,17 +0,0 @@
{$undef dummy}
{$ifdef DUMMY}
(* <= this should not be considered as a
higher comment level !!
test
{$endif dummy}
var
e : extended;
begin
e:=1.0;
writeln(ln(e));
end.

8
tests/tbf/tbf0234.pp
View File

@ -1,8 +0,0 @@
program bug0232;
var p:pointer;
begin
new(p);
dispose(p);
end.

11
tests/tbf/tbf0242.pp
View File

@ -1,11 +0,0 @@
procedure p;
begin
end;
procedure p1(var x);
begin
end;
begin
p1(p);
end.

26
tests/tbf/tbf0245.pp
View File

@ -1,26 +0,0 @@
const
r = 3.5;
s = 'test idiot';
type
preal = ^real;
pstring = ^string;
procedure ss;
begin
end;
var
p : pointer;
pr : preal;
ps : pstring;
begin
p:=@ss;
p:=@s;
pr:=@r;
ps:=@s;
pr^:=7.8;
ps^:='test3';
Writeln('r=',r,' s=',s);
end.

13
tests/tbf/tbf0246.pp
View File

@ -1,13 +0,0 @@
type
tref=record
ofs : longint;
end;
procedure p(const ref:tref);
begin
with ref do
ofs:=ofs+1; { This should issue an error, because ref is const ! }
end;
begin
end.

8
tests/tbf/tbf0248.pp
View File

@ -1,8 +0,0 @@
{$asmmode att}
begin
asm
call *%eax // this is correct
movl %esi,*%eax
end;
end.

21
tests/tbf/tbf0265.pp
View File

@ -1,21 +0,0 @@
PROGRAM t9;
PROCEDURE Eeep;
VAR
X: BYTE;
NewNG: STRING;
PROCEDURE SubProc;
BEGIN
newng := 'alt';
FOR X := 1 TO LENGTH(NewNG) DO BEGIN
WRITELN(X);
END;
END;
BEGIN
SubProc;
END;
BEGIN
Eeep;
END.

8
tests/tbf/tbf0269.pp
View File

@ -1,8 +0,0 @@
{ No idea how I could test this !! PM }
{ we should parse the compiler output !! }
{ Wrong line number for error message }
begin
repeat
writeln('test');
until sptr;
end.

36
tests/tbf/tbf0272.pp
View File

@ -1,36 +0,0 @@
program test_const_string;
const
conststring = 'Constant string';
function astring(s :string) : string;
begin
astring:='Test string'+s;
end;
procedure testvar(var s : string);
begin
writeln('testvar s is "',s,'"');
end;
procedure testconst(const s : string);
begin
writeln('testconst s is "',s,'"');
end;
procedure testvalue(s : string);
begin
writeln('testvalue s is "',s,'"');
end;
const
s : string = 'test';
begin
testvalue(astring('e'));
testconst(astring(s));
testconst(conststring);
testvar(conststring);{ refused a compile time }
end.

19
tests/tbf/tbf0281.pp
View File

@ -1,19 +0,0 @@
{$mode objfpc}
type
test_one = class
protected
fTest : String;
public
property Test: String READ fTest WRITE fTest;
procedure Testen(Test: BOolean);
{ ^ duplicate identifier? }
end;
procedure test_one.testen(test: boolean);
begin
end;
begin
end.

9
tests/tbf/tbf0284.pp
View File

@ -1,9 +0,0 @@
uses tbs0284b;
{$HINTS ON}
type
o2=object(o1)
p : longint;
end;
begin
end.

11
tests/tbf/tbf0298.pp
View File

@ -1,11 +0,0 @@
program test_loc_mem;
{$ifdef go32v2}
uses
dpmiexcp;
{$endif go32v2}
var l1,l2 : longint;
begin
l1+l2:=l1+l2;
end.

4
tests/tbf/tbf0300.pp
View File

@ -1,4 +0,0 @@
procedure nonexistent_class_or_object.method; begin end;
begin
end.

8
tests/tbf/tbf0301.pp
View File

@ -1,8 +0,0 @@
Program bug0301;
destructor done;
begin
end;
begin
end.

10
tests/tbf/tbf0310.pp
View File

@ -1,10 +0,0 @@
procedure p(s:string);
var
s : string;
begin
writeln(s);
end;
begin
p('test');
end.

11
tests/tbf/tbf0311.pp
View File

@ -1,11 +0,0 @@
type
tsplitextended = record
case byte of
0: (a: array[0..9] of byte);
{ the following "a" should give a duplicate identifier error }
1: (a: array[0..4] of word);
2: (a: array[0..1] of cardinal; w: word);
end;
begin
end.

9
tests/tbf/tbf0314.pp
View File

@ -1,9 +0,0 @@
procedure p(var b);
begin
end;
var
s : string;
begin
p(@s[1]);
end.

5
tests/tbf/tbf0315.pp
View File

@ -1,5 +0,0 @@
begin
asm
movl $%1000, %eax
end;
end.

27
tests/tbf/tbf0320.pp
View File

@ -1,27 +0,0 @@
{$ifdef fpc}{$mode delphi}{$endif}
{ These should give an error, as also done in tp,delphi.
See tbs0319.pp for a test with class which should compile in
delphi mode }
type
cl=object
k : longint;
procedure p1;
procedure p2;
end;
procedure cl.p1;
var
k : longint;
begin
end;
procedure cl.p2;
var
p1 : longint;
begin
end;
begin
end.

6
tests/tbf/tbf0323.pp
View File

@ -1,6 +0,0 @@
{$ifdef fpc}{$mode delphi}{$endif}
type
TA = (aOne := 1, aTwo, aThree, aFour, aSix);
begin
end.

10
tests/tbf/tbf0324.pp
View File

@ -1,10 +0,0 @@
{$ifdef fpc}{$mode delphi}{$endif}
function k2:longint;
var
result : word;
begin
end;
begin
end.

14
tests/tbf/tbf0325.pp
View File

@ -1,14 +0,0 @@
{$ifdef fpc}{$mode delphi}{$endif}
function k2(result:word):longint;
begin
end;
function k3(l:word):longint;
var
result : word;
begin
end;
begin
end.

6
tests/tbf/tbf0326.pp
View File

@ -1,6 +0,0 @@
{$mode delphi}
const
anyconst = %11111;
begin
end.

21
tests/tbf/tbf0328.pp
View File

@ -1,21 +0,0 @@
{$ifdef fpc}{$mode delphi}{$endif}
procedure k1(l:longint);
begin
end;
procedure k1(l:string);overload;
begin
end;
procedure k2(l:longint);overload;
begin
end;
procedure k2(l:string);
begin
end;
begin
end.

5
tests/tbf/tbf0342.pp
View File

@ -1,5 +0,0 @@
type
WORD=word;
begin
end.

9
tests/tbf/tbf0343.pp
View File

@ -1,9 +0,0 @@
{$mode delphi}
type
TListEntry = record
Next: ^TListEntry; (*<-- Error message here*)
Data: Integer;
end;
begin
end.

5
tests/tbf/tbf0345.pp
View File

@ -1,5 +0,0 @@
var
WORD : array[1..2] of word;
begin
end.

9
tests/tbf/tbf0347.pp
View File

@ -1,9 +0,0 @@
{$mode delphi}
type x = ^longint;
var y:x;
begin
y [5]:=5;
end.

14
tests/tbf/tbf0349.pp
View File

@ -1,14 +0,0 @@
{$mode delphi}
type
TCl=class;
const
b=1;
type
TCL=class
end;
begin
end.

10
tests/tbf/tbf0351.pp
View File

@ -1,10 +0,0 @@
{ $OPT=-Sew }
{$MACRO OFF}
{ The next line should give a Warning that macro support not has
been turned on }
{$define mac1 := writeln('test')}
begin
end.

15
tests/tbf/tbf0352.pp
View File

@ -1,15 +0,0 @@
{$ifdef fpc}{$MODE OBJFPC}{$endif}
Procedure Proc1(args:array of const);
begin
end;
Procedure Proc2(args:array of longint);
Begin
{ this should give an error }
Proc1(args);
End;
Begin
Proc1([0,1]);
End.

9
tests/tbf/tbf0353.pp
View File

@ -1,9 +0,0 @@
{ $version >= 1.1}
type
ti = interface
private
procedure p;
end;
begin
end.

8
tests/tbf/tbf0354.pp
View File

@ -1,8 +0,0 @@
{ $version >= 1.1}
type
ti = interface
constructor create;
end;
begin
end.

8
tests/tbf/tbf0355.pp
View File

@ -1,8 +0,0 @@
{ $version >= 1.1}
type
ti = interface
destructor destroy;
end;
begin
end.

8
tests/tbf/tbf0356.pp
View File

@ -1,8 +0,0 @@
{ $version >= 1.1}
type
ti = interface
l : longint;
end;
begin
end.

9
tests/tbf/tbf0357.pp
View File

@ -1,9 +0,0 @@
{ $version >= 1.1}
type
ti = interface
protected
procedure p;
end;
begin
end.

9
tests/tbf/tbf0358.pp
View File

@ -1,9 +0,0 @@
{ $version >= 1.1}
type
ti = interface
public
procedure p;
end;
begin
end.

9
tests/tbf/tbf0359.pp
View File

@ -1,9 +0,0 @@
{ $version >= 1.1}
type
ti = interface
published
procedure p;
end;
begin
end.

23
tests/tbf/tbf0360.pp
View File

@ -1,23 +0,0 @@
{$mode objfpc}
type
to1 = class
procedure p;virtual;
end;
to2 = class(to1)
function p : longint;override;
end;
procedure to1.p;
begin
end;
function to2.p : longint;
begin
end;
begin
end.

15
tests/tbf/tbff001.pp
View File

@ -1,15 +0,0 @@
procedure myproc;
var
a: word;
a: word;
a: word;
a: word;
a: word;
begin
a := 1;
writeln (a);
end;
begin
myproc;
end.

31
tests/tbf/tbff002.pp
View File

@ -1,31 +0,0 @@
type
ExecProc = Procedure;
type
MenuItem = record
Caption: String[32];
Exec: ExecProc;
end;
Procedure AddItem(ACaption: String; AExec: ExecProc; var Item: MenuItem);
begin
Item.Caption:=ACaption;
Item.Exec:=AExec;
end;
Procedure ExecFirstItem;
begin
Writeln('Result of "Item 1"');
end;
var M1,M2,M3: MenuItem;
Ep: ExecProc;
begin
AddItem('Item 1',Nil,M1);
Ep:=ExecFirstItem; // should give error in fpc mode
AddItem('Item 2',Ep,M2);
AddItem('Item 3',@ExecFirstItem,M3);
end.

9
tests/tbs/tbs0001.pp
View File

@ -1,9 +0,0 @@
program smalltest;
const
teststr : string = ' '#9#255#0;
begin
writeln(teststr);
teststr := 'gaga';
writeln(teststr);
if teststr<>'gaga' then halt(1);
end.

83
tests/tbs/tbs0002.pp
View File

@ -1,83 +0,0 @@
unit tbs0002;
interface
implementation
{$message starting hexstr}
function hexstr(val : longint;cnt : byte) : string;
const
hexval : string[16]=('0123456789ABCDEF');
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
begin
l2:=(val and l1) shr (4*(cnt-i));
l1:=l1 shr 4;
s[i]:=hexval[l2+1];
end;
hexstr:=s;
end;
{$message starting dump_stack}
procedure dump_stack(bp : longint);
{$message starting get_next_frame}
function get_next_frame(bp : longint) : longint;
begin
asm
movl bp,%eax
movl (%eax),%eax
movl %eax,__RESULT
end ['EAX'];
end;
procedure dump_frame(addr : longint);
begin
{ to be used by symify }
writeln(' 0x',HexStr(addr,8));
end;
{$message starting get_addr}
function get_addr(BP : longint) : longint;
begin
asm
movl BP,%eax
movl 4(%eax),%eax
movl %eax,__RESULT
end ['EAX'];
end;
{$message starting main}
var
i,prevbp : longint;
begin
prevbp:=bp-1;
i:=0;
while bp > prevbp do
begin
dump_frame(get_addr(bp));
i:=i+1;
if i>max_frame_dump then exit;
prevbp:=bp;
bp:=get_next_frame(bp);
end;
end;
end.

18
tests/tbs/tbs0003.pp
View File

@ -1,18 +0,0 @@
unit tbs0003;
interface
implementation
procedure dump_stack(bp : longint);
function get_next_frame(bp : longint) : longint;
begin
end;
begin
end;
end.

Some files were not shown because too many files have changed in this diff Show More