From f3dccf9e7dc94c3ff33e7cb7924c8acf3dbaac29 Mon Sep 17 00:00:00 2001 From: michael Date: Sat, 1 Nov 2008 22:15:23 +0000 Subject: [PATCH] * Added expression parser git-svn-id: trunk@12010 - --- .gitattributes | 3 + packages/fcl-base/Makefile | 122 +- packages/fcl-base/Makefile.fpc | 3 +- packages/fcl-base/examples/fpexprpars.txt | 102 + packages/fcl-base/examples/testexprpars.pp | 5999 ++++++++++++++++++++ packages/fcl-base/fpmake.pp | 1 + packages/fcl-base/src/fpexprpars.pp | 3406 +++++++++++ 7 files changed, 9572 insertions(+), 64 deletions(-) create mode 100644 packages/fcl-base/examples/fpexprpars.txt create mode 100644 packages/fcl-base/examples/testexprpars.pp create mode 100644 packages/fcl-base/src/fpexprpars.pp diff --git a/.gitattributes b/.gitattributes index 7f672cdfe3..999286be0d 100644 --- a/.gitattributes +++ b/.gitattributes @@ -1018,6 +1018,7 @@ packages/fcl-base/examples/dparser.pp svneol=native#text/plain packages/fcl-base/examples/dsockcli.pp svneol=native#text/plain packages/fcl-base/examples/dsocksvr.pp svneol=native#text/plain packages/fcl-base/examples/fpdoc.dtd -text +packages/fcl-base/examples/fpexprpars.txt svneol=native#text/plain packages/fcl-base/examples/fstream.pp svneol=native#text/plain packages/fcl-base/examples/htdump.pp svneol=native#text/plain packages/fcl-base/examples/intl/Makefile svneol=native#text/plain @@ -1062,6 +1063,7 @@ packages/fcl-base/examples/testbs.pp svneol=native#text/plain packages/fcl-base/examples/testcgi.html -text packages/fcl-base/examples/testcgi.pp svneol=native#text/plain packages/fcl-base/examples/testcont.pp svneol=native#text/plain +packages/fcl-base/examples/testexprpars.pp svneol=native#text/plain packages/fcl-base/examples/testez.pp svneol=native#text/plain packages/fcl-base/examples/testhres.pp svneol=native#text/plain packages/fcl-base/examples/testnres.pp svneol=native#text/plain @@ -1098,6 +1100,7 @@ packages/fcl-base/src/custapp.pp svneol=native#text/plain packages/fcl-base/src/daemonapp.pp svneol=native#text/plain packages/fcl-base/src/eventlog.pp svneol=native#text/plain packages/fcl-base/src/felog.inc svneol=native#text/plain +packages/fcl-base/src/fpexprpars.pp svneol=native#text/plain packages/fcl-base/src/fptimer.pp svneol=native#text/plain packages/fcl-base/src/gettext.pp svneol=native#text/plain packages/fcl-base/src/go32v2/custapp.inc svneol=native#text/plain diff --git a/packages/fcl-base/Makefile b/packages/fcl-base/Makefile index bc18082c29..5b27cb2d88 100644 --- a/packages/fcl-base/Makefile +++ b/packages/fcl-base/Makefile @@ -1,5 +1,5 @@ # -# Don't edit, this file is generated by FPCMake Version 2.0.0 [2008/10/22] +# Don't edit, this file is generated by FPCMake Version 2.0.0 [2008/06/18] # default: all MAKEFILETARGETS=i386-linux i386-go32v2 i386-win32 i386-os2 i386-freebsd i386-beos i386-haiku i386-netbsd i386-solaris i386-qnx i386-netware i386-openbsd i386-wdosx i386-darwin i386-emx i386-watcom i386-netwlibc i386-wince i386-embedded i386-symbian m68k-linux m68k-freebsd m68k-netbsd m68k-amiga m68k-atari m68k-openbsd m68k-palmos m68k-embedded powerpc-linux powerpc-netbsd powerpc-amiga powerpc-macos powerpc-darwin powerpc-morphos powerpc-embedded sparc-linux sparc-netbsd sparc-solaris sparc-embedded x86_64-linux x86_64-freebsd x86_64-darwin x86_64-win64 x86_64-embedded arm-linux arm-palmos arm-darwin arm-wince arm-gba arm-nds arm-embedded arm-symbian powerpc64-linux powerpc64-darwin powerpc64-embedded avr-embedded armeb-linux armeb-embedded @@ -115,10 +115,6 @@ FPC:=$(shell $(FPCPROG) -PB) endif ifneq ($(findstring Error,$(FPC)),) override FPC=$(firstword $(strip $(wildcard $(addsuffix /ppc386$(SRCEXEEXT),$(SEARCHPATH))))) -else -ifeq ($(strip $(wildcard $(FPC))),) -FPC:=$(firstword $(FPCPROG)) -endif endif else override FPC=$(firstword $(strip $(wildcard $(addsuffix /ppc386$(SRCEXEEXT),$(SEARCHPATH))))) @@ -271,178 +267,178 @@ ifeq ($(OS_TARGET),win64) INSTALL_DATADIR=${INSTALL_UNITDIR} endif ifeq ($(FULL_TARGET),i386-linux) -override TARGET_UNITS+=contnrs inifiles rtfpars idea base64 gettext iostream cachecls avl_tree uriparser eventlog custapp wformat whtml wtex rttiutils bufstream streamex blowfish streamio inicol pooledmm libtar streamcoll maskutils syncobjs daemonapp fptimer +override TARGET_UNITS+=contnrs inifiles rtfpars idea base64 gettext iostream cachecls avl_tree uriparser eventlog custapp wformat whtml wtex rttiutils bufstream streamex blowfish streamio inicol pooledmm libtar streamcoll maskutils fpexprpars syncobjs daemonapp fptimer endif ifeq ($(FULL_TARGET),i386-go32v2) -override TARGET_UNITS+=contnrs inifiles rtfpars idea base64 gettext iostream cachecls avl_tree uriparser eventlog custapp wformat whtml wtex rttiutils bufstream streamex blowfish streamio inicol pooledmm libtar streamcoll maskutils +override TARGET_UNITS+=contnrs inifiles rtfpars idea base64 gettext iostream cachecls avl_tree uriparser eventlog custapp wformat whtml wtex rttiutils bufstream streamex blowfish streamio inicol pooledmm libtar streamcoll maskutils fpexprpars endif ifeq ($(FULL_TARGET),i386-win32) -override TARGET_UNITS+=contnrs inifiles rtfpars idea base64 gettext iostream cachecls avl_tree uriparser eventlog custapp wformat whtml wtex rttiutils bufstream streamex blowfish streamio inicol pooledmm libtar streamcoll maskutils fileinfo syncobjs daemonapp ServiceManager fptimer +override TARGET_UNITS+=contnrs inifiles rtfpars idea base64 gettext iostream cachecls avl_tree uriparser eventlog custapp wformat whtml wtex rttiutils bufstream streamex blowfish streamio inicol pooledmm libtar streamcoll maskutils fpexprpars fileinfo syncobjs daemonapp ServiceManager fptimer endif ifeq ($(FULL_TARGET),i386-os2) -override TARGET_UNITS+=contnrs inifiles rtfpars idea base64 gettext iostream cachecls avl_tree uriparser eventlog custapp wformat whtml wtex rttiutils bufstream streamex blowfish streamio inicol pooledmm libtar streamcoll maskutils +override TARGET_UNITS+=contnrs inifiles rtfpars idea base64 gettext iostream cachecls avl_tree uriparser eventlog custapp wformat whtml wtex rttiutils bufstream streamex blowfish streamio inicol pooledmm libtar streamcoll maskutils fpexprpars endif ifeq ($(FULL_TARGET),i386-freebsd) -override TARGET_UNITS+=contnrs inifiles rtfpars idea base64 gettext iostream cachecls avl_tree uriparser eventlog custapp wformat whtml wtex rttiutils bufstream streamex blowfish streamio inicol pooledmm libtar streamcoll maskutils syncobjs daemonapp fptimer +override TARGET_UNITS+=contnrs inifiles rtfpars idea base64 gettext iostream cachecls avl_tree uriparser eventlog custapp wformat whtml wtex rttiutils bufstream streamex blowfish streamio inicol pooledmm libtar streamcoll maskutils fpexprpars syncobjs daemonapp fptimer endif ifeq ($(FULL_TARGET),i386-beos) -override TARGET_UNITS+=contnrs inifiles rtfpars idea base64 gettext iostream cachecls avl_tree uriparser eventlog custapp wformat whtml wtex rttiutils bufstream streamex blowfish streamio inicol pooledmm libtar streamcoll maskutils syncobjs +override TARGET_UNITS+=contnrs inifiles rtfpars idea base64 gettext iostream cachecls avl_tree uriparser eventlog custapp wformat whtml wtex rttiutils bufstream streamex blowfish streamio inicol pooledmm libtar streamcoll maskutils fpexprpars syncobjs endif ifeq ($(FULL_TARGET),i386-haiku) -override TARGET_UNITS+=contnrs inifiles rtfpars idea base64 gettext iostream cachecls avl_tree uriparser eventlog custapp wformat whtml wtex rttiutils bufstream streamex blowfish streamio inicol pooledmm libtar streamcoll maskutils syncobjs +override TARGET_UNITS+=contnrs inifiles rtfpars idea base64 gettext iostream cachecls avl_tree uriparser eventlog custapp wformat whtml wtex rttiutils bufstream streamex blowfish streamio inicol pooledmm libtar streamcoll maskutils fpexprpars syncobjs endif ifeq ($(FULL_TARGET),i386-netbsd) -override TARGET_UNITS+=contnrs inifiles rtfpars idea base64 gettext iostream cachecls avl_tree uriparser eventlog custapp wformat whtml wtex rttiutils bufstream streamex blowfish streamio inicol pooledmm libtar streamcoll maskutils daemonapp fptimer +override TARGET_UNITS+=contnrs inifiles rtfpars idea base64 gettext iostream cachecls avl_tree uriparser eventlog custapp wformat whtml wtex rttiutils bufstream streamex blowfish streamio inicol pooledmm libtar streamcoll maskutils fpexprpars daemonapp fptimer endif ifeq ($(FULL_TARGET),i386-solaris) -override TARGET_UNITS+=contnrs inifiles rtfpars idea base64 gettext iostream cachecls avl_tree uriparser eventlog custapp wformat whtml wtex rttiutils bufstream streamex blowfish streamio inicol pooledmm libtar streamcoll maskutils syncobjs daemonapp fptimer +override TARGET_UNITS+=contnrs inifiles rtfpars idea base64 gettext iostream cachecls avl_tree uriparser eventlog custapp wformat whtml wtex rttiutils bufstream streamex blowfish streamio inicol pooledmm libtar streamcoll maskutils fpexprpars syncobjs daemonapp fptimer endif ifeq ($(FULL_TARGET),i386-qnx) -override TARGET_UNITS+=contnrs inifiles rtfpars idea base64 gettext iostream cachecls avl_tree uriparser eventlog custapp wformat whtml wtex rttiutils bufstream streamex blowfish streamio inicol pooledmm libtar streamcoll maskutils +override TARGET_UNITS+=contnrs inifiles rtfpars idea base64 gettext iostream cachecls avl_tree uriparser eventlog custapp wformat whtml wtex rttiutils bufstream streamex blowfish streamio inicol pooledmm libtar streamcoll maskutils fpexprpars endif ifeq ($(FULL_TARGET),i386-netware) -override TARGET_UNITS+=contnrs inifiles rtfpars idea base64 gettext iostream cachecls avl_tree uriparser eventlog custapp wformat whtml wtex rttiutils bufstream streamex blowfish streamio inicol pooledmm libtar streamcoll maskutils syncobjs +override TARGET_UNITS+=contnrs inifiles rtfpars idea base64 gettext iostream cachecls avl_tree uriparser eventlog custapp wformat whtml wtex rttiutils bufstream streamex blowfish streamio inicol pooledmm libtar streamcoll maskutils fpexprpars syncobjs endif ifeq ($(FULL_TARGET),i386-openbsd) -override TARGET_UNITS+=contnrs inifiles rtfpars idea base64 gettext iostream cachecls avl_tree uriparser eventlog custapp wformat whtml wtex rttiutils bufstream streamex blowfish streamio inicol pooledmm libtar streamcoll maskutils daemonapp fptimer +override TARGET_UNITS+=contnrs inifiles rtfpars idea base64 gettext iostream cachecls avl_tree uriparser eventlog custapp wformat whtml wtex rttiutils bufstream streamex blowfish streamio inicol pooledmm libtar streamcoll maskutils fpexprpars daemonapp fptimer endif ifeq ($(FULL_TARGET),i386-wdosx) -override TARGET_UNITS+=contnrs inifiles rtfpars idea base64 gettext iostream cachecls avl_tree uriparser eventlog custapp wformat whtml wtex rttiutils bufstream streamex blowfish streamio inicol pooledmm libtar streamcoll maskutils +override TARGET_UNITS+=contnrs inifiles rtfpars idea base64 gettext iostream cachecls avl_tree uriparser eventlog custapp wformat whtml wtex rttiutils bufstream streamex blowfish streamio inicol pooledmm libtar streamcoll maskutils fpexprpars endif ifeq ($(FULL_TARGET),i386-darwin) -override TARGET_UNITS+=contnrs inifiles rtfpars idea base64 gettext iostream cachecls avl_tree uriparser eventlog custapp wformat whtml wtex rttiutils bufstream streamex blowfish streamio inicol pooledmm libtar streamcoll maskutils syncobjs daemonapp fptimer +override TARGET_UNITS+=contnrs inifiles rtfpars idea base64 gettext iostream cachecls avl_tree uriparser eventlog custapp wformat whtml wtex rttiutils bufstream streamex blowfish streamio inicol pooledmm libtar streamcoll maskutils fpexprpars syncobjs daemonapp fptimer endif ifeq ($(FULL_TARGET),i386-emx) -override TARGET_UNITS+=contnrs inifiles rtfpars idea base64 gettext iostream cachecls avl_tree uriparser eventlog custapp wformat whtml wtex rttiutils bufstream streamex blowfish streamio inicol pooledmm libtar streamcoll maskutils +override TARGET_UNITS+=contnrs inifiles rtfpars idea base64 gettext iostream cachecls avl_tree uriparser eventlog custapp wformat whtml wtex rttiutils bufstream streamex blowfish streamio inicol pooledmm libtar streamcoll maskutils fpexprpars endif ifeq ($(FULL_TARGET),i386-watcom) -override TARGET_UNITS+=contnrs inifiles rtfpars idea base64 gettext iostream cachecls avl_tree uriparser eventlog custapp wformat whtml wtex rttiutils bufstream streamex blowfish streamio inicol pooledmm libtar streamcoll maskutils +override TARGET_UNITS+=contnrs inifiles rtfpars idea base64 gettext iostream cachecls avl_tree uriparser eventlog custapp wformat whtml wtex rttiutils bufstream streamex blowfish streamio inicol pooledmm libtar streamcoll maskutils fpexprpars endif ifeq ($(FULL_TARGET),i386-netwlibc) -override TARGET_UNITS+=contnrs inifiles rtfpars idea base64 gettext iostream cachecls avl_tree uriparser eventlog custapp wformat whtml wtex rttiutils bufstream streamex blowfish streamio inicol pooledmm libtar streamcoll maskutils syncobjs +override TARGET_UNITS+=contnrs inifiles rtfpars idea base64 gettext iostream cachecls avl_tree uriparser eventlog custapp wformat whtml wtex rttiutils bufstream streamex blowfish streamio inicol pooledmm libtar streamcoll maskutils fpexprpars syncobjs endif ifeq ($(FULL_TARGET),i386-wince) -override TARGET_UNITS+=contnrs inifiles rtfpars idea base64 gettext iostream cachecls avl_tree uriparser eventlog custapp wformat whtml wtex rttiutils bufstream streamex blowfish streamio inicol pooledmm libtar streamcoll maskutils fileinfo syncobjs fptimer +override TARGET_UNITS+=contnrs inifiles rtfpars idea base64 gettext iostream cachecls avl_tree uriparser eventlog custapp wformat whtml wtex rttiutils bufstream streamex blowfish streamio inicol pooledmm libtar streamcoll maskutils fpexprpars fileinfo syncobjs fptimer endif ifeq ($(FULL_TARGET),i386-embedded) -override TARGET_UNITS+=contnrs inifiles rtfpars idea base64 gettext iostream cachecls avl_tree uriparser eventlog custapp wformat whtml wtex rttiutils bufstream streamex blowfish streamio inicol pooledmm libtar streamcoll maskutils +override TARGET_UNITS+=contnrs inifiles rtfpars idea base64 gettext iostream cachecls avl_tree uriparser eventlog custapp wformat whtml wtex rttiutils bufstream streamex blowfish streamio inicol pooledmm libtar streamcoll maskutils fpexprpars endif ifeq ($(FULL_TARGET),i386-symbian) -override TARGET_UNITS+=contnrs inifiles rtfpars idea base64 gettext iostream cachecls avl_tree uriparser eventlog custapp wformat whtml wtex rttiutils bufstream streamex blowfish streamio inicol pooledmm libtar streamcoll maskutils +override TARGET_UNITS+=contnrs inifiles rtfpars idea base64 gettext iostream cachecls avl_tree uriparser eventlog custapp wformat whtml wtex rttiutils bufstream streamex blowfish streamio inicol pooledmm libtar streamcoll maskutils fpexprpars endif ifeq ($(FULL_TARGET),m68k-linux) -override TARGET_UNITS+=contnrs inifiles rtfpars idea base64 gettext iostream cachecls avl_tree uriparser eventlog custapp wformat whtml wtex rttiutils bufstream streamex blowfish streamio inicol pooledmm libtar streamcoll maskutils syncobjs daemonapp fptimer +override TARGET_UNITS+=contnrs inifiles rtfpars idea base64 gettext iostream cachecls avl_tree uriparser eventlog custapp wformat whtml wtex rttiutils bufstream streamex blowfish streamio inicol pooledmm libtar streamcoll maskutils fpexprpars syncobjs daemonapp fptimer endif ifeq ($(FULL_TARGET),m68k-freebsd) -override TARGET_UNITS+=contnrs inifiles rtfpars idea base64 gettext iostream cachecls avl_tree uriparser eventlog custapp wformat whtml wtex rttiutils bufstream streamex blowfish streamio inicol pooledmm libtar streamcoll maskutils syncobjs daemonapp fptimer +override TARGET_UNITS+=contnrs inifiles rtfpars idea base64 gettext iostream cachecls avl_tree uriparser eventlog custapp wformat whtml wtex rttiutils bufstream streamex blowfish streamio inicol pooledmm libtar streamcoll maskutils fpexprpars syncobjs daemonapp fptimer endif ifeq ($(FULL_TARGET),m68k-netbsd) -override TARGET_UNITS+=contnrs inifiles rtfpars idea base64 gettext iostream cachecls avl_tree uriparser eventlog custapp wformat whtml wtex rttiutils bufstream streamex blowfish streamio inicol pooledmm libtar streamcoll maskutils daemonapp fptimer +override TARGET_UNITS+=contnrs inifiles rtfpars idea base64 gettext iostream cachecls avl_tree uriparser eventlog custapp wformat whtml wtex rttiutils bufstream streamex blowfish streamio inicol pooledmm libtar streamcoll maskutils fpexprpars daemonapp fptimer endif ifeq ($(FULL_TARGET),m68k-amiga) -override TARGET_UNITS+=contnrs inifiles rtfpars idea base64 gettext iostream cachecls avl_tree uriparser eventlog custapp wformat whtml wtex rttiutils bufstream streamex blowfish streamio inicol pooledmm libtar streamcoll maskutils +override TARGET_UNITS+=contnrs inifiles rtfpars idea base64 gettext iostream cachecls avl_tree uriparser eventlog custapp wformat whtml wtex rttiutils bufstream streamex blowfish streamio inicol pooledmm libtar streamcoll maskutils fpexprpars endif ifeq ($(FULL_TARGET),m68k-atari) -override TARGET_UNITS+=contnrs inifiles rtfpars idea base64 gettext iostream cachecls avl_tree uriparser eventlog custapp wformat whtml wtex rttiutils bufstream streamex blowfish streamio inicol pooledmm libtar streamcoll maskutils +override TARGET_UNITS+=contnrs inifiles rtfpars idea base64 gettext iostream cachecls avl_tree uriparser eventlog custapp wformat whtml wtex rttiutils bufstream streamex blowfish streamio inicol pooledmm libtar streamcoll maskutils fpexprpars endif ifeq ($(FULL_TARGET),m68k-openbsd) -override TARGET_UNITS+=contnrs inifiles rtfpars idea base64 gettext iostream cachecls avl_tree uriparser eventlog custapp wformat whtml wtex rttiutils bufstream streamex blowfish streamio inicol pooledmm libtar streamcoll maskutils daemonapp fptimer +override TARGET_UNITS+=contnrs inifiles rtfpars idea base64 gettext iostream cachecls avl_tree uriparser eventlog custapp wformat whtml wtex rttiutils bufstream streamex blowfish streamio inicol pooledmm libtar streamcoll maskutils fpexprpars daemonapp fptimer endif ifeq ($(FULL_TARGET),m68k-palmos) -override TARGET_UNITS+=contnrs inifiles rtfpars idea base64 gettext iostream cachecls avl_tree uriparser eventlog custapp wformat whtml wtex rttiutils bufstream streamex blowfish streamio inicol pooledmm libtar streamcoll maskutils +override TARGET_UNITS+=contnrs inifiles rtfpars idea base64 gettext iostream cachecls avl_tree uriparser eventlog custapp wformat whtml wtex rttiutils bufstream streamex blowfish streamio inicol pooledmm libtar streamcoll maskutils fpexprpars endif ifeq ($(FULL_TARGET),m68k-embedded) -override TARGET_UNITS+=contnrs inifiles rtfpars idea base64 gettext iostream cachecls avl_tree uriparser eventlog custapp wformat whtml wtex rttiutils bufstream streamex blowfish streamio inicol pooledmm libtar streamcoll maskutils +override TARGET_UNITS+=contnrs inifiles rtfpars idea base64 gettext iostream cachecls avl_tree uriparser eventlog custapp wformat whtml wtex rttiutils bufstream streamex blowfish streamio inicol pooledmm libtar streamcoll maskutils fpexprpars endif ifeq ($(FULL_TARGET),powerpc-linux) -override TARGET_UNITS+=contnrs inifiles rtfpars idea base64 gettext iostream cachecls avl_tree uriparser eventlog custapp wformat whtml wtex rttiutils bufstream streamex blowfish streamio inicol pooledmm libtar streamcoll maskutils syncobjs daemonapp fptimer +override TARGET_UNITS+=contnrs inifiles rtfpars idea base64 gettext iostream cachecls avl_tree uriparser eventlog custapp wformat whtml wtex rttiutils bufstream streamex blowfish streamio inicol pooledmm libtar streamcoll maskutils fpexprpars syncobjs daemonapp fptimer endif ifeq ($(FULL_TARGET),powerpc-netbsd) -override TARGET_UNITS+=contnrs inifiles rtfpars idea base64 gettext iostream cachecls avl_tree uriparser eventlog custapp wformat whtml wtex rttiutils bufstream streamex blowfish streamio inicol pooledmm libtar streamcoll maskutils daemonapp fptimer +override TARGET_UNITS+=contnrs inifiles rtfpars idea base64 gettext iostream cachecls avl_tree uriparser eventlog custapp wformat whtml wtex rttiutils bufstream streamex blowfish streamio inicol pooledmm libtar streamcoll maskutils fpexprpars daemonapp fptimer endif ifeq ($(FULL_TARGET),powerpc-amiga) -override TARGET_UNITS+=contnrs inifiles rtfpars idea base64 gettext iostream cachecls avl_tree uriparser eventlog custapp wformat whtml wtex rttiutils bufstream streamex blowfish streamio inicol pooledmm libtar streamcoll maskutils +override TARGET_UNITS+=contnrs inifiles rtfpars idea base64 gettext iostream cachecls avl_tree uriparser eventlog custapp wformat whtml wtex rttiutils bufstream streamex blowfish streamio inicol pooledmm libtar streamcoll maskutils fpexprpars endif ifeq ($(FULL_TARGET),powerpc-macos) -override TARGET_UNITS+=contnrs inifiles rtfpars idea base64 gettext iostream cachecls avl_tree uriparser eventlog custapp wformat whtml wtex rttiutils bufstream streamex blowfish streamio inicol pooledmm libtar streamcoll maskutils +override TARGET_UNITS+=contnrs inifiles rtfpars idea base64 gettext iostream cachecls avl_tree uriparser eventlog custapp wformat whtml wtex rttiutils bufstream streamex blowfish streamio inicol pooledmm libtar streamcoll maskutils fpexprpars endif ifeq ($(FULL_TARGET),powerpc-darwin) -override TARGET_UNITS+=contnrs inifiles rtfpars idea base64 gettext iostream cachecls avl_tree uriparser eventlog custapp wformat whtml wtex rttiutils bufstream streamex blowfish streamio inicol pooledmm libtar streamcoll maskutils syncobjs daemonapp fptimer +override TARGET_UNITS+=contnrs inifiles rtfpars idea base64 gettext iostream cachecls avl_tree uriparser eventlog custapp wformat whtml wtex rttiutils bufstream streamex blowfish streamio inicol pooledmm libtar streamcoll maskutils fpexprpars syncobjs daemonapp fptimer endif ifeq ($(FULL_TARGET),powerpc-morphos) -override TARGET_UNITS+=contnrs inifiles rtfpars idea base64 gettext iostream cachecls avl_tree uriparser eventlog custapp wformat whtml wtex rttiutils bufstream streamex blowfish streamio inicol pooledmm libtar streamcoll maskutils +override TARGET_UNITS+=contnrs inifiles rtfpars idea base64 gettext iostream cachecls avl_tree uriparser eventlog custapp wformat whtml wtex rttiutils bufstream streamex blowfish streamio inicol pooledmm libtar streamcoll maskutils fpexprpars endif ifeq ($(FULL_TARGET),powerpc-embedded) -override TARGET_UNITS+=contnrs inifiles rtfpars idea base64 gettext iostream cachecls avl_tree uriparser eventlog custapp wformat whtml wtex rttiutils bufstream streamex blowfish streamio inicol pooledmm libtar streamcoll maskutils +override TARGET_UNITS+=contnrs inifiles rtfpars idea base64 gettext iostream cachecls avl_tree uriparser eventlog custapp wformat whtml wtex rttiutils bufstream streamex blowfish streamio inicol pooledmm libtar streamcoll maskutils fpexprpars endif ifeq ($(FULL_TARGET),sparc-linux) -override TARGET_UNITS+=contnrs inifiles rtfpars idea base64 gettext iostream cachecls avl_tree uriparser eventlog custapp wformat whtml wtex rttiutils bufstream streamex blowfish streamio inicol pooledmm libtar streamcoll maskutils syncobjs daemonapp fptimer +override TARGET_UNITS+=contnrs inifiles rtfpars idea base64 gettext iostream cachecls avl_tree uriparser eventlog custapp wformat whtml wtex rttiutils bufstream streamex blowfish streamio inicol pooledmm libtar streamcoll maskutils fpexprpars syncobjs daemonapp fptimer endif ifeq ($(FULL_TARGET),sparc-netbsd) -override TARGET_UNITS+=contnrs inifiles rtfpars idea base64 gettext iostream cachecls avl_tree uriparser eventlog custapp wformat whtml wtex rttiutils bufstream streamex blowfish streamio inicol pooledmm libtar streamcoll maskutils daemonapp fptimer +override TARGET_UNITS+=contnrs inifiles rtfpars idea base64 gettext iostream cachecls avl_tree uriparser eventlog custapp wformat whtml wtex rttiutils bufstream streamex blowfish streamio inicol pooledmm libtar streamcoll maskutils fpexprpars daemonapp fptimer endif ifeq ($(FULL_TARGET),sparc-solaris) -override TARGET_UNITS+=contnrs inifiles rtfpars idea base64 gettext iostream cachecls avl_tree uriparser eventlog custapp wformat whtml wtex rttiutils bufstream streamex blowfish streamio inicol pooledmm libtar streamcoll maskutils syncobjs daemonapp fptimer +override TARGET_UNITS+=contnrs inifiles rtfpars idea base64 gettext iostream cachecls avl_tree uriparser eventlog custapp wformat whtml wtex rttiutils bufstream streamex blowfish streamio inicol pooledmm libtar streamcoll maskutils fpexprpars syncobjs daemonapp fptimer endif ifeq ($(FULL_TARGET),sparc-embedded) -override TARGET_UNITS+=contnrs inifiles rtfpars idea base64 gettext iostream cachecls avl_tree uriparser eventlog custapp wformat whtml wtex rttiutils bufstream streamex blowfish streamio inicol pooledmm libtar streamcoll maskutils +override TARGET_UNITS+=contnrs inifiles rtfpars idea base64 gettext iostream cachecls avl_tree uriparser eventlog custapp wformat whtml wtex rttiutils bufstream streamex blowfish streamio inicol pooledmm libtar streamcoll maskutils fpexprpars endif ifeq ($(FULL_TARGET),x86_64-linux) -override TARGET_UNITS+=contnrs inifiles rtfpars idea base64 gettext iostream cachecls avl_tree uriparser eventlog custapp wformat whtml wtex rttiutils bufstream streamex blowfish streamio inicol pooledmm libtar streamcoll maskutils syncobjs daemonapp fptimer +override TARGET_UNITS+=contnrs inifiles rtfpars idea base64 gettext iostream cachecls avl_tree uriparser eventlog custapp wformat whtml wtex rttiutils bufstream streamex blowfish streamio inicol pooledmm libtar streamcoll maskutils fpexprpars syncobjs daemonapp fptimer endif ifeq ($(FULL_TARGET),x86_64-freebsd) -override TARGET_UNITS+=contnrs inifiles rtfpars idea base64 gettext iostream cachecls avl_tree uriparser eventlog custapp wformat whtml wtex rttiutils bufstream streamex blowfish streamio inicol pooledmm libtar streamcoll maskutils syncobjs daemonapp fptimer +override TARGET_UNITS+=contnrs inifiles rtfpars idea base64 gettext iostream cachecls avl_tree uriparser eventlog custapp wformat whtml wtex rttiutils bufstream streamex blowfish streamio inicol pooledmm libtar streamcoll maskutils fpexprpars syncobjs daemonapp fptimer endif ifeq ($(FULL_TARGET),x86_64-darwin) -override TARGET_UNITS+=contnrs inifiles rtfpars idea base64 gettext iostream cachecls avl_tree uriparser eventlog custapp wformat whtml wtex rttiutils bufstream streamex blowfish streamio inicol pooledmm libtar streamcoll maskutils syncobjs daemonapp fptimer +override TARGET_UNITS+=contnrs inifiles rtfpars idea base64 gettext iostream cachecls avl_tree uriparser eventlog custapp wformat whtml wtex rttiutils bufstream streamex blowfish streamio inicol pooledmm libtar streamcoll maskutils fpexprpars syncobjs daemonapp fptimer endif ifeq ($(FULL_TARGET),x86_64-win64) -override TARGET_UNITS+=contnrs inifiles rtfpars idea base64 gettext iostream cachecls avl_tree uriparser eventlog custapp wformat whtml wtex rttiutils bufstream streamex blowfish streamio inicol pooledmm libtar streamcoll maskutils fileinfo syncobjs daemonapp ServiceManager fptimer +override TARGET_UNITS+=contnrs inifiles rtfpars idea base64 gettext iostream cachecls avl_tree uriparser eventlog custapp wformat whtml wtex rttiutils bufstream streamex blowfish streamio inicol pooledmm libtar streamcoll maskutils fpexprpars fileinfo syncobjs daemonapp ServiceManager fptimer endif ifeq ($(FULL_TARGET),x86_64-embedded) -override TARGET_UNITS+=contnrs inifiles rtfpars idea base64 gettext iostream cachecls avl_tree uriparser eventlog custapp wformat whtml wtex rttiutils bufstream streamex blowfish streamio inicol pooledmm libtar streamcoll maskutils +override TARGET_UNITS+=contnrs inifiles rtfpars idea base64 gettext iostream cachecls avl_tree uriparser eventlog custapp wformat whtml wtex rttiutils bufstream streamex blowfish streamio inicol pooledmm libtar streamcoll maskutils fpexprpars endif ifeq ($(FULL_TARGET),arm-linux) -override TARGET_UNITS+=contnrs inifiles rtfpars idea base64 gettext iostream cachecls avl_tree uriparser eventlog custapp wformat whtml wtex rttiutils bufstream streamex blowfish streamio inicol pooledmm libtar streamcoll maskutils syncobjs daemonapp fptimer +override TARGET_UNITS+=contnrs inifiles rtfpars idea base64 gettext iostream cachecls avl_tree uriparser eventlog custapp wformat whtml wtex rttiutils bufstream streamex blowfish streamio inicol pooledmm libtar streamcoll maskutils fpexprpars syncobjs daemonapp fptimer endif ifeq ($(FULL_TARGET),arm-palmos) -override TARGET_UNITS+=contnrs inifiles rtfpars idea base64 gettext iostream cachecls avl_tree uriparser eventlog custapp wformat whtml wtex rttiutils bufstream streamex blowfish streamio inicol pooledmm libtar streamcoll maskutils +override TARGET_UNITS+=contnrs inifiles rtfpars idea base64 gettext iostream cachecls avl_tree uriparser eventlog custapp wformat whtml wtex rttiutils bufstream streamex blowfish streamio inicol pooledmm libtar streamcoll maskutils fpexprpars endif ifeq ($(FULL_TARGET),arm-darwin) -override TARGET_UNITS+=contnrs inifiles rtfpars idea base64 gettext iostream cachecls avl_tree uriparser eventlog custapp wformat whtml wtex rttiutils bufstream streamex blowfish streamio inicol pooledmm libtar streamcoll maskutils syncobjs daemonapp fptimer +override TARGET_UNITS+=contnrs inifiles rtfpars idea base64 gettext iostream cachecls avl_tree uriparser eventlog custapp wformat whtml wtex rttiutils bufstream streamex blowfish streamio inicol pooledmm libtar streamcoll maskutils fpexprpars syncobjs daemonapp fptimer endif ifeq ($(FULL_TARGET),arm-wince) -override TARGET_UNITS+=contnrs inifiles rtfpars idea base64 gettext iostream cachecls avl_tree uriparser eventlog custapp wformat whtml wtex rttiutils bufstream streamex blowfish streamio inicol pooledmm libtar streamcoll maskutils fileinfo syncobjs fptimer +override TARGET_UNITS+=contnrs inifiles rtfpars idea base64 gettext iostream cachecls avl_tree uriparser eventlog custapp wformat whtml wtex rttiutils bufstream streamex blowfish streamio inicol pooledmm libtar streamcoll maskutils fpexprpars fileinfo syncobjs fptimer endif ifeq ($(FULL_TARGET),arm-gba) -override TARGET_UNITS+=contnrs inifiles rtfpars idea base64 gettext iostream cachecls avl_tree uriparser eventlog custapp wformat whtml wtex rttiutils bufstream streamex blowfish streamio inicol pooledmm libtar streamcoll maskutils +override TARGET_UNITS+=contnrs inifiles rtfpars idea base64 gettext iostream cachecls avl_tree uriparser eventlog custapp wformat whtml wtex rttiutils bufstream streamex blowfish streamio inicol pooledmm libtar streamcoll maskutils fpexprpars endif ifeq ($(FULL_TARGET),arm-nds) -override TARGET_UNITS+=contnrs inifiles rtfpars idea base64 gettext iostream cachecls avl_tree uriparser eventlog custapp wformat whtml wtex rttiutils bufstream streamex blowfish streamio inicol pooledmm libtar streamcoll maskutils +override TARGET_UNITS+=contnrs inifiles rtfpars idea base64 gettext iostream cachecls avl_tree uriparser eventlog custapp wformat whtml wtex rttiutils bufstream streamex blowfish streamio inicol pooledmm libtar streamcoll maskutils fpexprpars endif ifeq ($(FULL_TARGET),arm-embedded) -override TARGET_UNITS+=contnrs inifiles rtfpars idea base64 gettext iostream cachecls avl_tree uriparser eventlog custapp wformat whtml wtex rttiutils bufstream streamex blowfish streamio inicol pooledmm libtar streamcoll maskutils +override TARGET_UNITS+=contnrs inifiles rtfpars idea base64 gettext iostream cachecls avl_tree uriparser eventlog custapp wformat whtml wtex rttiutils bufstream streamex blowfish streamio inicol pooledmm libtar streamcoll maskutils fpexprpars endif ifeq ($(FULL_TARGET),arm-symbian) -override TARGET_UNITS+=contnrs inifiles rtfpars idea base64 gettext iostream cachecls avl_tree uriparser eventlog custapp wformat whtml wtex rttiutils bufstream streamex blowfish streamio inicol pooledmm libtar streamcoll maskutils +override TARGET_UNITS+=contnrs inifiles rtfpars idea base64 gettext iostream cachecls avl_tree uriparser eventlog custapp wformat whtml wtex rttiutils bufstream streamex blowfish streamio inicol pooledmm libtar streamcoll maskutils fpexprpars endif ifeq ($(FULL_TARGET),powerpc64-linux) -override TARGET_UNITS+=contnrs inifiles rtfpars idea base64 gettext iostream cachecls avl_tree uriparser eventlog custapp wformat whtml wtex rttiutils bufstream streamex blowfish streamio inicol pooledmm libtar streamcoll maskutils syncobjs daemonapp fptimer +override TARGET_UNITS+=contnrs inifiles rtfpars idea base64 gettext iostream cachecls avl_tree uriparser eventlog custapp wformat whtml wtex rttiutils bufstream streamex blowfish streamio inicol pooledmm libtar streamcoll maskutils fpexprpars syncobjs daemonapp fptimer endif ifeq ($(FULL_TARGET),powerpc64-darwin) -override TARGET_UNITS+=contnrs inifiles rtfpars idea base64 gettext iostream cachecls avl_tree uriparser eventlog custapp wformat whtml wtex rttiutils bufstream streamex blowfish streamio inicol pooledmm libtar streamcoll maskutils syncobjs daemonapp fptimer +override TARGET_UNITS+=contnrs inifiles rtfpars idea base64 gettext iostream cachecls avl_tree uriparser eventlog custapp wformat whtml wtex rttiutils bufstream streamex blowfish streamio inicol pooledmm libtar streamcoll maskutils fpexprpars syncobjs daemonapp fptimer endif ifeq ($(FULL_TARGET),powerpc64-embedded) -override TARGET_UNITS+=contnrs inifiles rtfpars idea base64 gettext iostream cachecls avl_tree uriparser eventlog custapp wformat whtml wtex rttiutils bufstream streamex blowfish streamio inicol pooledmm libtar streamcoll maskutils +override TARGET_UNITS+=contnrs inifiles rtfpars idea base64 gettext iostream cachecls avl_tree uriparser eventlog custapp wformat whtml wtex rttiutils bufstream streamex blowfish streamio inicol pooledmm libtar streamcoll maskutils fpexprpars endif ifeq ($(FULL_TARGET),avr-embedded) -override TARGET_UNITS+=contnrs inifiles rtfpars idea base64 gettext iostream cachecls avl_tree uriparser eventlog custapp wformat whtml wtex rttiutils bufstream streamex blowfish streamio inicol pooledmm libtar streamcoll maskutils +override TARGET_UNITS+=contnrs inifiles rtfpars idea base64 gettext iostream cachecls avl_tree uriparser eventlog custapp wformat whtml wtex rttiutils bufstream streamex blowfish streamio inicol pooledmm libtar streamcoll maskutils fpexprpars endif ifeq ($(FULL_TARGET),armeb-linux) -override TARGET_UNITS+=contnrs inifiles rtfpars idea base64 gettext iostream cachecls avl_tree uriparser eventlog custapp wformat whtml wtex rttiutils bufstream streamex blowfish streamio inicol pooledmm libtar streamcoll maskutils syncobjs daemonapp fptimer +override TARGET_UNITS+=contnrs inifiles rtfpars idea base64 gettext iostream cachecls avl_tree uriparser eventlog custapp wformat whtml wtex rttiutils bufstream streamex blowfish streamio inicol pooledmm libtar streamcoll maskutils fpexprpars syncobjs daemonapp fptimer endif ifeq ($(FULL_TARGET),armeb-embedded) -override TARGET_UNITS+=contnrs inifiles rtfpars idea base64 gettext iostream cachecls avl_tree uriparser eventlog custapp wformat whtml wtex rttiutils bufstream streamex blowfish streamio inicol pooledmm libtar streamcoll maskutils +override TARGET_UNITS+=contnrs inifiles rtfpars idea base64 gettext iostream cachecls avl_tree uriparser eventlog custapp wformat whtml wtex rttiutils bufstream streamex blowfish streamio inicol pooledmm libtar streamcoll maskutils fpexprpars endif ifeq ($(FULL_TARGET),i386-linux) override TARGET_RSTS+=cachecls custapp cgiapp eventlog registry streamcoll inicol diff --git a/packages/fcl-base/Makefile.fpc b/packages/fcl-base/Makefile.fpc index b5a89730c9..1c72d10942 100644 --- a/packages/fcl-base/Makefile.fpc +++ b/packages/fcl-base/Makefile.fpc @@ -14,7 +14,8 @@ packages_win64=winunits-base winunits-jedi units=contnrs inifiles rtfpars idea base64 gettext \ iostream cachecls avl_tree uriparser \ eventlog custapp wformat whtml wtex rttiutils bufstream \ - streamex blowfish streamio inicol pooledmm libtar streamcoll maskutils + streamex blowfish streamio inicol pooledmm libtar streamcoll \ + maskutils fpexprpars units_beos=syncobjs units_haiku=syncobjs units_freebsd=syncobjs daemonapp fptimer diff --git a/packages/fcl-base/examples/fpexprpars.txt b/packages/fcl-base/examples/fpexprpars.txt new file mode 100644 index 0000000000..e0a77ab2d8 --- /dev/null +++ b/packages/fcl-base/examples/fpexprpars.txt @@ -0,0 +1,102 @@ + +The fpexprpars unit contains an expression parser. +The parser compiles the expression into a node tree, which is +type checked after it was compiled. + +The expression parser handles the following types: + String + Integer (64-bit) + Float (TExprFloat, normally Double) + TDateTime + Boolean + +The following operations are allowed: + + - / * + not and or xor + ( ) +The binary operations can also be done on integer values, in which +case they act on the bits of the integer. + +In the case of strings addition results in concatenation of the strings. + +Operator precedence is observed. In case of equal precedence, evaluation +order is left-to-right. + +Normally, both operands of binary operations must have the same type. +There are 2 exceptions: The engine will convert integers to float or +TDateTime if it detects that one of the nodes is a float or datetime. + +The engine can be extended with variables and functions. There are over +60 built-in functions, which can be enabled by setting the Builtins property +of the expression parser to a set of the following values: + + bcStrings: Various string routines + length copy delete pos lowercase uppercase stringreplace comparetext + + bcDateTime: Various datetime routines + date time now dayofweek extractyear extractmonth extractday extracthour + extractmin extractsec extractmsec encodedate encodetime encodedatetime + shortdayname shortmonthname longdayname longmonthname formatdatetime + + bcMath: Various mathematical routines + pi cos sin arctan abs sqr sqrt exp ln log frac int round trunc + + bcBoolean: Various boolean routines + shl shr IFS IFF IFD IFI + + bcConversion : Conversion routines + inttostr strtoint strtointdef floattostr strtofloat strtofloatdef + booltostr strtobool strtobooldef datetostr timetostr strtodate strtodatedef + strtotime strtotimedef strtodatetime strtodatetimedef + +Additional functions/variables can be added to the Identifiers collection: + + FP : TFPexpressionParser; + +The following will define a TODAY variable which has value equal to the date +at the moment is is defined: + + FP.Identifiers.AddDateTimeVariable('TODAY',Date); + +The following will define a function echodate: + +Procedure EchoDate(Var Result : TFPExpressionResult; Const Args : TExprParameterArray); + +begin + Result.resDateTime:=Args[0].resDateTime; +end; + + FP.Identifiers.AddFunction('EchoDate','D','D',@EchoDate); + +The arguments are: + Name : Name of the function + Result type : Character with result type: + I : integer + S : String + F : FLoat + D : TDateTime + B : Boolean + Argument types : A string with each character the type of argument at that position. + Callback : executed when the function is called. This can be a procedural + variable or an event (procedure of object). + +Result and arguments are type-checked. + +The engine knows 2 built-in functions which are handled specially: + + IF(Expr,Res1,Res1) + +Will return Res1 if expr evaluates to True, or Res2 if expr evaluates to False. +The types of Res1 and Res2 must be the same, and expr must be a boolean +expression. + + CASE(Tag,Def,Label1,Value1,Label2,Value2,...) + +Case will examine the value of Tag and compare it with Label1, Label2 etc. +till a match is found. It will return Value1, Value2 etc. depending on the +match. If no match is found, Def will be returned. From this it follows that +1) The number of arguments is always even and is at least 4. +2) The types of Tag, label1, label2 must be the same; +3) The types of Def, Value1, Value2 must be the same; + + diff --git a/packages/fcl-base/examples/testexprpars.pp b/packages/fcl-base/examples/testexprpars.pp new file mode 100644 index 0000000000..ade1d229a9 --- /dev/null +++ b/packages/fcl-base/examples/testexprpars.pp @@ -0,0 +1,5999 @@ +{ + This file is part of the Free Component Library (FCL) + Copyright (c) 2008 Michael Van Canneyt. + + File which provides examples and all testcases for the expression parser. + It needs fcl-fpcunit to work. + + See the file COPYING.FPC, included in this distribution, + for details about the copyright. + + This program is distributed in the hope that it will be useful, + but WITHOUT ANY WARRANTY; without even the implied warranty of + MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. + + **********************************************************************} +unit testexprpars; + +{$mode objfpc}{$H+} + +interface + +uses + Classes, SysUtils, fpcunit, testutils, testregistry,fpexprpars; + +type + + { TTestExpressionScanner } + + TTestExpressionScanner = class(TTestCase) + Private + FP : TFPExpressionScanner; + FInvalidString : String; + procedure DoInvalidNumber(AString: String); + procedure TestInvalidNumber; + protected + procedure SetUp; override; + procedure TearDown; override; + Procedure AssertEquals(Msg : string; AExpected, AActual : TTokenType); overload; + Procedure TestString(Const AString : String; AToken : TTokenType); + published + procedure TestCreate; + procedure TestSetSource; + Procedure TestWhiteSpace; + Procedure TestTokens; + Procedure TestNumber; + Procedure TestInvalidCharacter; + Procedure TestUnterminatedString; + Procedure TestQuotesInString; + end; + + { TMyFPExpressionParser } + + TMyFPExpressionParser = Class(TFPExpressionParser) + Public + Procedure BuildHashList; + Property ExprNode; + Property Scanner; + Property Dirty; + end; + + { TTestBaseParser } + + TTestBaseParser = class(TTestCase) + private + procedure DoCheck; + Protected + FDestroyCalled : Integer; + FCheckNode : TFPExprNode; + procedure AssertNodeType(Msg: String; AClass: TClass; ANode: TFPExprNode); overload; + procedure AssertEquals(Msg: String; AResultType : TResultType; ANode: TFPExprNode); overload; + procedure AssertEquals(Msg: String; AExpected,AActual : TResultType); overload; + Function CreateBoolNode(ABoolean: Boolean) : TFPExprNode; + Function CreateIntNode(AInteger: Integer) : TFPExprNode; + Function CreateFloatNode(AFloat : TExprFloat) : TFPExprNode; + Function CreateStringNode(Astring : String) : TFPExprNode; + Function CreateDateTimeNode(ADateTime : TDateTime) : TFPExprNode; + Procedure AssertNodeOK(FN : TFPExprNode); + Procedure AssertNodeNotOK(Const Msg : String; FN : TFPExprNode); + Procedure Setup; override; + end; + + { TMyDestroyNode } + + TMyDestroyNode = Class(TFPConstExpression) + FTest : TTestBaseParser; + Public + Constructor CreateTest(ATest : TTestBaseParser); + Destructor Destroy; override; + end; + + { TTestDestroyNode } + + TTestDestroyNode = Class(TTestBaseParser) + Published + Procedure TestDestroy; + end; + + { TTestConstExprNode } + + TTestConstExprNode = Class(TTestBaseParser) + private + FN : TFPConstExpression; + Protected + Procedure TearDown; override; + Published + Procedure TestCreateInteger; + procedure TestCreateFloat; + procedure TestCreateBoolean; + procedure TestCreateDateTime; + procedure TestCreateString; + end; + + { TTestNegateExprNode } + + TTestNegateExprNode = Class(TTestBaseParser) + Private + FN : TFPNegateOperation; + Protected + Procedure TearDown; override; + Published + Procedure TestCreateInteger; + procedure TestCreateFloat; + procedure TestCreateOther1; + procedure TestCreateOther2; + Procedure TestDestroy; + end; + + { TTestBinaryAndNode } + + TTestBinaryAndNode = Class(TTestBaseParser) + Private + FN : TFPBinaryAndOperation; + Protected + Procedure TearDown; override; + Published + Procedure TestCreateInteger; + procedure TestCreateBoolean; + procedure TestCreateBooleanInteger; + procedure TestCreateString; + procedure TestCreateFloat; + procedure TestCreateDateTime; + Procedure TestDestroy; + end; + + { TTestNotNode } + + TTestNotNode = Class(TTestBaseParser) + Private + FN : TFPNotNode; + Protected + Procedure TearDown; override; + Published + Procedure TestCreateInteger; + procedure TestCreateBoolean; + procedure TestCreateString; + procedure TestCreateFloat; + procedure TestCreateDateTime; + Procedure TestDestroy; + end; + + { TTestBinaryOrNode } + + TTestBinaryOrNode = Class(TTestBaseParser) + Private + FN : TFPBinaryOrOperation; + Protected + Procedure TearDown; override; + Published + Procedure TestCreateInteger; + procedure TestCreateBoolean; + procedure TestCreateBooleanInteger; + procedure TestCreateString; + procedure TestCreateFloat; + procedure TestCreateDateTime; + Procedure TestDestroy; + end; + + { TTestBinaryXOrNode } + + TTestBinaryXOrNode = Class(TTestBaseParser) + Private + FN : TFPBinaryXOrOperation; + Protected + Procedure TearDown; override; + Published + Procedure TestCreateInteger; + procedure TestCreateBoolean; + procedure TestCreateBooleanInteger; + procedure TestCreateString; + procedure TestCreateFloat; + procedure TestCreateDateTime; + Procedure TestDestroy; + end; + + { TTestIfOperation } + + TTestIfOperation = Class(TTestBaseParser) + Private + FN : TIfOperation; + Protected + Procedure TearDown; override; + Published + Procedure TestCreateInteger; + procedure TestCreateBoolean; + procedure TestCreateBoolean2; + procedure TestCreateString; + procedure TestCreateFloat; + procedure TestCreateDateTime; + procedure TestCreateBooleanInteger; + procedure TestCreateBooleanInteger2; + procedure TestCreateBooleanString; + procedure TestCreateBooleanString2; + procedure TestCreateBooleanDateTime; + procedure TestCreateBooleanDateTime2; + Procedure TestDestroy; + end; + + { TTestCaseOperation } + + TTestCaseOperation = Class(TTestBaseParser) + Private + FN : TCaseOperation; + Protected + Function CreateArgs(Args : Array of Const) : TExprArgumentArray; + Procedure TearDown; override; + Published + Procedure TestCreateOne; + procedure TestCreateTwo; + procedure TestCreateThree; + procedure TestCreateOdd; + procedure TestCreateNoExpression; + procedure TestCreateWrongLabel; + procedure TestCreateWrongValue; + procedure TestIntegerTag; + procedure TestIntegerTagDefault; + procedure TestStringTag; + procedure TestStringTagDefault; + procedure TestFloatTag; + procedure TestFloatTagDefault; + procedure TestBooleanTag; + procedure TestBooleanTagDefault; + procedure TestDateTimeTag; + procedure TestDateTimeTagDefault; + procedure TestIntegerValue; + procedure TestIntegerValueDefault; + procedure TestStringValue; + procedure TestStringValueDefault; + procedure TestFloatValue; + procedure TestFloatValueDefault; + procedure TestBooleanValue; + procedure TestBooleanValueDefault; + procedure TestDateTimeValue; + procedure TestDateTimeValueDefault; + Procedure TestDestroy; + end; + + { TTestBooleanNode } + + TTestBooleanNode = Class(TTestBaseParser) + Protected + Procedure TestNode(B : TFPBooleanResultOperation; AResult : Boolean); + end; + + { TTestEqualNode } + + TTestEqualNode = Class(TTestBooleanNode) + Private + FN : TFPBooleanResultOperation; + Protected + Procedure TearDown; override; + Class Function NodeClass : TFPBooleanResultOperationClass; virtual; + Class Function ExpectedResult : Boolean; virtual; + Class Function OperatorString : String; virtual; + Published + Procedure TestCreateIntegerEqual; + procedure TestCreateIntegerUnEqual; + Procedure TestCreateFloatEqual; + procedure TestCreateFloatUnEqual; + Procedure TestCreateStringEqual; + procedure TestCreateStringUnEqual; + Procedure TestCreateBooleanEqual; + procedure TestCreateBooleanUnEqual; + Procedure TestCreateDateTimeEqual; + procedure TestCreateDateTimeUnEqual; + Procedure TestDestroy; + Procedure TestWrongTypes1; + procedure TestWrongTypes2; + procedure TestWrongTypes3; + procedure TestWrongTypes4; + procedure TestWrongTypes5; + Procedure TestAsString; + end; + + { TTestUnEqualNode } + + TTestUnEqualNode = Class(TTestEqualNode) + Protected + Class Function NodeClass : TFPBooleanResultOperationClass; override; + Class Function ExpectedResult : Boolean; override; + Class Function OperatorString : String; override; + end; + + { TTestLessThanNode } + + TTestLessThanNode = Class(TTestBooleanNode) + Private + FN : TFPBooleanResultOperation; + Protected + Class Function NodeClass : TFPBooleanResultOperationClass; virtual; + Class Function Larger : Boolean; virtual; + Class Function AllowEqual : Boolean; virtual; + Class Function OperatorString : String; virtual; + Procedure TearDown; override; + Published + Procedure TestCreateIntegerEqual; + procedure TestCreateIntegerSmaller; + procedure TestCreateIntegerLarger; + Procedure TestCreateFloatEqual; + procedure TestCreateFloatSmaller; + procedure TestCreateFloatLarger; + Procedure TestCreateDateTimeEqual; + procedure TestCreateDateTimeSmaller; + procedure TestCreateDateTimeLarger; + Procedure TestCreateStringEqual; + procedure TestCreateStringSmaller; + procedure TestCreateStringLarger; + Procedure TestWrongTypes1; + procedure TestWrongTypes2; + procedure TestWrongTypes3; + procedure TestWrongTypes4; + procedure TestWrongTypes5; + Procedure TestNoBoolean1; + Procedure TestNoBoolean2; + Procedure TestNoBoolean3; + Procedure TestAsString; + end; + + { TTestLessThanEqualNode } + + TTestLessThanEqualNode = Class(TTestLessThanNode) + protected + Class Function NodeClass : TFPBooleanResultOperationClass; override; + Class Function AllowEqual : Boolean; override; + Class Function OperatorString : String; override; + end; + + { TTestLargerThanNode } + + TTestLargerThanNode = Class(TTestLessThanNode) + protected + Class Function NodeClass : TFPBooleanResultOperationClass; override; + Class Function Larger : Boolean; override; + Class Function OperatorString : String; override; + end; + { TTestLargerThanEqualNode } + + TTestLargerThanEqualNode = Class(TTestLargerThanNode) + protected + Class Function NodeClass : TFPBooleanResultOperationClass; override; + Class Function AllowEqual : Boolean; override; + Class Function OperatorString : String; override; + end; + + { TTestAddNode } + + TTestAddNode = Class(TTestBaseParser) + Private + FN : TFPAddOperation; + Protected + Procedure TearDown; override; + Published + Procedure TestCreateInteger; + Procedure TestCreateFloat; + Procedure TestCreateDateTime; + Procedure TestCreateString; + Procedure TestCreateBoolean; + Procedure TestDestroy; + Procedure TestAsString; + end; + + { TTestSubtractNode } + + TTestSubtractNode = Class(TTestBaseParser) + Private + FN : TFPSubtractOperation; + Protected + Procedure TearDown; override; + Published + Procedure TestCreateInteger; + Procedure TestCreateFloat; + Procedure TestCreateDateTime; + Procedure TestCreateString; + Procedure TestCreateBoolean; + Procedure TestDestroy; + Procedure TestAsString; + end; + + { TTestMultiplyNode } + + TTestMultiplyNode = Class(TTestBaseParser) + Private + FN : TFPMultiplyOperation; + Protected + Procedure TearDown; override; + Published + Procedure TestCreateInteger; + Procedure TestCreateFloat; + Procedure TestCreateDateTime; + Procedure TestCreateString; + Procedure TestCreateBoolean; + Procedure TestDestroy; + Procedure TestAsString; + end; + + { TTestDivideNode } + + TTestDivideNode = Class(TTestBaseParser) + Private + FN : TFPDivideOperation; + Protected + Procedure TearDown; override; + Published + Procedure TestCreateInteger; + Procedure TestCreateFloat; + Procedure TestCreateDateTime; + Procedure TestCreateString; + Procedure TestCreateBoolean; + Procedure TestDestroy; + Procedure TestAsString; + end; + + { TTestIntToFloatNode } + + TTestIntToFloatNode = Class(TTestBaseParser) + Private + FN : TIntToFloatNode; + Protected + Procedure TearDown; override; + Published + Procedure TestCreateInteger; + Procedure TestCreateFloat; + Procedure TestDestroy; + Procedure TestAsString; + end; + + { TTestIntToDateTimeNode } + + TTestIntToDateTimeNode = Class(TTestBaseParser) + Private + FN : TIntToDateTimeNode; + Protected + Procedure TearDown; override; + Published + Procedure TestCreateInteger; + Procedure TestCreateFloat; + Procedure TestDestroy; + Procedure TestAsString; + end; + + { TTestFloatToDateTimeNode } + + TTestFloatToDateTimeNode = Class(TTestBaseParser) + Private + FN : TFloatToDateTimeNode; + Protected + Procedure TearDown; override; + Published + Procedure TestCreateInteger; + Procedure TestCreateFloat; + Procedure TestDestroy; + Procedure TestAsString; + end; + + { TTestExpressionParser } + TTestExpressionParser = class(TTestBaseParser) + Private + FP : TMyFPExpressionParser; + FTestExpr : String; + procedure DoAddInteger(var Result: TFPExpressionResult; + const Args: TExprParameterArray); + procedure DoDeleteString(var Result: TFPExpressionResult; + const Args: TExprParameterArray); + procedure DoEchoBoolean(var Result: TFPExpressionResult; Const Args: TExprParameterArray); + procedure DoEchoDate(var Result: TFPExpressionResult; Const Args: TExprParameterArray); + procedure DoEchoFloat(var Result: TFPExpressionResult; Const Args: TExprParameterArray); + procedure DoEchoInteger(var Result: TFPExpressionResult; Const Args: TExprParameterArray); + procedure DoEchoString(var Result: TFPExpressionResult; Const Args: TExprParameterArray); + procedure DoGetDate(var Result: TFPExpressionResult; Const Args: TExprParameterArray); + procedure DoParse; + procedure TestParser(AExpr: string); + protected + procedure SetUp; override; + procedure TearDown; override; + Procedure AssertLeftRight(N : TFPExprNode; LeftClass,RightClass : TClass); + Procedure AssertOperand(N : TFPExprNode; OperandClass : TClass); + Procedure AssertResultType(RT : TResultType); + Procedure AssertResult(F : TExprFloat); + Procedure AssertResult(I : Int64); + Procedure AssertResult(S : String); + Procedure AssertResult(B : Boolean); + Procedure AssertDateTimeResult(D : TDateTime); + end; + + { TTestParserExpressions } + + TTestParserExpressions = Class(TTestExpressionParser) + private + Published + Procedure TestCreate; + Procedure TestSimpleNodeFloat; + procedure TestSimpleNodeInteger; + procedure TestSimpleNodeBooleanTrue; + procedure TestSimpleNodeBooleanFalse; + procedure TestSimpleNodeString; + procedure TestSimpleNegativeInteger; + procedure TestSimpleNegativeFloat; + procedure TestSimpleAddInteger; + procedure TestSimpleAddFloat; + procedure TestSimpleAddIntegerFloat; + procedure TestSimpleAddFloatInteger; + procedure TestSimpleAddString; + procedure TestSimpleSubtractInteger; + procedure TestSimpleSubtractFloat; + procedure TestSimpleSubtractIntegerFloat; + procedure TestSimpleSubtractFloatInteger; + procedure TestSimpleMultiplyFloat; + procedure TestSimpleMultiplyInteger; + procedure TestSimpleDivideFloat; + procedure TestSimpleDivideInteger; + procedure TestSimpleBooleanAnd; + procedure TestSimpleIntegerAnd; + procedure TestSimpleBooleanOr; + procedure TestSimpleIntegerOr; + procedure TestSimpleBooleanNot; + procedure TestSimpleIntegerNot; + procedure TestSimpleAddSeries; + procedure TestSimpleMultiplySeries; + procedure TestSimpleAddMultiplySeries; + procedure TestSimpleAddAndSeries; + procedure TestSimpleAddOrSeries; + procedure TestSimpleOrNotSeries; + procedure TestSimpleAndNotSeries; + procedure TestDoubleAddMultiplySeries; + procedure TestDoubleSubtractMultiplySeries; + procedure TestSimpleIfInteger; + procedure TestSimpleIfString; + procedure TestSimpleIfFloat; + procedure TestSimpleIfBoolean; + procedure TestSimpleIfDateTime; + procedure TestSimpleIfOperation; + procedure TestSimpleBrackets; + procedure TestSimpleBrackets2; + procedure TestSimpleBracketsLeft; + procedure TestSimpleBracketsRight; + procedure TestSimpleBracketsDouble; + end; + + TTestParserBooleanOperations = Class(TTestExpressionParser) + Published + Procedure TestEqualInteger; + procedure TestUnEqualInteger; + procedure TestEqualFloat; + procedure TestEqualFloat2; + procedure TestUnEqualFloat; + procedure TestEqualString; + procedure TestEqualString2; + procedure TestUnEqualString; + procedure TestUnEqualString2; + Procedure TestEqualBoolean; + procedure TestUnEqualBoolean; + procedure TestLessThanInteger; + procedure TestLessThanInteger2; + procedure TestLessThanEqualInteger; + procedure TestLessThanEqualInteger2; + procedure TestLessThanFloat; + procedure TestLessThanFloat2; + procedure TestLessThanEqualFloat; + procedure TestLessThanEqualFloat2; + procedure TestLessThanString; + procedure TestLessThanString2; + procedure TestLessThanEqualString; + procedure TestLessThanEqualString2; + procedure TestGreaterThanInteger; + procedure TestGreaterThanInteger2; + procedure TestGreaterThanEqualInteger; + procedure TestGreaterThanEqualInteger2; + procedure TestGreaterThanFloat; + procedure TestGreaterThanFloat2; + procedure TestGreaterThanEqualFloat; + procedure TestGreaterThanEqualFloat2; + procedure TestGreaterThanString; + procedure TestGreaterThanString2; + procedure TestGreaterThanEqualString; + procedure TestGreaterThanEqualString2; + procedure EqualAndSeries; + procedure EqualAndSeries2; + procedure EqualOrSeries; + procedure EqualOrSeries2; + procedure UnEqualAndSeries; + procedure UnEqualAndSeries2; + procedure UnEqualOrSeries; + procedure UnEqualOrSeries2; + procedure LessThanAndSeries; + procedure LessThanAndSeries2; + procedure LessThanOrSeries; + procedure LessThanOrSeries2; + procedure GreaterThanAndSeries; + procedure GreaterThanAndSeries2; + procedure GreaterThanOrSeries; + procedure GreaterThanOrSeries2; + procedure LessThanEqualAndSeries; + procedure LessThanEqualAndSeries2; + procedure LessThanEqualOrSeries; + procedure LessThanEqualOrSeries2; + procedure GreaterThanEqualAndSeries; + procedure GreaterThanEqualAndSeries2; + procedure GreaterThanEqualOrSeries; + procedure GreaterThanEqualOrSeries2; + end; + + { TTestParserOperands } + + TTestParserOperands = Class(TTestExpressionParser) + private + Published + Procedure MissingOperand1; + procedure MissingOperand2; + procedure MissingOperand3; + procedure MissingOperand4; + procedure MissingOperand5; + procedure MissingOperand6; + procedure MissingOperand7; + procedure MissingOperand8; + procedure MissingOperand9; + procedure MissingOperand10; + procedure MissingOperand11; + procedure MissingOperand12; + procedure MissingOperand13; + procedure MissingOperand14; + procedure MissingOperand15; + procedure MissingOperand16; + procedure MissingOperand17; + procedure MissingOperand18; + procedure MissingOperand19; + procedure MissingOperand20; + procedure MissingOperand21; + procedure MissingBracket1; + procedure MissingBracket2; + procedure MissingBracket3; + procedure MissingBracket4; + procedure MissingBracket5; + procedure MissingBracket6; + procedure MissingBracket7; + procedure MissingArgument1; + procedure MissingArgument2; + procedure MissingArgument3; + procedure MissingArgument4; + procedure MissingArgument5; + procedure MissingArgument6; + procedure MissingArgument7; + end; + + { TTestParserTypeMatch } + + TTestParserTypeMatch = Class(TTestExpressionParser) + Private + Procedure AccessString; + Procedure AccessInteger; + Procedure AccessFloat; + Procedure AccessDateTime; + Procedure AccessBoolean; + Published + Procedure TestTypeMismatch1; + procedure TestTypeMismatch2; + procedure TestTypeMismatch3; + procedure TestTypeMismatch4; + procedure TestTypeMismatch5; + procedure TestTypeMismatch6; + procedure TestTypeMismatch7; + procedure TestTypeMismatch8; + procedure TestTypeMismatch9; + procedure TestTypeMismatch10; + procedure TestTypeMismatch11; + procedure TestTypeMismatch12; + procedure TestTypeMismatch13; + procedure TestTypeMismatch14; + procedure TestTypeMismatch15; + procedure TestTypeMismatch16; + procedure TestTypeMismatch17; + procedure TestTypeMismatch18; + procedure TestTypeMismatch19; + procedure TestTypeMismatch20; + procedure TestTypeMismatch21; + procedure TestTypeMismatch22; + procedure TestTypeMismatch23; + procedure TestTypeMismatch24; + end; + + { TTestParserVariables } + + TTestParserVariables = Class(TTestExpressionParser) + private + FAsWrongType : TResultType; + procedure TestAccess(Skip: TResultType); + Protected + procedure AddVariabletwice; + procedure UnknownVariable; + Procedure ReadWrongType; + procedure WriteWrongType; + Procedure DoDummy(var Result: TFPExpressionResult; Const Args: TExprParameterArray); + Published + Procedure TestVariableAssign; + Procedure TestVariableAssignAgain; + Procedure TestVariable1; + procedure TestVariable2; + procedure TestVariable3; + procedure TestVariable4; + procedure TestVariable5; + procedure TestVariable6; + procedure TestVariable7; + procedure TestVariable8; + procedure TestVariable9; + procedure TestVariable10; + procedure TestVariable11; + procedure TestVariable12; + procedure TestVariable13; + procedure TestVariable14; + procedure TestVariable15; + procedure TestVariable16; + procedure TestVariable17; + procedure TestVariable18; + procedure TestVariable19; + procedure TestVariable20; + procedure TestVariable21; + procedure TestVariable22; + procedure TestVariable23; + procedure TestVariable24; + procedure TestVariable25; + procedure TestVariable26; + procedure TestVariable27; + procedure TestVariable28; + procedure TestVariable29; + procedure TestVariable30; + end; + + { TTestParserFunctions } + + TTestParserFunctions = Class(TTestExpressionParser) + private + FAccessAs : TResultType; + Procedure TryRead; + procedure TryWrite; + Published + Procedure TestFunction1; + procedure TestFunction2; + procedure TestFunction3; + procedure TestFunction4; + procedure TestFunction5; + procedure TestFunction6; + procedure TestFunction7; + procedure TestFunction8; + procedure TestFunction9; + procedure TestFunction10; + procedure TestFunction11; + procedure TestFunction12; + procedure TestFunction13; + procedure TestFunction14; + procedure TestFunction15; + procedure TestFunction16; + procedure TestFunction17; + procedure TestFunction18; + procedure TestFunction19; + procedure TestFunction20; + procedure TestFunction21; + procedure TestFunction22; + procedure TestFunction23; + procedure TestFunction24; + procedure TestFunction25; + procedure TestFunction26; + procedure TestFunction27; + procedure TestFunction28; + procedure TestFunction29; + end; + + { TTestBuiltinsManager } + + TTestBuiltinsManager = Class(TTestExpressionParser) + private + FM : TExprBuiltInManager; + Protected + procedure Setup; override; + procedure Teardown; override; + Published + procedure TestCreate; + procedure TestVariable1; + procedure TestVariable2; + procedure TestVariable3; + procedure TestVariable4; + procedure TestVariable5; + procedure TestVariable6; + procedure TestFunction1; + procedure TestFunction2; + end; + + TTestBuiltins = Class(TTestExpressionParser) + private + FM : TExprBuiltInManager; + FExpr : String; + Protected + procedure Setup; override; + procedure Teardown; override; + Procedure SetExpression(Const AExpression : String); + Procedure AssertVariable(Const ADefinition : String; AResultType : TResultType); + Procedure AssertFunction(Const ADefinition,AResultType,ArgumentTypes : String; ACategory : TBuiltinCategory); + procedure AssertExpression(Const AExpression : String; AResult : Int64); + procedure AssertExpression(Const AExpression : String; Const AResult : String); + procedure AssertExpression(Const AExpression : String; Const AResult : TExprFloat); + procedure AssertExpression(Const AExpression : String; Const AResult : Boolean); + procedure AssertDateTimeExpression(Const AExpression : String; Const AResult : TDateTime); + Published + procedure TestRegister; + Procedure TestVariablepi; + Procedure TestFunctioncos; + Procedure TestFunctionsin; + Procedure TestFunctionarctan; + Procedure TestFunctionabs; + Procedure TestFunctionsqr; + Procedure TestFunctionsqrt; + Procedure TestFunctionexp; + Procedure TestFunctionln; + Procedure TestFunctionlog; + Procedure TestFunctionfrac; + Procedure TestFunctionint; + Procedure TestFunctionround; + Procedure TestFunctiontrunc; + Procedure TestFunctionlength; + Procedure TestFunctioncopy; + Procedure TestFunctiondelete; + Procedure TestFunctionpos; + Procedure TestFunctionlowercase; + Procedure TestFunctionuppercase; + Procedure TestFunctionstringreplace; + Procedure TestFunctioncomparetext; + Procedure TestFunctiondate; + Procedure TestFunctiontime; + Procedure TestFunctionnow; + Procedure TestFunctiondayofweek; + Procedure TestFunctionextractyear; + Procedure TestFunctionextractmonth; + Procedure TestFunctionextractday; + Procedure TestFunctionextracthour; + Procedure TestFunctionextractmin; + Procedure TestFunctionextractsec; + Procedure TestFunctionextractmsec; + Procedure TestFunctionencodedate; + Procedure TestFunctionencodetime; + Procedure TestFunctionencodedatetime; + Procedure TestFunctionshortdayname; + Procedure TestFunctionshortmonthname; + Procedure TestFunctionlongdayname; + Procedure TestFunctionlongmonthname; + Procedure TestFunctionformatdatetime; + Procedure TestFunctionshl; + Procedure TestFunctionshr; + Procedure TestFunctionIFS; + Procedure TestFunctionIFF; + Procedure TestFunctionIFD; + Procedure TestFunctionIFI; + Procedure TestFunctioninttostr; + Procedure TestFunctionstrtoint; + Procedure TestFunctionstrtointdef; + Procedure TestFunctionfloattostr; + Procedure TestFunctionstrtofloat; + Procedure TestFunctionstrtofloatdef; + Procedure TestFunctionbooltostr; + Procedure TestFunctionstrtobool; + Procedure TestFunctionstrtobooldef; + Procedure TestFunctiondatetostr; + Procedure TestFunctiontimetostr; + Procedure TestFunctionstrtodate; + Procedure TestFunctionstrtodatedef; + Procedure TestFunctionstrtotime; + Procedure TestFunctionstrtotimedef; + Procedure TestFunctionstrtodatetime; + Procedure TestFunctionstrtodatetimedef; + end; + +implementation + +uses typinfo; + +procedure TTestExpressionScanner.TestCreate; +begin + AssertEquals('Empty source','',FP.Source); + AssertEquals('Pos is zero',0,FP.Pos); + AssertEquals('CurrentChar is zero',#0,FP.CurrentChar); + AssertEquals('Current token type is EOF',ttEOF,FP.TokenType); + AssertEquals('Current token is empty','',FP.Token); +end; + +procedure TTestExpressionScanner.TestSetSource; +begin + FP.Source:='Abc'; + FP.Source:=''; + AssertEquals('Empty source','',FP.Source); + AssertEquals('Pos is zero',0,FP.Pos); + AssertEquals('CurrentChar is zero',#0,FP.CurrentChar); + AssertEquals('Current token type is EOF',ttEOF,FP.TokenType); + AssertEquals('Current token is empty','',FP.Token); +end; + +procedure TTestExpressionScanner.TestWhiteSpace; +begin + TestString(' ',ttEOF); +end; + +procedure TTestExpressionScanner.TestTokens; + +Const + TestStrings : Array[TTokenType] of String + = ('+','-','<','>','=','/', + '*','(',')','<=','>=', + '<>','1','''abc''','abc',',','and', + 'or','xor','true','false','not','if','case',''); + +var + t : TTokenType; + +begin + For T:=Low(TTokenType) to High(TTokenType) do + TestString(TestStrings[t],t); +end; + +procedure TTestExpressionScanner.TestInvalidNumber; + +begin + TestString(FInvalidString,ttNumber); +end; + +procedure TTestExpressionScanner.DoInvalidNumber(AString : String); + +begin + FInvalidString:=AString; + AssertException('Invalid number "'+AString+'"',EExprScanner,@TestInvalidNumber); +end; + +procedure TTestExpressionScanner.TestNumber; +begin + TestString('123',ttNumber); + TestString('123.4',ttNumber); + TestString('123.E4',ttNumber); + TestString('1.E4',ttNumber); + DoInvalidNumber('1..1'); + DoInvalidNumber('1.E--1'); + DoInvalidNumber('.E-1'); +end; + +procedure TTestExpressionScanner.TestInvalidCharacter; +begin + DoInvalidNumber('~'); + DoInvalidNumber('^'); + DoInvalidNumber('#'); + DoInvalidNumber('$'); + DoInvalidNumber('^'); +end; + +procedure TTestExpressionScanner.TestUnterminatedString; +begin + DoInvalidNumber('''abc'); +end; + +procedure TTestExpressionScanner.TestQuotesInString; +begin + TestString('''That''''s it''',ttString); + TestString('''''''s it''',ttString); + TestString('''s it''''''',ttString); +end; + +procedure TTestExpressionScanner.SetUp; +begin + FP:=TFPExpressionScanner.Create; +end; + +procedure TTestExpressionScanner.TearDown; +begin + FreeAndNil(FP); +end; + +procedure TTestExpressionScanner.AssertEquals(Msg: string; AExpected, + AActual: TTokenType); + +Var + S1,S2 : String; + +begin + S1:=TokenName(AExpected); + S2:=GetEnumName(TypeInfo(TTokenType),Ord(AActual)); + AssertEquals(Msg,S1,S2); +end; + +procedure TTestExpressionScanner.TestString(const AString: String; + AToken: TTokenType); +begin + FP.Source:=AString; + AssertEquals('String "'+AString+'" results in token '+TokenName(AToken),AToken,FP.GetToken); + If Not (FP.TokenType in [ttString,ttEOF]) then + AssertEquals('String "'+AString+'" results in token string '+TokenName(AToken),AString,FP.Token) + else if FP.TokenType=ttString then + AssertEquals('String "'+AString+'" results in token string '+TokenName(AToken), + StringReplace(AString,'''''','''',[rfreplaceAll]), + ''''+FP.Token+''''); +end; + +{ TTestBaseParser } + +procedure TTestBaseParser.DoCheck; +begin + FCheckNode.Check; +end; + +procedure TTestBaseParser.AssertNodeType(Msg: String; AClass: TClass; + ANode: TFPExprNode); +begin + AssertNotNull(Msg+': Not null',ANode); + AssertEquals(Msg+': Class OK',AClass,ANode.ClassType); +end; + +procedure TTestBaseParser.AssertEquals(Msg: String; AResultType: TResultType; + ANode: TFPExprNode); +begin + AssertNotNull(Msg+': Node not null',ANode); + AssertEquals(Msg,AResultType,Anode.NodeType); +end; + +procedure TTestBaseParser.AssertEquals(Msg: String; AExpected, + AActual: TResultType); + +begin + AssertEquals(Msg,ResultTypeName(AExpected),ResultTypeName(AActual)); +end; + +function TTestBaseParser.CreateIntNode(AInteger: Integer): TFPExprNode; +begin + Result:=TFPConstExpression.CreateInteger(AInteger); +end; + +function TTestBaseParser.CreateFloatNode(AFloat: TExprFloat): TFPExprNode; +begin + Result:=TFPConstExpression.CreateFloat(AFloat); +end; + +function TTestBaseParser.CreateStringNode(Astring: String): TFPExprNode; +begin + Result:=TFPConstExpression.CreateString(AString); +end; + +function TTestBaseParser.CreateDateTimeNode(ADateTime: TDateTime): TFPExprNode; +begin + Result:=TFPConstExpression.CreateDateTime(ADateTime); +end; + +procedure TTestBaseParser.AssertNodeOK(FN: TFPExprNode); + +Var + B : Boolean; + Msg : String; + +begin + AssertNotNull('Node to test OK',FN); + B:=False; + try + FN.Check; + B:=True; + except + On E : Exception do + Msg:=E.Message; + end; + If Not B then + Fail(Format('Node %s not OK: %s',[FN.ClassName,Msg])); +end; + +procedure TTestBaseParser.AssertNodeNotOK(const MSg : String; FN: TFPExprNode); +begin + FCheckNode:=FN; + AssertException(Msg,EExprParser,@DoCheck); +end; + +function TTestBaseParser.CreateBoolNode(ABoolean: Boolean): TFPExprNode; +begin + Result:=TFPConstExpression.CreateBoolean(ABoolean); +end; + +procedure TTestBaseParser.Setup; +begin + inherited Setup; + FDestroyCalled:=0; +end; + + +{ TTestConstExprNode } + +procedure TTestConstExprNode.TearDown; +begin + FreeAndNil(FN); + inherited TearDown; +end; + +procedure TTestConstExprNode.TestCreateInteger; +begin + FN:=TFPConstExpression.CreateInteger(1); + AssertEquals('Correct type',rtInteger,FN.NodeType); + AssertEquals('Correct result',1,FN.ConstValue.ResInteger); + AssertEquals('Correct result',1,FN.NodeValue.ResInteger); + AssertEquals('AsString ok','1',FN.AsString); +end; + +procedure TTestConstExprNode.TestCreateFloat; + +Var + S : String; + +begin + FN:=TFPConstExpression.CreateFloat(2.34); + AssertEquals('Correct type',rtFloat,FN.NodeType); + AssertEquals('Correct result',2.34,FN.ConstValue.ResFloat); + AssertEquals('Correct result',2.34,FN.NodeValue.ResFloat); + Str(TExprFLoat(2.34),S); + AssertEquals('AsString ok',S,FN.AsString); +end; + +procedure TTestConstExprNode.TestCreateBoolean; +begin + FN:=TFPConstExpression.CreateBoolean(True); + AssertEquals('Correct type',rtBoolean,FN.NodeType); + AssertEquals('Correct result',True,FN.ConstValue.ResBoolean); + AssertEquals('Correct result',True,FN.NodeValue.ResBoolean); + AssertEquals('AsString ok','True',FN.AsString); + FreeAndNil(FN); + FN:=TFPConstExpression.CreateBoolean(False); + AssertEquals('AsString ok','False',FN.AsString); +end; + +procedure TTestConstExprNode.TestCreateDateTime; + +Var + D : TDateTime; + S : String; + +begin + D:=Now; + FN:=TFPConstExpression.CreateDateTime(D); + AssertEquals('Correct type',rtDateTime,FN.NodeType); + AssertEquals('Correct result',D,FN.ConstValue.ResDateTime); + AssertEquals('Correct result',D,FN.NodeValue.ResDateTime); + S:=''''+FormatDateTime('cccc',D)+''''; + AssertEquals('AsString ok',S,FN.AsString); +end; + +procedure TTestConstExprNode.TestCreateString; + +Var + S : String; + +begin + S:='Ohlala'; + FN:=TFPConstExpression.CreateString(S); + AssertEquals('Correct type',rtString,FN.NodeType); + AssertEquals('Correct result',S,FN.ConstValue.ResString); + AssertEquals('Correct result',S,FN.NodeValue.ResString); + AssertEquals('AsString ok',''''+S+'''',FN.AsString); +end; + +{ TTestNegateExprNode } + +procedure TTestNegateExprNode.TearDown; +begin + FreeAndNil(FN); + inherited TearDown; +end; + +procedure TTestNegateExprNode.TestCreateInteger; + +begin + FN:=TFPNegateOperation.Create(CreateIntNode(23)); + AssertEquals('Negate has correct type',rtInteger,FN.NodeType); + AssertEquals('Negate has correct result',-23,FN.NodeValue.Resinteger); + AssertEquals('Negate has correct string','-23',FN.AsString); + AssertNodeOK(FN); +end; + + +procedure TTestNegateExprNode.TestCreateFloat; + +Var + S : String; + +begin + FN:=TFPNegateOperation.Create(CreateFloatNode(1.23)); + AssertEquals('Negate has correct type',rtFloat,FN.NodeType); + AssertEquals('Negate has correct result',-1.23,FN.NodeValue.ResFloat); + Str(TExprFloat(-1.23),S); + AssertEquals('Negate has correct string',S,FN.AsString); + AssertNodeOK(FN); +end; + +procedure TTestNegateExprNode.TestCreateOther1; + +begin + FN:=TFPNegateOperation.Create(TFPConstExpression.CreateString('1.23')); + AssertNodeNotOK('Negate does not accept string',FN); +end; + +procedure TTestNegateExprNode.TestCreateOther2; + +begin + FN:=TFPNegateOperation.Create(TFPConstExpression.CreateBoolean(True)); + AssertNodeNotOK('Negate does not accept boolean',FN) +end; + +procedure TTestNegateExprNode.TestDestroy; +begin + FN:=TFPNegateOperation.Create(TMyDestroyNode.CreateTest(Self)); + FreeAndNil(FN); + AssertEquals('Operand Destroy called',1,self.FDestroyCalled) +end; + +{ TTestDestroyNode } + +procedure TTestDestroyNode.TestDestroy; + +Var + FN : TMyDestroyNode; + +begin + AssertEquals('Destroy not called yet',0,self.FDestroyCalled); + FN:=TMyDestroyNode.CreateTest(Self); + FN.Free; + AssertEquals('Destroy called',1,self.FDestroyCalled) +end; + +{ TMyDestroyNode } + +constructor TMyDestroyNode.CreateTest(ATest: TTestBaseParser); +begin + FTest:=ATest; + Inherited CreateInteger(1); +end; + +destructor TMyDestroyNode.Destroy; +begin + Inc(FTest.FDestroyCalled); + inherited Destroy; +end; + +{ TTestBinaryAndNode } + +procedure TTestBinaryAndNode.TearDown; +begin + FreeAndNil(FN); + inherited TearDown; +end; + +procedure TTestBinaryAndNode.TestCreateInteger; +begin + FN:=TFPBinaryAndOperation.Create(CreateIntNode(3),CreateIntNode(2)); + AssertNodeOK(FN); + AssertEquals('Correct node type',rtInteger,FN.NodeType); + AssertEquals('Correct result',2,FN.NodeValue.ResInteger); +end; + +procedure TTestBinaryAndNode.TestCreateBoolean; +begin + FN:=TFPBinaryAndOperation.Create(CreateBoolNode(True),CreateBoolNode(True)); + AssertNodeOK(FN); + AssertEquals('Correct node type',rtBoolean,FN.NodeType); + AssertEquals('Correct result',True,FN.NodeValue.ResBoolean); +end; + +procedure TTestBinaryAndNode.TestCreateBooleanInteger; +begin + FN:=TFPBinaryAndOperation.Create(CreateBoolNode(True),CreateIntNode(0)); + AssertNodeNotOK('Different node types',FN); +end; + +procedure TTestBinaryAndNode.TestCreateString; +begin + FN:=TFPBinaryAndOperation.Create(CreateStringNode('True'),CreateStringNode('True')); + AssertNodeNotOK('String node type',FN); +end; + +procedure TTestBinaryAndNode.TestCreateFloat; +begin + FN:=TFPBinaryAndOperation.Create(CreateFloatNode(1.23),CreateFloatNode(1.23)); + AssertNodeNotOK('float node type',FN); +end; + +procedure TTestBinaryAndNode.TestCreateDateTime; +begin + FN:=TFPBinaryAndOperation.Create(CreateDateTimeNode(Now),CreateDateTimeNode(Now)); + AssertNodeNotOK('DateTime node type',FN); +end; + +procedure TTestBinaryAndNode.TestDestroy; +begin + FN:=TFPBinaryAndOperation.Create(TMyDestroyNode.CreateTest(Self),TMyDestroyNode.CreateTest(Self)); + FreeAndNil(FN); + AssertEquals('Destroy called for left and right nodes',2,self.FDestroyCalled) +end; + +{ TTestBinaryOrNode } + +procedure TTestBinaryOrNode.TearDown; +begin + FreeAndNil(FN); + inherited TearDown; +end; + +procedure TTestBinaryOrNode.TestCreateInteger; +begin + FN:=TFPBinaryOrOperation.Create(CreateIntNode(1),CreateIntNode(2)); + AssertNodeOK(FN); + AssertEquals('Correct node type',rtInteger,FN.NodeType); + AssertEquals('Correct result',3,FN.NodeValue.ResInteger); +end; + +procedure TTestBinaryOrNode.TestCreateBoolean; +begin + FN:=TFPBinaryOrOperation.Create(CreateBoolNode(True),CreateBoolNode(False)); + AssertNodeOK(FN); + AssertEquals('Correct node type',rtBoolean,FN.NodeType); + AssertEquals('Correct result',True,FN.NodeValue.ResBoolean); +end; + +procedure TTestBinaryOrNode.TestCreateBooleanInteger; +begin + FN:=TFPBinaryOrOperation.Create(CreateBoolNode(True),CreateIntNode(0)); + AssertNodeNotOK('Different node types',FN); +end; + +procedure TTestBinaryOrNode.TestCreateString; +begin + FN:=TFPBinaryOrOperation.Create(CreateStringNode('True'),CreateStringNode('True')); + AssertNodeNotOK('String node type',FN); +end; + +procedure TTestBinaryOrNode.TestCreateFloat; +begin + FN:=TFPBinaryOrOperation.Create(CreateFloatNode(1.23),CreateFloatNode(1.23)); + AssertNodeNotOK('float node type',FN); +end; + +procedure TTestBinaryOrNode.TestCreateDateTime; +begin + FN:=TFPBinaryOrOperation.Create(CreateDateTimeNode(Now),CreateDateTimeNode(Now)); + AssertNodeNotOK('DateTime node type',FN); +end; + +procedure TTestBinaryOrNode.TestDestroy; +begin + FN:=TFPBinaryOrOperation.Create(TMyDestroyNode.CreateTest(Self),TMyDestroyNode.CreateTest(Self)); + FreeAndNil(FN); + AssertEquals('Destroy called for left and right nodes',2,self.FDestroyCalled) +end; + +{ TTestBinaryXorNode } + +procedure TTestBinaryXorNode.TearDown; +begin + FreeAndNil(FN); + inherited TearDown; +end; + +procedure TTestBinaryXorNode.TestCreateInteger; +begin + FN:=TFPBinaryXorOperation.Create(CreateIntNode(1),CreateIntNode(2)); + AssertNodeOK(FN); + AssertEquals('Correct node type',rtInteger,FN.NodeType); + AssertEquals('Correct result',3,FN.NodeValue.ResInteger); +end; + +procedure TTestBinaryXorNode.TestCreateBoolean; +begin + FN:=TFPBinaryXorOperation.Create(CreateBoolNode(True),CreateBoolNode(True)); + AssertNodeOK(FN); + AssertEquals('Correct node type',rtBoolean,FN.NodeType); + AssertEquals('Correct result',False,FN.NodeValue.ResBoolean); +end; + +procedure TTestBinaryXorNode.TestCreateBooleanInteger; +begin + FN:=TFPBinaryXorOperation.Create(CreateBoolNode(True),CreateIntNode(0)); + AssertNodeNotOK('Different node types',FN); +end; + +procedure TTestBinaryXorNode.TestCreateString; +begin + FN:=TFPBinaryXorOperation.Create(CreateStringNode('True'),CreateStringNode('True')); + AssertNodeNotOK('String node type',FN); +end; + +procedure TTestBinaryXorNode.TestCreateFloat; +begin + FN:=TFPBinaryXorOperation.Create(CreateFloatNode(1.23),CreateFloatNode(1.23)); + AssertNodeNotOK('float node type',FN); +end; + +procedure TTestBinaryXorNode.TestCreateDateTime; +begin + FN:=TFPBinaryXorOperation.Create(CreateDateTimeNode(Now),CreateDateTimeNode(Now)); + AssertNodeNotOK('DateTime node type',FN); +end; + +procedure TTestBinaryXorNode.TestDestroy; +begin + FN:=TFPBinaryXorOperation.Create(TMyDestroyNode.CreateTest(Self),TMyDestroyNode.CreateTest(Self)); + FreeAndNil(FN); + AssertEquals('Destroy called for left and right nodes',2,self.FDestroyCalled) +end; + +{ TTestBooleanNode } + +procedure TTestBooleanNode.TestNode(B: TFPBooleanResultOperation; + AResult: Boolean); +begin + AssertEquals(Format('Test %s(%s,%s) result',[B.ClassName,B.Left.AsString,B.Right.AsString]),Aresult,B.NodeValue.resBoolean); +end; + +{ TTestEqualNode } + +procedure TTestEqualNode.TearDown; +begin + FreeAndNil(FN); + inherited TearDown; +end; + +class function TTestEqualNode.NodeClass: TFPBooleanResultOperationClass; +begin + Result:=TFPEqualOperation; +end; + +class function TTestEqualNode.ExpectedResult: Boolean; +begin + Result:=True +end; + +class function TTestEqualNode.OperatorString: String; +begin + Result:='='; +end; + +procedure TTestEqualNode.TestCreateIntegerEqual; +begin + FN:=NodeClass.Create(CreateIntNode(1),CreateIntNode(1)); + AssertNodeOk(FN); + AssertEquals('Boolean result',rtBoolean,FN.NodeType); + TestNode(FN,ExpectedResult); +end; + +procedure TTestEqualNode.TestCreateIntegerUnEqual; +begin + FN:=NodeClass.Create(CreateIntNode(2),CreateIntNode(1)); + AssertNodeOk(FN); + AssertEquals('Boolean result',rtBoolean,FN.NodeType); + TestNode(FN,Not ExpectedResult); +end; + +procedure TTestEqualNode.TestCreateFloatEqual; +begin + FN:=NodeClass.Create(CreateFloatNode(1.23),CreateFloatNode(1.23)); + AssertNodeOk(FN); + AssertEquals('Boolean result',rtBoolean,FN.NodeType); + TestNode(FN,ExpectedResult); +end; + +procedure TTestEqualNode.TestCreateFloatUnEqual; +begin + FN:=NodeClass.Create(CreateFloatNode(1.23),CreateFloatNode(1.34)); + AssertNodeOk(FN); + AssertEquals('Boolean result',rtBoolean,FN.NodeType); + TestNode(FN,Not ExpectedResult); +end; + +procedure TTestEqualNode.TestCreateStringEqual; +begin + FN:=NodeClass.Create(CreateStringNode('now'),CreateStringNode('now')); + AssertNodeOk(FN); + AssertEquals('Boolean result',rtBoolean,FN.NodeType); + TestNode(FN,ExpectedResult); +end; + +procedure TTestEqualNode.TestCreateStringUnEqual; +begin + FN:=NodeClass.Create(CreateStringNode('now'),CreateStringNode('then')); + AssertNodeOk(FN); + AssertEquals('Boolean result',rtBoolean,FN.NodeType); + TestNode(FN,Not ExpectedResult); +end; + +procedure TTestEqualNode.TestCreateBooleanEqual; +begin + FN:=NodeClass.Create(CreateBoolNode(True),CreateBoolNode(True)); + AssertNodeOk(FN); + AssertEquals('Boolean result',rtBoolean,FN.NodeType); + TestNode(FN,ExpectedResult); +end; + +procedure TTestEqualNode.TestCreateBooleanUnEqual; +begin + FN:=NodeClass.Create(CreateBoolNode(False),CreateBoolNode(True)); + AssertNodeOk(FN); + AssertEquals('Boolean result',rtBoolean,FN.NodeType); + TestNode(FN,Not ExpectedResult); +end; + +procedure TTestEqualNode.TestCreateDateTimeEqual; + +Var + D : TDateTime; + +begin + D:=Now; + FN:=NodeClass.Create(CreateDateTimeNode(D),CreateDateTimeNode(D)); + AssertNodeOk(FN); + AssertEquals('Boolean result',rtBoolean,FN.NodeType); + TestNode(FN,ExpectedResult); +end; + +procedure TTestEqualNode.TestCreateDateTimeUnEqual; + +Var + D : TDateTime; + +begin + D:=Now; + FN:=NodeClass.Create(CreateDateTimeNode(D),CreateDateTimeNode(D-1)); + AssertNodeOk(FN); + AssertEquals('Boolean result',rtBoolean,FN.NodeType); + TestNode(FN,Not ExpectedResult); +end; + + +procedure TTestEqualNode.TestDestroy; +begin + FN:=NodeClass.Create(TMyDestroyNode.CreateTest(Self),TMyDestroyNode.CreateTest(Self)); + FreeAndNil(FN); + AssertEquals('Destroy called for left and right nodes',2,self.FDestroyCalled) +end; + +procedure TTestEqualNode.TestWrongTypes1; +begin + FN:=NodeClass.Create(CreateIntNode(3),CreateStringNode('1.23')); + AssertNodeNotOk('Wrong Types',FN); +end; + +procedure TTestEqualNode.TestWrongTypes2; +begin + FN:=NodeClass.Create(CreateDateTimeNode(3),CreateStringNode('1.23')); + AssertNodeNotOk('Wrong Types',FN); +end; + +procedure TTestEqualNode.TestWrongTypes3; +begin + FN:=NodeClass.Create(CreateFloatNode(1.3),CreateStringNode('1.23')); + AssertNodeNotOk('Wrong Types',FN); +end; + +procedure TTestEqualNode.TestWrongTypes4; +begin + FN:=NodeClass.Create(CreateBoolNode(False),CreateStringNode('1.23')); + AssertNodeNotOk('Wrong Types',FN); +end; + +procedure TTestEqualNode.TestWrongTypes5; +begin + FN:=NodeClass.Create(CreateFloatNode(1),CreateIntNode(1)); + AssertNodeNotOk('Wrong Types',FN); +end; + + +procedure TTestEqualNode.TestAsString; +begin + FN:=NodeClass.Create(CreateIntNode(1),CreateIntNode(2)); + AssertEquals('Asstring works ok','1 '+OPeratorString+' 2',FN.AsString); +end; + +{ TTestUnEqualNode } + +class function TTestUnEqualNode.NodeClass: TFPBooleanResultOperationClass; +begin + Result:=TFPUnEqualOperation; +end; + +class function TTestUnEqualNode.ExpectedResult: Boolean; +begin + Result:=False; +end; + +class function TTestUnEqualNode.OperatorString: String; +begin + Result:='<>'; +end; + +{ TTestLessThanNode } + +class function TTestLessThanNode.NodeClass: TFPBooleanResultOperationClass; +begin + Result:=TFPLessThanOperation; +end; + +class function TTestLessThanNode.Larger: Boolean; +begin + Result:=False; +end; + +class function TTestLessThanNode.AllowEqual: Boolean; +begin + Result:=False; +end; + +class function TTestLessThanNode.OperatorString: String; +begin + Result:='<'; +end; + +procedure TTestLessThanNode.TearDown; +begin + FreeAndNil(FN); + inherited TearDown; +end; + +procedure TTestLessThanNode.TestCreateIntegerEqual; +begin + FN:=NodeClass.Create(CreateIntNode(1),CreateIntNode(1)); + AssertNodeOk(FN); + AssertEquals('Boolean result',rtBoolean,FN.NodeType); + TestNode(FN,AllowEqual); +end; + +procedure TTestLessThanNode.TestCreateIntegerSmaller; +begin + FN:=NodeClass.Create(CreateIntNode(1),CreateIntNode(2)); + AssertNodeOk(FN); + AssertEquals('Boolean result',rtBoolean,FN.NodeType); + TestNode(FN,Not Larger); +end; + +procedure TTestLessThanNode.TestCreateIntegerLarger; +begin + FN:=NodeClass.Create(CreateIntNode(2),CreateIntNode(1)); + AssertNodeOk(FN); + AssertEquals('Boolean result',rtBoolean,FN.NodeType); + TestNode(FN,Larger); +end; + +procedure TTestLessThanNode.TestCreateFloatEqual; +begin + FN:=NodeClass.Create(CreateFloatNode(1.23),CreateFloatNode(1.23)); + AssertNodeOk(FN); + AssertEquals('Boolean result',rtBoolean,FN.NodeType); + TestNode(FN,AllowEqual); +end; + +procedure TTestLessThanNode.TestCreateFloatSmaller; +begin + FN:=NodeClass.Create(CreateFloatNode(1.23),CreateFloatNode(4.56)); + AssertNodeOk(FN); + AssertEquals('Boolean result',rtBoolean,FN.NodeType); + TestNode(FN,Not Larger); +end; + +procedure TTestLessThanNode.TestCreateFloatLarger; +begin + FN:=NodeClass.Create(CreateFloatNode(4.56),CreateFloatNode(1.23)); + AssertNodeOk(FN); + AssertEquals('Boolean result',rtBoolean,FN.NodeType); + TestNode(FN,Larger); +end; + +procedure TTestLessThanNode.TestCreateDateTimeEqual; + +Var + D : TDateTime; + +begin + D:=Now; + FN:=NodeClass.Create(CreateDateTimeNode(D),CreateDateTimeNode(D)); + AssertNodeOk(FN); + AssertEquals('Boolean result',rtBoolean,FN.NodeType); + TestNode(FN,AllowEqual); +end; + +procedure TTestLessThanNode.TestCreateDateTimeSmaller; + +Var + D : TDateTime; + +begin + D:=Now; + FN:=NodeClass.Create(CreateDateTimeNode(D),CreateDateTimeNode(D+1)); + AssertNodeOk(FN); + AssertEquals('Boolean result',rtBoolean,FN.NodeType); + TestNode(FN,Not larger); +end; + +procedure TTestLessThanNode.TestCreateDateTimeLarger; + +Var + D : TDateTime; + +begin + D:=Now; + FN:=NodeClass.Create(CreateDateTimeNode(D),CreateDateTimeNode(D-1)); + AssertNodeOk(FN); + AssertEquals('Boolean result',rtBoolean,FN.NodeType); + TestNode(FN,larger); +end; + +procedure TTestLessThanNode.TestCreateStringEqual; +begin + FN:=NodeClass.Create(CreateStringNode('now'),CreateStringNode('now')); + AssertNodeOk(FN); + AssertEquals('Boolean result',rtBoolean,FN.NodeType); + TestNode(FN,AllowEqual); +end; + +procedure TTestLessThanNode.TestCreateStringSmaller; +begin + FN:=NodeClass.Create(CreateStringNode('now'),CreateStringNode('then')); + AssertNodeOk(FN); + AssertEquals('Boolean result',rtBoolean,FN.NodeType); + TestNode(FN,Not Larger); +end; + +procedure TTestLessThanNode.TestCreateStringLarger; +begin + FN:=NodeClass.Create(CreateStringNode('then'),CreateStringNode('now')); + AssertNodeOk(FN); + AssertEquals('Boolean result',rtBoolean,FN.NodeType); + TestNode(FN,Larger); +end; + +procedure TTestLessThanNode.TestWrongTypes1; +begin + FN:=NodeClass.Create(CreateIntNode(3),CreateStringNode('1.23')); + AssertNodeNotOk('Wrong Types',FN); +end; + +procedure TTestLessThanNode.TestWrongTypes2; +begin + FN:=NodeClass.Create(CreateDateTimeNode(3),CreateStringNode('1.23')); + AssertNodeNotOk('Wrong Types',FN); +end; + +procedure TTestLessThanNode.TestWrongTypes3; +begin + FN:=NodeClass.Create(CreateFloatNode(1.3),CreateStringNode('1.23')); + AssertNodeNotOk('Wrong Types',FN); +end; + +procedure TTestLessThanNode.TestWrongTypes4; +begin + FN:=NodeClass.Create(CreateBoolNode(False),CreateStringNode('1.23')); + AssertNodeNotOk('Wrong Types',FN); +end; + +procedure TTestLessThanNode.TestWrongTypes5; +begin + FN:=NodeClass.Create(CreateFloatNode(1.23),CreateIntNode(1)); + AssertNodeNotOk('Wrong Types',FN); +end; + +procedure TTestLessThanNode.TestNoBoolean1; +begin + FN:=NodeClass.Create(CreateBoolNode(False),CreateIntNode(1)); + AssertNodeNotOk('Wrong Types',FN); +end; + +procedure TTestLessThanNode.TestNoBoolean2; +begin + FN:=NodeClass.Create(CreateIntNode(1),CreateBoolNode(False)); + AssertNodeNotOk('Wrong Types',FN); +end; + +procedure TTestLessThanNode.TestNoBoolean3; +begin + FN:=NodeClass.Create(CreateBoolNode(False),CreateBoolNode(False)); + AssertNodeNotOk('Wrong Types',FN); +end; + +procedure TTestLessThanNode.TestAsString; +begin + FN:=NodeClass.Create(CreateIntNode(1),CreateIntNode(2)); + AssertEquals('Asstring works ok','1 '+OPeratorString+' 2',FN.AsString); +end; + +{ TTestLessThanEqualNode } + +class function TTestLessThanEqualNode.NodeClass: TFPBooleanResultOperationClass; +begin + Result:=TFPLessThanEqualOperation; +end; + +class function TTestLessThanEqualNode.AllowEqual: Boolean; +begin + Result:=True; +end; + +class function TTestLessThanEqualNode.OperatorString: String; +begin + Result:='<='; +end; + +{ TTestLargerThanNode } + +class function TTestLargerThanNode.NodeClass: TFPBooleanResultOperationClass; +begin + Result:=TFPGreaterThanOperation; +end; + +class function TTestLargerThanNode.Larger: Boolean; +begin + Result:=True; +end; + +class function TTestLargerThanNode.OperatorString: String; +begin + Result:='>'; +end; + +{ TTestLargerThanEqualNode } + +class function TTestLargerThanEqualNode.NodeClass: TFPBooleanResultOperationClass; +begin + Result:=TFPGreaterThanEqualOperation; +end; + +class function TTestLargerThanEqualNode.AllowEqual: Boolean; +begin + Result:=True; +end; + +class function TTestLargerThanEqualNode.OperatorString: String; +begin + Result:='>='; +end; + +{ TTestAddNode } + +procedure TTestAddNode.TearDown; +begin + FreeAndNil(FN); + inherited TearDown; +end; + +procedure TTestAddNode.TestCreateInteger; +begin + FN:=TFPAddOperation.Create(CreateIntNode(1),CreateIntNode(2)); + AssertEquals('Add has correct type',rtInteger,FN.NodeType); + AssertEquals('Add has correct result',3,FN.NodeValue.ResInteger); +end; + +procedure TTestAddNode.TestCreateFloat; +begin + FN:=TFPAddOperation.Create(CreateFloatNode(1.23),CreateFloatNode(4.56)); + AssertEquals('Add has correct type',rtFloat,FN.NodeType); + AssertEquals('Add has correct result',5.79,FN.NodeValue.ResFloat); +end; + +procedure TTestAddNode.TestCreateDateTime; + +Var + D,T : TDateTime; + +begin + D:=Date; + T:=Time; + FN:=TFPAddOperation.Create(CreateDateTimeNode(D),CreateDateTimeNode(T)); + AssertEquals('Add has correct type',rtDateTime,FN.NodeType); + AssertEquals('Add has correct result',D+T,FN.NodeValue.ResDateTime); +end; + +procedure TTestAddNode.TestCreateString; +begin + FN:=TFPAddOperation.Create(CreateStringNode('alo'),CreateStringNode('ha')); + AssertEquals('Add has correct type',rtString,FN.NodeType); + AssertEquals('Add has correct result','aloha',FN.NodeValue.ResString); +end; + +procedure TTestAddNode.TestCreateBoolean; +begin + FN:=TFPAddOperation.Create(CreateBoolNode(True),CreateBoolNode(False)); + AssertNodeNotOK('No boolean addition',FN); +end; + +procedure TTestAddNode.TestDestroy; +begin + FN:=TFPAddOperation.Create(TMyDestroyNode.CreateTest(Self),TMyDestroyNode.CreateTest(Self)); + FreeAndNil(FN); + AssertEquals('Destroy called for left and right nodes',2,self.FDestroyCalled) +end; + +procedure TTestAddNode.TestAsString; +begin + FN:=TFPAddOperation.Create(CreateIntNode(1),CreateIntNode(2)); + AssertEquals('Asstring works ok','1 + 2',FN.AsString); +end; + +{ TTestSubtractNode } + +procedure TTestSubtractNode.TearDown; +begin + FreeAndNil(FN); + inherited TearDown; +end; + +procedure TTestSubtractNode.TestCreateInteger; +begin + FN:=TFPSubtractOperation.Create(CreateIntNode(4),CreateIntNode(1)); + AssertEquals('Subtract has correct type',rtInteger,FN.NodeType); + AssertEquals('Subtract has correct result',3,FN.NodeValue.ResInteger); +end; + +procedure TTestSubtractNode.TestCreateFloat; +begin + FN:=TFPSubtractOperation.Create(CreateFloatNode(4.56),CreateFloatNode(1.23)); + AssertEquals('Subtract has correct type',rtFloat,FN.NodeType); + AssertEquals('Subtract has correct result',3.33,FN.NodeValue.ResFloat); +end; + +procedure TTestSubtractNode.TestCreateDateTime; + +Var + D,T : TDateTime; + +begin + D:=Date; + T:=Time; + FN:=TFPSubtractOperation.Create(CreateDateTimeNode(D+T),CreateDateTimeNode(T)); + AssertEquals('Subtract has correct type',rtDateTime,FN.NodeType); + AssertEquals('Subtract has correct result',D,FN.NodeValue.ResDateTime); +end; + +procedure TTestSubtractNode.TestCreateString; +begin + FN:=TFPSubtractOperation.Create(CreateStringNode('alo'),CreateStringNode('ha')); + AssertNodeNotOK('No string Subtract',FN); +end; + +procedure TTestSubtractNode.TestCreateBoolean; +begin + FN:=TFPSubtractOperation.Create(CreateBoolNode(True),CreateBoolNode(False)); + AssertNodeNotOK('No boolean Subtract',FN); +end; + +procedure TTestSubtractNode.TestDestroy; +begin + FN:=TFPSubtractOperation.Create(TMyDestroyNode.CreateTest(Self),TMyDestroyNode.CreateTest(Self)); + FreeAndNil(FN); + AssertEquals('Destroy called for left and right nodes',2,self.FDestroyCalled) +end; + +procedure TTestSubtractNode.TestAsString; +begin + FN:=TFPSubtractOperation.Create(CreateIntNode(1),CreateIntNode(2)); + AssertEquals('Asstring works ok','1 - 2',FN.AsString); +end; + +{ TTestMultiplyNode } + +procedure TTestMultiplyNode.TearDown; +begin + FreeAndNil(FN); + inherited TearDown; +end; + +procedure TTestMultiplyNode.TestCreateInteger; +begin + FN:=TFPMultiplyOperation.Create(CreateIntNode(4),CreateIntNode(2)); + AssertEquals('multiply has correct type',rtInteger,FN.NodeType); + AssertEquals('multiply has correct result',8,FN.NodeValue.ResInteger); +end; + +procedure TTestMultiplyNode.TestCreateFloat; +begin + FN:=TFPMultiplyOperation.Create(CreateFloatNode(2.0),CreateFloatNode(1.23)); + AssertEquals('multiply has correct type',rtFloat,FN.NodeType); + AssertEquals('multiply has correct result',2.46,FN.NodeValue.ResFloat); +end; + +procedure TTestMultiplyNode.TestCreateDateTime; + +Var + D,T : TDateTime; + +begin + D:=Date; + T:=Time; + FN:=TFPMultiplyOperation.Create(CreateDateTimeNode(D+T),CreateDateTimeNode(T)); + AssertNodeNotOK('No datetime multiply',FN); +end; + +procedure TTestMultiplyNode.TestCreateString; +begin + FN:=TFPMultiplyOperation.Create(CreateStringNode('alo'),CreateStringNode('ha')); + AssertNodeNotOK('No string multiply',FN); +end; + +procedure TTestMultiplyNode.TestCreateBoolean; +begin + FN:=TFPMultiplyOperation.Create(CreateBoolNode(True),CreateBoolNode(False)); + AssertNodeNotOK('No boolean multiply',FN); +end; + +procedure TTestMultiplyNode.TestDestroy; +begin + FN:=TFPMultiplyOperation.Create(TMyDestroyNode.CreateTest(Self),TMyDestroyNode.CreateTest(Self)); + FreeAndNil(FN); + AssertEquals('Destroy called for left and right nodes',2,self.FDestroyCalled) +end; + +procedure TTestMultiplyNode.TestAsString; +begin + FN:=TFPMultiplyOperation.Create(CreateIntNode(1),CreateIntNode(2)); + AssertEquals('Asstring works ok','1 * 2',FN.AsString); +end; + + +{ TTestDivideNode } + +procedure TTestDivideNode.TearDown; +begin + FreeAndNil(FN); + inherited TearDown; +end; + +procedure TTestDivideNode.TestCreateInteger; +begin + FN:=TFPDivideOperation.Create(CreateIntNode(4),CreateIntNode(2)); + AssertEquals('Divide has correct type',rtfloat,FN.NodeType); + AssertEquals('Divide has correct result',2.0,FN.NodeValue.ResFloat); +end; + +procedure TTestDivideNode.TestCreateFloat; +begin + FN:=TFPDivideOperation.Create(CreateFloatNode(9.0),CreateFloatNode(3.0)); + AssertEquals('Divide has correct type',rtFloat,FN.NodeType); + AssertEquals('Divide has correct result',3.0,FN.NodeValue.ResFloat); +end; + +procedure TTestDivideNode.TestCreateDateTime; + +Var + D,T : TDateTime; + +begin + D:=Date; + T:=Time; + FN:=TFPDivideOperation.Create(CreateDateTimeNode(D+T),CreateDateTimeNode(T)); + AssertNodeNotOK('No datetime division',FN); +end; + +procedure TTestDivideNode.TestCreateString; +begin + FN:=TFPDivideOperation.Create(CreateStringNode('alo'),CreateStringNode('ha')); + AssertNodeNotOK('No string division',FN); +end; + +procedure TTestDivideNode.TestCreateBoolean; +begin + FN:=TFPDivideOperation.Create(CreateBoolNode(True),CreateBoolNode(False)); + AssertNodeNotOK('No boolean division',FN); +end; + +procedure TTestDivideNode.TestDestroy; +begin + FN:=TFPDivideOperation.Create(TMyDestroyNode.CreateTest(Self),TMyDestroyNode.CreateTest(Self)); + FreeAndNil(FN); + AssertEquals('Destroy called for left and right nodes',2,self.FDestroyCalled) +end; + +procedure TTestDivideNode.TestAsString; +begin + FN:=TFPDivideOperation.Create(CreateIntNode(1),CreateIntNode(2)); + AssertEquals('Asstring works ok','1 / 2',FN.AsString); +end; + +{ TTestIntToFloatNode } + +procedure TTestIntToFloatNode.TearDown; +begin + FreeAndNil(Fn); + inherited TearDown; +end; + +procedure TTestIntToFloatNode.TestCreateInteger; +begin + FN:=TIntToFloatNode.Create(CreateIntNode(4)); + AssertEquals('Convert has correct type',rtfloat,FN.NodeType); + AssertEquals('Convert has correct result',4.0,FN.NodeValue.ResFloat); +end; + +procedure TTestIntToFloatNode.TestCreateFloat; +begin + FN:=TIntToFloatNode.Create(CreateFloatNode(4.0)); + AssertNodeNotOK('No float allowed',FN); +end; + +procedure TTestIntToFloatNode.TestDestroy; +begin + FN:=TIntToFloatNode.Create(TMyDestroyNode.CreateTest(Self)); + FreeAndNil(FN); + AssertEquals('Destroy called for left and right nodes',1,self.FDestroyCalled) +end; + +procedure TTestIntToFloatNode.TestAsString; +begin + FN:=TIntToFloatNode.Create(CreateIntNode(4)); + AssertEquals('Convert has correct asstring','4',FN.AsString); +end; + +{ TTestIntToDateTimeNode } + +procedure TTestIntToDateTimeNode.TearDown; +begin + FreeAndNil(FN); + inherited TearDown; +end; + +procedure TTestIntToDateTimeNode.TestCreateInteger; +begin + FN:=TIntToDateTimeNode.Create(CreateIntNode(Round(Date))); + AssertEquals('Convert has correct type',rtDateTime,FN.NodeType); + AssertEquals('Convert has correct result',Date,FN.NodeValue.ResDateTime); +end; + +procedure TTestIntToDateTimeNode.TestCreateFloat; +begin + FN:=TIntToDateTimeNode.Create(CreateFloatNode(4.0)); + AssertNodeNotOK('No float allowed',FN); +end; + +procedure TTestIntToDateTimeNode.TestDestroy; +begin + FN:=TIntToDateTimeNode.Create(TMyDestroyNode.CreateTest(Self)); + FreeAndNil(FN); + AssertEquals('Destroy called for left and right nodes',1,self.FDestroyCalled) +end; + +procedure TTestIntToDateTimeNode.TestAsString; +begin + FN:=TIntToDateTimeNode.Create(CreateIntNode(4)); + AssertEquals('Convert has correct asstring','4',FN.AsString); +end; + +{ TTestFloatToDateTimeNode } + +procedure TTestFloatToDateTimeNode.TearDown; +begin + FreeAndNil(FN); + inherited TearDown; +end; + +procedure TTestFloatToDateTimeNode.TestCreateInteger; +begin + FN:=TFloatToDateTimeNode.Create(CreateIntNode(4)); + AssertNodeNotOK('No int allowed',FN); +end; + +procedure TTestFloatToDateTimeNode.TestCreateFloat; + +Var + T : TExprFloat; + +begin + T:=Time; + FN:=TFloatToDateTimeNode.Create(CreateFloatNode(T)); + AssertEquals('Convert has correct type',rtDateTime,FN.NodeType); + AssertEquals('Convert has correct result',T,FN.NodeValue.ResDateTime); +end; + +procedure TTestFloatToDateTimeNode.TestDestroy; +begin + FN:=TFloatToDateTimeNode.Create(TMyDestroyNode.CreateTest(Self)); + FreeAndNil(FN); + AssertEquals('Destroy called for left and right nodes',1,self.FDestroyCalled) +end; + +procedure TTestFloatToDateTimeNode.TestAsString; + +Var + S : String; + +begin + FN:=TFloatToDateTimeNode.Create(CreateFloatNode(1.2)); + Str(TExprFloat(1.2),S); + AssertEquals('Convert has correct asstring',S,FN.AsString); +end; + +{ TMyFPExpressionParser } + +procedure TMyFPExpressionParser.BuildHashList; +begin + CreateHashList; +end; + +{ TTestExpressionParser } + +procedure TTestExpressionParser.SetUp; +begin + inherited SetUp; + FP:=TMyFPExpressionParser.Create(Nil); +end; + +procedure TTestExpressionParser.TearDown; +begin + FreeAndNil(FP); + inherited TearDown; +end; + +procedure TTestExpressionParser.DoParse; + +begin + FP.Expression:=FTestExpr; +end; + +procedure TTestExpressionParser.TestParser(AExpr : string); + +begin + FTestExpr:=AExpr; + AssertException(Format('Wrong expression: "%s"',[AExpr]),EExprParser,@DoParse); +end; + +procedure TTestExpressionParser.AssertLeftRight(N: TFPExprNode; LeftClass, + RightClass: TClass); +begin + AssertNotNull('Binary node not null',N); + If Not N.InheritsFrom(TFPBinaryOperation) then + Fail(N.ClassName+' does not descend from TFPBinaryOperation'); + AssertNotNull('Left node assigned',TFPBinaryOperation(N).Left); + AssertNotNull('Right node assigned',TFPBinaryOperation(N).Right); + AssertEquals('Left node correct class ',LeftClass, TFPBinaryOperation(N).Left.ClassType); + AssertEquals('Right node correct class ',RightClass, TFPBinaryOperation(N).Right.ClassType); +end; + +procedure TTestExpressionParser.AssertOperand(N: TFPExprNode; + OperandClass: TClass); +begin + AssertNotNull('Unary node not null',N); + If Not N.InheritsFrom(TFPUnaryOperator) then + Fail(N.ClassName+' does not descend from TFPUnaryOperator'); + AssertNotNull('Operand assigned',TFPUnaryOperator(N).Operand); + AssertEquals('Operand node correct class ',OperandClass, TFPUnaryOperator(N).Operand.ClassType); +end; + +procedure TTestExpressionParser.AssertResultType(RT: TResultType); +begin + AssertEquals('Result type is '+ResultTypeName(rt),rt,FP.ExprNode); + AssertEquals('Result type is '+ResultTypeName(rt),rt,FP.ResultType); +end; + +procedure TTestExpressionParser.AssertResult(F: TExprFloat); +begin + AssertEquals('Correct float result',F,FP.ExprNode.NodeValue.ResFloat); + AssertEquals('Correct float result',F,FP.Evaluate.ResFloat); +end; + +procedure TTestExpressionParser.AssertResult(I: Int64); +begin + AssertEquals('Correct integer result',I,FP.ExprNode.NodeValue.ResInteger); + AssertEquals('Correct integer result',I,FP.Evaluate.ResInteger); +end; + +procedure TTestExpressionParser.AssertResult(S: String); +begin + AssertEquals('Correct string result',S,FP.ExprNode.NodeValue.ResString); + AssertEquals('Correct string result',S,FP.Evaluate.ResString); +end; + +procedure TTestExpressionParser.AssertResult(B: Boolean); +begin + AssertEquals('Correct boolean result',B,FP.ExprNode.NodeValue.ResBoolean); + AssertEquals('Correct boolean result',B,FP.Evaluate.ResBoolean); +end; + +procedure TTestExpressionParser.AssertDateTimeResult(D: TDateTime); +begin + AssertEquals('Correct datetime result',D,FP.ExprNode.NodeValue.ResDateTime); + AssertEquals('Correct boolean result',D,FP.Evaluate.ResDateTime); +end; +//TTestParserExpressions +procedure TTestParserExpressions.TestCreate; +begin + AssertEquals('Expression is empty','',FP.Expression); + AssertNotNull('Identifiers assigned',FP.Identifiers); + AssertEquals('No identifiers',0,FP.Identifiers.Count); +end; + + +procedure TTestParserExpressions.TestSimpleNodeFloat; +begin + FP.Expression:='123.4'; + AssertNotNull('Have result node',FP.ExprNode); + AssertNodeType('Constant expression',TFPConstExpression, FP.ExprNode); + AssertResultType(rtFloat); + AssertResult(123.4); +end; + +procedure TTestParserExpressions.TestSimpleNodeInteger; +begin + FP.Expression:='1234'; + AssertNotNull('Have result node',FP.ExprNode); + AssertNodeType('Constant expression',TFPConstExpression, FP.ExprNode); + AssertResultType(rtInteger); + AssertResult(1234); +end; + +procedure TTestParserExpressions.TestSimpleNodeBooleanTrue; +begin + FP.Expression:='true'; + AssertNotNull('Have result node',FP.ExprNode); + AssertNodeType('Constant expression',TFPConstExpression, FP.ExprNode); + AssertResultType(rtBoolean); + AssertResult(True); +end; + +procedure TTestParserExpressions.TestSimpleNodeBooleanFalse; +begin + FP.Expression:='False'; + AssertNotNull('Have result node',FP.ExprNode); + AssertNodeType('Constant expression',TFPConstExpression, FP.ExprNode); + AssertResultType(rtBoolean); + AssertResult(False); +end; + +procedure TTestParserExpressions.TestSimpleNodeString; +begin + FP.Expression:='''A string'''; + AssertNotNull('Have result node',FP.ExprNode); + AssertNodeType('Constant expression',TFPConstExpression, FP.ExprNode); + AssertResultType(rtString); + AssertResult('A string'); +end; + +procedure TTestParserExpressions.TestSimpleNegativeInteger; +begin + FP.Expression:='-1234'; + AssertNotNull('Have result node',FP.ExprNode); + AssertNodeType('Constant expression',TFPNegateOperation, FP.ExprNode); + AssertNodeType('Constant expression',TFPConstExpression, TFPNegateOperation(FP.ExprNode).Operand); + AssertResultType(rtInteger); + AssertResult(-1234); +end; + +procedure TTestParserExpressions.TestSimpleNegativeFloat; +begin + FP.Expression:='-1.234'; + AssertNotNull('Have result node',FP.ExprNode); + AssertNodeType('Constant expression',TFPNegateOperation, FP.ExprNode); + AssertNodeType('Constant expression',TFPConstExpression, TFPNegateOperation(FP.ExprNode).Operand); + AssertResultType(rtFloat); + AssertResult(-1.234); +end; + +procedure TTestParserExpressions.TestSimpleAddInteger; +begin + FP.Expression:='4+1'; + AssertNotNull('Have result node',FP.ExprNode); + AssertNodeType('Constant expression',TFPAddOperation, FP.ExprNode); + AssertLeftRight(FP.ExprNode,TFPConstExpression,TFPConstExpression); + AssertResultType(rtInteger); + AssertResult(5); +end; + +procedure TTestParserExpressions.TestSimpleAddFloat; +begin + FP.Expression:='1.2+3.4'; + AssertNotNull('Have result node',FP.ExprNode); + AssertNodeType('Constant expression',TFPAddOperation, FP.ExprNode); + AssertLeftRight(FP.ExprNode,TFPConstExpression,TFPConstExpression); + AssertResultType(rtFloat); + AssertResult(4.6); +end; + +procedure TTestParserExpressions.TestSimpleAddIntegerFloat; +begin + FP.Expression:='1+3.4'; + AssertNotNull('Have result node',FP.ExprNode); + AssertNodeType('Constant expression',TFPAddOperation, FP.ExprNode); + AssertLeftRight(FP.ExprNode,TIntToFLoatNode,TFPConstExpression); + AssertResultType(rtFloat); + AssertResult(4.4); +end; + +procedure TTestParserExpressions.TestSimpleAddFloatInteger; +begin + FP.Expression:='3.4 + 1'; + AssertNotNull('Have result node',FP.ExprNode); + AssertNodeType('Constant expression',TFPAddOperation, FP.ExprNode); + AssertLeftRight(FP.ExprNode,TFPConstExpression,TIntToFLoatNode); + AssertResultType(rtFloat); + AssertResult(4.4); +end; + +procedure TTestParserExpressions.TestSimpleAddString; +begin + FP.Expression:='''alo''+''ha'''; + AssertNotNull('Have result node',FP.ExprNode); + AssertNodeType('Constant expression',TFPAddOperation, FP.ExprNode); + AssertLeftRight(FP.ExprNode,TFPConstExpression,TFPConstExpression); + AssertResultType(rtString); + AssertResult('aloha'); +end; + +procedure TTestParserExpressions.TestSimpleSubtractInteger; +begin + FP.Expression:='4-1'; + AssertNotNull('Have result node',FP.ExprNode); + AssertNodeType('Constant expression',TFPSubtractOperation, FP.ExprNode); + AssertLeftRight(FP.ExprNode,TFPConstExpression,TFPConstExpression); + AssertResultType(rtInteger); + AssertResult(3); +end; + +procedure TTestParserExpressions.TestSimpleSubtractFloat; +begin + FP.Expression:='3.4-1.2'; + AssertNotNull('Have result node',FP.ExprNode); + AssertNodeType('Constant expression',TFPSubtractOperation, FP.ExprNode); + AssertLeftRight(FP.ExprNode,TFPConstExpression,TFPConstExpression); + AssertResultType(rtFloat); + AssertResult(2.2); +end; + +procedure TTestParserExpressions.TestSimpleSubtractIntegerFloat; +begin + FP.Expression:='3-1.2'; + AssertNotNull('Have result node',FP.ExprNode); + AssertNodeType('Constant expression',TFPSubtractOperation, FP.ExprNode); + AssertLeftRight(FP.ExprNode,TIntToFloatNode,TFPConstExpression); + AssertResultType(rtFloat); + AssertResult(1.8); +end; + +procedure TTestParserExpressions.TestSimpleSubtractFloatInteger; +begin + FP.Expression:='3.3-2'; + AssertNotNull('Have result node',FP.ExprNode); + AssertNodeType('Constant expression',TFPSubtractOperation, FP.ExprNode); + AssertLeftRight(FP.ExprNode,TFPConstExpression,TIntToFloatNode); + AssertResultType(rtFloat); + AssertResult(1.3); +end; + +procedure TTestParserExpressions.TestSimpleMultiplyInteger; +begin + FP.Expression:='4*2'; + AssertNotNull('Have result node',FP.ExprNode); + AssertNodeType('Constant expression',TFPMultiplyOperation, FP.ExprNode); + AssertLeftRight(FP.ExprNode,TFPConstExpression,TFPConstExpression); + AssertResultType(rtInteger); + AssertResult(8); +end; + +procedure TTestParserExpressions.TestSimpleMultiplyFloat; +begin + FP.Expression:='3.4*1.5'; + AssertNotNull('Have result node',FP.ExprNode); + AssertNodeType('Constant expression',TFPMultiplyOperation, FP.ExprNode); + AssertLeftRight(FP.ExprNode,TFPConstExpression,TFPConstExpression); + AssertResultType(rtFloat); + AssertResult(5.1); +end; + +procedure TTestParserExpressions.TestSimpleDivideInteger; +begin + FP.Expression:='4/2'; + AssertNotNull('Have result node',FP.ExprNode); + AssertNodeType('Constant expression',TFPDivideOperation, FP.ExprNode); + AssertLeftRight(FP.ExprNode,TFPConstExpression,TFPConstExpression); + AssertResultType(rtFloat); + AssertResult(2.0); +end; + +procedure TTestParserExpressions.TestSimpleDivideFloat; +begin + FP.Expression:='5.1/1.5'; + AssertNotNull('Have result node',FP.ExprNode); + AssertNodeType('Constant expression',TFPDivideOperation, FP.ExprNode); + AssertLeftRight(FP.ExprNode,TFPConstExpression,TFPConstExpression); + AssertResultType(rtFloat); + AssertResult(3.4); +end; + +procedure TTestParserExpressions.TestSimpleBooleanAnd; +begin + FP.Expression:='true and true'; + AssertNotNull('Have result node',FP.ExprNode); + AssertNodeType('Constant expression',TFPBinaryAndOperation, FP.ExprNode); + AssertLeftRight(FP.ExprNode,TFPConstExpression,TFPConstExpression); + AssertResultType(rtBoolean); + AssertResult(True); +end; + +procedure TTestParserExpressions.TestSimpleIntegerAnd; +begin + FP.Expression:='3 and 1'; + AssertNotNull('Have result node',FP.ExprNode); + AssertNodeType('Constant expression',TFPBinaryAndOperation, FP.ExprNode); + AssertLeftRight(FP.ExprNode,TFPConstExpression,TFPConstExpression); + AssertResultType(rtInteger); + AssertResult(1); +end; + +procedure TTestParserExpressions.TestSimpleBooleanOr; +begin + FP.Expression:='false or true'; + AssertNotNull('Have result node',FP.ExprNode); + AssertNodeType('Constant expression',TFPBinaryOrOperation, FP.ExprNode); + AssertLeftRight(FP.ExprNode,TFPConstExpression,TFPConstExpression); + AssertResultType(rtBoolean); + AssertResult(True); +end; + +procedure TTestParserExpressions.TestSimpleIntegerOr; +begin + FP.Expression:='2 or 1'; + AssertNotNull('Have result node',FP.ExprNode); + AssertNodeType('Constant expression',TFPBinaryOrOperation, FP.ExprNode); + AssertLeftRight(FP.ExprNode,TFPConstExpression,TFPConstExpression); + AssertResultType(rtInteger); + AssertResult(3); +end; + +procedure TTestParserExpressions.TestSimpleBooleanNot; +begin + FP.Expression:='not false'; + AssertNotNull('Have result node',FP.ExprNode); + AssertNodeType('Not node',TFPNotNode, FP.ExprNode); + AssertOperand(FP.ExprNode,TFPConstExpression); + AssertResultType(rtBoolean); + AssertResult(true); +end; + +procedure TTestParserExpressions.TestSimpleIntegerNot; +begin + FP.Expression:='Not 3'; + AssertNotNull('Have result node',FP.ExprNode); + AssertNodeType('Not node',TFPNotNode, FP.ExprNode); + AssertOperand(FP.ExprNode,TFPConstExpression); + AssertResultType(rtInteger); + AssertResult(Not Int64(3)); +end; + +procedure TTestParserExpressions.TestSimpleAddSeries; +begin + FP.Expression:='1 + 2 + 3'; + AssertNotNull('Have result node',FP.ExprNode); + AssertNodeType('Constant expression',TFPAddOperation, FP.ExprNode); + AssertLeftRight(FP.ExprNode,TFPAddOperation,TFPConstExpression); + AssertResultType(rtInteger); + AssertResult(6); +end; + +procedure TTestParserExpressions.TestSimpleMultiplySeries; +begin + FP.Expression:='2 * 3 * 4'; + AssertNotNull('Have result node',FP.ExprNode); + AssertNodeType('Constant expression',TFPMultiplyOperation, FP.ExprNode); + AssertLeftRight(FP.ExprNode,TFPMultiplyOperation,TFPConstExpression); + AssertResultType(rtInteger); + AssertResult(24); +end; + +procedure TTestParserExpressions.TestSimpleAddMultiplySeries; +begin + FP.Expression:='2 * 3 + 4'; + AssertNotNull('Have result node',FP.ExprNode); + AssertNodeType('Constant expression',TFPAddOperation, FP.ExprNode); + AssertLeftRight(FP.ExprNode,TFPMultiplyOperation,TFPConstExpression); + AssertResultType(rtInteger); + AssertResult(10); +end; + +procedure TTestParserExpressions.TestSimpleAddAndSeries; +begin + // 2 and (3+4) + FP.Expression:='2 and 3 + 4'; + AssertNotNull('Have result node',FP.ExprNode); + AssertNodeType('Constant expression',TFPBinaryAndOperation, FP.ExprNode); + AssertLeftRight(FP.ExprNode,TFPConstExpression,TFPAddOperation); + AssertResultType(rtInteger); + AssertResult(2); +end; + +procedure TTestParserExpressions.TestSimpleAddOrSeries; +begin + // 2 or (3+4) + FP.Expression:='2 or 3 + 4'; + AssertNotNull('Have result node',FP.ExprNode); + AssertNodeType('Constant expression',TFPBinaryOrOperation, FP.ExprNode); + AssertLeftRight(FP.ExprNode,TFPConstExpression,TFPAddOperation); + AssertResultType(rtInteger); + AssertResult(7); +end; + +procedure TTestParserExpressions.TestSimpleOrNotSeries; +begin + FP.Expression:='Not 1 or 3'; + AssertNotNull('Have result node',FP.ExprNode); + AssertNodeType('Constant expression',TFPBinaryOrOperation, FP.ExprNode); + AssertLeftRight(FP.ExprNode,TFPNotNode,TFPConstExpression); + AssertResultType(rtInteger); + AssertResult((Not Int64(1)) or Int64(3)); +end; + +procedure TTestParserExpressions.TestSimpleAndNotSeries; +begin + FP.Expression:='Not False and False'; + AssertNotNull('Have result node',FP.ExprNode); + AssertNodeType('Constant expression',TFPBinaryAndOperation, FP.ExprNode); + AssertLeftRight(FP.ExprNode,TFPNotNode,TFPConstExpression); + AssertResultType(rtBoolean); + AssertResult(False); +end; + +procedure TTestParserExpressions.TestDoubleAddMultiplySeries; +begin + FP.Expression:='2 * 3 + 4 * 5'; + AssertNotNull('Have result node',FP.ExprNode); + AssertNodeType('Constant expression',TFPAddOperation, FP.ExprNode); + AssertLeftRight(FP.ExprNode,TFPMultiplyOperation,TFPMultiplyOperation); + AssertResultType(rtInteger); + AssertResult(26); +end; + +procedure TTestParserExpressions.TestDoubleSubtractMultiplySeries; +begin + FP.Expression:='4 * 5 - 2 * 3'; + AssertNotNull('Have result node',FP.ExprNode); + AssertNodeType('Constant expression',TFPSubtractOperation, FP.ExprNode); + AssertLeftRight(FP.ExprNode,TFPMultiplyOperation,TFPMultiplyOperation); + AssertResultType(rtInteger); + AssertResult(14); +end; + +procedure TTestParserExpressions.TestSimpleIfInteger; +begin + FP.Expression:='If(True,1,2)'; + AssertNotNull('Have result node',FP.ExprNode); + AssertNodeType('If operation',TIfOperation, FP.ExprNode); + AssertLeftRight(FP.ExprNode,TFPConstExpression,TFPConstExpression); + AssertResultType(rtInteger); + AssertResult(1); +end; + +procedure TTestParserExpressions.TestSimpleIfString; +begin + FP.Expression:='If(True,''a'',''b'')'; + AssertNotNull('Have result node',FP.ExprNode); + AssertNodeType('If operation',TIfOperation, FP.ExprNode); + AssertLeftRight(FP.ExprNode,TFPConstExpression,TFPConstExpression); + AssertResultType(rtString); + AssertResult('a'); +end; + +procedure TTestParserExpressions.TestSimpleIfFloat; +begin + FP.Expression:='If(True,1.2,3.4)'; + AssertNotNull('Have result node',FP.ExprNode); + AssertNodeType('If operation',TIfOperation, FP.ExprNode); + AssertLeftRight(FP.ExprNode,TFPConstExpression,TFPConstExpression); + AssertResultType(rtFloat); + AssertResult(1.2); +end; + +procedure TTestParserExpressions.TestSimpleIfBoolean; +begin + FP.Expression:='If(True,False,True)'; + AssertNotNull('Have result node',FP.ExprNode); + AssertNodeType('If operation',TIfOperation, FP.ExprNode); + AssertLeftRight(FP.ExprNode,TFPConstExpression,TFPConstExpression); + AssertResultType(rtBoolean); + AssertResult(False); +end; + +procedure TTestParserExpressions.TestSimpleIfDateTime; +begin + FP.Identifiers.AddDateTimeVariable('a',Date); + FP.Identifiers.AddDateTimeVariable('b',Date-1); + FP.Expression:='If(True,a,b)'; + AssertNotNull('Have result node',FP.ExprNode); + AssertNodeType('If operation',TIfOperation, FP.ExprNode); + AssertLeftRight(FP.ExprNode,TFPExprVariable,TFPExprVariable); + AssertResultType(rtDateTime); + AssertResult(Date); +end; + +procedure TTestParserExpressions.TestSimpleIfOperation; +begin + FP.Expression:='If(True,''a'',''b'')+''c'''; + AssertNotNull('Have result node',FP.ExprNode); + AssertResultType(rtString); + AssertResult('ac'); +end; + +procedure TTestParserExpressions.TestSimpleBrackets; +begin + FP.Expression:='(4 + 2)'; + AssertNotNull('Have result node',FP.ExprNode); + AssertNodeType('Constant expression',TFPAddOperation, FP.ExprNode); + AssertLeftRight(FP.ExprNode,TFPConstExpression,TFPConstExpression); + AssertResultType(rtInteger); + AssertResult(6); +end; + +procedure TTestParserExpressions.TestSimpleBrackets2; +begin + FP.Expression:='(4 * 2)'; + AssertNotNull('Have result node',FP.ExprNode); + AssertNodeType('Constant expression',TFPMultiplyOperation, FP.ExprNode); + AssertLeftRight(FP.ExprNode,TFPConstExpression,TFPConstExpression); + AssertResultType(rtInteger); + AssertResult(8); +end; + +procedure TTestParserExpressions.TestSimpleBracketsLeft; +begin + FP.Expression:='(4 + 2) * 3'; + AssertNotNull('Have result node',FP.ExprNode); + AssertNodeType('Constant expression',TFPMultiplyOperation, FP.ExprNode); + AssertLeftRight(FP.ExprNode,TFPAddOperation,TFPConstExpression); + AssertResultType(rtInteger); + AssertResult(18); +end; + +procedure TTestParserExpressions.TestSimpleBracketsRight; +begin + FP.Expression:='3 * (4 + 2)'; + AssertNotNull('Have result node',FP.ExprNode); + AssertNodeType('Constant expression',TFPMultiplyOperation, FP.ExprNode); + AssertLeftRight(FP.ExprNode,TFPConstExpression,TFPAddOperation); + AssertResultType(rtInteger); + AssertResult(18); +end; + +procedure TTestParserExpressions.TestSimpleBracketsDouble; +begin + FP.Expression:='(3 + 4) * (4 + 2)'; + AssertNotNull('Have result node',FP.ExprNode); + AssertNodeType('Constant expression',TFPMultiplyOperation, FP.ExprNode); + AssertLeftRight(FP.ExprNode,TFPAddOperation,TFPAddOperation); + AssertResultType(rtInteger); + AssertResult(42); +end; + +//TTestParserBooleanOperations + +procedure TTestParserBooleanOperations.TestEqualInteger; +begin + FP.Expression:='1 = 2'; + AssertNotNull('Have result node',FP.ExprNode); + AssertNodeType('Constant expression',TFPEqualOperation, FP.ExprNode); + AssertLeftRight(FP.ExprNode,TFPConstExpression,TFPConstExpression); + AssertResultType(rtBoolean); + AssertResult(False); +end; + +procedure TTestParserBooleanOperations.TestUnEqualInteger; +begin + FP.Expression:='1 <> 2'; + AssertNotNull('Have result node',FP.ExprNode); + AssertNodeType('Constant expression',TFPUnEqualOperation, FP.ExprNode); + AssertLeftRight(FP.ExprNode,TFPConstExpression,TFPConstExpression); + AssertResultType(rtBoolean); + AssertResult(True); +end; + +procedure TTestParserBooleanOperations.TestEqualFloat; +begin + FP.Expression:='1.2 = 2.3'; + AssertNotNull('Have result node',FP.ExprNode); + AssertNodeType('Constant expression',TFPEqualOperation, FP.ExprNode); + AssertLeftRight(FP.ExprNode,TFPConstExpression,TFPConstExpression); + AssertResultType(rtBoolean); + AssertResult(False); +end; + +procedure TTestParserBooleanOperations.TestEqualFloat2; +begin + FP.Expression:='1.2 = 1.2'; + AssertNotNull('Have result node',FP.ExprNode); + AssertNodeType('Constant expression',TFPEqualOperation, FP.ExprNode); + AssertLeftRight(FP.ExprNode,TFPConstExpression,TFPConstExpression); + AssertResultType(rtBoolean); + AssertResult(True); +end; + +procedure TTestParserBooleanOperations.TestUnEqualFloat; +begin + FP.Expression:='1.2 <> 2.3'; + AssertNotNull('Have result node',FP.ExprNode); + AssertNodeType('Constant expression',TFPUnEqualOperation, FP.ExprNode); + AssertLeftRight(FP.ExprNode,TFPConstExpression,TFPConstExpression); + AssertResultType(rtBoolean); + AssertResult(True); +end; +procedure TTestParserBooleanOperations.TestEqualString; +begin + FP.Expression:='''1.2'' = ''2.3'''; + AssertNotNull('Have result node',FP.ExprNode); + AssertNodeType('Constant expression',TFPEqualOperation, FP.ExprNode); + AssertLeftRight(FP.ExprNode,TFPConstExpression,TFPConstExpression); + AssertResultType(rtBoolean); + AssertResult(False); +end; + +procedure TTestParserBooleanOperations.TestEqualString2; +begin + FP.Expression:='''1.2'' = ''1.2'''; + AssertNotNull('Have result node',FP.ExprNode); + AssertNodeType('Constant expression',TFPEqualOperation, FP.ExprNode); + AssertLeftRight(FP.ExprNode,TFPConstExpression,TFPConstExpression); + AssertResultType(rtBoolean); + AssertResult(True); +end; + +procedure TTestParserBooleanOperations.TestUnEqualString; +begin + FP.Expression:='''1.2'' <> ''2.3'''; + AssertNotNull('Have result node',FP.ExprNode); + AssertNodeType('Constant expression',TFPUnEqualOperation, FP.ExprNode); + AssertLeftRight(FP.ExprNode,TFPConstExpression,TFPConstExpression); + AssertResultType(rtBoolean); + AssertResult(True); +end; + +procedure TTestParserBooleanOperations.TestUnEqualString2; +begin + FP.Expression:='''aa'' <> ''AA'''; + AssertNotNull('Have result node',FP.ExprNode); + AssertNodeType('Constant expression',TFPUnEqualOperation, FP.ExprNode); + AssertLeftRight(FP.ExprNode,TFPConstExpression,TFPConstExpression); + AssertResultType(rtBoolean); + AssertResult(True); +end; + +procedure TTestParserBooleanOperations.TestEqualBoolean; +begin + FP.Expression:='False = True'; + AssertNotNull('Have result node',FP.ExprNode); + AssertNodeType('Constant expression',TFPEqualOperation, FP.ExprNode); + AssertLeftRight(FP.ExprNode,TFPConstExpression,TFPConstExpression); + AssertResultType(rtBoolean); + AssertResult(False); +end; + +procedure TTestParserBooleanOperations.TestUnEqualBoolean; +begin + FP.Expression:='False <> True'; + AssertNotNull('Have result node',FP.ExprNode); + AssertNodeType('Constant expression',TFPUnEqualOperation, FP.ExprNode); + AssertLeftRight(FP.ExprNode,TFPConstExpression,TFPConstExpression); + AssertResultType(rtBoolean); + AssertResult(True); +end; + +procedure TTestParserBooleanOperations.TestLessThanInteger; +begin + FP.Expression:='1 < 2'; + AssertNotNull('Have result node',FP.ExprNode); + AssertNodeType('Constant expression',TFPLessThanOperation, FP.ExprNode); + AssertLeftRight(FP.ExprNode,TFPConstExpression,TFPConstExpression); + AssertResultType(rtBoolean); + AssertResult(True); +end; + +procedure TTestParserBooleanOperations.TestLessThanInteger2; +begin + FP.Expression:='2 < 2'; + AssertNotNull('Have result node',FP.ExprNode); + AssertNodeType('Constant expression',TFPLessThanOperation, FP.ExprNode); + AssertLeftRight(FP.ExprNode,TFPConstExpression,TFPConstExpression); + AssertResultType(rtBoolean); + AssertResult(False); +end; + +procedure TTestParserBooleanOperations.TestLessThanEqualInteger; +begin + FP.Expression:='3 <= 2'; + AssertNotNull('Have result node',FP.ExprNode); + AssertNodeType('Constant expression',TFPLessThanEqualOperation, FP.ExprNode); + AssertLeftRight(FP.ExprNode,TFPConstExpression,TFPConstExpression); + AssertResultType(rtBoolean); + AssertResult(False); +end; + +procedure TTestParserBooleanOperations.TestLessThanEqualInteger2; +begin + FP.Expression:='2 <= 2'; + AssertNotNull('Have result node',FP.ExprNode); + AssertNodeType('Constant expression',TFPLessThanEqualOperation, FP.ExprNode); + AssertLeftRight(FP.ExprNode,TFPConstExpression,TFPConstExpression); + AssertResultType(rtBoolean); + AssertResult(True); +end; + +procedure TTestParserBooleanOperations.TestLessThanFloat; +begin + FP.Expression:='1.2 < 2.3'; + AssertNotNull('Have result node',FP.ExprNode); + AssertNodeType('Constant expression',TFPLessThanOperation, FP.ExprNode); + AssertLeftRight(FP.ExprNode,TFPConstExpression,TFPConstExpression); + AssertResultType(rtBoolean); + AssertResult(True); +end; + +procedure TTestParserBooleanOperations.TestLessThanFloat2; +begin + FP.Expression:='2.2 < 2.2'; + AssertNotNull('Have result node',FP.ExprNode); + AssertNodeType('Constant expression',TFPLessThanOperation, FP.ExprNode); + AssertLeftRight(FP.ExprNode,TFPConstExpression,TFPConstExpression); + AssertResultType(rtBoolean); + AssertResult(False); +end; + +procedure TTestParserBooleanOperations.TestLessThanEqualFloat; +begin + FP.Expression:='3.1 <= 2.1'; + AssertNotNull('Have result node',FP.ExprNode); + AssertNodeType('Constant expression',TFPLessThanEqualOperation, FP.ExprNode); + AssertLeftRight(FP.ExprNode,TFPConstExpression,TFPConstExpression); + AssertResultType(rtBoolean); + AssertResult(False); +end; + +procedure TTestParserBooleanOperations.TestLessThanEqualFloat2; +begin + FP.Expression:='2.1 <= 2.1'; + AssertNotNull('Have result node',FP.ExprNode); + AssertNodeType('Constant expression',TFPLessThanEqualOperation, FP.ExprNode); + AssertLeftRight(FP.ExprNode,TFPConstExpression,TFPConstExpression); + AssertResultType(rtBoolean); + AssertResult(True); +end; + +procedure TTestParserBooleanOperations.TestLessThanString; +begin + FP.Expression:='''1'' < ''2'''; + AssertNotNull('Have result node',FP.ExprNode); + AssertNodeType('Constant expression',TFPLessThanOperation, FP.ExprNode); + AssertLeftRight(FP.ExprNode,TFPConstExpression,TFPConstExpression); + AssertResultType(rtBoolean); + AssertResult(True); +end; + +procedure TTestParserBooleanOperations.TestLessThanString2; +begin + FP.Expression:='''2'' < ''2'''; + AssertNotNull('Have result node',FP.ExprNode); + AssertNodeType('Constant expression',TFPLessThanOperation, FP.ExprNode); + AssertLeftRight(FP.ExprNode,TFPConstExpression,TFPConstExpression); + AssertResultType(rtBoolean); + AssertResult(False); +end; + +procedure TTestParserBooleanOperations.TestLessThanEqualString; +begin + FP.Expression:='''3'' <= ''2'''; + AssertNotNull('Have result node',FP.ExprNode); + AssertNodeType('Constant expression',TFPLessThanEqualOperation, FP.ExprNode); + AssertLeftRight(FP.ExprNode,TFPConstExpression,TFPConstExpression); + AssertResultType(rtBoolean); + AssertResult(False); +end; + +procedure TTestParserBooleanOperations.TestLessThanEqualString2; +begin + FP.Expression:='''2'' <= ''2'''; + AssertNotNull('Have result node',FP.ExprNode); + AssertNodeType('Constant expression',TFPLessThanEqualOperation, FP.ExprNode); + AssertLeftRight(FP.ExprNode,TFPConstExpression,TFPConstExpression); + AssertResultType(rtBoolean); + AssertResult(True); +end; + + +procedure TTestParserBooleanOperations.TestGreaterThanInteger; +begin + FP.Expression:='1 > 2'; + AssertNotNull('Have result node',FP.ExprNode); + AssertNodeType('Constant expression',TFPGreaterThanOperation, FP.ExprNode); + AssertLeftRight(FP.ExprNode,TFPConstExpression,TFPConstExpression); + AssertResultType(rtBoolean); + AssertResult(False); +end; + +procedure TTestParserBooleanOperations.TestGreaterThanInteger2; +begin + FP.Expression:='2 > 2'; + AssertNotNull('Have result node',FP.ExprNode); + AssertNodeType('Constant expression',TFPGreaterThanOperation, FP.ExprNode); + AssertLeftRight(FP.ExprNode,TFPConstExpression,TFPConstExpression); + AssertResultType(rtBoolean); + AssertResult(False); +end; + +procedure TTestParserBooleanOperations.TestGreaterThanEqualInteger; +begin + FP.Expression:='3 >= 2'; + AssertNotNull('Have result node',FP.ExprNode); + AssertNodeType('Constant expression',TFPGreaterThanEqualOperation, FP.ExprNode); + AssertLeftRight(FP.ExprNode,TFPConstExpression,TFPConstExpression); + AssertResultType(rtBoolean); + AssertResult(True); +end; + +procedure TTestParserBooleanOperations.TestGreaterThanEqualInteger2; +begin + FP.Expression:='2 >= 2'; + AssertNotNull('Have result node',FP.ExprNode); + AssertNodeType('Constant expression',TFPGreaterThanEqualOperation, FP.ExprNode); + AssertLeftRight(FP.ExprNode,TFPConstExpression,TFPConstExpression); + AssertResultType(rtBoolean); + AssertResult(True); +end; + +procedure TTestParserBooleanOperations.TestGreaterThanFloat; +begin + FP.Expression:='1.2 > 2.3'; + AssertNotNull('Have result node',FP.ExprNode); + AssertNodeType('Constant expression',TFPGreaterThanOperation, FP.ExprNode); + AssertLeftRight(FP.ExprNode,TFPConstExpression,TFPConstExpression); + AssertResultType(rtBoolean); + AssertResult(False); +end; + +procedure TTestParserBooleanOperations.TestGreaterThanFloat2; +begin + FP.Expression:='2.2 > 2.2'; + AssertNotNull('Have result node',FP.ExprNode); + AssertNodeType('Constant expression',TFPGreaterThanOperation, FP.ExprNode); + AssertLeftRight(FP.ExprNode,TFPConstExpression,TFPConstExpression); + AssertResultType(rtBoolean); + AssertResult(False); +end; + +procedure TTestParserBooleanOperations.TestGreaterThanEqualFloat; +begin + FP.Expression:='3.1 >= 2.1'; + AssertNotNull('Have result node',FP.ExprNode); + AssertNodeType('Constant expression',TFPGreaterThanEqualOperation, FP.ExprNode); + AssertLeftRight(FP.ExprNode,TFPConstExpression,TFPConstExpression); + AssertResultType(rtBoolean); + AssertResult(True); +end; + +procedure TTestParserBooleanOperations.TestGreaterThanEqualFloat2; +begin + FP.Expression:='2.1 >= 2.1'; + AssertNotNull('Have result node',FP.ExprNode); + AssertNodeType('Constant expression',TFPGreaterThanEqualOperation, FP.ExprNode); + AssertLeftRight(FP.ExprNode,TFPConstExpression,TFPConstExpression); + AssertResultType(rtBoolean); + AssertResult(True); +end; + +procedure TTestParserBooleanOperations.TestGreaterThanString; +begin + FP.Expression:='''1'' > ''2'''; + AssertNotNull('Have result node',FP.ExprNode); + AssertNodeType('Constant expression',TFPGreaterThanOperation, FP.ExprNode); + AssertLeftRight(FP.ExprNode,TFPConstExpression,TFPConstExpression); + AssertResultType(rtBoolean); + AssertResult(False); +end; + +procedure TTestParserBooleanOperations.TestGreaterThanString2; +begin + FP.Expression:='''2'' > ''2'''; + AssertNotNull('Have result node',FP.ExprNode); + AssertNodeType('Constant expression',TFPGreaterThanOperation, FP.ExprNode); + AssertLeftRight(FP.ExprNode,TFPConstExpression,TFPConstExpression); + AssertResultType(rtBoolean); + AssertResult(False); +end; + +procedure TTestParserBooleanOperations.TestGreaterThanEqualString; +begin + FP.Expression:='''3'' >= ''2'''; + AssertNotNull('Have result node',FP.ExprNode); + AssertNodeType('Constant expression',TFPGreaterThanEqualOperation, FP.ExprNode); + AssertLeftRight(FP.ExprNode,TFPConstExpression,TFPConstExpression); + AssertResultType(rtBoolean); + AssertResult(True); +end; + +procedure TTestParserBooleanOperations.TestGreaterThanEqualString2; +begin + FP.Expression:='''2'' >= ''2'''; + AssertNotNull('Have result node',FP.ExprNode); + AssertNodeType('Constant expression',TFPGreaterThanEqualOperation, FP.ExprNode); + AssertLeftRight(FP.ExprNode,TFPConstExpression,TFPConstExpression); + AssertResultType(rtBoolean); + AssertResult(True); +end; + +procedure TTestParserBooleanOperations.EqualAndSeries; +begin + // (1=2) and (3=4) + FP.Expression:='1 = 2 and 3 = 4'; + AssertNotNull('Have result node',FP.ExprNode); + AssertNodeType('Constant expression',TFPBinaryAndOperation, FP.ExprNode); + AssertLeftRight(FP.ExprNode,TFPEqualOperation,TFPEqualOperation); + AssertResultType(rtBoolean); + AssertResult(False); +end; + +procedure TTestParserBooleanOperations.EqualAndSeries2; +begin + // (1=2) and (3=4) + FP.Expression:='1 = 1 and 3 = 3'; + AssertNotNull('Have result node',FP.ExprNode); + AssertNodeType('Constant expression',TFPBinaryAndOperation, FP.ExprNode); + AssertLeftRight(FP.ExprNode,TFPEqualOperation,TFPEqualOperation); + AssertResultType(rtBoolean); + AssertResult(True); +end; + +procedure TTestParserBooleanOperations.EqualOrSeries; +begin + // (1=2) or (3=4) + FP.Expression:='1 = 2 or 3 = 4'; + AssertNotNull('Have result node',FP.ExprNode); + AssertNodeType('Constant expression',TFPBinaryOrOperation, FP.ExprNode); + AssertLeftRight(FP.ExprNode,TFPEqualOperation,TFPEqualOperation); + AssertResultType(rtBoolean); + AssertResult(False); +end; + +procedure TTestParserBooleanOperations.EqualOrSeries2; +begin + // (1=1) or (3=4) + FP.Expression:='1 = 1 or 3 = 4'; + AssertNotNull('Have result node',FP.ExprNode); + AssertNodeType('Constant expression',TFPBinaryOrOperation, FP.ExprNode); + AssertLeftRight(FP.ExprNode,TFPEqualOperation,TFPEqualOperation); + AssertResultType(rtBoolean); + AssertResult(True); +end; + +procedure TTestParserBooleanOperations.UnEqualAndSeries; +begin + // (1<>2) and (3<>4) + FP.Expression:='1 <> 2 and 3 <> 4'; + AssertNotNull('Have result node',FP.ExprNode); + AssertNodeType('Constant expression',TFPBinaryAndOperation, FP.ExprNode); + AssertLeftRight(FP.ExprNode,TFPUnEqualOperation,TFPUnEqualOperation); + AssertResultType(rtBoolean); + AssertResult(True); +end; + +procedure TTestParserBooleanOperations.UnEqualAndSeries2; +begin + // (1<>2) and (3<>4) + FP.Expression:='1 <> 1 and 3 <> 3'; + AssertNotNull('Have result node',FP.ExprNode); + AssertNodeType('Constant expression',TFPBinaryAndOperation, FP.ExprNode); + AssertLeftRight(FP.ExprNode,TFPUnEqualOperation,TFPUnEqualOperation); + AssertResultType(rtBoolean); + AssertResult(False); +end; + +procedure TTestParserBooleanOperations.UnEqualOrSeries; +begin + // (1<>2) or (3<>4) + FP.Expression:='1 <> 2 or 3 <> 4'; + AssertNotNull('Have result node',FP.ExprNode); + AssertNodeType('Constant expression',TFPBinaryOrOperation, FP.ExprNode); + AssertLeftRight(FP.ExprNode,TFPUnEqualOperation,TFPUnEqualOperation); + AssertResultType(rtBoolean); + AssertResult(True); +end; + +procedure TTestParserBooleanOperations.UnEqualOrSeries2; +begin + // (1<>1) or (3<>4) + FP.Expression:='1 <> 1 or 3 <> 4'; + AssertNotNull('Have result node',FP.ExprNode); + AssertNodeType('Constant expression',TFPBinaryOrOperation, FP.ExprNode); + AssertLeftRight(FP.ExprNode,TFPUnEqualOperation,TFPUnEqualOperation); + AssertResultType(rtBoolean); + AssertResult(True); +end; + +procedure TTestParserBooleanOperations.LessThanAndSeries; +begin + // (1<2) and (3<4) + FP.Expression:='1 < 2 and 3 < 4'; + AssertNotNull('Have result node',FP.ExprNode); + AssertNodeType('Constant expression',TFPBinaryAndOperation, FP.ExprNode); + AssertLeftRight(FP.ExprNode,TFPLessThanOperation,TFPLessThanOperation); + AssertResultType(rtBoolean); + AssertResult(True); +end; + +procedure TTestParserBooleanOperations.LessThanAndSeries2; +begin + // (1<2) and (3<4) + FP.Expression:='1 < 1 and 3 < 3'; + AssertNotNull('Have result node',FP.ExprNode); + AssertNodeType('Constant expression',TFPBinaryAndOperation, FP.ExprNode); + AssertLeftRight(FP.ExprNode,TFPLessThanOperation,TFPLessThanOperation); + AssertResultType(rtBoolean); + AssertResult(False); +end; + +procedure TTestParserBooleanOperations.LessThanOrSeries; +begin + // (1<2) or (3<4) + FP.Expression:='1 < 2 or 3 < 4'; + AssertNotNull('Have result node',FP.ExprNode); + AssertNodeType('Constant expression',TFPBinaryOrOperation, FP.ExprNode); + AssertLeftRight(FP.ExprNode,TFPLessThanOperation,TFPLessThanOperation); + AssertResultType(rtBoolean); + AssertResult(True); +end; + +procedure TTestParserBooleanOperations.LessThanOrSeries2; +begin + // (1<1) or (3<4) + FP.Expression:='1 < 1 or 3 < 4'; + AssertNotNull('Have result node',FP.ExprNode); + AssertNodeType('Constant expression',TFPBinaryOrOperation, FP.ExprNode); + AssertLeftRight(FP.ExprNode,TFPLessThanOperation,TFPLessThanOperation); + AssertResultType(rtBoolean); + AssertResult(True); +end; + +procedure TTestParserBooleanOperations.GreaterThanAndSeries; +begin + // (1>2) and (3>4) + FP.Expression:='1 > 2 and 3 > 4'; + AssertNotNull('Have result node',FP.ExprNode); + AssertNodeType('Constant expression',TFPBinaryAndOperation, FP.ExprNode); + AssertLeftRight(FP.ExprNode,TFPGreaterThanOperation,TFPGreaterThanOperation); + AssertResultType(rtBoolean); + AssertResult(False); +end; + +procedure TTestParserBooleanOperations.GreaterThanAndSeries2; +begin + // (1>2) and (3>4) + FP.Expression:='1 > 1 and 3 > 3'; + AssertNotNull('Have result node',FP.ExprNode); + AssertNodeType('Constant expression',TFPBinaryAndOperation, FP.ExprNode); + AssertLeftRight(FP.ExprNode,TFPGreaterThanOperation,TFPGreaterThanOperation); + AssertResultType(rtBoolean); + AssertResult(False); +end; + +procedure TTestParserBooleanOperations.GreaterThanOrSeries; +begin + // (1>2) or (3>4) + FP.Expression:='1 > 2 or 3 > 4'; + AssertNotNull('Have result node',FP.ExprNode); + AssertNodeType('Constant expression',TFPBinaryOrOperation, FP.ExprNode); + AssertLeftRight(FP.ExprNode,TFPGreaterThanOperation,TFPGreaterThanOperation); + AssertResultType(rtBoolean); + AssertResult(False); +end; + +procedure TTestParserBooleanOperations.GreaterThanOrSeries2; +begin + // (1>1) or (3>4) + FP.Expression:='1 > 1 or 3 > 4'; + AssertNotNull('Have result node',FP.ExprNode); + AssertNodeType('Constant expression',TFPBinaryOrOperation, FP.ExprNode); + AssertLeftRight(FP.ExprNode,TFPGreaterThanOperation,TFPGreaterThanOperation); + AssertResultType(rtBoolean); + AssertResult(False); +end; + +procedure TTestParserBooleanOperations.LessThanEqualAndSeries; +begin + // (1<=2) and (3<=4) + FP.Expression:='1 <= 2 and 3 <= 4'; + AssertNotNull('Have result node',FP.ExprNode); + AssertNodeType('Constant expression',TFPBinaryAndOperation, FP.ExprNode); + AssertLeftRight(FP.ExprNode,TFPLessThanEqualOperation,TFPLessThanEqualOperation); + AssertResultType(rtBoolean); + AssertResult(True); +end; + +procedure TTestParserBooleanOperations.LessThanEqualAndSeries2; +begin + // (1<=2) and (3<=4) + FP.Expression:='1 <= 1 and 3 <= 3'; + AssertNotNull('Have result node',FP.ExprNode); + AssertNodeType('Constant expression',TFPBinaryAndOperation, FP.ExprNode); + AssertLeftRight(FP.ExprNode,TFPLessThanEqualOperation,TFPLessThanEqualOperation); + AssertResultType(rtBoolean); + AssertResult(True); +end; + +procedure TTestParserBooleanOperations.LessThanEqualOrSeries; +begin + // (1<=2) or (3<=4) + FP.Expression:='1 <= 2 or 3 <= 4'; + AssertNotNull('Have result node',FP.ExprNode); + AssertNodeType('Constant expression',TFPBinaryOrOperation, FP.ExprNode); + AssertLeftRight(FP.ExprNode,TFPLessThanEqualOperation,TFPLessThanEqualOperation); + AssertResultType(rtBoolean); + AssertResult(True); +end; + +procedure TTestParserBooleanOperations.LessThanEqualOrSeries2; +begin + // (1<=1) or (3<=4) + FP.Expression:='1 <= 1 or 3 <= 4'; + AssertNotNull('Have result node',FP.ExprNode); + AssertNodeType('Constant expression',TFPBinaryOrOperation, FP.ExprNode); + AssertLeftRight(FP.ExprNode,TFPLessThanEqualOperation,TFPLessThanEqualOperation); + AssertResultType(rtBoolean); + AssertResult(True); +end; + +procedure TTestParserBooleanOperations.GreaterThanEqualAndSeries; +begin + // (1>=2) and (3>=4) + FP.Expression:='1 >= 2 and 3 >= 4'; + AssertNotNull('Have result node',FP.ExprNode); + AssertNodeType('Constant expression',TFPBinaryAndOperation, FP.ExprNode); + AssertLeftRight(FP.ExprNode,TFPGreaterThanEqualOperation,TFPGreaterThanEqualOperation); + AssertResultType(rtBoolean); + AssertResult(False); +end; + +procedure TTestParserBooleanOperations.GreaterThanEqualAndSeries2; +begin + // (1>=2) and (3>=4) + FP.Expression:='1 >= 1 and 3 >= 3'; + AssertNotNull('Have result node',FP.ExprNode); + AssertNodeType('Constant expression',TFPBinaryAndOperation, FP.ExprNode); + AssertLeftRight(FP.ExprNode,TFPGreaterThanEqualOperation,TFPGreaterThanEqualOperation); + AssertResultType(rtBoolean); + AssertResult(True); +end; + +procedure TTestParserBooleanOperations.GreaterThanEqualOrSeries; +begin + // (1>=2) or (3>=4) + FP.Expression:='1 >= 2 or 3 >= 4'; + AssertNotNull('Have result node',FP.ExprNode); + AssertNodeType('Constant expression',TFPBinaryOrOperation, FP.ExprNode); + AssertLeftRight(FP.ExprNode,TFPGreaterThanEqualOperation,TFPGreaterThanEqualOperation); + AssertResultType(rtBoolean); + AssertResult(False); +end; + +procedure TTestParserBooleanOperations.GreaterThanEqualOrSeries2; +begin + // (1>=1) or (3>=4) + FP.Expression:='1 >= 1 or 3 >= 4'; + AssertNotNull('Have result node',FP.ExprNode); + AssertNodeType('Constant expression',TFPBinaryOrOperation, FP.ExprNode); + AssertLeftRight(FP.ExprNode,TFPGreaterThanEqualOperation,TFPGreaterThanEqualOperation); + AssertResultType(rtBoolean); + AssertResult(True); +end; + +//TTestParserOperands +procedure TTestParserOperands.MissingOperand1; +begin + TestParser('1+'); +end; + +procedure TTestParserOperands.MissingOperand2; +begin + TestParser('*1'); +end; + +procedure TTestParserOperands.MissingOperand3; +begin + TestParser('1*'); +end; + +procedure TTestParserOperands.MissingOperand4; +begin + TestParser('1+'); +end; + +procedure TTestParserOperands.MissingOperand5; +begin + TestParser('1 and'); +end; + +procedure TTestParserOperands.MissingOperand6; +begin + TestParser('1 or'); +end; + +procedure TTestParserOperands.MissingOperand7; +begin + TestParser('and 1'); +end; + +procedure TTestParserOperands.MissingOperand8; +begin + TestParser('or 1'); +end; + +procedure TTestParserOperands.MissingOperand9; +begin + TestParser('1-'); +end; + +procedure TTestParserOperands.MissingOperand10; +begin + TestParser('1 = '); +end; + +procedure TTestParserOperands.MissingOperand11; +begin + TestParser('= 1'); +end; + +procedure TTestParserOperands.MissingOperand12; +begin + TestParser('1 <> '); +end; + +procedure TTestParserOperands.MissingOperand13; +begin + TestParser('<> 1'); +end; + +procedure TTestParserOperands.MissingOperand14; +begin + TestParser('1 >= '); +end; + +procedure TTestParserOperands.MissingOperand15; +begin + TestParser('>= 1'); +end; + +procedure TTestParserOperands.MissingOperand16; +begin + TestParser('1 <= '); +end; + +procedure TTestParserOperands.MissingOperand17; +begin + TestParser('<= 1'); +end; + +procedure TTestParserOperands.MissingOperand18; +begin + TestParser('1 < '); +end; + +procedure TTestParserOperands.MissingOperand19; +begin + TestParser('< 1'); +end; + +procedure TTestParserOperands.MissingOperand20; +begin + TestParser('1 > '); +end; + +procedure TTestParserOperands.MissingOperand21; +begin + TestParser('> 1'); +end; + +procedure TTestParserOperands.MissingBracket1; +begin + TestParser('(1+3'); +end; + +procedure TTestParserOperands.MissingBracket2; +begin + TestParser('1+3)'); +end; + +procedure TTestParserOperands.MissingBracket3; +begin + TestParser('(1+3))'); +end; + +procedure TTestParserOperands.MissingBracket4; +begin + TestParser('((1+3)'); +end; + +procedure TTestParserOperands.MissingBracket5; +begin + TestParser('((1+3) 4'); +end; + +procedure TTestParserOperands.MissingBracket6; +begin + TestParser('IF(true,1,2'); +end; + +procedure TTestParserOperands.MissingBracket7; +begin + TestParser('case(1,1,2,4'); +end; + +procedure TTestParserOperands.MissingArgument1; +begin + TestParser('IF(true,1)'); +end; + +procedure TTestParserOperands.MissingArgument2; +begin + TestParser('IF(True)'); +end; + +procedure TTestParserOperands.MissingArgument3; +begin + TestParser('case(1)'); +end; + +procedure TTestParserOperands.MissingArgument4; +begin + TestParser('case(1,2)'); +end; + +procedure TTestParserOperands.MissingArgument5; + +begin + TestParser('case(1,2,3)'); +end; + +procedure TTestParserOperands.MissingArgument6; + +begin + TestParser('IF(true,1,2,3)'); +end; + +procedure TTestParserOperands.MissingArgument7; + +begin + TestParser('case(0,1,2,3,4,5,6)'); +end; + +procedure TTestParserTypeMatch.AccessString; +begin + FP.AsString; +end; + +procedure TTestParserTypeMatch.AccessInteger; +begin + FP.AsInteger; +end; + +procedure TTestParserTypeMatch.AccessFloat; +begin + FP.AsFloat; +end; + +procedure TTestParserTypeMatch.AccessDateTime; +begin + FP.AsDateTime; +end; + +procedure TTestParserTypeMatch.AccessBoolean; +begin + FP.AsBoolean; +end; + +//TTestParserTypeMatch +procedure TTestParserTypeMatch.TestTypeMismatch1; +begin + TestParser('1+''string'''); +end; + +procedure TTestParserTypeMatch.TestTypeMismatch2; +begin + TestParser('1+True'); +end; + +procedure TTestParserTypeMatch.TestTypeMismatch3; +begin + TestParser('True+''string'''); +end; + +procedure TTestParserTypeMatch.TestTypeMismatch4; +begin + TestParser('1.23+''string'''); +end; + +procedure TTestParserTypeMatch.TestTypeMismatch5; +begin + TestParser('1.23+true'); +end; + +procedure TTestParserTypeMatch.TestTypeMismatch6; +begin + TestParser('1.23 and true'); +end; + +procedure TTestParserTypeMatch.TestTypeMismatch7; +begin + TestParser('1.23 or true'); +end; + +procedure TTestParserTypeMatch.TestTypeMismatch8; +begin + TestParser('''string'' or true'); +end; + +procedure TTestParserTypeMatch.TestTypeMismatch9; +begin + TestParser('''string'' and true'); +end; + +procedure TTestParserTypeMatch.TestTypeMismatch10; +begin + TestParser('1.23 or 1'); +end; + +procedure TTestParserTypeMatch.TestTypeMismatch11; +begin + TestParser('1.23 and 1'); +end; + +procedure TTestParserTypeMatch.TestTypeMismatch12; +begin + TestParser('''astring'' = 1'); +end; + +procedure TTestParserTypeMatch.TestTypeMismatch13; +begin + TestParser('true = 1'); +end; + +procedure TTestParserTypeMatch.TestTypeMismatch14; +begin + TestParser('true * 1'); +end; + +procedure TTestParserTypeMatch.TestTypeMismatch15; +begin + TestParser('''astring'' * 1'); +end; + +procedure TTestParserTypeMatch.TestTypeMismatch16; +begin + TestParser('If(1,1,1)'); +end; + +procedure TTestParserTypeMatch.TestTypeMismatch17; +begin + TestParser('If(True,1,''3'')'); +end; + +procedure TTestParserTypeMatch.TestTypeMismatch18; +begin + TestParser('case(1,1,''3'',1)'); +end; + +procedure TTestParserTypeMatch.TestTypeMismatch19; +begin + TestParser('case(1,1,1,''3'')'); +end; + +procedure TTestParserTypeMatch.TestTypeMismatch20; +begin + FP.Expression:='1'; + AssertException('Accessing integer as string',EExprParser,@AccessString); +end; + +procedure TTestParserTypeMatch.TestTypeMismatch21; +begin + FP.Expression:='''a'''; + AssertException('Accessing string as integer',EExprParser,@AccessInteger); +end; + +procedure TTestParserTypeMatch.TestTypeMismatch22; +begin + FP.Expression:='''a'''; + AssertException('Accessing string as float',EExprParser,@AccessFloat); +end; + +procedure TTestParserTypeMatch.TestTypeMismatch23; +begin + FP.Expression:='''a'''; + AssertException('Accessing string as boolean',EExprParser,@AccessBoolean); +end; + +procedure TTestParserTypeMatch.TestTypeMismatch24; +begin + FP.Expression:='''a'''; + AssertException('Accessing string as datetime',EExprParser,@AccessDateTime); +end; + +//TTestParserVariables + +Procedure GetDate(Var Result : TFPExpressionResult; Const Args : TExprParameterArray); + +begin + Result.resDateTime:=Date; +end; + +procedure TTestParserVariables.TestVariable1; + +Var + I : TFPExprIdentifierDef; + +begin + I:=FP.Identifiers.AddVariable('a',rtBoolean,'True'); + AssertEquals('List is dirty',True,FP.Dirty); + AssertNotNull('Addvariable returns result',I); + AssertEquals('One variable added',1,FP.Identifiers.Count); + AssertSame('Result equals variable added',I,FP.Identifiers[0]); + AssertEquals('Variable has correct resulttype',rtBoolean,I.ResultType); + AssertEquals('Variable has correct value','True',I.Value); +end; + +procedure TTestParserVariables.TestVariable2; + +Var + I : TFPExprIdentifierDef; + +begin + I:=FP.Identifiers.AddBooleanVariable('a',False); + AssertEquals('List is dirty',True,FP.Dirty); + AssertNotNull('Addvariable returns result',I); + AssertEquals('One variable added',1,FP.Identifiers.Count); + AssertSame('Result equals variable added',I,FP.Identifiers[0]); + AssertEquals('Variable has correct resulttype',rtBoolean,I.ResultType); + AssertEquals('Variable has correct value','False',I.Value); +end; + +procedure TTestParserVariables.TestVariable3; + +Var + I : TFPExprIdentifierDef; + +begin + I:=FP.Identifiers.AddIntegerVariable('a',123); + AssertEquals('List is dirty',True,FP.Dirty); + AssertNotNull('Addvariable returns result',I); + AssertEquals('One variable added',1,FP.Identifiers.Count); + AssertSame('Result equals variable added',I,FP.Identifiers[0]); + AssertEquals('Variable has correct resulttype',rtInteger,I.ResultType); + AssertEquals('Variable has correct value','123',I.Value); +end; + +procedure TTestParserVariables.TestVariable4; + +Var + I : TFPExprIdentifierDef; + +begin + I:=FP.Identifiers.AddFloatVariable('a',1.23); + AssertEquals('List is dirty',True,FP.Dirty); + AssertNotNull('Addvariable returns result',I); + AssertEquals('One variable added',1,FP.Identifiers.Count); + AssertSame('Result equals variable added',I,FP.Identifiers[0]); + AssertEquals('Variable has correct resulttype',rtFloat,I.ResultType); + AssertEquals('Variable has correct value',FloatToStr(1.23),I.Value); +end; + +procedure TTestParserVariables.TestVariable5; + +Var + I : TFPExprIdentifierDef; + +begin + I:=FP.Identifiers.AddStringVariable('a','1.23'); + AssertEquals('List is dirty',True,FP.Dirty); + AssertNotNull('Addvariable returns result',I); + AssertEquals('One variable added',1,FP.Identifiers.Count); + AssertSame('Result equals variable added',I,FP.Identifiers[0]); + AssertEquals('Variable has correct resulttype',rtString,I.ResultType); + AssertEquals('Variable has correct value','1.23',I.Value); +end; + +procedure TTestParserVariables.TestVariable6; +Var + I : TFPExprIdentifierDef; + D : TDateTime; + +begin + D:=Now; + I:=FP.Identifiers.AddDateTimeVariable('a',D); + AssertEquals('List is dirty',True,FP.Dirty); + AssertNotNull('Addvariable returns result',I); + AssertEquals('One variable added',1,FP.Identifiers.Count); + AssertSame('Result equals variable added',I,FP.Identifiers[0]); + AssertEquals('Variable has correct resulttype',rtDateTime,I.ResultType); + AssertEquals('Variable has correct value',FormatDateTime('cccc',D),I.Value); +end; + +procedure TTestParserVariables.AddVariabletwice; + +begin + FP.Identifiers.AddDateTimeVariable('a',Now); +end; + +procedure TTestParserVariables.UnknownVariable; +begin + FP.Identifiers.IdentifierByName('unknown'); +end; + +procedure TTestParserVariables.ReadWrongType; + +Var + Res : TFPExpressioNResult; + +begin + AssertEquals('Only one identifier',1,FP.Identifiers.Count); + Case FAsWrongType of + rtBoolean : res.ResBoolean:=FP.Identifiers[0].AsBoolean; + rtString : res.ResString:=FP.Identifiers[0].AsString; + rtInteger : Res.ResInteger:=FP.Identifiers[0].AsInteger; + rtFloat : Res.ResFloat:=FP.Identifiers[0].AsFloat; + rtDateTime : Res.ResDateTime:=FP.Identifiers[0].AsDateTime; + end; +end; + +procedure TTestParserVariables.WriteWrongType; + +Var + Res : TFPExpressioNResult; + +begin + AssertEquals('Only one identifier',1,FP.Identifiers.Count); + Case FAsWrongType of + rtBoolean : FP.Identifiers[0].AsBoolean:=res.ResBoolean; + rtString : FP.Identifiers[0].AsString:=res.ResString; + rtInteger : FP.Identifiers[0].AsInteger:=Res.ResInteger; + rtFloat : FP.Identifiers[0].AsFloat:=Res.ResFloat; + rtDateTime : FP.Identifiers[0].AsDateTime:=Res.ResDateTime; + end; +end; + +procedure TTestParserVariables.DoDummy(var Result: TFPExpressionResult; + const Args: TExprParameterArray); +begin + // Do nothing; +end; + +procedure TTestParserVariables.TestVariableAssign; + +Var + I,J : TFPExprIdentifierDef; + +begin + I:=TFPExprIdentifierDef.Create(Nil); + try + J:=TFPExprIdentifierDef.Create(Nil); + try + I.Name:='Aname'; + I.ParameterTypes:='ISDBF'; + I.ResultType:=rtFloat; + I.Value:='1.23'; + I.OnGetFunctionValue:=@DoDummy; + I.OnGetFunctionValueCallBack:=@GetDate; + J.Assign(I); + AssertEquals('Names match',I.Name,J.Name); + AssertEquals('Parametertypes match',I.ParameterTypes,J.ParameterTypes); + AssertEquals('Values match',I.Value,J.Value); + AssertEquals('Result types match',Ord(I.ResultType),Ord(J.ResultType)); + AssertSame('Callbacks match',Pointer(I.OnGetFunctionValueCallBack),Pointer(J.OnGetFunctionValueCallback)); + If (I.OnGetFunctionValue)<>(J.OnGetFunctionValue) then + Fail('OnGetFUnctionValue as Method does not match'); + finally + J.Free; + end; + finally + I.Free; + end; +end; + +procedure TTestParserVariables.TestVariableAssignAgain; + +Var + I,J : TFPBuiltinExprIdentifierDef; + +begin + I:=TFPBuiltinExprIdentifierDef.Create(Nil); + try + J:=TFPBuiltinExprIdentifierDef.Create(Nil); + try + I.Name:='Aname'; + I.ParameterTypes:='ISDBF'; + I.ResultType:=rtFloat; + I.Value:='1.23'; + I.OnGetFunctionValue:=@DoDummy; + I.OnGetFunctionValueCallBack:=@GetDate; + I.Category:=bcUser; + J.Assign(I); + AssertEquals('Names match',I.Name,J.Name); + AssertEquals('Parametertypes match',I.ParameterTypes,J.ParameterTypes); + AssertEquals('Values match',I.Value,J.Value); + AssertEquals('Result types match',Ord(I.ResultType),Ord(J.ResultType)); + AssertEquals('Categories match',Ord(I.Category),Ord(J.Category)); + AssertSame('Callbacks match',Pointer(I.OnGetFunctionValueCallBack),Pointer(J.OnGetFunctionValueCallback)); + If (I.OnGetFunctionValue)<>(J.OnGetFunctionValue) then + Fail('OnGetFUnctionValue as Method does not match'); + finally + J.Free; + end; + finally + I.Free; + end; +end; + +procedure TTestParserVariables.TestVariable7; + +Var + I : TFPExprIdentifierDef; + D : TDateTime; + +begin + D:=Now; + I:=FP.Identifiers.AddDateTimeVariable('a',D); + AssertException('Cannot add same name twice',EExprParser,@AddVariabletwice); +end; + +procedure TTestParserVariables.TestVariable8; + +Var + I : TFPExprIdentifierDef; + +begin + FP.Identifiers.AddIntegerVariable('a',123); + FP.Identifiers.AddIntegerVariable('b',123); + AssertEquals('List is dirty',True,FP.Dirty); + FP.BuildHashList; + FP.Identifiers.Delete(0); + AssertEquals('List is dirty',True,FP.Dirty); +end; + +procedure TTestParserVariables.TestVariable9; + +Var + I : TFPExprIdentifierDef; + +begin + I:=FP.Identifiers.AddIntegerVariable('a',123); + FP.Expression:='a'; + AssertNotNull('Have result node',FP.ExprNode); + AssertNodeType('Constant expression',TFPExprVariable, FP.ExprNode); + AssertResultType(rtInteger); + AssertResult(123); +end; + +procedure TTestParserVariables.TestVariable10; + +Var + I : TFPExprIdentifierDef; + +begin + I:=FP.Identifiers.AddStringVariable('a','a123'); + FP.Expression:='a'; + AssertNotNull('Have result node',FP.ExprNode); + AssertNodeType('Constant expression',TFPExprVariable, FP.ExprNode); + AssertResultType(rtString); + AssertResult('a123'); +end; + +procedure TTestParserVariables.TestVariable11; + +Var + I : TFPExprIdentifierDef; + +begin + I:=FP.Identifiers.AddFloatVariable('a',1.23); + FP.Expression:='a'; + AssertNotNull('Have result node',FP.ExprNode); + AssertNodeType('Constant expression',TFPExprVariable, FP.ExprNode); + AssertResultType(rtFloat); + AssertResult(1.23); +end; + +procedure TTestParserVariables.TestVariable12; + +Var + I : TFPExprIdentifierDef; + +begin + I:=FP.Identifiers.AddBooleanVariable('a',True); + FP.Expression:='a'; + AssertNotNull('Have result node',FP.ExprNode); + AssertNodeType('Constant expression',TFPExprVariable, FP.ExprNode); + AssertResultType(rtBoolean); + AssertResult(True); +end; + +procedure TTestParserVariables.TestVariable13; + +Var + I : TFPExprIdentifierDef; + D : TDateTime; + +begin + D:=Date; + I:=FP.Identifiers.AddDateTimeVariable('a',D); + FP.Expression:='a'; + AssertNotNull('Have result node',FP.ExprNode); + AssertNodeType('Constant expression',TFPExprVariable, FP.ExprNode); + AssertResultType(rtDateTime); + AssertDateTimeResult(D); +end; + +procedure TTestParserVariables.TestVariable14; + +Var + I,S : TFPExprIdentifierDef; + +begin + I:=FP.Identifiers.AddIntegerVariable('a',1); + FP.BuildHashList; + S:=FP.IdentifierByName('a'); + AssertSame('Identifier found',I,S); +end; + +procedure TTestParserVariables.TestVariable15; + +Var + I,S : TFPExprIdentifierDef; + +begin + I:=FP.Identifiers.AddIntegerVariable('a',1); + FP.BuildHashList; + S:=FP.IdentifierByName('A'); + AssertSame('Identifier found',I,S); +end; + +procedure TTestParserVariables.TestVariable16; + +Var + I,S : TFPExprIdentifierDef; + +begin + I:=FP.Identifiers.AddIntegerVariable('a',1); + FP.BuildHashList; + S:=FP.IdentifierByName('B'); + AssertNull('Identifier not found',S); +end; + +procedure TTestParserVariables.TestVariable17; + +Var + I,S : TFPExprIdentifierDef; + +begin + I:=FP.Identifiers.AddIntegerVariable('a',1); + FP.BuildHashList; + AssertException('Identifier not found',EExprParser,@unknownvariable); +end; + +procedure TTestParserVariables.TestVariable18; + +Var + I,S : TFPExprIdentifierDef; + +begin + I:=FP.Identifiers.AddIntegerVariable('a',1); + S:=FP.Identifiers.FindIdentifier('B'); + AssertNull('Identifier not found',S); +end; + +procedure TTestParserVariables.TestVariable19; + +Var + I,S : TFPExprIdentifierDef; + +begin + I:=FP.Identifiers.AddIntegerVariable('a',1); + S:=FP.Identifiers.FindIdentifier('a'); + AssertSame('Identifier found',I,S); +end; + +procedure TTestParserVariables.TestVariable20; + +Var + I,S : TFPExprIdentifierDef; + +begin + I:=FP.Identifiers.AddIntegerVariable('a',1); + S:=FP.Identifiers.FindIdentifier('A'); + AssertSame('Identifier found',I,S); +end; + +procedure TTestParserVariables.TestAccess(Skip : TResultType); + +Var + rt : TResultType; + +begin + For rt:=Low(TResultType) to High(TResultType) do + if rt<>skip then + begin + FasWrongType:=rt; + AssertException('Acces as '+ResultTypeName(rt),EExprParser,@ReadWrongtype); + end; + For rt:=Low(TResultType) to High(TResultType) do + if rt<>skip then + begin + FasWrongType:=rt; + AssertException('Acces as '+ResultTypeName(rt),EExprParser,@WriteWrongtype); + end; +end; + +procedure TTestParserVariables.TestVariable21; +begin + FP.IDentifiers.AddIntegerVariable('a',1); + TestAccess(rtInteger); +end; + +procedure TTestParserVariables.TestVariable22; +begin + FP.IDentifiers.AddFloatVariable('a',1.0); + TestAccess(rtFloat); +end; + +procedure TTestParserVariables.TestVariable23; +begin + FP.IDentifiers.AddStringVariable('a','1.0'); + TestAccess(rtString); +end; + +procedure TTestParserVariables.TestVariable24; +begin + FP.IDentifiers.AddBooleanVariable('a',True); + TestAccess(rtBoolean); +end; + +procedure TTestParserVariables.TestVariable25; + +begin + FP.IDentifiers.AddDateTimeVariable('a',Date); + TestAccess(rtDateTime); +end; + +procedure TTestParserVariables.TestVariable26; + +Var + I : TFPExprIdentifierDef; + +begin + I:=FP.IDentifiers.AddStringVariable('a','1.0'); + I.AsString:='12'; + AssertEquals('Correct value','12',I.AsString); +end; + +procedure TTestParserVariables.TestVariable27; +Var + I : TFPExprIdentifierDef; + +begin + I:=FP.IDentifiers.AddIntegerVariable('a',10); + I.Asinteger:=12; + AssertEquals('Correct value',12,I.AsInteger); +end; + +procedure TTestParserVariables.TestVariable28; +Var + I : TFPExprIdentifierDef; + +begin + I:=FP.IDentifiers.AddFloatVariable('a',1.0); + I.AsFloat:=1.2; + AssertEquals('Correct value',1.2,I.AsFloat); +end; + +procedure TTestParserVariables.TestVariable29; + +Var + I : TFPExprIdentifierDef; + +begin + I:=FP.IDentifiers.AddDateTimeVariable('a',Now); + I.AsDateTime:=Date-1; + AssertEquals('Correct value',Date-1,I.AsDateTime); +end; + +procedure TTestParserVariables.TestVariable30; + +Var + I : TFPExprIdentifierDef; + +begin + I:=FP.Identifiers.AddBooleanVariable('a',True); + I.AsBoolean:=False; + AssertEquals('Correct value',False,I.AsBoolean); +end; + + + +Procedure EchoDate(Var Result : TFPExpressionResult; Const Args : TExprParameterArray); + +begin + Result.resDateTime:=Args[0].resDateTime; +end; + +Procedure EchoInteger(Var Result : TFPExpressionResult; Const Args : TExprParameterArray); + +begin + Result.resInteger:=Args[0].resInteger; +end; + +Procedure EchoBoolean(Var Result : TFPExpressionResult; Const Args : TExprParameterArray); + +begin + Result.resBoolean:=Args[0].resBoolean; +end; + +Procedure EchoFloat(Var Result : TFPExpressionResult; Const Args : TExprParameterArray); + +begin + Result.resFloat:=Args[0].resFloat; +end; + +Procedure EchoString(Var Result : TFPExpressionResult; Const Args : TExprParameterArray); + +begin + Result.resString:=Args[0].resString; +end; + +Procedure TTestExpressionParser.DoEchoDate(Var Result : TFPExpressionResult; Const Args : TExprParameterArray); + +begin + Result.resDateTime:=Args[0].resDateTime; +end; + +Procedure TTestExpressionParser.DoEchoInteger(Var Result : TFPExpressionResult; Const Args : TExprParameterArray); + +begin + Result.resInteger:=Args[0].resInteger; +end; + +Procedure TTestExpressionParser.DoEchoBoolean(Var Result : TFPExpressionResult; Const Args : TExprParameterArray); + +begin + Result.resBoolean:=Args[0].resBoolean; +end; + +Procedure TTestExpressionParser.DoEchoFloat(Var Result : TFPExpressionResult; Const Args : TExprParameterArray); + +begin + Result.resFloat:=Args[0].resFloat; +end; + +Procedure TTestExpressionParser.DoEchoString(Var Result : TFPExpressionResult; Const Args : TExprParameterArray); + +begin + Result.resString:=Args[0].resString; +end; + +procedure TTestExpressionParser.DoGetDate(var Result: TFPExpressionResult; Const Args: TExprParameterArray); +begin + Result.ResDatetime:=Date; +end; + +procedure TTestExpressionParser.DoAddInteger(var Result: TFPExpressionResult; Const Args: TExprParameterArray); +begin + Result.Resinteger:=Args[0].ResInteger+Args[1].ResInteger; +end; + +procedure TTestExpressionParser.DoDeleteString(var Result: TFPExpressionResult; Const Args: TExprParameterArray); +begin + Result.ResString:=Args[0].ResString; + Delete(Result.ResString,Args[1].ResInteger,Args[2].ResInteger); +end; + +procedure TTestParserFunctions.TryRead; + +Var + Res : TFPExpressioNResult; + +begin + AssertEquals('Only one identifier',1,FP.Identifiers.Count); + Case FAccessAs of + rtBoolean : res.ResBoolean:=FP.Identifiers[0].AsBoolean; + rtString : res.ResString:=FP.Identifiers[0].AsString; + rtInteger : Res.ResInteger:=FP.Identifiers[0].AsInteger; + rtFloat : Res.ResFloat:=FP.Identifiers[0].AsFloat; + rtDateTime : Res.ResDateTime:=FP.Identifiers[0].AsDateTime; + end; +end; + +procedure TTestParserFunctions.TryWrite; + +Var + Res : TFPExpressioNResult; + +begin + AssertEquals('Only one identifier',1,FP.Identifiers.Count); + Case FAccessAs of + rtBoolean : FP.Identifiers[0].AsBoolean:=res.ResBoolean; + rtString : FP.Identifiers[0].AsString:=res.ResString; + rtInteger : FP.Identifiers[0].AsInteger:=Res.ResInteger; + rtFloat : FP.Identifiers[0].AsFloat:=Res.ResFloat; + rtDateTime : FP.Identifiers[0].AsDateTime:=Res.ResDateTime; + end; +end; + +// TTestParserFunctions +procedure TTestParserFunctions.TestFunction1; + +Var + I : TFPExprIdentifierDef; + +begin + I:=FP.Identifiers.AddFunction('Date','D','',@GetDate); + AssertEquals('List is dirty',True,FP.Dirty); + AssertNotNull('Addvariable returns result',I); + AssertEquals('One variable added',1,FP.Identifiers.Count); + AssertSame('Result equals variable added',I,FP.Identifiers[0]); + AssertEquals('Function has correct resulttype',rtDateTime,I.ResultType); + AssertSame('Function has correct address',Pointer(@GetDate),Pointer(I.OnGetFunctionValueCallBack)); + FaccessAs:=rtDateTime; + AssertException('No read access',EExprParser,@TryRead); + AssertException('No write access',EExprParser,@TryWrite); +end; + +procedure TTestParserFunctions.TestFunction2; + +Var + I : TFPExprIdentifierDef; + +begin + I:=FP.Identifiers.AddFunction('EchoDate','D','D',@EchoDate); + AssertEquals('List is dirty',True,FP.Dirty); + AssertNotNull('Addvariable returns result',I); + AssertEquals('One variable added',1,FP.Identifiers.Count); + AssertSame('Result equals variable added',I,FP.Identifiers[0]); + AssertEquals('Function has correct resulttype',rtDateTime,I.ResultType); + AssertSame('Function has correct address',Pointer(@EchoDate),Pointer(I.OnGetFunctionValueCallBack)); +end; + +procedure TTestParserFunctions.TestFunction3; + +Var + I : TFPExprIdentifierDef; + +begin + I:=FP.Identifiers.AddFunction('EchoInteger','I','I',@EchoInteger); + AssertEquals('List is dirty',True,FP.Dirty); + AssertNotNull('Addvariable returns result',I); + AssertEquals('One variable added',1,FP.Identifiers.Count); + AssertSame('Result equals variable added',I,FP.Identifiers[0]); + AssertEquals('Function has correct resulttype',rtInteger,I.ResultType); + AssertSame('Function has correct address',Pointer(@EchoInteger),Pointer(I.OnGetFunctionValueCallBack)); + FaccessAs:=rtInteger; + AssertException('No read access',EExprParser,@TryRead); + AssertException('No write access',EExprParser,@TryWrite); +end; + +procedure TTestParserFunctions.TestFunction4; + +Var + I : TFPExprIdentifierDef; + +begin + I:=FP.Identifiers.AddFunction('EchoBoolean','B','B',@EchoBoolean); + AssertEquals('List is dirty',True,FP.Dirty); + AssertNotNull('Addvariable returns result',I); + AssertEquals('One variable added',1,FP.Identifiers.Count); + AssertSame('Result equals variable added',I,FP.Identifiers[0]); + AssertEquals('Function has correct resulttype',rtBoolean,I.ResultType); + AssertSame('Function has correct address',Pointer(@EchoBoolean),Pointer(I.OnGetFunctionValueCallBack)); + FaccessAs:=rtBoolean; + AssertException('No read access',EExprParser,@TryRead); + AssertException('No write access',EExprParser,@TryWrite); +end; + +procedure TTestParserFunctions.TestFunction5; + +Var + I : TFPExprIdentifierDef; + +begin + I:=FP.Identifiers.AddFunction('EchoFloat','F','F',@EchoFloat); + AssertEquals('List is dirty',True,FP.Dirty); + AssertNotNull('Addvariable returns result',I); + AssertEquals('One variable added',1,FP.Identifiers.Count); + AssertSame('Result equals variable added',I,FP.Identifiers[0]); + AssertEquals('Function has correct resulttype',rtFloat,I.ResultType); + AssertSame('Function has correct address',Pointer(@EchoFloat),Pointer(I.OnGetFunctionValueCallBack)); + FaccessAs:=rtfloat; + AssertException('No read access',EExprParser,@TryRead); + AssertException('No write access',EExprParser,@TryWrite); +end; + +procedure TTestParserFunctions.TestFunction6; + +Var + I : TFPExprIdentifierDef; + +begin + I:=FP.Identifiers.AddFunction('EchoString','S','S',@EchoString); + AssertEquals('List is dirty',True,FP.Dirty); + AssertNotNull('Addvariable returns result',I); + AssertEquals('One variable added',1,FP.Identifiers.Count); + AssertSame('Result equals variable added',I,FP.Identifiers[0]); + AssertEquals('Function has correct resulttype',rtString,I.ResultType); + AssertSame('Function has correct address',Pointer(@EchoString),Pointer(I.OnGetFunctionValueCallBack)); + FaccessAs:=rtString; + AssertException('No read access',EExprParser,@TryRead); + AssertException('No write access',EExprParser,@TryWrite); +end; + +procedure TTestParserFunctions.TestFunction7; + +Var + I : TFPExprIdentifierDef; + +begin + I:=FP.Identifiers.AddFunction('EchoDate','D','D',@DoEchoDate); + AssertEquals('List is dirty',True,FP.Dirty); + AssertNotNull('Addvariable returns result',I); + AssertEquals('One variable added',1,FP.Identifiers.Count); + AssertSame('Result equals variable added',I,FP.Identifiers[0]); + AssertEquals('Function has correct resulttype',rtDateTime,I.ResultType); +// AssertSame('Function has correct address',TMethod(@Self.DoEchoDate),TMethod(I.OnGetFunctionValue)); +end; + +procedure TTestParserFunctions.TestFunction8; + +Var + I : TFPExprIdentifierDef; + +begin + I:=FP.Identifiers.AddFunction('EchoInteger','I','I',@DOEchoInteger); + AssertEquals('List is dirty',True,FP.Dirty); + AssertNotNull('Addvariable returns result',I); + AssertEquals('One variable added',1,FP.Identifiers.Count); + AssertSame('Result equals variable added',I,FP.Identifiers[0]); + AssertEquals('Function has correct resulttype',rtInteger,I.ResultType); +// AssertSame('Function has correct address',Pointer(@EchoInteger),Pointer(I.OnGetFunctionValueCallBack)); +end; + +procedure TTestParserFunctions.TestFunction9; + +Var + I : TFPExprIdentifierDef; + +begin + I:=FP.Identifiers.AddFunction('EchoBoolean','B','B',@DoEchoBoolean); + AssertEquals('List is dirty',True,FP.Dirty); + AssertNotNull('Addvariable returns result',I); + AssertEquals('One variable added',1,FP.Identifiers.Count); + AssertSame('Result equals variable added',I,FP.Identifiers[0]); + AssertEquals('Function has correct resulttype',rtBoolean,I.ResultType); +// AssertSame('Function has correct address',Pointer(@EchoBoolean),Pointer(I.OnGetFunctionValueCallBack)); +end; + +procedure TTestParserFunctions.TestFunction10; + +Var + I : TFPExprIdentifierDef; + +begin + I:=FP.Identifiers.AddFunction('EchoFloat','F','F',@DoEchoFloat); + AssertEquals('List is dirty',True,FP.Dirty); + AssertNotNull('Addvariable returns result',I); + AssertEquals('One variable added',1,FP.Identifiers.Count); + AssertSame('Result equals variable added',I,FP.Identifiers[0]); + AssertEquals('Function has correct resulttype',rtFloat,I.ResultType); +// AssertSame('Function has correct address',Pointer(@EchoFloat),Pointer(I.OnGetFunctionValueCallBack)); +end; + +procedure TTestParserFunctions.TestFunction11; + +Var + I : TFPExprIdentifierDef; + +begin + I:=FP.Identifiers.AddFunction('EchoString','S','S',@DoEchoString); + AssertEquals('List is dirty',True,FP.Dirty); + AssertNotNull('Addvariable returns result',I); + AssertEquals('One variable added',1,FP.Identifiers.Count); + AssertSame('Result equals variable added',I,FP.Identifiers[0]); + AssertEquals('Function has correct resulttype',rtString,I.ResultType); +// AssertSame('Function has correct address',Pointer(@EchoString),Pointer(I.OnGetFunctionValueCallBack)); +end; + +procedure TTestParserFunctions.TestFunction12; + +Var + I : TFPExprIdentifierDef; + D : TDateTime; + +begin + D:=Date; + I:=FP.Identifiers.AddFunction('Date','D','',@GetDate); + FP.Expression:='Date'; + AssertNotNull('Have result node',FP.ExprNode); + AssertNodeType('Constant expression',TFPFunctionCallBack, FP.ExprNode); + AssertResultType(rtDateTime); + AssertDateTimeResult(D); +end; + +procedure TTestParserFunctions.TestFunction13; + +Var + I : TFPExprIdentifierDef; + D : TDateTime; + +begin + D:=Date; + I:=FP.Identifiers.AddDateTimeVariable('a',D); + I:=FP.Identifiers.AddFunction('EchoDate','D','D',@EchoDate); + FP.Expression:='EchoDate(a)'; + AssertNotNull('Have result node',FP.ExprNode); + AssertNodeType('Constant expression',TFPFunctionCallBack, FP.ExprNode); + AssertResultType(rtDateTime); + AssertDateTimeResult(D); +end; + +procedure TTestParserFunctions.TestFunction14; +Var + I : TFPExprIdentifierDef; + D : TDateTime; + +begin + D:=Date; + I:=FP.Identifiers.AddFunction('EchoInteger','I','I',@EchoInteger); + FP.Expression:='EchoInteger(13)'; + AssertNotNull('Have result node',FP.ExprNode); + AssertNodeType('Constant expression',TFPFunctionCallBack, FP.ExprNode); + AssertResultType(rtInteger); + AssertResult(13); +end; + +procedure TTestParserFunctions.TestFunction15; +Var + I : TFPExprIdentifierDef; + D : TDateTime; + +begin + D:=Date; + I:=FP.Identifiers.AddFunction('EchoBoolean','B','B',@EchoBoolean); + FP.Expression:='EchoBoolean(True)'; + AssertNotNull('Have result node',FP.ExprNode); + AssertNodeType('Constant expression',TFPFunctionCallBack, FP.ExprNode); + AssertResultType(rtBoolean); + AssertResult(True); +end; + +procedure TTestParserFunctions.TestFunction16; +Var + I : TFPExprIdentifierDef; + D : TDateTime; + +begin + D:=Date; + I:=FP.Identifiers.AddFunction('EchoFloat','F','F',@EchoFloat); + FP.Expression:='EchoFloat(1.234)'; + AssertNotNull('Have result node',FP.ExprNode); + AssertNodeType('Constant expression',TFPFunctionCallBack, FP.ExprNode); + AssertResultType(rtFloat); + AssertResult(1.234); +end; + +procedure TTestParserFunctions.TestFunction17; +Var + I : TFPExprIdentifierDef; + D : TDateTime; + +begin + D:=Date; + I:=FP.Identifiers.AddFunction('EchoString','S','S',@EchoString); + FP.Expression:='EchoString(''Aloha'')'; + AssertNotNull('Have result node',FP.ExprNode); + AssertNodeType('Constant expression',TFPFunctionCallBack, FP.ExprNode); + AssertResultType(rtString); + AssertResult('Aloha'); +end; + + +procedure TTestParserFunctions.TestFunction18; + +Var + I : TFPExprIdentifierDef; + D : TDateTime; + +begin + D:=Date; + I:=FP.Identifiers.AddDateTimeVariable('a',D); + I:=FP.Identifiers.AddFunction('EchoDate','D','D',@DoEchoDate); + FP.Expression:='EchoDate(a)'; + AssertNotNull('Have result node',FP.ExprNode); + AssertNodeType('Constant expression',TFPFunctionEventHandler, FP.ExprNode); + AssertResultType(rtDateTime); + AssertDateTimeResult(D); +end; + +procedure TTestParserFunctions.TestFunction19; +Var + I : TFPExprIdentifierDef; + D : TDateTime; + +begin + D:=Date; + I:=FP.Identifiers.AddFunction('EchoInteger','I','I',@DoEchoInteger); + FP.Expression:='EchoInteger(13)'; + AssertNotNull('Have result node',FP.ExprNode); + AssertNodeType('Constant expression',TFPFunctionEventHandler, FP.ExprNode); + AssertResultType(rtInteger); + AssertResult(13); +end; + +procedure TTestParserFunctions.TestFunction20; +Var + I : TFPExprIdentifierDef; + D : TDateTime; + +begin + D:=Date; + I:=FP.Identifiers.AddFunction('EchoBoolean','B','B',@DoEchoBoolean); + FP.Expression:='EchoBoolean(True)'; + AssertNotNull('Have result node',FP.ExprNode); + AssertNodeType('Constant expression',TFPFunctionEventHandler, FP.ExprNode); + AssertResultType(rtBoolean); + AssertResult(True); +end; + +procedure TTestParserFunctions.TestFunction21; +Var + I : TFPExprIdentifierDef; + D : TDateTime; + +begin + D:=Date; + I:=FP.Identifiers.AddFunction('EchoFloat','F','F',@DoEchoFloat); + FP.Expression:='EchoFloat(1.234)'; + AssertNotNull('Have result node',FP.ExprNode); + AssertNodeType('Constant expression',TFPFunctionEventHandler, FP.ExprNode); + AssertResultType(rtFloat); + AssertResult(1.234); +end; + +procedure TTestParserFunctions.TestFunction22; +Var + I : TFPExprIdentifierDef; + D : TDateTime; + +begin + D:=Date; + I:=FP.Identifiers.AddFunction('EchoString','S','S',@DoEchoString); + FP.Expression:='EchoString(''Aloha'')'; + AssertNotNull('Have result node',FP.ExprNode); + AssertNodeType('Constant expression',TFPFunctionEventHandler, FP.ExprNode); + AssertResultType(rtString); + AssertResult('Aloha'); +end; + +procedure TTestParserFunctions.TestFunction23; + +Var + I : TFPExprIdentifierDef; + D : TDateTime; + +begin + D:=Date; + I:=FP.Identifiers.AddFunction('Date','D','',@DoGetDate); + AssertEquals('List is dirty',True,FP.Dirty); + AssertNotNull('Addvariable returns result',I); + AssertEquals('One variable added',1,FP.Identifiers.Count); + AssertSame('Result equals variable added',I,FP.Identifiers[0]); + AssertEquals('Function has correct resulttype',rtDateTime,I.ResultType); + FP.Expression:='Date'; + AssertNotNull('Have result node',FP.ExprNode); + AssertNodeType('Constant expression',TFPFunctionEventHandler, FP.ExprNode); + AssertResultType(rtDateTime); + AssertDateTimeResult(D); +end; + +procedure TTestParserFunctions.TestFunction24; + +Var + I : TFPExprIdentifierDef; + +begin + I:=FP.Identifiers.AddFunction('AddInteger','I','II',@DoAddInteger); + AssertEquals('List is dirty',True,FP.Dirty); + AssertNotNull('Addvariable returns result',I); + AssertEquals('One variable added',1,FP.Identifiers.Count); + AssertSame('Result equals variable added',I,FP.Identifiers[0]); + AssertEquals('Function has correct resulttype',rtInteger,I.ResultType); + FP.Expression:='AddInteger(1,2)'; + AssertNotNull('Have result node',FP.ExprNode); + AssertNodeType('Constant expression',TFPFunctionEventHandler, FP.ExprNode); + AssertResultType(rtInteger); + AssertResult(3); +end; + +procedure TTestParserFunctions.TestFunction25; + +Var + I : TFPExprIdentifierDef; + +begin + I:=FP.Identifiers.AddFunction('Delete','S','SII',@DoDeleteString); + AssertEquals('List is dirty',True,FP.Dirty); + AssertNotNull('Addvariable returns result',I); + AssertEquals('One variable added',1,FP.Identifiers.Count); + AssertSame('Result equals variable added',I,FP.Identifiers[0]); + AssertEquals('Function has correct resulttype',rtString,I.ResultType); + FP.Expression:='Delete(''ABCDEFGHIJ'',3,2)'; + AssertNotNull('Have result node',FP.ExprNode); + AssertNodeType('Constant expression',TFPFunctionEventHandler, FP.ExprNode); + AssertResultType(rtString); + AssertResult('ABEFGHIJ'); +end; + +procedure TTestParserFunctions.TestFunction26; + +Var + I : TFPExprIdentifierDef; + +begin + I:=FP.Identifiers.AddFunction('AddInteger','I','II',@DoAddInteger); + AssertEquals('List is dirty',True,FP.Dirty); + AssertNotNull('Addvariable returns result',I); + AssertEquals('One variable added',1,FP.Identifiers.Count); + AssertSame('Result equals variable added',I,FP.Identifiers[0]); + AssertEquals('Function has correct resulttype',rtInteger,I.ResultType); + FP.Expression:='AddInteger(1,2+3)'; + AssertNotNull('Have result node',FP.ExprNode); + AssertNodeType('Constant expression',TFPFunctionEventHandler, FP.ExprNode); + AssertResultType(rtInteger); + AssertResult(6); +end; + +procedure TTestParserFunctions.TestFunction27; + +Var + I : TFPExprIdentifierDef; + +begin + I:=FP.Identifiers.AddFunction('AddInteger','I','II',@DoAddInteger); + AssertEquals('List is dirty',True,FP.Dirty); + AssertNotNull('Addvariable returns result',I); + AssertEquals('One variable added',1,FP.Identifiers.Count); + AssertSame('Result equals variable added',I,FP.Identifiers[0]); + AssertEquals('Function has correct resulttype',rtInteger,I.ResultType); + FP.Expression:='AddInteger(1+2,3*4)'; + AssertNotNull('Have result node',FP.ExprNode); + AssertNodeType('Constant expression',TFPFunctionEventHandler, FP.ExprNode); + AssertResultType(rtInteger); + AssertResult(15); +end; + +procedure TTestParserFunctions.TestFunction28; + +Var + I : TFPExprIdentifierDef; + +begin + I:=FP.Identifiers.AddFunction('AddInteger','I','II',@DoAddInteger); + AssertEquals('List is dirty',True,FP.Dirty); + AssertNotNull('Addvariable returns result',I); + AssertEquals('One variable added',1,FP.Identifiers.Count); + AssertSame('Result equals variable added',I,FP.Identifiers[0]); + AssertEquals('Function has correct resulttype',rtInteger,I.ResultType); + FP.Expression:='AddInteger(3 and 2,3*4)'; + AssertNotNull('Have result node',FP.ExprNode); + AssertNodeType('Constant expression',TFPFunctionEventHandler, FP.ExprNode); + AssertResultType(rtInteger); + AssertResult(14); +end; + +procedure TTestParserFunctions.TestFunction29; + +Var + I : TFPExprIdentifierDef; + +begin + // Test type mismatch + I:=FP.Identifiers.AddFunction('AddInteger','I','II',@DoAddInteger); + TestParser('AddInteger(3 and 2,''s'')'); +end; + +{ TTestBuiltinsManager } + +procedure TTestBuiltinsManager.Setup; +begin + inherited Setup; + FM:=TExprBuiltInManager.Create(Nil); +end; + +procedure TTestBuiltinsManager.Teardown; +begin + FreeAndNil(FM); + inherited Teardown; +end; + +procedure TTestBuiltinsManager.TestCreate; +begin + AssertEquals('Have no builtin expressions',0,FM.IdentifierCount); +end; + +procedure TTestBuiltinsManager.TestVariable1; + +Var + I : TFPBuiltinExprIdentifierDef; + +begin + I:=FM.AddVariable(bcuser,'a',rtBoolean,'True'); + AssertNotNull('Addvariable returns result',I); + AssertEquals('One variable added',1,FM.IdentifierCount); + AssertSame('Result equals variable added',I,FM.Identifiers[0]); + AssertEquals('Variable has correct category',ord(bcUser),Ord(I.Category)); + AssertEquals('Variable has correct resulttype',rtBoolean,I.ResultType); + AssertEquals('Variable has correct value','True',I.Value); +end; + +procedure TTestBuiltinsManager.TestVariable2; + +Var + I : TFPBuiltinExprIdentifierDef; + +begin + I:=FM.AddBooleanVariable(bcUser,'a',False); + AssertNotNull('Addvariable returns result',I); + AssertEquals('One variable added',1,FM.IdentifierCount); + AssertSame('Result equals variable added',I,FM.Identifiers[0]); + AssertEquals('Variable has correct category',ord(bcUser),Ord(I.Category)); + AssertEquals('Variable has correct resulttype',rtBoolean,I.ResultType); + AssertEquals('Variable has correct value','False',I.Value); +end; + +procedure TTestBuiltinsManager.TestVariable3; + +Var + I : TFPBuiltinExprIdentifierDef; + +begin + I:=FM.AddIntegerVariable(bcUser,'a',123); + AssertNotNull('Addvariable returns result',I); + AssertEquals('One variable added',1,FM.IdentifierCount); + AssertSame('Result equals variable added',I,FM.Identifiers[0]); + AssertEquals('Variable has correct category',ord(bcUser),Ord(I.Category)); + AssertEquals('Variable has correct resulttype',rtInteger,I.ResultType); + AssertEquals('Variable has correct value','123',I.Value); +end; + +procedure TTestBuiltinsManager.TestVariable4; + +Var + I : TFPBuiltinExprIdentifierDef; + +begin + I:=FM.AddFloatVariable(bcUser,'a',1.23); + AssertNotNull('Addvariable returns result',I); + AssertEquals('One variable added',1,FM.IdentifierCount); + AssertSame('Result equals variable added',I,FM.Identifiers[0]); + AssertEquals('Variable has correct category',ord(bcUser),Ord(I.Category)); + AssertEquals('Variable has correct resulttype',rtFloat,I.ResultType); + AssertEquals('Variable has correct value',FloatToStr(1.23),I.Value); +end; + +procedure TTestBuiltinsManager.TestVariable5; + +Var + I : TFPBuiltinExprIdentifierDef; + +begin + I:=FM.AddStringVariable(bcUser,'a','1.23'); + AssertNotNull('Addvariable returns result',I); + AssertEquals('One variable added',1,FM.IdentifierCount); + AssertSame('Result equals variable added',I,FM.Identifiers[0]); + AssertEquals('Variable has correct category',ord(bcUser),Ord(I.Category)); + AssertEquals('Variable has correct resulttype',rtString,I.ResultType); + AssertEquals('Variable has correct value','1.23',I.Value); +end; + +procedure TTestBuiltinsManager.TestVariable6; +Var + I : TFPBuiltinExprIdentifierDef; + D : TDateTime; + +begin + D:=Now; + I:=FM.AddDateTimeVariable(bcUser,'a',D); + AssertNotNull('Addvariable returns result',I); + AssertEquals('One variable added',1,FM.IdentifierCount); + AssertSame('Result equals variable added',I,FM.Identifiers[0]); + AssertEquals('Variable has correct category',ord(bcUser),Ord(I.Category)); + AssertEquals('Variable has correct resulttype',rtDateTime,I.ResultType); + AssertEquals('Variable has correct value',FormatDateTime('cccc',D),I.Value); +end; + +procedure TTestBuiltinsManager.TestFunction1; + +Var + I : TFPBuiltinExprIdentifierDef; + +begin + I:=FM.AddFunction(bcUser,'Date','D','',@GetDate); + AssertNotNull('Addvariable returns result',I); + AssertEquals('One variable added',1,FM.IdentifierCount); + AssertSame('Result equals variable added',I,FM.Identifiers[0]); + AssertEquals('Variable has correct category',ord(bcUser),Ord(I.Category)); + AssertEquals('Function has correct resulttype',rtDateTime,I.ResultType); + AssertSame('Function has correct address',Pointer(@GetDate),Pointer(I.OnGetFunctionValueCallBack)); +end; + +procedure TTestBuiltinsManager.TestFunction2; + +Var + I,I2 : TFPBuiltinExprIdentifierDef; + ind : Integer; + +begin + FM.AddFunction(bcUser,'EchoDate','D','D',@EchoDate); + I:=FM.AddFunction(bcUser,'Echo','D','D',@EchoDate); + FM.AddFunction(bcUser,'DoEcho','D','D',@EchoDate); + ind:=FM.IndexOfIdentifier('Echo'); + AssertEquals('Found identifier',1,ind); + I2:=FM.FindIdentifier('Echo'); + AssertNotNull('FindIdentifier returns result',I2); + AssertSame('Findidentifier returns correct result',I,I2); + ind:=FM.IndexOfIdentifier('NoNoNo'); + AssertEquals('Found no such identifier',-1,ind); + I2:=FM.FindIdentifier('NoNoNo'); + AssertNull('FindIdentifier returns no result',I2); +end; + +{ TTestBuiltins } + +procedure TTestBuiltins.Setup; +begin + inherited Setup; + FM:=TExprBuiltInManager.Create(Nil); +end; + +procedure TTestBuiltins.Teardown; +begin + FreeAndNil(FM); + inherited Teardown; +end; + +procedure TTestBuiltins.SetExpression(Const AExpression : String); + +Var + Msg : String; + +begin + Msg:=''; + try + FP.Expression:=AExpression; + except + On E : Exception do + Msg:=E.message; + end; + If (Msg<>'') then + Fail('Parsing of expression "'+AExpression+'" failed :'+Msg); +end; + +procedure TTestBuiltins.AssertVariable(const ADefinition: String; + AResultType: TResultType); + +Var + I : TFPBuiltinExprIdentifierDef; + +begin + I:=FM.FindIdentifier(ADefinition); + AssertNotNull('Definition '+ADefinition+' is present.',I); + AssertEquals('Correct result type',AResultType,I.ResultType); +end; + +procedure TTestBuiltins.AssertFunction(const ADefinition, AResultType, + ArgumentTypes: String; ACategory : TBuiltinCategory); + +Var + I : TFPBuiltinExprIdentifierDef; + +begin + I:=FM.FindIdentifier(ADefinition); + AssertEquals('Correct result type for test',1,Length(AResultType)); + AssertNotNull('Definition '+ADefinition+' is present.',I); + AssertEquals(ADefinition+' has correct parameter types',ArgumentTypes,I.ParameterTypes); + AssertEquals(ADefinition+' has correct result type',CharToResultType(AResultType[1]),I.ResultType); + AssertEquals(ADefinition+' has correct category',Ord(ACategory),Ord(I.Category)); +end; + +procedure TTestBuiltins.AssertExpression(const AExpression: String; + AResult: Int64); + +begin + FP.BuiltIns:=AllBuiltIns; + SetExpression(AExpression); + AssertResult(AResult); +end; + +procedure TTestBuiltins.AssertExpression(const AExpression: String; + const AResult: String); +begin + FP.BuiltIns:=AllBuiltIns; + SetExpression(AExpression); + AssertResult(AResult); +end; + +procedure TTestBuiltins.AssertExpression(const AExpression: String; + const AResult: TExprFloat); +begin + FP.BuiltIns:=AllBuiltIns; + SetExpression(AExpression); + AssertResult(AResult); +end; + +procedure TTestBuiltins.AssertExpression(const AExpression: String; + const AResult: Boolean); +begin + FP.BuiltIns:=AllBuiltIns; + SetExpression(AExpression); + AssertResult(AResult); +end; + +procedure TTestBuiltins.AssertDateTimeExpression(const AExpression: String; + const AResult: TDateTime); +begin + FP.BuiltIns:=AllBuiltIns; + SetExpression(AExpression); + AssertDatetimeResult(AResult); +end; + +procedure TTestBuiltins.TestRegister; + +begin + RegisterStdBuiltins(FM); + AssertEquals('Correct number of identifiers',64,FM.IdentifierCount); + Assertvariable('pi',rtFloat); + AssertFunction('cos','F','F',bcMath); + AssertFunction('sin','F','F',bcMath); + AssertFunction('arctan','F','F',bcMath); + AssertFunction('abs','F','F',bcMath); + AssertFunction('sqr','F','F',bcMath); + AssertFunction('sqrt','F','F',bcMath); + AssertFunction('exp','F','F',bcMath); + AssertFunction('ln','F','F',bcMath); + AssertFunction('log','F','F',bcMath); + AssertFunction('frac','F','F',bcMath); + AssertFunction('int','F','F',bcMath); + AssertFunction('round','I','F',bcMath); + AssertFunction('trunc','I','F',bcMath); + AssertFunction('length','I','S',bcStrings); + AssertFunction('copy','S','SII',bcStrings); + AssertFunction('delete','S','SII',bcStrings); + AssertFunction('pos','I','SS',bcStrings); + AssertFunction('lowercase','S','S',bcStrings); + AssertFunction('uppercase','S','S',bcStrings); + AssertFunction('stringreplace','S','SSSBB',bcStrings); + AssertFunction('comparetext','I','SS',bcStrings); + AssertFunction('date','D','',bcDateTime); + AssertFunction('time','D','',bcDateTime); + AssertFunction('now','D','',bcDateTime); + AssertFunction('dayofweek','I','D',bcDateTime); + AssertFunction('extractyear','I','D',bcDateTime); + AssertFunction('extractmonth','I','D',bcDateTime); + AssertFunction('extractday','I','D',bcDateTime); + AssertFunction('extracthour','I','D',bcDateTime); + AssertFunction('extractmin','I','D',bcDateTime); + AssertFunction('extractsec','I','D',bcDateTime); + AssertFunction('extractmsec','I','D',bcDateTime); + AssertFunction('encodedate','D','III',bcDateTime); + AssertFunction('encodetime','D','IIII',bcDateTime); + AssertFunction('encodedatetime','D','IIIIIII',bcDateTime); + AssertFunction('shortdayname','S','I',bcDateTime); + AssertFunction('shortmonthname','S','I',bcDateTime); + AssertFunction('longdayname','S','I',bcDateTime); + AssertFunction('longmonthname','S','I',bcDateTime); + AssertFunction('formatdatetime','S','SD',bcDateTime); + AssertFunction('shl','I','II',bcBoolean); + AssertFunction('shr','I','II',bcBoolean); + AssertFunction('IFS','S','BSS',bcBoolean); + AssertFunction('IFF','F','BFF',bcBoolean); + AssertFunction('IFD','D','BDD',bcBoolean); + AssertFunction('IFI','I','BII',bcBoolean); + AssertFunction('inttostr','S','I',bcConversion); + AssertFunction('strtoint','I','S',bcConversion); + AssertFunction('strtointdef','I','SI',bcConversion); + AssertFunction('floattostr','S','F',bcConversion); + AssertFunction('strtofloat','F','S',bcConversion); + AssertFunction('strtofloatdef','F','SF',bcConversion); + AssertFunction('booltostr','S','B',bcConversion); + AssertFunction('strtobool','B','S',bcConversion); + AssertFunction('strtobooldef','B','SB',bcConversion); + AssertFunction('datetostr','S','D',bcConversion); + AssertFunction('timetostr','S','D',bcConversion); + AssertFunction('strtodate','D','S',bcConversion); + AssertFunction('strtodatedef','D','SD',bcConversion); + AssertFunction('strtotime','D','S',bcConversion); + AssertFunction('strtotimedef','D','SD',bcConversion); + AssertFunction('strtodatetime','D','S',bcConversion); + AssertFunction('strtodatetimedef','D','SD',bcConversion); +end; + +procedure TTestBuiltins.TestVariablepi; +begin + AssertExpression('pi',Pi); +end; + +procedure TTestBuiltins.TestFunctioncos; +begin + AssertExpression('cos(0.5)',Cos(0.5)); + AssertExpression('cos(0.75)',Cos(0.75)); +end; + +procedure TTestBuiltins.TestFunctionsin; +begin + AssertExpression('sin(0.5)',sin(0.5)); + AssertExpression('sin(0.75)',sin(0.75)); +end; + +procedure TTestBuiltins.TestFunctionarctan; +begin + AssertExpression('arctan(0.5)',arctan(0.5)); + AssertExpression('arctan(0.75)',arctan(0.75)); +end; + +procedure TTestBuiltins.TestFunctionabs; +begin + AssertExpression('abs(0.5)',0.5); + AssertExpression('abs(-0.75)',0.75); +end; + +procedure TTestBuiltins.TestFunctionsqr; +begin + AssertExpression('sqr(0.5)',sqr(0.5)); + AssertExpression('sqr(-0.75)',sqr(0.75)); +end; + +procedure TTestBuiltins.TestFunctionsqrt; +begin + AssertExpression('sqrt(0.5)',sqrt(0.5)); + AssertExpression('sqrt(0.75)',sqrt(0.75)); +end; + +procedure TTestBuiltins.TestFunctionexp; +begin + AssertExpression('exp(1.0)',exp(1)); + AssertExpression('exp(0.0)',1.0); +end; + +procedure TTestBuiltins.TestFunctionln; +begin + AssertExpression('ln(0.5)',ln(0.5)); + AssertExpression('ln(1.5)',ln(1.5)); +end; + +procedure TTestBuiltins.TestFunctionlog; +begin + AssertExpression('log(0.5)',ln(0.5)/ln(10.0)); + AssertExpression('log(1.5)',ln(1.5)/ln(10.0)); + AssertExpression('log(10.0)',1.0); +end; + +procedure TTestBuiltins.TestFunctionfrac; +begin + AssertExpression('frac(0.5)',frac(0.5)); + AssertExpression('frac(1.5)',frac(1.5)); +end; + +procedure TTestBuiltins.TestFunctionint; +begin + AssertExpression('int(0.5)',int(0.5)); + AssertExpression('int(1.5)',int(1.5)); +end; + +procedure TTestBuiltins.TestFunctionround; +begin + AssertExpression('round(0.5)',round(0.5)); + AssertExpression('round(1.55)',round(1.55)); +end; + +procedure TTestBuiltins.TestFunctiontrunc; +begin + AssertExpression('trunc(0.5)',trunc(0.5)); + AssertExpression('trunc(1.55)',trunc(1.55)); +end; + +procedure TTestBuiltins.TestFunctionlength; +begin + AssertExpression('length(''123'')',3); +end; + +procedure TTestBuiltins.TestFunctioncopy; +begin + AssertExpression('copy(''123456'',2,4)','2345'); +end; + +procedure TTestBuiltins.TestFunctiondelete; +begin + AssertExpression('delete(''123456'',2,4)','16'); +end; + +procedure TTestBuiltins.TestFunctionpos; +begin + AssertExpression('pos(''234'',''123456'')',2); +end; + +procedure TTestBuiltins.TestFunctionlowercase; +begin + AssertExpression('lowercase(''AbCdEf'')','abcdef'); +end; + +procedure TTestBuiltins.TestFunctionuppercase; +begin + AssertExpression('uppercase(''AbCdEf'')','ABCDEF'); +end; + +procedure TTestBuiltins.TestFunctionstringreplace; +begin + // last options are replaceall, ignorecase + AssertExpression('stringreplace(''AbCdEf'',''C'',''Z'',false,false)','AbZdEf'); + AssertExpression('stringreplace(''AbCdEf'',''c'',''Z'',false,false)','AbCdEf'); + AssertExpression('stringreplace(''AbCdEf'',''c'',''Z'',false,true)','AbZdEf'); + AssertExpression('stringreplace(''AbCdEfC'',''C'',''Z'',false,false)','AbZdEfC'); + AssertExpression('stringreplace(''AbCdEfC'',''C'',''Z'',True,false)','AbZdEfZ'); +end; + +procedure TTestBuiltins.TestFunctioncomparetext; +begin + AssertExpression('comparetext(''AbCdEf'',''AbCdEf'')',0); + AssertExpression('comparetext(''AbCdEf'',''ABCDEF'')',0); + AssertExpression('comparetext(''AbCdEf'',''FEDCBA'')',comparetext('AbCdEf','FEDCBA')); +end; + +procedure TTestBuiltins.TestFunctiondate; +begin + AssertExpression('date',date); +end; + +procedure TTestBuiltins.TestFunctiontime; +begin + AssertExpression('time',time); +end; + +procedure TTestBuiltins.TestFunctionnow; +begin + AssertExpression('now',now); +end; + +procedure TTestBuiltins.TestFunctiondayofweek; +begin + FP.Identifiers.AddDateTimeVariable('D',Date); + AssertExpression('dayofweek(d)',DayOfWeek(date)); +end; + +procedure TTestBuiltins.TestFunctionextractyear; + +Var + Y,M,D : Word; + +begin + DecodeDate(Date,Y,M,D); + FP.Identifiers.AddDateTimeVariable('D',Date); + AssertExpression('extractyear(d)',Y); +end; + +procedure TTestBuiltins.TestFunctionextractmonth; + +Var + Y,M,D : Word; + +begin + FP.Identifiers.AddDateTimeVariable('D',Date); + DecodeDate(Date,Y,M,D); + AssertExpression('extractmonth(d)',M); +end; + +procedure TTestBuiltins.TestFunctionextractday; + +Var + Y,M,D : Word; + +begin + DecodeDate(Date,Y,M,D); + FP.Identifiers.AddDateTimeVariable('D',Date); + AssertExpression('extractday(d)',D); +end; + +procedure TTestBuiltins.TestFunctionextracthour; + +Var + T : TDateTime; + H,m,s,ms : Word; + +begin + T:=Time; + DecodeTime(T,h,m,s,ms); + FP.Identifiers.AddDateTimeVariable('T',T); + AssertExpression('extracthour(t)',h); +end; + +procedure TTestBuiltins.TestFunctionextractmin; +Var + T : TDateTime; + H,m,s,ms : Word; + +begin + T:=Time; + DecodeTime(T,h,m,s,ms); + FP.Identifiers.AddDateTimeVariable('T',T); + AssertExpression('extractmin(t)',m); +end; + +procedure TTestBuiltins.TestFunctionextractsec; +Var + T : TDateTime; + H,m,s,ms : Word; + +begin + T:=Time; + DecodeTime(T,h,m,s,ms); + FP.Identifiers.AddDateTimeVariable('T',T); + AssertExpression('extractsec(t)',s); +end; + +procedure TTestBuiltins.TestFunctionextractmsec; +Var + T : TDateTime; + H,m,s,ms : Word; + +begin + T:=Time; + DecodeTime(T,h,m,s,ms); + FP.Identifiers.AddDateTimeVariable('T',T); + AssertExpression('extractmsec(t)',ms); +end; + +procedure TTestBuiltins.TestFunctionencodedate; +begin + AssertExpression('encodedate(2008,10,11)',EncodeDate(2008,10,11)); +end; + +procedure TTestBuiltins.TestFunctionencodetime; +begin + AssertExpression('encodetime(14,10,11,0)',EncodeTime(14,10,11,0)); +end; + +procedure TTestBuiltins.TestFunctionencodedatetime; +begin + AssertExpression('encodedatetime(2008,12,13,14,10,11,0)',EncodeDate(2008,12,13)+EncodeTime(14,10,11,0)); +end; + +procedure TTestBuiltins.TestFunctionshortdayname; +begin + AssertExpression('shortdayname(1)',ShortDayNames[1]); + AssertExpression('shortdayname(7)',ShortDayNames[7]); +end; + +procedure TTestBuiltins.TestFunctionshortmonthname; +begin + AssertExpression('shortmonthname(1)',ShortMonthNames[1]); + AssertExpression('shortmonthname(12)',ShortMonthNames[12]); +end; + +procedure TTestBuiltins.TestFunctionlongdayname; +begin + AssertExpression('longdayname(1)',longDayNames[1]); + AssertExpression('longdayname(7)',longDayNames[7]); +end; + +procedure TTestBuiltins.TestFunctionlongmonthname; +begin + AssertExpression('longmonthname(1)',longMonthNames[1]); + AssertExpression('longmonthname(12)',longMonthNames[12]); +end; + +procedure TTestBuiltins.TestFunctionformatdatetime; +begin + AssertExpression('FormatDateTime(''cccc'',Date)',FormatDateTime('cccc',Date)); +end; + +procedure TTestBuiltins.TestFunctionshl; + +Var + I : Int64; + +begin + AssertExpression('shl(12,3)',12 shl 3); + I:=12 shl 30; + AssertExpression('shl(12,30)',I); +end; + +procedure TTestBuiltins.TestFunctionshr; +begin + AssertExpression('shr(12,2)',12 shr 2); +end; + +procedure TTestBuiltins.TestFunctionIFS; +begin + AssertExpression('ifs(true,''string1'',''string2'')','string1'); + AssertExpression('ifs(false,''string1'',''string2'')','string2'); +end; + +procedure TTestBuiltins.TestFunctionIFF; +begin + AssertExpression('iff(true,1.0,2.0)',1.0); + AssertExpression('iff(false,1.0,2.0)',2.0); +end; + +procedure TTestBuiltins.TestFunctionIFD; +begin + FP.Identifiers.AddDateTimeVariable('A',Date); + FP.Identifiers.AddDateTimeVariable('B',Date-1); + AssertExpression('ifd(true,A,B)',Date); + AssertExpression('ifd(false,A,B)',Date-1); +end; + +procedure TTestBuiltins.TestFunctionIFI; +begin + AssertExpression('ifi(true,1,2)',1); + AssertExpression('ifi(false,1,2)',2); +end; + +procedure TTestBuiltins.TestFunctioninttostr; +begin + AssertExpression('inttostr(2)','2'); +end; + +procedure TTestBuiltins.TestFunctionstrtoint; +begin + AssertExpression('strtoint(''2'')',2); +end; + +procedure TTestBuiltins.TestFunctionstrtointdef; +begin + AssertExpression('strtointdef(''abc'',2)',2); +end; + +procedure TTestBuiltins.TestFunctionfloattostr; +begin + AssertExpression('floattostr(1.23)',Floattostr(1.23)); +end; + +procedure TTestBuiltins.TestFunctionstrtofloat; + +Var + S : String; + +begin + S:='1.23'; + S[2]:=DecimalSeparator; + AssertExpression('strtofloat('''+S+''')',1.23); +end; + +procedure TTestBuiltins.TestFunctionstrtofloatdef; + +begin + AssertExpression('strtofloatdef(''abc'',1.23)',1.23); +end; + +procedure TTestBuiltins.TestFunctionbooltostr; +begin + AssertExpression('strtofloatdef(''abc'',1.23)',1.23); +end; + +procedure TTestBuiltins.TestFunctionstrtobool; +begin + AssertExpression('strtobool(''0'')',false); +end; + +procedure TTestBuiltins.TestFunctionstrtobooldef; +begin + AssertExpression('strtobooldef(''XYZ'',True)',True); +end; + +procedure TTestBuiltins.TestFunctiondatetostr; +begin + FP.Identifiers.AddDateTimeVariable('A',Date); + AssertExpression('DateToStr(A)',DateToStr(Date)); +end; + +procedure TTestBuiltins.TestFunctiontimetostr; + +Var + T : TDateTime; + +begin + T:=Time; + FP.Identifiers.AddDateTimeVariable('A',T); + AssertExpression('TimeToStr(A)',TimeToStr(T)); +end; + +procedure TTestBuiltins.TestFunctionstrtodate; + +begin + FP.Identifiers.AddStringVariable('S',DateToStr(Date)); + AssertExpression('StrToDate(S)',Date); +end; + +procedure TTestBuiltins.TestFunctionstrtodatedef; +begin + FP.Identifiers.AddDateTimeVariable('A',Date); + AssertExpression('StrToDateDef(''S'',A)',Date); +end; + +procedure TTestBuiltins.TestFunctionstrtotime; + +Var + T : TDateTime; + +begin + T:=Time; + FP.Identifiers.AddStringVariable('S',TimeToStr(T)); + AssertExpression('StrToTime(S)',T); +end; + +procedure TTestBuiltins.TestFunctionstrtotimedef; +Var + T : TDateTime; + +begin + T:=Time; + FP.Identifiers.AddDateTimeVariable('S',T); + AssertExpression('StrToTimeDef(''q'',S)',T); +end; + +procedure TTestBuiltins.TestFunctionstrtodatetime; + +Var + T : TDateTime; + S : String; + +begin + T:=Now; + S:=DateTimetostr(T); + AssertExpression('StrToDateTime('''+S+''')',T); +end; + +procedure TTestBuiltins.TestFunctionstrtodatetimedef; + +Var + T : TDateTime; + S : String; + +begin + T:=Now; + S:=DateTimetostr(T); + FP.Identifiers.AddDateTimeVariable('S',T); + AssertExpression('StrToDateTimeDef('''+S+''',S)',T); +end; + +{ TTestNotNode } + +procedure TTestNotNode.TearDown; +begin + FreeAndNil(FN); + inherited TearDown; +end; + +procedure TTestNotNode.TestCreateInteger; +begin + FN:=TFPNotNode.Create(CreateIntNode(3)); + AssertNodeOK(FN); + AssertEquals('Correct node type',rtInteger,FN.NodeType); + AssertEquals('Correct result',Not(Int64(3)),FN.NodeValue.ResInteger); +end; + +procedure TTestNotNode.TestCreateBoolean; +begin + FN:=TFPNotNode.Create(CreateBoolNode(True)); + AssertNodeOK(FN); + AssertEquals('Correct node type',rtBoolean,FN.NodeType); + AssertEquals('Correct result',False,FN.NodeValue.ResBoolean); +end; + +procedure TTestNotNode.TestCreateString; +begin + FN:=TFPNotNode.Create(CreateStringNode('True')); + AssertNodeNotOK('String node type',FN); +end; + +procedure TTestNotNode.TestCreateFloat; +begin + FN:=TFPNotNode.Create(CreateFloatNode(1.23)); + AssertNodeNotOK('String node type',FN); +end; + +procedure TTestNotNode.TestCreateDateTime; +begin + FN:=TFPNotNode.Create(CreateDateTimeNode(Now)); + AssertNodeNotOK('String node type',FN); +end; + +procedure TTestNotNode.TestDestroy; +begin + FN:=TFPNotNode.Create(TMyDestroyNode.CreateTest(Self)); + FreeAndNil(FN); + AssertEquals('Destroy called for operand',1,self.FDestroyCalled) +end; + +{ TTestIfOperation } + +procedure TTestIfOperation.TearDown; +begin + FreeAndNil(FN); + inherited TearDown; +end; + +procedure TTestIfOperation.TestCreateInteger; +begin + FN:=TIfOperation.Create(CreateIntNode(1),CreateIntNode(2),CreateIntNode(3)); + AssertNodeNotOK('First argument wrong',FN); +end; + +procedure TTestIfOperation.TestCreateBoolean; +begin + FN:=TIfOperation.Create(CreateBoolNode(True),CreateIntNode(2),CreateIntNode(3)); + AssertNodeOK(FN); + AssertEquals('Correct node type',rtInteger,FN.NodeType); + AssertEquals('Correct result',2,FN.NodeValue.ResInteger); +end; + +procedure TTestIfOperation.TestCreateBoolean2; +begin + FN:=TIfOperation.Create(CreateBoolNode(False),CreateIntNode(2),CreateIntNode(3)); + AssertNodeOK(FN); + AssertEquals('Correct node type',rtInteger,FN.NodeType); + AssertEquals('Correct result',3,FN.NodeValue.ResInteger); +end; + +procedure TTestIfOperation.TestCreateBooleanInteger; +begin + FN:=TIfOperation.Create(CreateBoolNode(False),CreateIntNode(2),CreateBoolNode(False)); + AssertNodeNotOK('Arguments differ in type',FN); +end; + +procedure TTestIfOperation.TestCreateBooleanInteger2; +begin + FN:=TIfOperation.Create(CreateBoolNode(True),CreateIntNode(2),CreateIntNode(3)); + AssertNodeOK(FN); + AssertEquals('Correct node type',rtInteger,FN.NodeType); + AssertEquals('Correct result',2,FN.NodeValue.ResInteger); +end; + +procedure TTestIfOperation.TestCreateBooleanString; +begin + FN:=TIfOperation.Create(CreateBoolNode(True),CreateStringNode('2'),CreateStringNode('3')); + AssertNodeOK(FN); + AssertEquals('Correct node type',rtString,FN.NodeType); + AssertEquals('Correct result','2',FN.NodeValue.ResString); +end; + +procedure TTestIfOperation.TestCreateBooleanString2; +begin + FN:=TIfOperation.Create(CreateBoolNode(False),CreateStringNode('2'),CreateStringNode('3')); + AssertNodeOK(FN); + AssertEquals('Correct node type',rtString,FN.NodeType); + AssertEquals('Correct result','3',FN.NodeValue.ResString); +end; + +procedure TTestIfOperation.TestCreateBooleanDateTime; +begin + FN:=TIfOperation.Create(CreateBoolNode(True),CreateDateTimeNode(Date),CreateDateTimeNode(Date-1)); + AssertNodeOK(FN); + AssertEquals('Correct node type',rtDateTime,FN.NodeType); + AssertEquals('Correct result',Date,FN.NodeValue.ResDateTime); +end; + +procedure TTestIfOperation.TestCreateBooleanDateTime2; +begin + FN:=TIfOperation.Create(CreateBoolNode(False),CreateDateTimeNode(Date),CreateDateTimeNode(Date-1)); + AssertNodeOK(FN); + AssertEquals('Correct node type',rtDateTime,FN.NodeType); + AssertEquals('Correct result',Date-1,FN.NodeValue.ResDateTime); +end; + +procedure TTestIfOperation.TestCreateString; +begin + FN:=TIfOperation.Create(CreateStringNode('1'),CreateIntNode(2),CreateIntNode(3)); + AssertNodeNotOK('First argument wrong',FN); +end; + +procedure TTestIfOperation.TestCreateFloat; +begin + FN:=TIfOperation.Create(CreateFloatNode(2.0),CreateIntNode(2),CreateIntNode(3)); + AssertNodeNotOK('First argument wrong',FN); +end; + +procedure TTestIfOperation.TestCreateDateTime; +begin + FN:=TIfOperation.Create(CreateDateTimeNode(Date),CreateIntNode(2),CreateIntNode(3)); + AssertNodeNotOK('First argument wrong',FN); +end; + +procedure TTestIfOperation.TestDestroy; +begin + FN:=TIfOperation.Create(TMyDestroyNode.CreateTest(Self),TMyDestroyNode.CreateTest(Self),TMyDestroyNode.CreateTest(Self)); + FreeAndNil(FN); + AssertEquals('Destroy called for operand',3,self.FDestroyCalled) +end; + +{ TTestCaseOperation } + +function TTestCaseOperation.CreateArgs( + Args: array of const): TExprArgumentArray; + +Var + I : Integer; + +begin + SetLength(Result,High(Args)-Low(Args)+1); + For I:=Low(Args) to High(Args) do + Result[I]:=Args[i].VObject as TFPExprNode; +end; + +procedure TTestCaseOperation.TearDown; +begin + FreeAndNil(FN); + inherited TearDown; +end; + +procedure TTestCaseOperation.TestCreateOne; +begin + FN:=TCaseOperation.Create(CreateArgs([CreateBoolNode(False)])); + AssertNodeNotOK('Too little arguments',FN); +end; + +procedure TTestCaseOperation.TestCreateTwo; +begin + FN:=TCaseOperation.Create(CreateArgs([CreateBoolNode(False),CreateBoolNode(False)])); + AssertNodeNotOK('Too little arguments',FN); +end; + +procedure TTestCaseOperation.TestCreateThree; +begin + FN:=TCaseOperation.Create(CreateArgs([CreateBoolNode(False),CreateBoolNode(False),CreateBoolNode(False)])); + AssertNodeNotOK('Too little arguments',FN); +end; + +procedure TTestCaseOperation.TestCreateOdd; +begin + FN:=TCaseOperation.Create(CreateArgs([CreateBoolNode(False),CreateBoolNode(False), + CreateBoolNode(False),CreateBoolNode(False), + CreateBoolNode(False)])); + AssertNodeNotOK('Odd number of arguments',FN); +end; + +procedure TTestCaseOperation.TestCreateNoExpression; +begin + FN:=TCaseOperation.Create(CreateArgs([CreateBoolNode(False), + CreateBoolNode(False), + TFPBinaryOrOperation.Create(CreateBoolNode(False),CreateBoolNode(False)), + CreateBoolNode(False)])); + AssertNodeNotOK('Label is not a constant expression',FN); +end; + +procedure TTestCaseOperation.TestCreateWrongLabel; +begin + FN:=TCaseOperation.Create(CreateArgs([CreateIntNode(1),CreateBoolNode(False), + CreateIntNode(1),CreateBoolNode(False), + CreateBoolNode(True),CreateBoolNode(False)])); + AssertNodeNotOK('Wrong label',FN); +end; + +procedure TTestCaseOperation.TestCreateWrongValue; +begin + FN:=TCaseOperation.Create(CreateArgs([CreateIntNode(1),CreateBoolNode(False), + CreateIntNode(1),CreateBoolNode(False), + CreateIntNode(2),CreateIntNode(1)])); + AssertNodeNotOK('Wrong value',FN); +end; + +procedure TTestCaseOperation.TestIntegerTag; +begin + FN:=TCaseOperation.Create(CreateArgs([CreateIntNode(1),CreateStringNode('many'), + CreateIntNode(1),CreateStringNode('one'), + CreateIntNode(2),CreateStringNode('two')])); + AssertNodeOK(FN); + AssertEquals('Correct node type',rtString,FN.NodeType); + AssertEquals('Correct result','one',FN.NodeValue.ResString); +end; + +procedure TTestCaseOperation.TestIntegerTagDefault; +begin + FN:=TCaseOperation.Create(CreateArgs([CreateIntNode(3),CreateStringNode('many'), + CreateIntNode(1),CreateStringNode('one'), + CreateIntNode(2),CreateStringNode('two')])); + AssertNodeOK(FN); + AssertEquals('Correct node type',rtString,FN.NodeType); + AssertEquals('Correct result','many',FN.NodeValue.ResString); +end; + +procedure TTestCaseOperation.TestStringTag; +begin + FN:=TCaseOperation.Create(CreateArgs([CreateStringNode('one'),CreateIntNode(3), + CreateStringNode('one'),CreateIntNode(1), + CreateStringNode('two'),CreateIntNode(2)])); + AssertNodeOK(FN); + AssertEquals('Correct node type',rtInteger,FN.NodeType); + AssertEquals('Correct result',1,FN.NodeValue.ResInteger); +end; + +procedure TTestCaseOperation.TestStringTagDefault; +begin + FN:=TCaseOperation.Create(CreateArgs([CreateStringNode('many'),CreateIntNode(3), + CreateStringNode('one'),CreateIntNode(1), + CreateStringNode('two'),CreateIntNode(2)])); + AssertNodeOK(FN); + AssertEquals('Correct node type',rtInteger,FN.NodeType); + AssertEquals('Correct result',3,FN.NodeValue.ResInteger); +end; + +procedure TTestCaseOperation.TestFloatTag; +begin + FN:=TCaseOperation.Create(CreateArgs([CreateFloatNode(1.0),CreateStringNode('many'), + CreateFloatNode(1.0),CreateStringNode('one'), + CreateFloatNode(2.0),CreateStringNode('two')])); + AssertNodeOK(FN); + AssertEquals('Correct node type',rtString,FN.NodeType); + AssertEquals('Correct result','one',FN.NodeValue.ResString); +end; + +procedure TTestCaseOperation.TestFloatTagDefault; +begin + FN:=TCaseOperation.Create(CreateArgs([CreateFloatNode(3.0),CreateStringNode('many'), + CreateFloatNode(1.0),CreateStringNode('one'), + CreateFloatNode(2.0),CreateStringNode('two')])); + AssertNodeOK(FN); + AssertEquals('Correct node type',rtString,FN.NodeType); + AssertEquals('Correct result','many',FN.NodeValue.ResString); +end; + +procedure TTestCaseOperation.TestBooleanTag; +begin + FN:=TCaseOperation.Create(CreateArgs([CreateBoolNode(True),CreateStringNode('unknown'), + CreateBoolNode(True),CreateStringNode('one'), + CreateBoolNode(False),CreateStringNode('two')])); + AssertNodeOK(FN); + AssertEquals('Correct node type',rtString,FN.NodeType); + AssertEquals('Correct result','one',FN.NodeValue.ResString); +end; + +procedure TTestCaseOperation.TestBooleanTagDefault; +begin + FN:=TCaseOperation.Create(CreateArgs([CreateBoolNode(True),CreateStringNode('unknown'), + CreateBoolNode(False),CreateStringNode('two')])); + AssertNodeOK(FN); + AssertEquals('Correct node type',rtString,FN.NodeType); + AssertEquals('Correct result','unknown',FN.NodeValue.ResString); +end; + +procedure TTestCaseOperation.TestDateTimeTag; +begin + FN:=TCaseOperation.Create(CreateArgs([CreateDateTimeNode(Date),CreateStringNode('later'), + CreateDateTimeNode(Date),CreateStringNode('today'), + CreateDateTimeNode(Date+1),CreateStringNode('tomorrow')])); + AssertNodeOK(FN); + AssertEquals('Correct node type',rtString,FN.NodeType); + AssertEquals('Correct result','today',FN.NodeValue.ResString); +end; + +procedure TTestCaseOperation.TestDateTimeTagDefault; +begin + FN:=TCaseOperation.Create(CreateArgs([CreateDateTimeNode(Date+2),CreateStringNode('later'), + CreateDateTimeNode(Date),CreateStringNode('today'), + CreateDateTimeNode(Date+1),CreateStringNode('tomorrow')])); + AssertNodeOK(FN); + AssertEquals('Correct node type',rtString,FN.NodeType); + AssertEquals('Correct result','later',FN.NodeValue.ResString); +end; + +procedure TTestCaseOperation.TestIntegerValue; +begin + FN:=TCaseOperation.Create(CreateArgs([CreateIntNode(1),CreateIntNode(0), + CreateIntNode(1),CreateIntNode(-1), + CreateIntNode(2),CreateIntNode(-2)])); + AssertNodeOK(FN); + AssertEquals('Correct node type',rtInteger,FN.NodeType); + AssertEquals('Correct result',-1,FN.NodeValue.ResInteger); +end; + +procedure TTestCaseOperation.TestIntegerValueDefault; +begin + FN:=TCaseOperation.Create(CreateArgs([CreateIntNode(3),CreateIntNode(0), + CreateIntNode(1),CreateIntNode(-1), + CreateIntNode(2),CreateIntNode(-2)])); + AssertNodeOK(FN); + AssertEquals('Correct node type',rtInteger,FN.NodeType); + AssertEquals('Correct result',0,FN.NodeValue.ResInteger); +end; + +procedure TTestCaseOperation.TestStringValue; +begin + FN:=TCaseOperation.Create(CreateArgs([CreateIntNode(1),CreateStringNode('many'), + CreateIntNode(1),CreateStringNode('one'), + CreateIntNode(2),CreateStringNode('two')])); + AssertNodeOK(FN); + AssertEquals('Correct node type',rtString,FN.NodeType); + AssertEquals('Correct result','one',FN.NodeValue.ResString); +end; + +procedure TTestCaseOperation.TestStringValueDefault; +begin + FN:=TCaseOperation.Create(CreateArgs([CreateIntNode(3),CreateStringNode('many'), + CreateIntNode(1),CreateStringNode('one'), + CreateIntNode(2),CreateStringNode('two')])); + AssertNodeOK(FN); + AssertEquals('Correct node type',rtString,FN.NodeType); + AssertEquals('Correct result','many',FN.NodeValue.ResString); +end; + +procedure TTestCaseOperation.TestFloatValue; +begin + FN:=TCaseOperation.Create(CreateArgs([CreateIntNode(1),CreateFloatNode(0.0), + CreateIntNode(1),CreateFloatNode(2.0), + CreateIntNode(2),CreateFloatNode(1.0)])); + AssertNodeOK(FN); + AssertEquals('Correct node type',rtFloat,FN.NodeType); + AssertEquals('Correct result',2.0,FN.NodeValue.ResFloat); +end; + +procedure TTestCaseOperation.TestFloatValueDefault; +begin + FN:=TCaseOperation.Create(CreateArgs([CreateIntNode(3),CreateFloatNode(0.0), + CreateIntNode(1),CreateFloatNode(2.0), + CreateIntNode(2),CreateFloatNode(1.0)])); + AssertNodeOK(FN); + AssertEquals('Correct node type',rtFloat,FN.NodeType); + AssertEquals('Correct result',0.0,FN.NodeValue.ResFloat); +end; + +procedure TTestCaseOperation.TestBooleanValue; +begin + FN:=TCaseOperation.Create(CreateArgs([CreateIntNode(1),CreateBoolNode(False), + CreateIntNode(1),CreateBoolNode(True), + CreateIntNode(2),CreateBoolNode(False)])); + AssertNodeOK(FN); + AssertEquals('Correct node type',rtBoolean,FN.NodeType); + AssertEquals('Correct result',True,FN.NodeValue.ResBoolean); +end; + +procedure TTestCaseOperation.TestBooleanValueDefault; +begin + FN:=TCaseOperation.Create(CreateArgs([CreateIntNode(3),CreateBoolNode(False), + CreateIntNode(1),CreateBoolNode(True), + CreateIntNode(2),CreateBoolNode(False)])); + AssertNodeOK(FN); + AssertEquals('Correct node type',rtBoolean,FN.NodeType); + AssertEquals('Correct result',False,FN.NodeValue.ResBoolean); +end; + +procedure TTestCaseOperation.TestDateTimeValue; +begin + FN:=TCaseOperation.Create(CreateArgs([CreateIntNode(1),CreateDateTimeNode(Date+1), + CreateIntNode(1),CreateDateTimeNode(Date), + CreateIntNode(2),CreateDateTimeNode(Date-1)])); + AssertNodeOK(FN); + AssertEquals('Correct node type',rtDateTime,FN.NodeType); + AssertEquals('Correct result',Date,FN.NodeValue.ResDateTime); +end; + +procedure TTestCaseOperation.TestDateTimeValueDefault; +begin + FN:=TCaseOperation.Create(CreateArgs([CreateIntNode(3),CreateDateTimeNode(Date+1), + CreateIntNode(1),CreateDateTimeNode(Date), + CreateIntNode(2),CreateDateTimeNode(Date-1)])); + AssertNodeOK(FN); + AssertEquals('Correct node type',rtDateTime,FN.NodeType); + AssertEquals('Correct result',Date+1,FN.NodeValue.ResDateTime); +end; + +procedure TTestCaseOperation.TestDestroy; +begin + FN:=TCaseOperation.Create(CreateArgs([TMyDestroyNode.CreateTest(Self), + TMyDestroyNode.CreateTest(Self), + TMyDestroyNode.CreateTest(Self), + TMyDestroyNode.CreateTest(Self)])); + FreeAndNil(FN); + AssertEquals('Destroy called for operand',4,self.FDestroyCalled) +end; + +initialization + + RegisterTests([TTestExpressionScanner, TTestDestroyNode, + TTestConstExprNode,TTestNegateExprNode, + TTestBinaryAndNode,TTestBinaryOrNode,TTestBinaryXOrNode, + TTestNotNode,TTestEqualNode,TTestUnEqualNode, + TTestIfOperation,TTestCaseOperation, + TTestLessThanNode,TTestLessThanEqualNode, + TTestLargerThanNode,TTestLargerThanEqualNode, + TTestAddNode,TTestSubtractNode, + TTestMultiplyNode,TTestDivideNode, + TTestIntToFloatNode,TTestIntToDateTimeNode, + TTestFloatToDateTimeNode, + TTestParserExpressions, TTestParserBooleanOperations, + TTestParserOperands, TTestParserTypeMatch, + TTestParserVariables,TTestParserFunctions, + TTestBuiltinsManager,TTestBuiltins]); +end. + diff --git a/packages/fcl-base/fpmake.pp b/packages/fcl-base/fpmake.pp index 2169847fbf..1a12b91460 100644 --- a/packages/fcl-base/fpmake.pp +++ b/packages/fcl-base/fpmake.pp @@ -99,6 +99,7 @@ begin begin AddUnit('wformat'); end; + T:=P.Targets.AddUnit('fpexprpars.pp'); // Windows units T:=P.Targets.AddUnit('ServiceManager.pas',[Win32,Win64]); diff --git a/packages/fcl-base/src/fpexprpars.pp b/packages/fcl-base/src/fpexprpars.pp new file mode 100644 index 0000000000..437be73947 --- /dev/null +++ b/packages/fcl-base/src/fpexprpars.pp @@ -0,0 +1,3406 @@ +{ + This file is part of the Free Component Library (FCL) + Copyright (c) 2008 Michael Van Canneyt. + + Expression parser, supports variables, functions and + float/integer/string/boolean/datetime operations. + + See the file COPYING.FPC, included in this distribution, + for details about the copyright. + + This program is distributed in the hope that it will be useful, + but WITHOUT ANY WARRANTY; without even the implied warranty of + MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. + + **********************************************************************} +{$mode objfpc} +{$h+} +unit fpexprpars; + +interface + +uses + Classes, SysUtils, contnrs; + +Type + // tokens + TTokenType = (ttPlus, ttMinus, ttLessThan, ttLargerThan, ttEqual, ttDiv, + ttMul, ttLeft, ttRight, ttLessThanEqual, ttLargerThanEqual, + ttunequal, ttNumber, ttString, ttIdentifier, + ttComma, ttand, ttOr,ttXor,ttTrue,ttFalse,ttnot,ttif, + ttCase,ttEOF); + + TExprFloat = Double; + +Const + ttDelimiters = [ttPlus, ttMinus, ttLessThan, ttLargerThan, ttEqual, ttDiv, + ttMul, ttLeft, ttRight, ttLessThanEqual, ttLargerThanEqual, + ttunequal]; + ttComparisons = [ttLargerThan,ttLessthan, + ttLargerThanEqual,ttLessthanEqual, + ttEqual,ttUnequal]; + +Type + + TFPExpressionParser = Class; + TExprBuiltInManager = Class; + + { TFPExpressionScanner } + + TFPExpressionScanner = Class(TObject) + FSource : String; + LSource, + FPos : Integer; + FChar : PChar; + FToken : String; + FTokenType : TTokenType; + private + function GetCurrentChar: Char; + procedure ScanError(Msg: String); + protected + procedure SetSource(const AValue: String); virtual; + function DoIdentifier: TTokenType; + function DoNumber: TTokenType; + function DoDelimiter: TTokenType; + function DoString: TTokenType; + Function NextPos : Char; // inline; + procedure SkipWhiteSpace; // inline; + function IsWordDelim(C : Char) : Boolean; // inline; + function IsDelim(C : Char) : Boolean; // inline; + function IsDigit(C : Char) : Boolean; // inline; + function IsAlpha(C : Char) : Boolean; // inline; + public + Constructor Create; + Function GetToken : TTokenType; + Property Token : String Read FToken; + Property TokenType : TTokenType Read FTokenType; + Property Source : String Read FSource Write SetSource; + Property Pos : Integer Read FPos; + Property CurrentChar : Char Read GetCurrentChar; + end; + + EExprScanner = Class(Exception); + + TResultType = (rtBoolean,rtInteger,rtFloat,rtDateTime,rtString); + TResultTypes = set of TResultType; + + TFPExpressionResult = record + ResString : String; + Case ResultType : TResultType of + rtBoolean : (ResBoolean : Boolean); + rtInteger : (ResInteger : Int64); + rtFloat : (ResFloat : TExprFloat); + rtDateTime : (ResDateTime : TDatetime); + rtString : (); + end; + PFPExpressionResult = ^TFPExpressionResult; + TExprParameterArray = Array of TFPExpressionResult; + + { TFPExprNode } + + TFPExprNode = Class(TObject) + Protected + Procedure CheckNodeType(Anode : TFPExprNode; Allowed : TResultTypes); + // A procedure with var saves an implicit try/finally in each node + // A marked difference in execution speed. + Procedure GetNodeValue(var Result : TFPExpressionResult); virtual; abstract; + Public + Procedure Check; virtual; abstract; + Function NodeType : TResultType; virtual; abstract; + Function NodeValue : TFPExpressionResult; + Function AsString : string; virtual; abstract; + end; + TExprArgumentArray = Array of TFPExprNode; + + { TFPBinaryOperation } + + TFPBinaryOperation = Class(TFPExprNode) + private + FLeft: TFPExprNode; + FRight: TFPExprNode; + Protected + Procedure CheckSameNodeTypes; + Public + Constructor Create(ALeft,ARight : TFPExprNode); + Destructor Destroy; override; + Procedure Check; override; + Property left : TFPExprNode Read FLeft; + Property Right : TFPExprNode Read FRight; + end; + TFPBinaryOperationClass = Class of TFPBinaryOperation; + + + { TFPBooleanOperation } + + TFPBooleanOperation = Class(TFPBinaryOperation) + Public + Procedure Check; override; + Function NodeType : TResultType; override; + end; + { TFPBinaryAndOperation } + + TFPBinaryAndOperation = Class(TFPBooleanOperation) + Protected + Procedure GetNodeValue(var Result : TFPExpressionResult); override; + Public + Function AsString : string ; override; + end; + + { TFPBinaryOrOperation } + + TFPBinaryOrOperation = Class(TFPBooleanOperation) + Protected + Procedure GetNodeValue(var Result : TFPExpressionResult); override; + Public + Function AsString : string ; override; + end; + + { TFPBinaryXOrOperation } + + TFPBinaryXOrOperation = Class(TFPBooleanOperation) + Protected + Procedure GetNodeValue(var Result : TFPExpressionResult); override; + Public + Function AsString : string ; override; + end; + + { TFPBooleanResultOperation } + + TFPBooleanResultOperation = Class(TFPBinaryOperation) + Public + Procedure Check; override; + Function NodeType : TResultType; override; + end; + TFPBooleanResultOperationClass = Class of TFPBooleanResultOperation; + + + { TFPEqualOperation } + + TFPEqualOperation = Class(TFPBooleanResultOperation) + Protected + Procedure GetNodeValue(var Result : TFPExpressionResult); override; + Public + Function AsString : string ; override; + end; + + { TFPUnequalOperation } + + TFPUnequalOperation = Class(TFPEqualOperation) + Protected + Procedure GetNodeValue(var Result : TFPExpressionResult); override; + Public + Function AsString : string ; override; + end; + + { TFPOrderingOperation } + + TFPOrderingOperation = Class(TFPBooleanResultOperation) + Procedure Check; override; + end; + + { TFPLessThanOperation } + + TFPLessThanOperation = Class(TFPOrderingOperation) + Protected + Procedure GetNodeValue(var Result : TFPExpressionResult); override; + Public + Function AsString : string ; override; + end; + + { TFPGreaterThanOperation } + + TFPGreaterThanOperation = Class(TFPOrderingOperation) + Protected + Procedure GetNodeValue(var Result : TFPExpressionResult); override; + Public + Function AsString : string ; override; + end; + + { TFPLessThanEqualOperation } + + TFPLessThanEqualOperation = Class(TFPGreaterThanOperation) + Protected + Procedure GetNodeValue(var Result : TFPExpressionResult); override; + Public + Function AsString : string ; override; + end; + + + { TFPGreaterThanEqualOperation } + + TFPGreaterThanEqualOperation = Class(TFPLessThanOperation) + Protected + Procedure GetNodeValue(var Result : TFPExpressionResult); override; + Public + Function AsString : string ; override; + end; + + { TIfOperation } + + TIfOperation = Class(TFPBinaryOperation) + private + FCondition: TFPExprNode; + protected + Procedure GetNodeValue(var Result : TFPExpressionResult); override; + Procedure Check; override; + Function NodeType : TResultType; override; + Public + Constructor Create(ACondition,ALeft,ARight : TFPExprNode); + Destructor destroy; override; + Function AsString : string ; override; + Property Condition : TFPExprNode Read FCondition; + end; + + { TCaseOperation } + + TCaseOperation = Class(TFPExprNode) + private + FArgs : TExprArgumentArray; + FCondition: TFPExprNode; + protected + Procedure GetNodeValue(var Result : TFPExpressionResult); override; + Procedure Check; override; + Function NodeType : TResultType; override; + Public + Constructor Create(Args : TExprArgumentArray); + Destructor destroy; override; + Function AsString : string ; override; + Property Condition : TFPExprNode Read FCondition; + end; + + { TMathOperation } + + TMathOperation = Class(TFPBinaryOperation) + protected + Procedure Check; override; + Function NodeType : TResultType; override; + end; + + { TFPAddOperation } + + TFPAddOperation = Class(TMathOperation) + Protected + Procedure GetNodeValue(var Result : TFPExpressionResult); override; + Public + Function AsString : string ; override; + end; + + { TFPSubtractOperation } + + TFPSubtractOperation = Class(TMathOperation) + Protected + Procedure check; override; + Procedure GetNodeValue(var Result : TFPExpressionResult); override; + Public + Function AsString : string ; override; + end; + + { TFPMultiplyOperation } + + TFPMultiplyOperation = Class(TMathOperation) + Protected + Procedure check; override; + Public + Function AsString : string ; override; + Procedure GetNodeValue(var Result : TFPExpressionResult); override; + end; + + { TFPDivideOperation } + + TFPDivideOperation = Class(TMathOperation) + Protected + Procedure check; override; + Public + Function AsString : string ; override; + Function NodeType : TResultType; override; + Procedure GetNodeValue(var Result : TFPExpressionResult); override; + end; + + { TFPUnaryOperator } + + TFPUnaryOperator = Class(TFPExprNode) + private + FOperand: TFPExprNode; + Public + Constructor Create(AOperand : TFPExprNode); + Destructor Destroy; override; + Procedure Check; override; + Property Operand : TFPExprNode Read FOperand; + end; + + { TFPConvertNode } + + TFPConvertNode = Class(TFPUnaryOperator) + Function AsString : String; override; + end; + + { TFPNotNode } + + TFPNotNode = Class(TFPUnaryOperator) + Protected + Procedure Check; override; + Public + Function NodeType : TResultType; override; + Procedure GetNodeValue(var Result : TFPExpressionResult); override; + Function AsString : String; override; + end; + + TIntConvertNode = Class(TFPConvertNode) + Protected + Procedure Check; override; + end; + + { TIntToFloatNode } + TIntToFloatNode = Class(TIntConvertNode) + Public + Function NodeType : TResultType; override; + Procedure GetNodeValue(var Result : TFPExpressionResult); override; + end; + + { TIntToDateTimeNode } + + TIntToDateTimeNode = Class(TIntConvertNode) + Public + Function NodeType : TResultType; override; + Procedure GetNodeValue(var Result : TFPExpressionResult); override; + end; + + { TFloatToDateTimeNode } + + TFloatToDateTimeNode = Class(TFPConvertNode) + Protected + Procedure Check; override; + Public + Function NodeType : TResultType; override; + Procedure GetNodeValue(var Result : TFPExpressionResult); override; + end; + + { TFPNegateOperation } + + TFPNegateOperation = Class(TFPUnaryOperator) + Public + Procedure Check; override; + Function NodeType : TResultType; override; + Procedure GetNodeValue(var Result : TFPExpressionResult); override; + Function AsString : String; override; + end; + + { TFPConstExpression } + + TFPConstExpression = Class(TFPExprnode) + private + FValue : TFPExpressionResult; + public + Constructor CreateString(AValue : String); + Constructor CreateInteger(AValue : Int64); + Constructor CreateDateTime(AValue : TDateTime); + Constructor CreateFloat(AValue : TExprFloat); + Constructor CreateBoolean(AValue : Boolean); + Procedure Check; override; + Function NodeType : TResultType; override; + Procedure GetNodeValue(var Result : TFPExpressionResult); override; + Function AsString : string ; override; + // For inspection + Property ConstValue : TFPExpressionResult read FValue; + end; + + + TIdentifierType = (itVariable,itFunctionCallBack,itFunctionHandler); + TFPExprFunctionCallBack = Procedure (Var Result : TFPExpressionResult; Const Args : TExprParameterArray); + TFPExprFunctionEvent = Procedure (Var Result : TFPExpressionResult; Const Args : TExprParameterArray) of object; + + { TFPExprIdentifierDef } + + TFPExprIdentifierDef = Class(TCollectionItem) + private + FStringValue : String; + FValue : TFPExpressionResult; + FArgumentTypes: String; + FIDType: TIdentifierType; + FName: ShortString; + FOnGetValue: TFPExprFunctionEvent; + FOnGetValueCB: TFPExprFunctionCallBack; + function GetAsBoolean: Boolean; + function GetAsDateTime: TDateTime; + function GetAsFloat: TExprFloat; + function GetAsInteger: Int64; + function GetAsString: String; + function GetResultType: TResultType; + function GetValue: String; + procedure SetArgumentTypes(const AValue: String); + procedure SetAsBoolean(const AValue: Boolean); + procedure SetAsDateTime(const AValue: TDateTime); + procedure SetAsFloat(const AValue: TExprFloat); + procedure SetAsInteger(const AValue: Int64); + procedure SetAsString(const AValue: String); + procedure SetName(const AValue: ShortString); + procedure SetResultType(const AValue: TResultType); + procedure SetValue(const AValue: String); + Protected + Procedure CheckResultType(Const AType : TResultType); + Procedure CheckVariable; + Public + Function ArgumentCount : Integer; + Procedure Assign(Source : TPersistent); override; + Property AsFloat : TExprFloat Read GetAsFloat Write SetAsFloat; + Property AsInteger : Int64 Read GetAsInteger Write SetAsInteger; + Property AsString : String Read GetAsString Write SetAsString; + Property AsBoolean : Boolean Read GetAsBoolean Write SetAsBoolean; + Property AsDateTime : TDateTime Read GetAsDateTime Write SetAsDateTime; + Property OnGetFunctionValueCallBack : TFPExprFunctionCallBack Read FOnGetValueCB Write FOnGetValueCB; + Published + Property IdentifierType : TIdentifierType Read FIDType Write FIDType; + Property Name : ShortString Read FName Write SetName; + Property Value : String Read GetValue Write SetValue; + Property ParameterTypes : String Read FArgumentTypes Write SetArgumentTypes; + Property ResultType : TResultType Read GetResultType Write SetResultType; + Property OnGetFunctionValue : TFPExprFunctionEvent Read FOnGetValue Write FOnGetValue; + end; + + + TBuiltInCategory = (bcStrings,bcDateTime,bcMath,bcBoolean,bcConversion,bcData,bcVaria,bcUser); + TBuiltInCategories = Set of TBuiltInCategory; + + { TFPBuiltInExprIdentifierDef } + + TFPBuiltInExprIdentifierDef = Class(TFPExprIdentifierDef) + private + FCategory: TBuiltInCategory; + Public + Procedure Assign(Source : TPersistent); override; + Published + Property Category : TBuiltInCategory Read FCategory Write FCategory; + end; + + { TFPExprIdentifierDefs } + + TFPExprIdentifierDefs = Class(TCollection) + private + FParser: TFPExpressionParser; + function GetI(AIndex : Integer): TFPExprIdentifierDef; + procedure SetI(AIndex : Integer; const AValue: TFPExprIdentifierDef); + Protected + procedure Update(Item: TCollectionItem); override; + Property Parser: TFPExpressionParser Read FParser; + Public + Function IndexOfIdentifier(Const AName : ShortString) : Integer; + Function FindIdentifier(Const AName : ShortString) : TFPExprIdentifierDef; + Function IdentifierByName(Const AName : ShortString) : TFPExprIdentifierDef; + Function AddVariable(Const AName : ShortString; AResultType : TResultType; AValue : String) : TFPExprIdentifierDef; + Function AddBooleanVariable(Const AName : ShortString; AValue : Boolean) : TFPExprIdentifierDef; + Function AddIntegerVariable(Const AName : ShortString; AValue : Integer) : TFPExprIdentifierDef; + Function AddFloatVariable(Const AName : ShortString; AValue : TExprFloat) : TFPExprIdentifierDef; + Function AddStringVariable(Const AName : ShortString; AValue : String) : TFPExprIdentifierDef; + Function AddDateTimeVariable(Const AName : ShortString; AValue : TDateTime) : TFPExprIdentifierDef; + Function AddFunction(Const AName : ShortString; Const AResultType : Char; Const AParamTypes : String; ACallBack : TFPExprFunctionCallBack) : TFPExprIdentifierDef; + Function AddFunction(Const AName : ShortString; Const AResultType : Char; Const AParamTypes : String; ACallBack : TFPExprFunctionEvent) : TFPExprIdentifierDef; + property Identifiers[AIndex : Integer] : TFPExprIdentifierDef Read GetI Write SetI; Default; + end; + + { TFPExprIdentifierNode } + + TFPExprIdentifierNode = Class(TFPExprNode) + Private + FID : TFPExprIdentifierDef; + PResult : PFPExpressionResult; + FResultType : TResultType; + public + Constructor CreateIdentifier(AID : TFPExprIdentifierDef); + Function NodeType : TResultType; override; + Procedure GetNodeValue(var Result : TFPExpressionResult); override; + Property Identifier : TFPExprIdentifierDef Read FID; + end; + + { TFPExprVariable } + + TFPExprVariable = Class(TFPExprIdentifierNode) + Procedure Check; override; + function AsString: string; override; + end; + + { TFPExprFunction } + + TFPExprFunction = Class(TFPExprIdentifierNode) + private + FArgumentNodes : TExprArgumentArray; + FargumentParams : TExprParameterArray; + Protected + Procedure CalcParams; + Procedure Check; override; + Public + Constructor CreateFunction(AID : TFPExprIdentifierDef; Const Args : TExprArgumentArray); virtual; + Destructor Destroy; override; + Property ArgumentNodes : TExprArgumentArray Read FArgumentNodes; + Property ArgumentParams : TExprParameterArray Read FArgumentParams; + Function AsString : String; override; + end; + + { TFPFunctionCallBack } + + TFPFunctionCallBack = Class(TFPExprFunction) + Private + FCallBack : TFPExprFunctionCallBack; + Public + Constructor CreateFunction(AID : TFPExprIdentifierDef; Const Args : TExprArgumentArray); override; + Procedure GetNodeValue(var Result : TFPExpressionResult); override; + Property CallBack : TFPExprFunctionCallBack Read FCallBack; + end; + + { TFPFunctionEventHandler } + + TFPFunctionEventHandler = Class(TFPExprFunction) + Private + FCallBack : TFPExprFunctionEvent; + Public + Constructor CreateFunction(AID : TFPExprIdentifierDef; Const Args : TExprArgumentArray); override; + Procedure GetNodeValue(var Result : TFPExpressionResult); override; + Property CallBack : TFPExprFunctionEvent Read FCallBack; + end; + + { TFPExpressionParser } + + TFPExpressionParser = class(TComponent) + private + FBuiltIns: TBuiltInCategories; + FExpression: String; + FScanner : TFPExpressionScanner; + FExprNode : TFPExprNode; + FIdentifiers : TFPExprIdentifierDefs; + FHashList : TFPHashObjectlist; + FDirty : Boolean; + procedure CheckEOF; + function ConvertNode(Todo: TFPExprNode; ToType: TResultType): TFPExprNode; + function GetAsBoolean: Boolean; + function GetAsDateTime: TDateTime; + function GetAsFloat: TExprFloat; + function GetAsInteger: Int64; + function GetAsString: String; + function MatchNodes(Todo, Match: TFPExprNode): TFPExprNode; + procedure CheckNodes(var Left, Right: TFPExprNode); + procedure SetBuiltIns(const AValue: TBuiltInCategories); + procedure SetIdentifiers(const AValue: TFPExprIdentifierDefs); + Protected + procedure ParserError(Msg: String); + procedure SetExpression(const AValue: String); virtual; + Procedure CheckResultType(Const Res :TFPExpressionResult; AType : TResultType); inline; + class Function BuiltinsManager : TExprBuiltInManager; + Function Level1 : TFPExprNode; + Function Level2 : TFPExprNode; + Function Level3 : TFPExprNode; + Function Level4 : TFPExprNode; + Function Level5 : TFPExprNode; + Function Level6 : TFPExprNode; + Function Primitive : TFPExprNode; + function GetToken: TTokenType; + Function TokenType : TTokenType; + Function CurrentToken : String; + Procedure CreateHashList; + Property Scanner : TFPExpressionScanner Read FScanner; + Property ExprNode : TFPExprNode Read FExprNode; + Property Dirty : Boolean Read FDirty; + public + Constructor Create(AOwner :TComponent); override; + Destructor Destroy; override; + Function IdentifierByName(AName : ShortString) : TFPExprIdentifierDef; + Procedure Clear; + Procedure EvaluateExpression(Var Result : TFPExpressionResult); + Function Evaluate : TFPExpressionResult; + Function ResultType : TResultType; + Property AsFloat : TExprFloat Read GetAsFloat; + Property AsInteger : Int64 Read GetAsInteger; + Property AsString : String Read GetAsString; + Property AsBoolean : Boolean Read GetAsBoolean; + Property AsDateTime : TDateTime Read GetAsDateTime; + Published + // The Expression to parse + property Expression : String read FExpression write SetExpression; + Property Identifiers : TFPExprIdentifierDefs Read FIdentifiers Write SetIdentifiers; + Property BuiltIns : TBuiltInCategories Read FBuiltIns Write SetBuiltIns; + end; + + { TExprBuiltInManager } + + TExprBuiltInManager = Class(TComponent) + Private + FDefs : TFPExprIdentifierDefs; + function GetCount: Integer; + function GetI(AIndex : Integer): TFPBuiltInExprIdentifierDef; + protected + Property Defs : TFPExprIdentifierDefs Read FDefs; + Public + Constructor Create(AOwner : TComponent); override; + Destructor Destroy; override; + Function IndexOfIdentifier(Const AName : ShortString) : Integer; + Function FindIdentifier(Const AName : ShortString) : TFPBuiltinExprIdentifierDef; + Function IdentifierByName(Const AName : ShortString) : TFPBuiltinExprIdentifierDef; + Function AddVariable(Const ACategory : TBuiltInCategory; Const AName : ShortString; AResultType : TResultType; AValue : String) : TFPBuiltInExprIdentifierDef; + Function AddBooleanVariable(Const ACategory : TBuiltInCategory; Const AName : ShortString; AValue : Boolean) : TFPBuiltInExprIdentifierDef; + Function AddIntegerVariable(Const ACategory : TBuiltInCategory; Const AName : ShortString; AValue : Integer) : TFPBuiltInExprIdentifierDef; + Function AddFloatVariable(Const ACategory : TBuiltInCategory; Const AName : ShortString; AValue : TExprFloat) : TFPBuiltInExprIdentifierDef; + Function AddStringVariable(Const ACategory : TBuiltInCategory; Const AName : ShortString; AValue : String) : TFPBuiltInExprIdentifierDef; + Function AddDateTimeVariable(Const ACategory : TBuiltInCategory; Const AName : ShortString; AValue : TDateTime) : TFPBuiltInExprIdentifierDef; + Function AddFunction(Const ACategory : TBuiltInCategory; Const AName : ShortString; Const AResultType : Char; Const AParamTypes : String; ACallBack : TFPExprFunctionCallBack) : TFPBuiltInExprIdentifierDef; + Function AddFunction(Const ACategory : TBuiltInCategory; Const AName : ShortString; Const AResultType : Char; Const AParamTypes : String; ACallBack : TFPExprFunctionEvent) : TFPBuiltInExprIdentifierDef; + Property IdentifierCount : Integer Read GetCount; + Property Identifiers[AIndex : Integer] :TFPBuiltInExprIdentifierDef Read GetI; + end; + + EExprParser = Class(Exception); + + +Function TokenName (AToken : TTokenType) : String; +Function ResultTypeName (AResult : TResultType) : String; +Function CharToResultType(C : Char) : TResultType; +Function BuiltinIdentifiers : TExprBuiltInManager; +Procedure RegisterStdBuiltins(AManager : TExprBuiltInManager); + +Const + AllBuiltIns = [bcStrings,bcDateTime,bcMath,bcBoolean,bcConversion,bcData,bcVaria,bcUser]; + + +implementation + +uses typinfo; + +{ TFPExpressionParser } + +const + cNull=#0; + cSingleQuote = ''''; + + Digits = ['0'..'9','.']; + WhiteSpace = [' ',#13,#10,#9]; + Operators = ['+','-','<','>','=','/','*']; + Delimiters = Operators+[',','(',')']; + Symbols = ['%','^']+Delimiters; + WordDelimiters = WhiteSpace + Symbols; + +Resourcestring + SBadQuotes = 'Unterminated string'; + SUnknownDelimiter = 'Unknown delimiter character: "%s"'; + SErrUnknownCharacter = 'Unknown character at pos %d: "%s"'; + SErrUnexpectedEndOfExpression = 'Unexpected end of expression'; + SErrUnknownComparison = 'Internal error: Unknown comparison'; + SErrUnknownBooleanOp = 'Internal error: Unknown boolean operation'; + SErrBracketExpected = 'Expected ) bracket at position %d, but got %s'; + SerrUnknownTokenAtPos = 'Unknown token at pos %d : %s'; + SErrLeftBracketExpected = 'Expected ( bracket at position %d, but got %s'; + SErrInvalidFloat = '%s is not a valid floating-point value'; + SErrUnknownIdentifier = 'Unknown identifier: %s'; + SErrInExpression = 'Cannot evaluate: error in expression'; + SErrInExpressionEmpty = 'Cannot evaluate: empty expression'; + SErrCommaExpected = 'Expected comma (,) at position %d, but got %s'; + SErrInvalidNumberChar = 'Unexpected character in number : %s'; + SErrInvalidNumber = 'Invalid numerical value : %s'; + SErrNoOperand = 'No operand for unary operation %s'; + SErrNoleftOperand = 'No left operand for binary operation %s'; + SErrNoRightOperand = 'No left operand for binary operation %s'; + SErrNoNegation = 'Cannot negate expression of type %s : %s'; + SErrNoNOTOperation = 'Cannot perform "not" on expression of type %s: %s'; + SErrTypesDoNotMatch = 'Type mismatch: %s<>%s for expressions "%s" and "%s".'; + SErrTypesIncompatible = 'Incompatible types: %s<>%s for expressions "%s" and "%s".'; + SErrNoNodeToCheck = 'Internal error: No node to check !'; + SInvalidNodeType = 'Node type (%s) not in allowed types (%s) for expression: %s'; + SErrUnterminatedExpression = 'Badly terminated expression. Found token at position %d : %s'; + SErrDuplicateIdentifier = 'An identifier with name "%s" already exists.'; + SErrInvalidResultCharacter = '"%s" is not a valid return type indicator'; + ErrInvalidArgumentCount = 'Invalid argument count for function %s'; + SErrInvalidArgumentType = 'Invalid type for argument %d: Expected %s, got %s'; + SErrInvalidResultType = 'Invalid result type: %s'; + SErrNotVariable = 'Identifier %s is not a variable'; + SErrInactive = 'Operation not allowed while an expression is active'; + SErrIFNeedsBoolean = 'First argument to IF must be of type boolean: %s'; + SErrCaseNeeds3 = 'Case statement needs to have at least 4 arguments'; + SErrCaseEvenCount = 'Case statement needs to have an even number of arguments'; + SErrCaseLabelNotAConst = 'Case label %d "%s" is not a constant expression'; + SErrCaseLabelType = 'Case label %d "%s" needs type %s, but has type %s'; + SErrCaseValueType = 'Case value %d "%s" needs type %s, but has type %s'; + +{ --------------------------------------------------------------------- + Auxiliary functions + ---------------------------------------------------------------------} + +Procedure RaiseParserError(Msg : String); +begin + Raise EExprParser.Create(Msg); +end; + +Procedure RaiseParserError(Fmt : String; Args : Array of const); +begin + Raise EExprParser.CreateFmt(Fmt,Args); +end; + +Function TokenName (AToken : TTokenType) : String; + +begin + Result:=GetEnumName(TypeInfo(TTokenType),Ord(AToken)); +end; + +Function ResultTypeName (AResult : TResultType) : String; + +begin + Result:=GetEnumName(TypeInfo(TResultType),Ord(AResult)); +end; + +function CharToResultType(C: Char): TResultType; +begin + Case Upcase(C) of + 'S' : Result:=rtString; + 'D' : Result:=rtDateTime; + 'B' : Result:=rtBoolean; + 'I' : Result:=rtInteger; + 'F' : Result:=rtFloat; + else + RaiseParserError(SErrInvalidResultCharacter,[C]); + end; +end; + +Var + BuiltIns : TExprBuiltInManager; + +Function BuiltinIdentifiers : TExprBuiltInManager; + +begin + If (BuiltIns=Nil) then + BuiltIns:=TExprBuiltInManager.Create(Nil); + Result:=BuiltIns; +end; + +Procedure FreeBuiltIns; + +begin + FreeAndNil(Builtins); +end; + +{ --------------------------------------------------------------------- + TFPExpressionScanner + ---------------------------------------------------------------------} + +function TFPExpressionScanner.IsAlpha(C: Char): Boolean; +begin + Result := C in ['A'..'Z', 'a'..'z']; +end; + +constructor TFPExpressionScanner.Create; +begin + Source:=''; +end; + + +procedure TFPExpressionScanner.SetSource(const AValue: String); +begin + FSource:=AValue; + LSource:=Length(FSource); + FTokenType:=ttEOF; + If LSource=0 then + FPos:=0 + else + FPos:=1; + FChar:=Pchar(FSource); + FToken:=''; +end; + +function TFPExpressionScanner.NextPos: Char; +begin + Inc(FPos); + Inc(FChar); + Result:=FChar^; +end; + + +function TFPExpressionScanner.IsWordDelim(C: Char): Boolean; +begin + Result:=C in WordDelimiters; +end; + +function TFPExpressionScanner.IsDelim(C: Char): Boolean; +begin + Result:=C in Delimiters; +end; + +function TFPExpressionScanner.IsDigit(C: Char): Boolean; +begin + Result:=C in Digits; +end; + +Procedure TFPExpressionScanner.SkipWhiteSpace; + +begin + While (FChar^ in WhiteSpace) and (FPos<=LSource) do + NextPos; +end; + +Function TFPExpressionScanner.DoDelimiter : TTokenType; + +Var + B : Boolean; + C,D : Char; + +begin + C:=FChar^; + FToken:=C; + B:=C in ['<','>']; + D:=C; + C:=NextPos; + + if B and (C in ['=','>']) then + begin + FToken:=FToken+C; + NextPos; + If (D='>') then + Result:=ttLargerThanEqual + else if (C='>') then + Result:=ttUnequal + else + Result:=ttLessThanEqual; + end + else + Case D of + '+' : Result := ttPlus; + '-' : Result := ttMinus; + '<' : Result := ttLessThan; + '>' : Result := ttLargerThan; + '=' : Result := ttEqual; + '/' : Result := ttDiv; + '*' : Result := ttMul; + '(' : Result := ttLeft; + ')' : Result := ttRight; + ',' : Result := ttComma; + else + ScanError(Format(SUnknownDelimiter,[D])); + end; + +end; + +Procedure TFPExpressionScanner.ScanError(Msg : String); + +begin + Raise EExprScanner.Create(Msg) +end; + +Function TFPExpressionScanner.DoString : TTokenType; + + Function TerminatingChar(C : Char) : boolean; + + begin + Result:=(C=cNull) or + ((C=cSingleQuote) and + Not ((FPosNil then + Result:=FChar^ + else + Result:=#0; +end; + +Function TFPExpressionScanner.DoNumber : TTokenType; + +Var + C : Char; + X : TExprFloat; + I : Integer; + +begin + C:=CurrentChar; + while (not IsWordDelim(C)) and (C<>cNull) do + begin + If Not (IsDigit(C) or ((FToken<>'') and (Upcase(C)='E'))) then + ScanError(Format(SErrInvalidNumberChar,[C])); + FToken := FToken+C; + C:=NextPos; + end; + Val(FToken,X,I); + If (I<>0) then + ScanError(Format(SErrInvalidNumber,[FToken])); + Result:=ttNumber; +end; + +Function TFPExpressionScanner.DoIdentifier : TTokenType; + +Var + C : Char; + S : String; +begin + C:=CurrentChar; + while (not IsWordDelim(C)) and (C<>cNull) do + begin + FToken:=FToken+C; + C:=NextPos; + end; + S:=LowerCase(Token); + If (S='or') then + Result:=ttOr + else if (S='xor') then + Result:=ttXOr + else if (S='and') then + Result:=ttAnd + else if (S='true') then + Result:=ttTrue + else if (S='false') then + Result:=ttFalse + else if (S='not') then + Result:=ttnot + else if (S='if') then + Result:=ttif + else if (S='case') then + Result:=ttcase + else + Result:=ttIdentifier; +end; + +Function TFPExpressionScanner.GetToken : TTokenType; + +Var + C : Char; + +begin + FToken := ''; + SkipWhiteSpace; + C:=FChar^; + if c=cNull then + Result:=ttEOF + else if IsDelim(C) then + Result:=DoDelimiter + else if (C=cSingleQuote) then + Result:=DoString + else if IsDigit(C) then + Result:=DoNumber + else if IsAlpha(C) then + Result:=DoIdentifier + else + ScanError(Format(SErrUnknownCharacter,[FPos,C])) ; + FTokenType:=Result; +end; + +{ --------------------------------------------------------------------- + TFPExpressionParser + ---------------------------------------------------------------------} + +Function TFPExpressionParser.TokenType : TTokenType; + +begin + Result:=FScanner.TokenType; +end; + +function TFPExpressionParser.CurrentToken: String; +begin + Result:=FScanner.Token; +end; + +procedure TFPExpressionParser.CreateHashList; + +Var + ID : TFPExpridentifierDef; + BID : TFPBuiltinExpridentifierDef; + I : Integer; + M : TExprBuiltinManager; + +begin + FHashList.Clear; + // Builtins + M:=BuiltinsManager; + If (FBuiltins<>[]) and Assigned(M) then + For I:=0 to M.IdentifierCount-1 do + begin + BID:=M.Identifiers[I]; + If BID.Category in FBuiltins then + FHashList.Add(LowerCase(BID.Name),BID); + end; + // User + For I:=0 to FIdentifiers.Count-1 do + begin + ID:=FIdentifiers[i]; + FHashList.Add(LowerCase(ID.Name),ID); + end; + FDirty:=False; +end; + +function TFPExpressionParser.IdentifierByName(AName: ShortString): TFPExprIdentifierDef; +begin + If FDirty then + CreateHashList; + Result:=TFPExprIdentifierDef(FHashList.Find(LowerCase(AName))); +end; + +procedure TFPExpressionParser.Clear; +begin + FExpression:=''; + FHashList.Clear; + FExprNode.Free; +end; + +constructor TFPExpressionParser.Create(AOwner: TComponent); +begin + inherited Create(AOwner); + FIdentifiers:=TFPExprIdentifierDefs.Create(TFPExprIdentifierDef); + FIdentifiers.FParser:=Self; + FScanner:=TFPExpressionScanner.Create; + FHashList:=TFPHashObjectList.Create(False); +end; + +destructor TFPExpressionParser.Destroy; +begin + FreeAndNil(FHashList); + FreeAndNil(FExprNode); + FreeAndNil(FIdentifiers); + FreeAndNil(FScanner); + inherited Destroy; +end; + +Function TFPExpressionParser.GetToken : TTokenType; + +begin + Result:=FScanner.GetToken; +end; + +Procedure TFPExpressionParser.CheckEOF; + +begin + If (TokenType=ttEOF) then + ParserError(SErrUnexpectedEndOfExpression); +end; + +procedure TFPExpressionParser.SetIdentifiers(const AValue: TFPExprIdentifierDefs + ); +begin + FIdentifiers.Assign(AValue) +end; + +procedure TFPExpressionParser.EvaluateExpression(var Result: TFPExpressionResult); +begin + If (FExpression='') then + ParserError(SErrInExpressionEmpty); + if not Assigned(FExprNode) then + ParserError(SErrInExpression); + FExprNode.GetNodeValue(Result); +end; + +procedure TFPExpressionParser.ParserError(Msg: String); +begin + Raise EExprParser.Create(Msg); +end; + +function TFPExpressionParser.ConvertNode(Todo : TFPExprNode; ToType : TResultType): TFPExprNode; + + +begin + Result:=ToDo; + Case ToDo.NodeType of + rtInteger : + Case ToType of + rtFloat : Result:=TIntToFloatNode.Create(Result); + rtDateTime : Result:=TIntToDateTimeNode.Create(Result); + end; + rtFloat : + Case ToType of + rtDateTime : Result:=TFloatToDateTimeNode.Create(Result); + end; + end; +end; + +function TFPExpressionParser.GetAsBoolean: Boolean; + +var + Res: TFPExpressionResult; + +begin + EvaluateExpression(Res); + CheckResultType(Res,rtBoolean); + Result:=Res.ResBoolean; +end; + +function TFPExpressionParser.GetAsDateTime: TDateTime; +var + Res: TFPExpressionResult; + +begin + EvaluateExpression(Res); + CheckResultType(Res,rtDateTime); + Result:=Res.ResDatetime; +end; + +function TFPExpressionParser.GetAsFloat: TExprFloat; + +var + Res: TFPExpressionResult; + +begin + EvaluateExpression(Res); + CheckResultType(Res,rtFloat); + Result:=Res.ResFloat; +end; + +function TFPExpressionParser.GetAsInteger: Int64; + +var + Res: TFPExpressionResult; + +begin + EvaluateExpression(Res); + CheckResultType(Res,rtInteger); + Result:=Res.ResInteger; +end; + +function TFPExpressionParser.GetAsString: String; + +var + Res: TFPExpressionResult; + +begin + EvaluateExpression(Res); + CheckResultType(Res,rtString); + Result:=Res.ResString; +end; + +{ + Checks types of todo and match. If ToDO can be converted to it matches + the type of match, then a node is inserted. + For binary operations, this function is called for both operands. +} + +function TFPExpressionParser.MatchNodes(Todo,Match : TFPExprNode): TFPExprNode; + +Var + TT,MT : TResultType; + +begin + Result:=Todo; + TT:=Todo.NodeType; + MT:=Match.NodeType; + If (TT<>MT) then + begin + if (TT=rtInteger) then + begin + if (MT in [rtFloat,rtDateTime]) then + Result:=ConvertNode(Todo,MT); + end + else if (TT=rtFloat) then + begin + if (MT=rtDateTime) then + Result:=ConvertNode(Todo,rtDateTime); + end; + end; +end; + +{ + if the result types differ, they are converted to a common type if possible. +} + +Procedure TFPExpressionParser.CheckNodes(Var Left,Right : TFPExprNode); + +begin + Left:=MatchNodes(Left,Right); + Right:=MatchNodes(Right,Left); +end; + +procedure TFPExpressionParser.SetBuiltIns(const AValue: TBuiltInCategories); +begin + if FBuiltIns=AValue then exit; + FBuiltIns:=AValue; + FDirty:=True; +end; + +Function TFPExpressionParser.Level1 : TFPExprNode; + +var + tt: TTokenType; + Right : TFPExprNode; + +begin +{$ifdef debugexpr}Writeln('Level 1 ',TokenName(TokenType),': ',CurrentToken);{$endif debugexpr} + if TokenType = ttNot then + begin + GetToken; + CheckEOF; + Right:=Level2; + Result:=TFPNotNode.Create(Right); + end + else + Result:=Level2; + Try + while (TokenType in [ttAnd,ttOr,ttXor]) do + begin + tt:=TokenType; + GetToken; + CheckEOF; + Right:=Level2; + Case tt of + ttOr : Result:=TFPBinaryOrOperation.Create(Result,Right); + ttAnd : Result:=TFPBinaryAndOperation.Create(Result,Right); + ttXor : Result:=TFPBinaryXorOperation.Create(Result,Right); + Else + ParserError(SErrUnknownBooleanOp) + end; + end; + Except + Result.Free; + Raise; + end; +end; + +function TFPExpressionParser.Level2: TFPExprNode; + +var + Right : TFPExprNode; + tt : TTokenType; + C : TFPBinaryOperationClass; + +begin +{$ifdef debugexpr} Writeln('Level 2 ',TokenName(TokenType),': ',CurrentToken);{$endif debugexpr} + Result:=Level3; + try + if (TokenType in ttComparisons) then + begin + tt:=TokenType; + GetToken; + CheckEOF; + Right:=Level3; + CheckNodes(Result,Right); + Case tt of + ttLessthan : C:=TFPLessThanOperation; + ttLessthanEqual : C:=TFPLessThanEqualOperation; + ttLargerThan : C:=TFPGreaterThanOperation; + ttLargerThanEqual : C:=TFPGreaterThanEqualOperation; + ttEqual : C:=TFPEqualOperation; + ttUnequal : C:=TFPUnequalOperation; + Else + ParserError(SErrUnknownComparison) + end; + Result:=C.Create(Result,Right); + end; + Except + Result.Free; + Raise; + end; +end; + +function TFPExpressionParser.Level3: TFPExprNode; + +var + tt : TTokenType; + right : TFPExprNode; + +begin +{$ifdef debugexpr} Writeln('Level 3 ',TokenName(TokenType),': ',CurrentToken);{$endif debugexpr} + Result:=Level4; + try + while TokenType in [ttPlus,ttMinus] do + begin + tt:=TokenType; + GetToken; + CheckEOF; + Right:=Level4; + CheckNodes(Result,Right); + Case tt of + ttPlus : Result:=TFPAddOperation.Create(Result,Right); + ttMinus : Result:=TFPSubtractOperation.Create(Result,Right); + end; + end; + Except + Result.Free; + Raise; + end; +end; + + + + +function TFPExpressionParser.Level4: TFPExprNode; + +var + tt : TTokenType; + right : TFPExprNode; + +begin +{$ifdef debugexpr} Writeln('Level 4 ',TokenName(TokenType),': ',CurrentToken);{$endif debugexpr} + Result:=Level5; + try + while (TokenType in [ttMul,ttDiv]) do + begin + tt:=TokenType; + GetToken; + Right:=Level5; + CheckNodes(Result,Right); + Case tt of + ttMul : Result:=TFPMultiplyOperation.Create(Result,Right); + ttDiv : Result:=TFPDivideOperation.Create(Result,Right); + end; + end; + Except + Result.Free; + Raise; + end; +end; + +function TFPExpressionParser.Level5: TFPExprNode; + +Var + B : Boolean; + +begin +{$ifdef debugexpr} Writeln('Level 5 ',TokenName(TokenType),': ',CurrentToken);{$endif debugexpr} + B:=False; + if (TokenType in [ttPlus,ttMinus]) then + begin + B:=TokenType=ttMinus; + GetToken; + end; + Result:=Level6; + If B then + Result:=TFPNegateOperation.Create(Result); +end; + +function TFPExpressionParser.Level6: TFPExprNode; +begin +{$ifdef debugexpr} Writeln('Level 6 ',TokenName(TokenType),': ',CurrentToken);{$endif debugexpr} + if (TokenType=ttLeft) then + begin + GetToken; + Result:=Level1; + try + if (TokenType<>ttRight) then + ParserError(Format(SErrBracketExpected,[SCanner.Pos,CurrentToken])); + GetToken; + Except + Result.Free; + Raise; + end; + end + else + Result:=Primitive; +end; + +function TFPExpressionParser.Primitive: TFPExprNode; + +Var + I : Int64; + C : Integer; + X : TExprFloat; + ACount : Integer; + IFF : Boolean; + IFC : Boolean; + ID : TFPExprIdentifierDef; + Args : TExprArgumentArray; + AI : Integer; + +begin +{$ifdef debugexpr} Writeln('Primitive : ',TokenName(TokenType),': ',CurrentToken);{$endif debugexpr} + SetLength(Args,0); + if (TokenType=ttNumber) then + begin + if TryStrToInt64(CurrentToken,I) then + Result:=TFPConstExpression.CreateInteger(I) + else + begin + Val(CurrentToken,X,C); + If (I=0) then + Result:=TFPConstExpression.CreateFloat(X) + else + ParserError(Format(SErrInvalidFloat,[CurrentToken])); + end; + end + else if (TokenType=ttString) then + Result:=TFPConstExpression.CreateString(CurrentToken) + else if (TokenType in [ttTrue,ttFalse]) then + Result:=TFPConstExpression.CreateBoolean(TokenType=ttTrue) + else if Not (TokenType in [ttIdentifier,ttIf,ttcase]) then + ParserError(Format(SerrUnknownTokenAtPos,[Scanner.Pos,CurrentToken])) + else + begin + IFF:=TokenType=ttIf; + IFC:=TokenType=ttCase; + if Not (IFF or IFC) then + begin + ID:=self.IdentifierByName(CurrentToken); + If (ID=Nil) then + ParserError(Format(SErrUnknownIdentifier,[CurrentToken])) + end; + // Determine number of arguments + if Iff then + ACount:=3 + else if IfC then + ACount:=-4 + else if (ID.IdentifierType in [itFunctionCallBack,itFunctionHandler]) then + ACount:=ID.ArgumentCount + else + ACount:=0; + // Parse arguments. + // Negative is for variable number of arguments, where Abs(value) is the minimum number of arguments + If (ACount<>0) then + begin + GetToken; + If (TokenType<>ttLeft) then + ParserError(Format(SErrLeftBracketExpected,[Scanner.Pos,CurrentToken])); + SetLength(Args,Abs(ACount)); + AI:=0; + Try + Repeat + GetToken; + // Check if we must enlarge the argument array + If (ACount<0) and (AI=Length(Args)) then + begin + SetLength(Args,AI+1); + Args[AI]:=Nil; + end; + Args[AI]:=Level1; + Inc(AI); + If (TokenType<>ttComma) then + If (AIttRight then + ParserError(Format(SErrBracketExpected,[Scanner.Pos,CurrentToken])); + except + On E : Exception do + begin + Dec(AI); + While (AI>=0) do + begin + FreeAndNil(Args[Ai]); + Dec(AI); + end; + Raise; + end; + end; + end; + If Iff then + Result:=TIfOperation.Create(Args[0],Args[1],Args[2]) + else If IfC then + Result:=TCaseOperation.Create(Args) + else + Case ID.IdentifierType of + itVariable : Result:= TFPExprVariable.CreateIdentifier(ID); + itFunctionCallBack : Result:= TFPFunctionCallback.CreateFunction(ID,Args); + itFunctionHandler : Result:= TFPFunctionEventHandler.CreateFunction(ID,Args); + end; + end; + GetToken; +end; + + +procedure TFPExpressionParser.SetExpression(const AValue: String); +begin + if FExpression=AValue then exit; + FExpression:=AValue; + FScanner.Source:=AValue; + If Assigned(FExprNode) then + FreeAndNil(FExprNode); + If (FExpression<>'') then + begin + GetToken; + FExprNode:=Level1; + If (TokenType<>ttEOF) then + ParserError(Format(SErrUnterminatedExpression,[Scanner.Pos,CurrentToken])); + FExprNode.Check; + end + else + FExprNode:=Nil; +end; + +procedure TFPExpressionParser.CheckResultType(const Res: TFPExpressionResult; + AType: TResultType); inline; +begin + If (Res.ResultType<>AType) then + RaiseParserError(SErrInvalidResultType,[ResultTypeName(Res.ResultType)]); +end; + +class function TFPExpressionParser.BuiltinsManager: TExprBuiltInManager; +begin + Result:=BuiltinIdentifiers; +end; + + +function TFPExpressionParser.Evaluate: TFPExpressionResult; +begin + EvaluateExpression(Result); +end; + +function TFPExpressionParser.ResultType: TResultType; +begin + if not Assigned(FExprNode) then + ParserError(SErrInExpression); + Result:=FExprNode.NodeType;; +end; + +{ --------------------------------------------------------------------- + TFPExprIdentifierDefs + ---------------------------------------------------------------------} + +function TFPExprIdentifierDefs.GetI(AIndex : Integer): TFPExprIdentifierDef; +begin + Result:=TFPExprIdentifierDef(Items[AIndex]); +end; + +procedure TFPExprIdentifierDefs.SetI(AIndex : Integer; + const AValue: TFPExprIdentifierDef); +begin + Items[AIndex]:=AValue; +end; + +procedure TFPExprIdentifierDefs.Update(Item: TCollectionItem); +begin + If Assigned(FParser) then + FParser.FDirty:=True; +end; + +function TFPExprIdentifierDefs.IndexOfIdentifier(const AName: ShortString + ): Integer; +begin + Result:=Count-1; + While (Result>=0) And (CompareText(GetI(Result).Name,AName)<>0) do + Dec(Result); +end; + +function TFPExprIdentifierDefs.FindIdentifier(const AName: ShortString + ): TFPExprIdentifierDef; + +Var + I : Integer; + +begin + I:=IndexOfIdentifier(AName); + If (I=-1) then + Result:=Nil + else + Result:=GetI(I); +end; + +function TFPExprIdentifierDefs.IdentifierByName(const AName: ShortString + ): TFPExprIdentifierDef; +begin + Result:=FindIdentifier(AName); + if (Result=Nil) then + RaiseParserError(SErrUnknownIdentifier,[AName]); +end; + +function TFPExprIdentifierDefs.AddVariable(Const AName: ShortString; + AResultType: TResultType; AValue: String): TFPExprIdentifierDef; +begin + Result:=Add as TFPExprIdentifierDef; + Result.IdentifierType:=itVariable; + Result.Name:=AName; + Result.ResultType:=AResultType; + Result.Value:=AValue; +end; + +function TFPExprIdentifierDefs.AddBooleanVariable(Const AName: ShortString; AValue: Boolean + ): TFPExprIdentifierDef; +begin + Result:=Add as TFPExprIdentifierDef; + Result.IdentifierType:=itVariable; + Result.Name:=AName; + Result.ResultType:=rtBoolean; + Result.FValue.ResBoolean:=AValue; +end; + +function TFPExprIdentifierDefs.AddIntegerVariable(Const AName: ShortString; AValue: Integer + ): TFPExprIdentifierDef; +begin + Result:=Add as TFPExprIdentifierDef; + Result.IdentifierType:=itVariable; + Result.Name:=AName; + Result.ResultType:=rtInteger; + Result.FValue.ResInteger:=AValue; +end; + +function TFPExprIdentifierDefs.AddFloatVariable(Const AName: ShortString; AValue: TExprFloat + ): TFPExprIdentifierDef; +begin + Result:=Add as TFPExprIdentifierDef; + Result.IdentifierType:=itVariable; + Result.Name:=AName; + Result.ResultType:=rtFloat; + Result.FValue.ResFloat:=AValue; +end; + +function TFPExprIdentifierDefs.AddStringVariable(Const AName: ShortString; AValue: String + ): TFPExprIdentifierDef; +begin + Result:=Add as TFPExprIdentifierDef; + Result.IdentifierType:=itVariable; + Result.Name:=AName; + Result.ResultType:=rtString; + Result.FValue.ResString:=AValue; +end; + +function TFPExprIdentifierDefs.AddDateTimeVariable(Const AName: ShortString; AValue: TDateTime + ): TFPExprIdentifierDef; +begin + Result:=Add as TFPExprIdentifierDef; + Result.IdentifierType:=itVariable; + Result.Name:=AName; + Result.ResultType:=rtDateTime; + Result.FValue.ResDateTime:=AValue; +end; + +function TFPExprIdentifierDefs.AddFunction(const AName: ShortString; + const AResultType: Char; const AParamTypes: String; + ACallBack: TFPExprFunctionCallBack): TFPExprIdentifierDef; +begin + Result:=Add as TFPExprIdentifierDef; + Result.Name:=Aname; + Result.IdentifierType:=itFunctionCallBack; + Result.ParameterTypes:=AParamTypes; + Result.ResultType:=CharToResultType(AResultType); + Result.FOnGetValueCB:=ACallBack; +end; + +function TFPExprIdentifierDefs.AddFunction(const AName: ShortString; + const AResultType: Char; const AParamTypes: String; + ACallBack: TFPExprFunctionEvent): TFPExprIdentifierDef; +begin + Result:=Add as TFPExprIdentifierDef; + Result.Name:=Aname; + Result.IdentifierType:=itFunctionHandler; + Result.ParameterTypes:=AParamTypes; + Result.ResultType:=CharToResultType(AResultType); + Result.FOnGetValue:=ACallBack; +end; + +{ --------------------------------------------------------------------- + TFPExprIdentifierDef + ---------------------------------------------------------------------} + +procedure TFPExprIdentifierDef.SetName(const AValue: ShortString); +begin + if FName=AValue then exit; + If (AValue<>'') then + If Assigned(Collection) and (TFPExprIdentifierDefs(Collection).IndexOfIdentifier(AValue)<>-1) then + RaiseParserError(SErrDuplicateIdentifier,[AValue]); + FName:=AValue; +end; + +procedure TFPExprIdentifierDef.SetResultType(const AValue: TResultType); + +begin + If AValue<>FValue.ResultType then + begin + FValue.ResultType:=AValue; + SetValue(FStringValue); + end; +end; + +procedure TFPExprIdentifierDef.SetValue(const AValue: String); +begin + FStringValue:=AValue; + If (AValue<>'') then + Case FValue.ResultType of + rtBoolean : FValue.ResBoolean:=FStringValue='True'; + rtInteger : FValue.ResInteger:=StrToInt(AValue); + rtFloat : FValue.ResFloat:=StrToFloat(AValue); + rtDateTime : FValue.ResDateTime:=StrToDateTime(AValue); + rtString : FValue.ResString:=AValue; + end + else + Case FValue.ResultType of + rtBoolean : FValue.ResBoolean:=False; + rtInteger : FValue.ResInteger:=0; + rtFloat : FValue.ResFloat:=0.0; + rtDateTime : FValue.ResDateTime:=0; + rtString : FValue.ResString:=''; + end +end; + +procedure TFPExprIdentifierDef.CheckResultType(const AType: TResultType); +begin + If FValue.ResultType<>AType then + RaiseParserError(SErrInvalidResultType,[ResultTypeName(AType)]) +end; + +procedure TFPExprIdentifierDef.CheckVariable; +begin + If Identifiertype<>itvariable then + RaiseParserError(SErrNotVariable,[Name]); +end; + +function TFPExprIdentifierDef.ArgumentCount: Integer; +begin + Result:=Length(FArgumentTypes); +end; + +procedure TFPExprIdentifierDef.Assign(Source: TPersistent); + +Var + EID : TFPExprIdentifierDef; + +begin + if (Source is TFPExprIdentifierDef) then + begin + EID:=Source as TFPExprIdentifierDef; + FStringValue:=EID.FStringValue; + FValue:=EID.FValue; + FArgumentTypes:=EID.FArgumentTypes; + FIDType:=EID.FIDType; + FName:=EID.FName; + FOnGetValue:=EID.FOnGetValue; + FOnGetValueCB:=EID.FOnGetValueCB; + end + else + inherited Assign(Source); +end; + +procedure TFPExprIdentifierDef.SetArgumentTypes(const AValue: String); + +Var + I : integer; + +begin + if FArgumentTypes=AValue then exit; + For I:=1 to Length(AValue) do + CharToResultType(AValue[i]); + FArgumentTypes:=AValue; +end; + +procedure TFPExprIdentifierDef.SetAsBoolean(const AValue: Boolean); +begin + CheckVariable; + CheckResultType(rtBoolean); + FValue.ResBoolean:=AValue; +end; + +procedure TFPExprIdentifierDef.SetAsDateTime(const AValue: TDateTime); +begin + CheckVariable; + CheckResultType(rtDateTime); + FValue.ResDateTime:=AValue; +end; + +procedure TFPExprIdentifierDef.SetAsFloat(const AValue: TExprFloat); +begin + CheckVariable; + CheckResultType(rtFloat); + FValue.ResFloat:=AValue; +end; + +procedure TFPExprIdentifierDef.SetAsInteger(const AValue: Int64); +begin + CheckVariable; + CheckResultType(rtInteger); + FValue.ResInteger:=AValue; +end; + +procedure TFPExprIdentifierDef.SetAsString(const AValue: String); +begin + CheckVariable; + CheckResultType(rtString); + FValue.resString:=AValue; +end; + +function TFPExprIdentifierDef.GetValue: String; +begin + Case FValue.ResultType of + rtBoolean : If FValue.ResBoolean then + Result:='True' + else + Result:='False'; + rtInteger : Result:=IntToStr(FValue.ResInteger); + rtFloat : Result:=FloatToStr(FValue.ResFloat); + rtDateTime : Result:=FormatDateTime('cccc',FValue.ResDateTime); + rtString : Result:=FValue.ResString; + end; +end; + +function TFPExprIdentifierDef.GetResultType: TResultType; +begin + Result:=FValue.ResultType; +end; + +function TFPExprIdentifierDef.GetAsFloat: TExprFloat; +begin + CheckResultType(rtFloat); + CheckVariable; + Result:=FValue.ResFloat; +end; + +function TFPExprIdentifierDef.GetAsBoolean: Boolean; +begin + CheckResultType(rtBoolean); + CheckVariable; + Result:=FValue.ResBoolean; +end; + +function TFPExprIdentifierDef.GetAsDateTime: TDateTime; +begin + CheckResultType(rtDateTime); + CheckVariable; + Result:=FValue.ResDateTime; +end; + +function TFPExprIdentifierDef.GetAsInteger: Int64; +begin + CheckResultType(rtInteger); + CheckVariable; + Result:=FValue.ResInteger; +end; + +function TFPExprIdentifierDef.GetAsString: String; +begin + CheckResultType(rtString); + CheckVariable; + Result:=FValue.ResString; +end; + +{ --------------------------------------------------------------------- + TExprBuiltInManager + ---------------------------------------------------------------------} + +function TExprBuiltInManager.GetCount: Integer; +begin + Result:=FDefs.Count; +end; + +function TExprBuiltInManager.GetI(AIndex : Integer + ): TFPBuiltInExprIdentifierDef; +begin + Result:=TFPBuiltInExprIdentifierDef(FDefs[Aindex]) +end; + +constructor TExprBuiltInManager.Create(AOwner: TComponent); +begin + inherited Create(AOwner); + FDefs:=TFPExprIdentifierDefs.Create(TFPBuiltInExprIdentifierDef) +end; + +destructor TExprBuiltInManager.Destroy; +begin + FreeAndNil(FDefs); + inherited Destroy; +end; + +function TExprBuiltInManager.IndexOfIdentifier(const AName: ShortString + ): Integer; +begin + Result:=FDefs.IndexOfIdentifier(AName); +end; + +function TExprBuiltInManager.FindIdentifier(const AName: ShortString + ): TFPBuiltinExprIdentifierDef; +begin + Result:=TFPBuiltinExprIdentifierDef(FDefs.FindIdentifier(AName)); +end; + +function TExprBuiltInManager.IdentifierByName(const AName: ShortString + ): TFPBuiltinExprIdentifierDef; +begin + Result:=TFPBuiltinExprIdentifierDef(FDefs.IdentifierByName(AName)); +end; + +function TExprBuiltInManager.AddVariable(const ACategory: TBuiltInCategory; + const AName: ShortString; AResultType: TResultType; AValue: String + ): TFPBuiltInExprIdentifierDef; +begin + Result:=TFPBuiltInExprIdentifierDef(FDefs.Addvariable(AName,AResultType,AValue)); + Result.Category:=ACategory; +end; + +function TExprBuiltInManager.AddBooleanVariable( + const ACategory: TBuiltInCategory; const AName: ShortString; AValue: Boolean + ): TFPBuiltInExprIdentifierDef; +begin + Result:=TFPBuiltInExprIdentifierDef(FDefs.AddBooleanvariable(AName,AValue)); + Result.Category:=ACategory; +end; + +function TExprBuiltInManager.AddIntegerVariable( + const ACategory: TBuiltInCategory; const AName: ShortString; AValue: Integer + ): TFPBuiltInExprIdentifierDef; +begin + Result:=TFPBuiltInExprIdentifierDef(FDefs.AddIntegerVariable(AName,AValue)); + Result.Category:=ACategory; +end; + +function TExprBuiltInManager.AddFloatVariable( + const ACategory: TBuiltInCategory; const AName: ShortString; + AValue: TExprFloat): TFPBuiltInExprIdentifierDef; +begin + Result:=TFPBuiltInExprIdentifierDef(FDefs.AddFloatVariable(AName,AValue)); + Result.Category:=ACategory; +end; + +function TExprBuiltInManager.AddStringVariable( + const ACategory: TBuiltInCategory; const AName: ShortString; AValue: String + ): TFPBuiltInExprIdentifierDef; +begin + Result:=TFPBuiltInExprIdentifierDef(FDefs.AddStringVariable(AName,AValue)); + Result.Category:=ACategory; +end; + +function TExprBuiltInManager.AddDateTimeVariable( + const ACategory: TBuiltInCategory; const AName: ShortString; AValue: TDateTime + ): TFPBuiltInExprIdentifierDef; +begin + Result:=TFPBuiltInExprIdentifierDef(FDefs.AddDateTimeVariable(AName,AValue)); + Result.Category:=ACategory; +end; + +function TExprBuiltInManager.AddFunction(const ACategory: TBuiltInCategory; + const AName: ShortString; const AResultType: Char; const AParamTypes: String; + ACallBack: TFPExprFunctionCallBack): TFPBuiltInExprIdentifierDef; +begin + Result:=TFPBuiltInExprIdentifierDef(FDefs.AddFunction(AName,AResultType,AParamTypes,ACallBack)); + Result.Category:=ACategory; +end; + +function TExprBuiltInManager.AddFunction(const ACategory: TBuiltInCategory; + const AName: ShortString; const AResultType: Char; const AParamTypes: String; + ACallBack: TFPExprFunctionEvent): TFPBuiltInExprIdentifierDef; +begin + Result:=TFPBuiltInExprIdentifierDef(FDefs.AddFunction(AName,AResultType,AParamTypes,ACallBack)); + Result.Category:=ACategory; +end; + + +{ --------------------------------------------------------------------- + Various Nodes + ---------------------------------------------------------------------} + +{ TFPBinaryOperation } + +procedure TFPBinaryOperation.CheckSameNodeTypes; + +Var + LT,RT : TResultType; + + +begin + LT:=Left.NodeType; + RT:=Right.NodeType; + if (RT<>LT) then + RaiseParserError(SErrTypesDoNotMatch,[ResultTypeName(LT),ResultTypeName(RT),Left.AsString,Right.AsString]) +end; + +constructor TFPBinaryOperation.Create(ALeft, ARight: TFPExprNode); +begin + FLeft:=ALeft; + FRight:=ARight; +end; + +destructor TFPBinaryOperation.Destroy; +begin + FreeAndNil(FLeft); + FreeAndNil(FRight); + inherited Destroy; +end; + +procedure TFPBinaryOperation.Check; +begin + If Not Assigned(Left) then + RaiseParserError(SErrNoLeftOperand,[classname]); + If Not Assigned(Right) then + RaiseParserError(SErrNoRightOperand,[classname]); +end; + +{ TFPUnaryOperator } + +constructor TFPUnaryOperator.Create(AOperand: TFPExprNode); +begin + FOperand:=AOperand; +end; + +destructor TFPUnaryOperator.Destroy; +begin + FreeAndNil(FOperand); + inherited Destroy; +end; + +procedure TFPUnaryOperator.Check; +begin + If Not Assigned(Operand) then + RaiseParserError(SErrNoOperand,[Self.className]); +end; + +{ TFPConstExpression } + +constructor TFPConstExpression.CreateString(AValue: String); +begin + FValue.ResultType:=rtString; + FValue.ResString:=AValue; +end; + +constructor TFPConstExpression.CreateInteger(AValue: Int64); +begin + FValue.ResultType:=rtInteger; + FValue.ResInteger:=AValue; +end; + +constructor TFPConstExpression.CreateDateTime(AValue: TDateTime); +begin + FValue.ResultType:=rtDateTime; + FValue.ResDateTime:=AValue; +end; + +constructor TFPConstExpression.CreateFloat(AValue: TExprFloat); +begin + Inherited create; + FValue.ResultType:=rtFloat; + FValue.ResFloat:=AValue; +end; + +constructor TFPConstExpression.CreateBoolean(AValue: Boolean); +begin + FValue.ResultType:=rtBoolean; + FValue.ResBoolean:=AValue; +end; + +procedure TFPConstExpression.Check; +begin + // Nothing to check; +end; + +function TFPConstExpression.NodeType: TResultType; +begin + Result:=FValue.ResultType; +end; + +Procedure TFPConstExpression.GetNodeValue(var Result : TFPExpressionResult); +begin + Result:=FValue; +end; + +function TFPConstExpression.AsString: string ; +begin + Case NodeType of + rtString : Result:=''''+FValue.resString+''''; + rtInteger : Result:=IntToStr(FValue.resInteger); + rtDateTime : Result:=''''+FormatDateTime('cccc',FValue.resDateTime)+''''; + rtBoolean : If FValue.ResBoolean then Result:='True' else Result:='False'; + rtFloat : Str(FValue.ResFloat,Result); + end; +end; + + +{ TFPNegateOperation } + +procedure TFPNegateOperation.Check; +begin + Inherited; + If Not (Operand.NodeType in [rtInteger,rtFloat]) then + RaiseParserError(SErrNoNegation,[ResultTypeName(Operand.NodeType),Operand.AsString]) +end; + +function TFPNegateOperation.NodeType: TResultType; +begin + Result:=Operand.NodeType; +end; + +Procedure TFPNegateOperation.GetNodeValue(var Result : TFPExpressionResult); +begin + Operand.GetNodeValue(Result); + Case Result.ResultType of + rtInteger : Result.resInteger:=-Result.ResInteger; + rtFloat : Result.resFloat:=-Result.ResFloat; + end; +end; + +function TFPNegateOperation.AsString: String; +begin + Result:='-'+TrimLeft(Operand.AsString); +end; + +{ TFPBinaryAndOperation } + +procedure TFPBooleanOperation.Check; +begin + inherited Check; + CheckNodeType(Left,[rtInteger,rtBoolean]); + CheckNodeType(Right,[rtInteger,rtBoolean]); + CheckSameNodeTypes; +end; + +function TFPBooleanOperation.NodeType: TResultType; +begin + Result:=Left.NodeType; +end; + +Procedure TFPBinaryAndOperation.GetNodeValue(var Result : TFPExpressionResult); + +Var + RRes : TFPExpressionResult; + +begin + Left.GetNodeValue(Result); + Right.GetNodeValue(RRes); + Case Result.ResultType of + rtBoolean : Result.resBoolean:=Result.ResBoolean and RRes.ResBoolean; + rtInteger : Result.resInteger:=Result.ResInteger and RRes.ResInteger; + end; +end; + +function TFPBinaryAndOperation.AsString: string; +begin + Result:=Left.AsString+' and '+Right.AsString; +end; + +{ TFPExprNode } + +procedure TFPExprNode.CheckNodeType(Anode: TFPExprNode; Allowed: TResultTypes); + +Var + S : String; + A : TResultType; + +begin + If (Anode=Nil) then + RaiseParserError(SErrNoNodeToCheck); + If Not (ANode.NodeType in Allowed) then + begin + S:=''; + For A:=Low(TResultType) to High(TResultType) do + If A in Allowed then + begin + If S<>'' then + S:=S+','; + S:=S+ResultTypeName(A); + end; + RaiseParserError(SInvalidNodeType,[ResultTypeName(ANode.NodeType),S,ANode.AsString]); + end; +end; + +function TFPExprNode.NodeValue: TFPExpressionResult; +begin + GetNodeValue(Result); +end; + +{ TFPBinaryOrOperation } + +function TFPBinaryOrOperation.AsString: string; +begin + Result:=Left.AsString+' or '+Right.AsString; +end; + +Procedure TFPBinaryOrOperation.GetNodeValue(var Result : TFPExpressionResult); + +Var + RRes : TFPExpressionResult; + +begin + Left.GetNodeValue(Result); + Right.GetNodeValue(RRes); + Case Result.ResultType of + rtBoolean : Result.resBoolean:=Result.ResBoolean or RRes.ResBoolean; + rtInteger : Result.resInteger:=Result.ResInteger or RRes.ResInteger; + end; +end; + +{ TFPBinaryXOrOperation } + +function TFPBinaryXOrOperation.AsString: string; +begin + Result:=Left.AsString+' xor '+Right.AsString; +end; + +Procedure TFPBinaryXOrOperation.GetNodeValue(var Result : TFPExpressionResult); +Var + RRes : TFPExpressionResult; + +begin + Left.GetNodeValue(Result); + Right.GetNodeValue(RRes); + Case Result.ResultType of + rtBoolean : Result.resBoolean:=Result.ResBoolean xor RRes.ResBoolean; + rtInteger : Result.resInteger:=Result.ResInteger xor RRes.ResInteger; + end; +end; + +{ TFPNotNode } + +procedure TFPNotNode.Check; +begin + If Not (Operand.NodeType in [rtInteger,rtBoolean]) then + RaiseParserError(SErrNoNotOperation,[ResultTypeName(Operand.NodeType),Operand.AsString]) +end; + +function TFPNotNode.NodeType: TResultType; +begin + Result:=Operand.NodeType; +end; + +procedure TFPNotNode.GetNodeValue(var Result: TFPExpressionResult); +begin + Operand.GetNodeValue(Result); + Case result.ResultType of + rtInteger : Result.resInteger:=Not Result.resInteger; + rtBoolean : Result.resBoolean:=Not Result.resBoolean; + end +end; + +function TFPNotNode.AsString: String; +begin + Result:='not '+Operand.AsString; +end; + +{ TIfOperation } + +constructor TIfOperation.Create(ACondition, ALeft, ARight: TFPExprNode); +begin + Inherited Create(ALeft,ARight); + FCondition:=ACondition; +end; + +destructor TIfOperation.destroy; +begin + FreeAndNil(FCondition); + inherited destroy; +end; + +procedure TIfOperation.GetNodeValue(var Result: TFPExpressionResult); + +begin + FCondition.GetNodeValue(Result); + If Result.ResBoolean then + Left.GetNodeValue(Result) + else + Right.GetNodeValue(Result) +end; + +procedure TIfOperation.Check; +begin + inherited Check; + if (Condition.NodeType<>rtBoolean) then + RaiseParserError(SErrIFNeedsBoolean,[Condition.AsString]); + CheckSameNodeTypes; +end; + +function TIfOperation.NodeType: TResultType; +begin + Result:=Left.NodeType; +end; + +function TIfOperation.AsString: string; +begin + Result:=Format('if(%s , %s , %s)',[Condition.AsString,Left.AsString,Right.AsString]); +end; + +{ TCaseOperation } + +procedure TCaseOperation.GetNodeValue(var Result: TFPExpressionResult); + +Var + I,L : Integer; + B : Boolean; + RT,RV : TFPExpressionResult; + +begin + FArgs[0].GetNodeValue(RT); + L:=Length(FArgs); + I:=2; + B:=False; + While (Not B) and (IT) then + RaiseParserError(SErrCaseLabelType,[I div 2,N.AsString,ResultTypeName(T),ResultTypeName(N.NodeType)]); + end + else // Odd argument types (values) must match first. + begin + If (N.NodeType<>V) then + RaiseParserError(SErrCaseValueType,[(I-1)div 2,N.AsString,ResultTypeName(V),ResultTypeName(N.NodeType)]); + end + end; +end; + +function TCaseOperation.NodeType: TResultType; +begin + Result:=FArgs[1].NodeType; +end; + +constructor TCaseOperation.Create(Args: TExprArgumentArray); +begin + Fargs:=Args; +end; + +destructor TCaseOperation.destroy; + +Var + I : Integer; + +begin + For I:=0 to Length(FArgs)-1 do + FreeAndNil(Fargs[I]); + inherited destroy; +end; + +function TCaseOperation.AsString: string; + +Var + I : integer; + +begin + Result:=''; + For I:=0 to Length(FArgs)-1 do + begin + If (Result<>'') then + Result:=Result+', '; + Result:=Result+FArgs[i].AsString; + end; + Result:='Case('+Result+')'; +end; + +{ TFPBooleanResultOperation } + +procedure TFPBooleanResultOperation.Check; +begin + inherited Check; + CheckSameNodeTypes; +end; + +function TFPBooleanResultOperation.NodeType: TResultType; +begin + Result:=rtBoolean; +end; + +{ TFPEqualOperation } + +function TFPEqualOperation.AsString: string; +begin + Result:=Left.AsString+' = '+Right.AsString; +end; + +Procedure TFPEqualOperation.GetNodeValue(var Result : TFPExpressionResult); + +Var + RRes : TFPExpressionResult; + +begin + Left.GetNodeValue(Result); + Right.GetNodeValue(RRes); + Case Result.ResultType of + rtBoolean : Result.resBoolean:=Result.ResBoolean=RRes.ResBoolean; + rtInteger : Result.resBoolean:=Result.ResInteger=RRes.ResInteger; + rtFloat : Result.resBoolean:=Result.ResFloat=RRes.ResFLoat; + rtDateTime : Result.resBoolean:=Result.ResDateTime=RRes.ResDateTime; + rtString : Result.resBoolean:=Result.ResString=RRes.ResString; + end; + Result.ResultType:=rtBoolean; +end; + +{ TFPUnequalOperation } + +function TFPUnequalOperation.AsString: string; +begin + Result:=Left.AsString+' <> '+Right.AsString; +end; + +Procedure TFPUnequalOperation.GetNodeValue(var Result : TFPExpressionResult); +begin + Inherited GetNodeValue(Result); + Result.ResBoolean:=Not Result.ResBoolean; +end; + + +{ TFPLessThanOperation } + +function TFPLessThanOperation.AsString: string; +begin + Result:=Left.AsString+' < '+Right.AsString; +end; + +procedure TFPLessThanOperation.GetNodeValue(var Result : TFPExpressionResult); +Var + RRes : TFPExpressionResult; + +begin + Left.GetNodeValue(Result); + Right.GetNodeValue(RRes); + Case Result.ResultType of + rtInteger : Result.resBoolean:=Result.ResInteger '+Right.AsString; +end; + +Procedure TFPGreaterThanOperation.GetNodeValue(var Result : TFPExpressionResult); + +Var + RRes : TFPExpressionResult; + +begin + Left.GetNodeValue(Result); + Right.GetNodeValue(RRes); + Case Result.ResultType of + rtInteger : case Right.NodeType of + rtInteger : Result.resBoolean:=Result.ResInteger>RRes.ResInteger; + rtFloat : Result.resBoolean:=Result.ResInteger>RRes.ResFloat; + end; + rtFloat : case Right.NodeType of + rtInteger : Result.resBoolean:=Result.ResFloat>RRes.ResInteger; + rtFloat : Result.resBoolean:=Result.ResFloat>RRes.ResFLoat; + end; + rtDateTime : Result.resBoolean:=Result.ResDateTime>RRes.ResDateTime; + rtString : Result.resBoolean:=Result.ResString>RRes.ResString; + end; + Result.ResultType:=rtBoolean; +end; + +{ TFPGreaterThanEqualOperation } + +function TFPGreaterThanEqualOperation.AsString: string; +begin + Result:=Left.AsString+' >= '+Right.AsString; +end; + +Procedure TFPGreaterThanEqualOperation.GetNodeValue(var Result : TFPExpressionResult); +begin + Inherited GetNodeValue(Result); + Result.ResBoolean:=Not Result.ResBoolean; +end; + +{ TFPLessThanEqualOperation } + +function TFPLessThanEqualOperation.AsString: string; +begin + Result:=Left.AsString+' <= '+Right.AsString; +end; + +Procedure TFPLessThanEqualOperation.GetNodeValue(var Result : TFPExpressionResult); +begin + Inherited GetNodeValue(Result); + Result.ResBoolean:=Not Result.ResBoolean; +end; + +{ TFPOrderingOperation } + +procedure TFPOrderingOperation.Check; + +Const + AllowedTypes =[rtInteger,rtfloat,rtDateTime,rtString]; + +begin + CheckNodeType(Left,AllowedTypes); + CheckNodeType(Right,AllowedTypes); + inherited Check; +end; + +{ TMathOperation } + +procedure TMathOperation.Check; + +Const + AllowedTypes =[rtInteger,rtfloat,rtDateTime,rtString]; + +begin + inherited Check; + CheckNodeType(Left,AllowedTypes); + CheckNodeType(Right,AllowedTypes); + CheckSameNodeTypes; +end; + +function TMathOperation.NodeType: TResultType; +begin + Result:=Left.NodeType; +end; + +{ TFPAddOperation } + +function TFPAddOperation.AsString: string; +begin + Result:=Left.AsString+' + '+Right.asString; +end; + +Procedure TFPAddOperation.GetNodeValue(var Result : TFPExpressionResult); + +Var + RRes : TFPExpressionResult; + +begin + Left.GetNodeValue(Result); + Right.GetNodeValue(RRes); + case Result.ResultType of + rtInteger : Result.ResInteger:=Result.ResInteger+RRes.ResInteger; + rtString : Result.ResString:=Result.ResString+RRes.ResString; + rtDateTime : Result.ResDateTime:=Result.ResDateTime+RRes.ResDateTime; + rtFloat : Result.ResFLoat:=Result.ResFLoat+RRes.ResFLoat; + end; + Result.ResultType:=NodeType; +end; + +{ TFPSubtractOperation } + +procedure TFPSubtractOperation.check; + +Const + AllowedTypes =[rtInteger,rtfloat,rtDateTime]; + +begin + CheckNodeType(Left,AllowedTypes); + CheckNodeType(Right,AllowedTypes); + inherited check; +end; + +function TFPSubtractOperation.AsString: string; +begin + Result:=Left.AsString+' - '+Right.asString; +end; + +Procedure TFPSubtractOperation.GetNodeValue(var Result : TFPExpressionResult); + +Var + RRes : TFPExpressionResult; + +begin + Left.GetNodeValue(Result); + Right.GetNodeValue(RRes); + case Result.ResultType of + rtInteger : Result.ResInteger:=Result.ResInteger-RRes.ResInteger; + rtDateTime : Result.ResDateTime:=Result.ResDateTime-RRes.ResDateTime; + rtFloat : Result.ResFLoat:=Result.ResFLoat-RRes.ResFLoat; + end; +end; + +{ TFPMultiplyOperation } + +procedure TFPMultiplyOperation.check; + +Const + AllowedTypes =[rtInteger,rtfloat]; + +begin + CheckNodeType(Left,AllowedTypes); + CheckNodeType(Right,AllowedTypes); + Inherited; +end; + +function TFPMultiplyOperation.AsString: string; +begin + Result:=Left.AsString+' * '+Right.asString; +end; + +Procedure TFPMultiplyOperation.GetNodeValue(var Result : TFPExpressionResult); +Var + RRes : TFPExpressionResult; + +begin + Left.GetNodeValue(Result); + Right.GetNodeValue(RRes); + case Result.ResultType of + rtInteger : Result.ResInteger:=Result.ResInteger*RRes.ResInteger; + rtFloat : Result.ResFLoat:=Result.ResFLoat*RRes.ResFLoat; + end; +end; + +{ TFPDivideOperation } + +procedure TFPDivideOperation.check; +Const + AllowedTypes =[rtInteger,rtfloat]; + +begin + CheckNodeType(Left,AllowedTypes); + CheckNodeType(Right,AllowedTypes); + inherited check; +end; + +function TFPDivideOperation.AsString: string; +begin + Result:=Left.AsString+' / '+Right.asString; +end; + +function TFPDivideOperation.NodeType: TResultType; +begin + Result:=rtFLoat; +end; + +Procedure TFPDivideOperation.GetNodeValue(var Result : TFPExpressionResult); + +Var + RRes : TFPExpressionResult; + +begin + Left.GetNodeValue(Result); + Right.GetNodeValue(RRes); + case Result.ResultType of + rtInteger : Result.ResFloat:=Result.ResInteger/RRes.ResInteger; + rtFloat : Result.ResFLoat:=Result.ResFLoat/RRes.ResFLoat; + end; + Result.ResultType:=rtFloat; +end; + +{ TFPConvertNode } + +function TFPConvertNode.AsString: String; +begin + Result:=Operand.AsString; +end; + +{ TIntToFloatNode } + +procedure TIntConvertNode.Check; +begin + inherited Check; + CheckNodeType(Operand,[rtInteger]) +end; + +function TIntToFloatNode.NodeType: TResultType; +begin + Result:=rtFloat; +end; + +Procedure TIntToFloatNode.GetNodeValue(var Result : TFPExpressionResult); +begin + Operand.GetNodeValue(Result); + Result.ResFloat:=Result.ResInteger; + Result.ResultType:=rtFloat; +end; + + +{ TIntToDateTimeNode } + +function TIntToDateTimeNode.NodeType: TResultType; +begin + Result:=rtDatetime; +end; + +procedure TIntToDateTimeNode.GetNodeValue(var Result : TFPExpressionResult); +begin + Operand.GetnodeValue(Result); + Result.ResDateTime:=Result.ResInteger; + Result.ResultType:=rtDateTime; +end; + +{ TFloatToDateTimeNode } + +procedure TFloatToDateTimeNode.Check; +begin + inherited Check; + CheckNodeType(Operand,[rtFloat]); +end; + +function TFloatToDateTimeNode.NodeType: TResultType; +begin + Result:=rtDateTime; +end; + +Procedure TFloatToDateTimeNode.GetNodeValue(var Result : TFPExpressionResult); +begin + Operand.GetNodeValue(Result); + Result.ResDateTime:=Result.ResFloat; + Result.ResultType:=rtDateTime; +end; + +{ TFPExprIdentifierNode } + +constructor TFPExprIdentifierNode.CreateIdentifier(AID: TFPExprIdentifierDef); +begin + Inherited Create; + FID:=AID; + PResult:=@FID.FValue; + FResultType:=FID.ResultType; +end; + +function TFPExprIdentifierNode.NodeType: TResultType; +begin + Result:=FResultType; +end; + +Procedure TFPExprIdentifierNode.GetNodeValue(var Result : TFPExpressionResult); +begin + Result:=PResult^; + Result.ResultType:=FResultType; +end; + +{ TFPExprVariable } + +procedure TFPExprVariable.Check; +begin + // Do nothing; +end; + +function TFPExprVariable.AsString: string; +begin + Result:=FID.Name; +end; + +{ TFPExprFunction } + +procedure TFPExprFunction.CalcParams; + +Var + I : Integer; + +begin + For I:=0 to Length(FArgumentParams)-1 do + FArgumentNodes[i].GetNodeValue(FArgumentParams[i]); +end; + +procedure TFPExprFunction.Check; + +Var + I : Integer; + rtp,rta : TResultType; + +begin + If Length(FArgumentNodes)<>FID.ArgumentCount then + RaiseParserError(ErrInvalidArgumentCount,[FID.Name]); + For I:=0 to Length(FArgumentNodes)-1 do + begin + rtp:=CharToResultType(FID.ParameterTypes[i+1]); + rta:=FArgumentNodes[i].NodeType; + If (rtp<>rta) then + RaiseParserError(SErrInvalidArgumentType,[I+1,ResultTypeName(rtp),ResultTypeName(rta)]) + end; +end; + +constructor TFPExprFunction.CreateFunction(AID: TFPExprIdentifierDef; + const Args: TExprArgumentArray); +begin + Inherited CreateIdentifier(AID); + FArgumentNodes:=Args; + SetLength(FArgumentParams,Length(Args)); +end; + +destructor TFPExprFunction.Destroy; + +Var + I : Integer; + +begin + For I:=0 to Length(FArgumentNodes)-1 do + FreeAndNil(FArgumentNodes[I]); + inherited Destroy; +end; + +function TFPExprFunction.AsString: String; + +Var + S : String; + I : Integer; + +begin + S:=''; + For I:=0 to length(FArgumentNodes)-1 do + begin + If (S<>'') then + S:=S+','; + S:=S+FArgumentNodes[I].AsString; + end; + If (S<>'') then + S:='('+S+')'; + Result:=FID.Name+S; +end; + +{ TFPFunctionCallBack } + +constructor TFPFunctionCallBack.CreateFunction(AID: TFPExprIdentifierDef; + Const Args : TExprArgumentArray); +begin + Inherited; + FCallBack:=AID.OnGetFunctionValueCallBack; +end; + +Procedure TFPFunctionCallBack.GetNodeValue(var Result : TFPExpressionResult); +begin + If Length(FArgumentParams)>0 then + CalcParams; + FCallBack(Result,FArgumentParams); + Result.ResultType:=NodeType; +end; + +{ TFPFunctionEventHandler } + +constructor TFPFunctionEventHandler.CreateFunction(AID: TFPExprIdentifierDef; + Const Args : TExprArgumentArray); +begin + Inherited; + FCallBack:=AID.OnGetFunctionValue; +end; + +Procedure TFPFunctionEventHandler.GetNodeValue(var Result : TFPExpressionResult); +begin + If Length(FArgumentParams)>0 then + CalcParams; + FCallBack(Result,FArgumentParams); + Result.ResultType:=NodeType; +end; + +{ --------------------------------------------------------------------- + Standard Builtins support + ---------------------------------------------------------------------} + +{ Template for builtin. + +Procedure MyCallback (Var Result : TFPExpressionResult; Const Args : TExprParameterArray); +begin +end; + +} + +// Math builtins + +Procedure BuiltInCos(Var Result : TFPExpressionResult; Const Args : TExprParameterArray); +begin + Result.resFloat:=Cos(Args[0].resFloat); +end; + +Procedure BuiltInSin(Var Result : TFPExpressionResult; Const Args : TExprParameterArray); +begin + Result.resFloat:=Sin(Args[0].resFloat); +end; + +Procedure BuiltInArcTan(Var Result : TFPExpressionResult; Const Args : TExprParameterArray); +begin + Result.resFloat:=Arctan(Args[0].resFloat); +end; + +Procedure BuiltInAbs(Var Result : TFPExpressionResult; Const Args : TExprParameterArray); +begin + Result.resFloat:=Abs(Args[0].resFloat); +end; + +Procedure BuiltInSqr(Var Result : TFPExpressionResult; Const Args : TExprParameterArray); +begin + Result.resFloat:=Sqr(Args[0].resFloat); +end; + +Procedure BuiltInSqrt(Var Result : TFPExpressionResult; Const Args : TExprParameterArray); +begin + Result.resFloat:=Sqrt(Args[0].resFloat); +end; + +Procedure BuiltInExp(Var Result : TFPExpressionResult; Const Args : TExprParameterArray); +begin + Result.resFloat:=Exp(Args[0].resFloat); +end; + +Procedure BuiltInLn(Var Result : TFPExpressionResult; Const Args : TExprParameterArray); +begin + Result.resFloat:=Ln(Args[0].resFloat); +end; + +Const + L10 = ln(10); + +Procedure BuiltInLog(Var Result : TFPExpressionResult; Const Args : TExprParameterArray); +begin + Result.resFloat:=Ln(Args[0].resFloat)/L10; +end; + +Procedure BuiltInRound(Var Result : TFPExpressionResult; Const Args : TExprParameterArray); +begin + Result.resInteger:=Round(Args[0].resFloat); +end; + +Procedure BuiltInTrunc(Var Result : TFPExpressionResult; Const Args : TExprParameterArray); +begin + Result.resInteger:=Trunc(Args[0].resFloat); +end; + +Procedure BuiltInInt(Var Result : TFPExpressionResult; Const Args : TExprParameterArray); +begin + Result.resFloat:=Int(Args[0].resFloat); +end; + +Procedure BuiltInFrac(Var Result : TFPExpressionResult; Const Args : TExprParameterArray); +begin + Result.resFloat:=frac(Args[0].resFloat); +end; + +// String builtins + +Procedure BuiltInLength(Var Result : TFPExpressionResult; Const Args : TExprParameterArray); +begin + Result.resInteger:=Length(Args[0].resString); +end; + +Procedure BuiltInCopy(Var Result : TFPExpressionResult; Const Args : TExprParameterArray); +begin + Result.resString:=Copy(Args[0].resString,Args[1].resInteger,Args[2].resInteger); +end; + +Procedure BuiltInDelete(Var Result : TFPExpressionResult; Const Args : TExprParameterArray); +begin + Result.resString:=Args[0].resString; + Delete(Result.resString,Args[1].resInteger,Args[2].resInteger); +end; + +Procedure BuiltInPos(Var Result : TFPExpressionResult; Const Args : TExprParameterArray); +begin + Result.resInteger:=Pos(Args[0].resString,Args[1].resString); +end; + +Procedure BuiltInUppercase(Var Result : TFPExpressionResult; Const Args : TExprParameterArray); +begin + Result.resString:=Uppercase(Args[0].resString); +end; + +Procedure BuiltInLowercase(Var Result : TFPExpressionResult; Const Args : TExprParameterArray); +begin + Result.resString:=Lowercase(Args[0].resString); +end; + +Procedure BuiltInStringReplace(Var Result : TFPExpressionResult; Const Args : TExprParameterArray); + +Var + F : TReplaceFlags; + +begin + F:=[]; + If Args[3].resBoolean then + Include(F,rfReplaceAll); + If Args[4].resBoolean then + Include(F,rfIgnoreCase); + Result.resString:=StringReplace(Args[0].resString,Args[1].resString,Args[2].resString,f); +end; + +Procedure BuiltInCompareText(Var Result : TFPExpressionResult; Const Args : TExprParameterArray); +begin + Result.resInteger:=CompareText(Args[0].resString,Args[1].resString); +end; + +// Date/Time builtins + +Procedure BuiltInDate(Var Result : TFPExpressionResult; Const Args : TExprParameterArray); +begin + Result.resDateTime:=Date; +end; + +Procedure BuiltInTime(Var Result : TFPExpressionResult; Const Args : TExprParameterArray); +begin + Result.resDateTime:=Time; +end; + +Procedure BuiltInNow(Var Result : TFPExpressionResult; Const Args : TExprParameterArray); +begin + Result.resDateTime:=Now; +end; + +Procedure BuiltInDayofWeek(Var Result : TFPExpressionResult; Const Args : TExprParameterArray); +begin + Result.resInteger:=DayOfWeek(Args[0].resDateTime); +end; + +Procedure BuiltInExtractYear(Var Result : TFPExpressionResult; Const Args : TExprParameterArray); + +Var + Y,M,D : Word; + +begin + DecodeDate(Args[0].resDateTime,Y,M,D); + Result.resInteger:=Y; +end; + +Procedure BuiltInExtractMonth(Var Result : TFPExpressionResult; Const Args : TExprParameterArray); + +Var + Y,M,D : Word; + +begin + DecodeDate(Args[0].resDateTime,Y,M,D); + Result.resInteger:=M; +end; + +Procedure BuiltInExtractDay(Var Result : TFPExpressionResult; Const Args : TExprParameterArray); + +Var + Y,M,D : Word; + +begin + DecodeDate(Args[0].resDateTime,Y,M,D); + Result.resInteger:=D; +end; + +Procedure BuiltInExtractHour(Var Result : TFPExpressionResult; Const Args : TExprParameterArray); + +Var + H,M,S,MS : Word; + +begin + DecodeTime(Args[0].resDateTime,H,M,S,MS); + Result.resInteger:=H; +end; + +Procedure BuiltInExtractMin(Var Result : TFPExpressionResult; Const Args : TExprParameterArray); + +Var + H,M,S,MS : Word; + +begin + DecodeTime(Args[0].resDateTime,H,M,S,MS); + Result.resInteger:=M; +end; + +Procedure BuiltInExtractSec(Var Result : TFPExpressionResult; Const Args : TExprParameterArray); + +Var + H,M,S,MS : Word; + +begin + DecodeTime(Args[0].resDateTime,H,M,S,MS); + Result.resInteger:=S; +end; + +Procedure BuiltInExtractMSec(Var Result : TFPExpressionResult; Const Args : TExprParameterArray); + +Var + H,M,S,MS : Word; + +begin + DecodeTime(Args[0].resDateTime,H,M,S,MS); + Result.resInteger:=MS; +end; + +Procedure BuiltInEncodedate(Var Result : TFPExpressionResult; Const Args : TExprParameterArray); + +begin + Result.resDateTime:=Encodedate(Args[0].resInteger,Args[1].resInteger,Args[2].resInteger); +end; + +Procedure BuiltInEncodeTime(Var Result : TFPExpressionResult; Const Args : TExprParameterArray); + +begin + Result.resDateTime:=EncodeTime(Args[0].resInteger,Args[1].resInteger,Args[2].resInteger,Args[3].resInteger); +end; + +Procedure BuiltInEncodeDateTime(Var Result : TFPExpressionResult; Const Args : TExprParameterArray); + +begin + Result.resDateTime:=EncodeDate(Args[0].resInteger,Args[1].resInteger,Args[2].resInteger) + +EncodeTime(Args[3].resInteger,Args[4].resInteger,Args[5].resInteger,Args[6].resInteger); +end; + +Procedure BuiltInShortDayName(Var Result : TFPExpressionResult; Const Args : TExprParameterArray); + +begin + Result.resString:=ShortDayNames[Args[0].resInteger]; +end; + +Procedure BuiltInShortMonthName(Var Result : TFPExpressionResult; Const Args : TExprParameterArray); + +begin + Result.resString:=ShortMonthNames[Args[0].resInteger]; +end; +Procedure BuiltInLongDayName(Var Result : TFPExpressionResult; Const Args : TExprParameterArray); + +begin + Result.resString:=LongDayNames[Args[0].resInteger]; +end; + +Procedure BuiltInLongMonthName(Var Result : TFPExpressionResult; Const Args : TExprParameterArray); + +begin + Result.resString:=LongMonthNames[Args[0].resInteger]; +end; + +Procedure BuiltInFormatDateTime(Var Result : TFPExpressionResult; Const Args : TExprParameterArray); + +begin + Result.resString:=FormatDateTime(Args[0].resString,Args[1].resDateTime); +end; + + +// Conversion +Procedure BuiltInIntToStr(Var Result : TFPExpressionResult; Const Args : TExprParameterArray); + +begin + Result.resString:=IntToStr(Args[0].resinteger); +end; + +Procedure BuiltInStrToInt(Var Result : TFPExpressionResult; Const Args : TExprParameterArray); + +begin + Result.resInteger:=StrToInt(Args[0].resString); +end; + +Procedure BuiltInStrToIntDef(Var Result : TFPExpressionResult; Const Args : TExprParameterArray); + +begin + Result.resInteger:=StrToIntDef(Args[0].resString,Args[1].resInteger); +end; + +Procedure BuiltInFloatToStr(Var Result : TFPExpressionResult; Const Args : TExprParameterArray); + +begin + Result.resString:=FloatToStr(Args[0].resFloat); +end; + +Procedure BuiltInStrToFloat(Var Result : TFPExpressionResult; Const Args : TExprParameterArray); + +begin + Result.resFloat:=StrToFloat(Args[0].resString); +end; + +Procedure BuiltInStrToFloatDef(Var Result : TFPExpressionResult; Const Args : TExprParameterArray); + +begin + Result.resFloat:=StrToFloatDef(Args[0].resString,Args[1].resFloat); +end; + +Procedure BuiltInDateToStr(Var Result : TFPExpressionResult; Const Args : TExprParameterArray); + +begin + Result.resString:=DateToStr(Args[0].resDateTime); +end; + +Procedure BuiltInTimeToStr(Var Result : TFPExpressionResult; Const Args : TExprParameterArray); + +begin + Result.resString:=TimeToStr(Args[0].resDateTime); +end; + +Procedure BuiltInStrToDate(Var Result : TFPExpressionResult; Const Args : TExprParameterArray); + +begin + Result.resDateTime:=StrToDate(Args[0].resString); +end; + +Procedure BuiltInStrToDateDef(Var Result : TFPExpressionResult; Const Args : TExprParameterArray); + +begin + Result.resDateTime:=StrToDateDef(Args[0].resString,Args[1].resDateTime); +end; + +Procedure BuiltInStrToTime(Var Result : TFPExpressionResult; Const Args : TExprParameterArray); + +begin + Result.resDateTime:=StrToTime(Args[0].resString); +end; + +Procedure BuiltInStrToTimeDef(Var Result : TFPExpressionResult; Const Args : TExprParameterArray); + +begin + Result.resDateTime:=StrToTimeDef(Args[0].resString,Args[1].resDateTime); +end; + +Procedure BuiltInStrToDateTime(Var Result : TFPExpressionResult; Const Args : TExprParameterArray); + +begin + Result.resDateTime:=StrToDateTime(Args[0].resString); +end; + +Procedure BuiltInStrToDateTimeDef(Var Result : TFPExpressionResult; Const Args : TExprParameterArray); + +begin + Result.resDateTime:=StrToDateTimeDef(Args[0].resString,Args[1].resDateTime); +end; + +Procedure BuiltInBoolToStr(Var Result : TFPExpressionResult; Const Args : TExprParameterArray); + +begin + Result.resString:=BoolToStr(Args[0].resBoolean); +end; + +Procedure BuiltInStrToBool(Var Result : TFPExpressionResult; Const Args : TExprParameterArray); + +begin + Result.resBoolean:=StrToBool(Args[0].resString); +end; + +Procedure BuiltInStrToBoolDef(Var Result : TFPExpressionResult; Const Args : TExprParameterArray); + +begin + Result.resBoolean:=StrToBoolDef(Args[0].resString,Args[1].resBoolean); +end; + +// Boolean +Procedure BuiltInShl(Var Result : TFPExpressionResult; Const Args : TExprParameterArray); + +begin + Result.resInteger:=Args[0].resInteger shl Args[1].resInteger +end; + +Procedure BuiltInShr(Var Result : TFPExpressionResult; Const Args : TExprParameterArray); + +begin + Result.resInteger:=Args[0].resInteger shr Args[1].resInteger +end; + +Procedure BuiltinIFS(Var Result : TFPExpressionResult; Const Args : TExprParameterArray); + +begin + If Args[0].resBoolean then + Result.resString:=Args[1].resString + else + Result.resString:=Args[2].resString +end; + +Procedure BuiltinIFI(Var Result : TFPExpressionResult; Const Args : TExprParameterArray); + +begin + If Args[0].resBoolean then + Result.resinteger:=Args[1].resinteger + else + Result.resinteger:=Args[2].resinteger +end; + +Procedure BuiltinIFF(Var Result : TFPExpressionResult; Const Args : TExprParameterArray); + +begin + If Args[0].resBoolean then + Result.resfloat:=Args[1].resfloat + else + Result.resfloat:=Args[2].resfloat +end; + +Procedure BuiltinIFD(Var Result : TFPExpressionResult; Const Args : TExprParameterArray); + +begin + If Args[0].resBoolean then + Result.resDateTime:=Args[1].resDateTime + else + Result.resDateTime:=Args[2].resDateTime +end; + +Procedure RegisterStdBuiltins(AManager : TExprBuiltInManager); + +begin + With AManager do + begin + AddFloatVariable(bcMath,'pi',Pi); + // Math functions + AddFunction(bcMath,'cos','F','F',@BuiltinCos); + AddFunction(bcMath,'sin','F','F',@BuiltinSin); + AddFunction(bcMath,'arctan','F','F',@BuiltinArctan); + AddFunction(bcMath,'abs','F','F',@BuiltinAbs); + AddFunction(bcMath,'sqr','F','F',@BuiltinSqr); + AddFunction(bcMath,'sqrt','F','F',@BuiltinSqrt); + AddFunction(bcMath,'exp','F','F',@BuiltinExp); + AddFunction(bcMath,'ln','F','F',@BuiltinLn); + AddFunction(bcMath,'log','F','F',@BuiltinLog); + AddFunction(bcMath,'frac','F','F',@BuiltinFrac); + AddFunction(bcMath,'int','F','F',@BuiltinInt); + AddFunction(bcMath,'round','I','F',@BuiltinRound); + AddFunction(bcMath,'trunc','I','F',@BuiltinTrunc); + // String + AddFunction(bcStrings,'length','I','S',@BuiltinLength); + AddFunction(bcStrings,'copy','S','SII',@BuiltinCopy); + AddFunction(bcStrings,'delete','S','SII',@BuiltinDelete); + AddFunction(bcStrings,'pos','I','SS',@BuiltinPos); + AddFunction(bcStrings,'lowercase','S','S',@BuiltinLowercase); + AddFunction(bcStrings,'uppercase','S','S',@BuiltinUppercase); + AddFunction(bcStrings,'stringreplace','S','SSSBB',@BuiltinStringReplace); + AddFunction(bcStrings,'comparetext','I','SS',@BuiltinCompareText); + // Date/Time + AddFunction(bcDateTime,'date','D','',@BuiltinDate); + AddFunction(bcDateTime,'time','D','',@BuiltinTime); + AddFunction(bcDateTime,'now','D','',@BuiltinNow); + AddFunction(bcDateTime,'dayofweek','I','D',@BuiltinDayofweek); + AddFunction(bcDateTime,'extractyear','I','D',@BuiltinExtractYear); + AddFunction(bcDateTime,'extractmonth','I','D',@BuiltinExtractMonth); + AddFunction(bcDateTime,'extractday','I','D',@BuiltinExtractDay); + AddFunction(bcDateTime,'extracthour','I','D',@BuiltinExtractHour); + AddFunction(bcDateTime,'extractmin','I','D',@BuiltinExtractMin); + AddFunction(bcDateTime,'extractsec','I','D',@BuiltinExtractSec); + AddFunction(bcDateTime,'extractmsec','I','D',@BuiltinExtractMSec); + AddFunction(bcDateTime,'encodedate','D','III',@BuiltinEncodedate); + AddFunction(bcDateTime,'encodetime','D','IIII',@BuiltinEncodeTime); + AddFunction(bcDateTime,'encodedatetime','D','IIIIIII',@BuiltinEncodeDateTime); + AddFunction(bcDateTime,'shortdayname','S','I',@BuiltinShortDayName); + AddFunction(bcDateTime,'shortmonthname','S','I',@BuiltinShortMonthName); + AddFunction(bcDateTime,'longdayname','S','I',@BuiltinLongDayName); + AddFunction(bcDateTime,'longmonthname','S','I',@BuiltinLongMonthName); + AddFunction(bcDateTime,'formatdatetime','S','SD',@BuiltinFormatDateTime); + // Boolean + AddFunction(bcBoolean,'shl','I','II',@BuiltinShl); + AddFunction(bcBoolean,'shr','I','II',@BuiltinShr); + AddFunction(bcBoolean,'IFS','S','BSS',@BuiltinIFS); + AddFunction(bcBoolean,'IFF','F','BFF',@BuiltinIFF); + AddFunction(bcBoolean,'IFD','D','BDD',@BuiltinIFD); + AddFunction(bcBoolean,'IFI','I','BII',@BuiltinIFI); + // Conversion + AddFunction(bcConversion,'inttostr','S','I',@BuiltInIntToStr); + AddFunction(bcConversion,'strtoint','I','S',@BuiltInStrToInt); + AddFunction(bcConversion,'strtointdef','I','SI',@BuiltInStrToIntDef); + AddFunction(bcConversion,'floattostr','S','F',@BuiltInFloatToStr); + AddFunction(bcConversion,'strtofloat','F','S',@BuiltInStrToFloat); + AddFunction(bcConversion,'strtofloatdef','F','SF',@BuiltInStrToFloatDef); + AddFunction(bcConversion,'booltostr','S','B',@BuiltInBoolToStr); + AddFunction(bcConversion,'strtobool','B','S',@BuiltInStrToBool); + AddFunction(bcConversion,'strtobooldef','B','SB',@BuiltInStrToBoolDef); + AddFunction(bcConversion,'datetostr','S','D',@BuiltInDateToStr); + AddFunction(bcConversion,'timetostr','S','D',@BuiltInTimeToStr); + AddFunction(bcConversion,'strtodate','D','S',@BuiltInStrToDate); + AddFunction(bcConversion,'strtodatedef','D','SD',@BuiltInStrToDateDef); + AddFunction(bcConversion,'strtotime','D','S',@BuiltInStrToTime); + AddFunction(bcConversion,'strtotimedef','D','SD',@BuiltInStrToTimeDef); + AddFunction(bcConversion,'strtodatetime','D','S',@BuiltInStrToDateTime); + AddFunction(bcConversion,'strtodatetimedef','D','SD',@BuiltInStrToDateTimeDef); + end; +end; + +{ TFPBuiltInExprIdentifierDef } + +procedure TFPBuiltInExprIdentifierDef.Assign(Source: TPersistent); +begin + inherited Assign(Source); + If Source is TFPBuiltInExprIdentifierDef then + FCategory:=(Source as TFPBuiltInExprIdentifierDef).Category; +end; + +initialization + RegisterStdBuiltins(BuiltinIdentifiers); + +finalization + FreeBuiltins; +end.