From c5b96dfe41856165004587ea5fe3d9ec0ed1a80e Mon Sep 17 00:00:00 2001 From: Martin Vogel Date: Tue, 17 Jul 2001 20:30:15 +0000 Subject: [PATCH] 2001-07-17 22:30 MEST Martin Vogel --- harbour/ChangeLog | 9 + harbour/contrib/libct/tests/Makefile | 3 +- harbour/contrib/libct/tests/addascii.prg | 10 +- harbour/contrib/libct/tests/afteratn.prg | 4 + harbour/contrib/libct/tests/asciisum.prg | 4 + harbour/contrib/libct/tests/ascpos.prg | 4 + harbour/contrib/libct/tests/atadjust.prg | 4 + harbour/contrib/libct/tests/atnum.prg | 4 + harbour/contrib/libct/tests/atrepl.prg | 4 + harbour/contrib/libct/tests/attoken.prg | 4 + harbour/contrib/libct/tests/beforatn.prg | 4 + harbour/contrib/libct/tests/charadd.prg | 4 + harbour/contrib/libct/tests/charand.prg | 4 + harbour/contrib/libct/tests/chareven.prg | 4 + harbour/contrib/libct/tests/charhist.prg | 4 + harbour/contrib/libct/tests/charlist.prg | 4 + harbour/contrib/libct/tests/charmirr.prg | 4 + harbour/contrib/libct/tests/charmix.prg | 4 + harbour/contrib/libct/tests/charnlst.prg | 4 + harbour/contrib/libct/tests/charnot.prg | 4 + harbour/contrib/libct/tests/charodd.prg | 4 + harbour/contrib/libct/tests/charone.prg | 4 + harbour/contrib/libct/tests/charonly.prg | 4 + harbour/contrib/libct/tests/charor.prg | 4 + harbour/contrib/libct/tests/charrem.prg | 4 + harbour/contrib/libct/tests/charrepl.prg | 4 + harbour/contrib/libct/tests/charrll.prg | 4 + harbour/contrib/libct/tests/charrlr.prg | 4 + harbour/contrib/libct/tests/charshl.prg | 4 + harbour/contrib/libct/tests/charshr.prg | 4 + harbour/contrib/libct/tests/charslst.prg | 4 + harbour/contrib/libct/tests/charsort.prg | 4 + harbour/contrib/libct/tests/charsub.prg | 4 + harbour/contrib/libct/tests/charswap.prg | 4 + harbour/contrib/libct/tests/charxor.prg | 4 + harbour/contrib/libct/tests/csetarge.prg | 302 +++++++++++++++++++++++ harbour/contrib/libct/tests/csetatmu.prg | 4 + harbour/contrib/libct/tests/csetref.prg | 4 + harbour/contrib/libct/tests/numtoken.prg | 4 + harbour/contrib/libct/tests/setatlik.prg | 4 + harbour/contrib/libct/tests/token.prg | 4 + harbour/contrib/libct/tests/tokenlow.prg | 4 + harbour/contrib/libct/tests/tokensep.prg | 4 + harbour/contrib/libct/tests/tokenupp.prg | 4 + harbour/contrib/libct/tests/valpos.prg | 4 + harbour/contrib/libct/tests/wordone.prg | 4 + harbour/contrib/libct/tests/wordonly.prg | 4 + harbour/contrib/libct/tests/wordrem.prg | 4 + harbour/contrib/libct/tests/wordrepl.prg | 4 + harbour/contrib/libct/tests/wordswap.prg | 4 + 50 files changed, 499 insertions(+), 9 deletions(-) create mode 100644 harbour/contrib/libct/tests/csetarge.prg diff --git a/harbour/ChangeLog b/harbour/ChangeLog index e15f5d27f7..41d40a958c 100644 --- a/harbour/ChangeLog +++ b/harbour/ChangeLog @@ -1,3 +1,12 @@ +2001-07-17 22:30 MEST Martin Vogel + + * contrib/libct/tests/Makefile + + contrib/libct/tests/csetarge.prg + + Test program for the new CSETARGERR() function. + + * contrib/libct/tests/*.prg + + added calls to CTINIT() and CTEXIT() + 2001-07-17 21:50 UTC+1 JFL (mafact) * source/vm/classes.c ! Fixed Scoping where a protected var could be diff --git a/harbour/contrib/libct/tests/Makefile b/harbour/contrib/libct/tests/Makefile index eed9dae23a..8019560254 100644 --- a/harbour/contrib/libct/tests/Makefile +++ b/harbour/contrib/libct/tests/Makefile @@ -63,8 +63,9 @@ PRG_SOURCES=\ charswap.prg \ charsub.prg \ charxor.prg \ - csetref.prg \ csetatmu.prg \ + csetarge.prg \ + csetref.prg \ numtoken.prg \ setatlik.prg \ token.prg \ diff --git a/harbour/contrib/libct/tests/addascii.prg b/harbour/contrib/libct/tests/addascii.prg index 2798ed7cf0..1e06683065 100644 --- a/harbour/contrib/libct/tests/addascii.prg +++ b/harbour/contrib/libct/tests/addascii.prg @@ -60,6 +60,8 @@ procedure main local cStr := "This is a test!" + ctinit() + qout ("Begin test of ADDASCII()") qout ("") // simple tests @@ -100,14 +102,6 @@ local cStr := "This is a test!" qout (" return value of addascii([AAAA],258,,.T.) call ('AABC')...:", addascii("AAAA",258,,.T.)) qout (" return value of addascii([ABBA],-257,3,.T.) call ('AAAA').:", addascii("ABBA",-257,3,.T.)) - // wrong parameter test - qout () - qout ("Wrong parameter tests:") - qout (" return value of valtype (addascii (5789676,1,2,.T.)) call ('C'): ", valtype(addascii(5789676,1,2,.T.))) - qout (" return value of addascii ([ABCD],[A],2,.F.) call ('ABCD')......: ", addascii("ABCD","A",2,.F.)) - qout (" return value of addascii ([ABCD],1,5,.F.) call ('ABCD')........: ", addascii("ABCD",1,5,.F.)) - qout () - qout ("End test of ADDASCII()") qout ("") diff --git a/harbour/contrib/libct/tests/afteratn.prg b/harbour/contrib/libct/tests/afteratn.prg index 69d49a199e..cb4fdbbd1d 100644 --- a/harbour/contrib/libct/tests/afteratn.prg +++ b/harbour/contrib/libct/tests/afteratn.prg @@ -60,6 +60,8 @@ procedure main local cStr := "...This...is...a...test!" + ctinit() + qout ("Begin test of AFTERATNUM()") qout ("") qout (" Value of cStr is:"+chr(34)+cStr+chr(34)) @@ -104,6 +106,8 @@ local cStr := "...This...is...a...test!" qout ("End test of AFTERATNUM()") qout () + ctexit() + return diff --git a/harbour/contrib/libct/tests/asciisum.prg b/harbour/contrib/libct/tests/asciisum.prg index 6c10e260bc..475b31d1db 100644 --- a/harbour/contrib/libct/tests/asciisum.prg +++ b/harbour/contrib/libct/tests/asciisum.prg @@ -58,6 +58,8 @@ procedure main + ctinit() + qout ("Begin test of ASCIISUM()") qout ("") @@ -69,6 +71,8 @@ procedure main qout ("End test of ASCIISUM()") qout ("") + ctexit() + return diff --git a/harbour/contrib/libct/tests/ascpos.prg b/harbour/contrib/libct/tests/ascpos.prg index b843e098b3..0aa28e8db2 100644 --- a/harbour/contrib/libct/tests/ascpos.prg +++ b/harbour/contrib/libct/tests/ascpos.prg @@ -58,6 +58,8 @@ procedure main + ctinit() + qout ("Begin test of ASCPOS()") qout ("") @@ -69,6 +71,8 @@ procedure main qout ("End test of ASCPOS()") qout ("") + ctexit() + return diff --git a/harbour/contrib/libct/tests/atadjust.prg b/harbour/contrib/libct/tests/atadjust.prg index a77693e274..2223fe59ba 100644 --- a/harbour/contrib/libct/tests/atadjust.prg +++ b/harbour/contrib/libct/tests/atadjust.prg @@ -65,6 +65,8 @@ local aStr := {"Introduction: 1",; "Discussion: 21"} local ni + ctinit() + // Some simple tests qout ("Begin test of ATADJUST()") qout ("") @@ -98,6 +100,8 @@ local ni qout ("End test of ATADJUST()") qout ("") + ctexit() + return diff --git a/harbour/contrib/libct/tests/atnum.prg b/harbour/contrib/libct/tests/atnum.prg index 8c7a911180..bf60756d9a 100644 --- a/harbour/contrib/libct/tests/atnum.prg +++ b/harbour/contrib/libct/tests/atnum.prg @@ -60,6 +60,8 @@ procedure main local cStr := "...This...is...a...test!" + ctinit() + qout ("Begin test of ATNUM()") qout ("") qout (" Value of cStr is:"+chr(34)+cStr+chr(34)) @@ -104,6 +106,8 @@ local cStr := "...This...is...a...test!" qout ("End test of ATNUM()") qout () + ctexit() + return diff --git a/harbour/contrib/libct/tests/atrepl.prg b/harbour/contrib/libct/tests/atrepl.prg index 885d1405bc..497f214a1e 100644 --- a/harbour/contrib/libct/tests/atrepl.prg +++ b/harbour/contrib/libct/tests/atrepl.prg @@ -57,6 +57,8 @@ procedure main() + ctinit() + qout ("Begin test of ATREPL()") qout ("") @@ -73,6 +75,8 @@ procedure main() qout ("End test of ATREPL()") qout ("") + ctexit() + return diff --git a/harbour/contrib/libct/tests/attoken.prg b/harbour/contrib/libct/tests/attoken.prg index 6b0a9295e1..2c3e72a879 100644 --- a/harbour/contrib/libct/tests/attoken.prg +++ b/harbour/contrib/libct/tests/attoken.prg @@ -61,6 +61,8 @@ procedure main local cStr := "...This...is...a...test!" local ni, npos + ctinit() + qout ("Begin test of ATTOKEN()") qout ("") @@ -85,6 +87,8 @@ local ni, npos qout ("End test of ATTOKEN()") qout () + ctexit() + return diff --git a/harbour/contrib/libct/tests/beforatn.prg b/harbour/contrib/libct/tests/beforatn.prg index c92c04093d..0dab278cc3 100644 --- a/harbour/contrib/libct/tests/beforatn.prg +++ b/harbour/contrib/libct/tests/beforatn.prg @@ -60,6 +60,8 @@ procedure main local cStr := "...This...is...a...test!" + ctinit() + qout ("Begin test of BEFORATNUM()") qout ("") qout (" Value of cStr is:"+chr(34)+cStr+chr(34)) @@ -104,6 +106,8 @@ local cStr := "...This...is...a...test!" qout ("End test of BEFORATNUM()") qout () + ctexit() + return diff --git a/harbour/contrib/libct/tests/charadd.prg b/harbour/contrib/libct/tests/charadd.prg index 878c7c8c17..f2afc6f191 100644 --- a/harbour/contrib/libct/tests/charadd.prg +++ b/harbour/contrib/libct/tests/charadd.prg @@ -58,6 +58,8 @@ procedure main + ctinit() + qout ("Begin test of CHARADD()") qout ("") @@ -71,6 +73,8 @@ procedure main qout ("End test of CHARADD()") qout ("") + ctexit() + return diff --git a/harbour/contrib/libct/tests/charand.prg b/harbour/contrib/libct/tests/charand.prg index 6da766150a..a9b5878745 100644 --- a/harbour/contrib/libct/tests/charand.prg +++ b/harbour/contrib/libct/tests/charand.prg @@ -58,6 +58,8 @@ procedure main + ctinit() + qout ("Begin test of CHARAND()") qout ("") @@ -70,6 +72,8 @@ procedure main qout ("End test of CHARAND()") qout ("") + ctexit() + return diff --git a/harbour/contrib/libct/tests/chareven.prg b/harbour/contrib/libct/tests/chareven.prg index 59b02db775..857b17e3eb 100644 --- a/harbour/contrib/libct/tests/chareven.prg +++ b/harbour/contrib/libct/tests/chareven.prg @@ -58,6 +58,8 @@ procedure main + ctinit() + qout ("Begin test of CHAREVEN()") qout ("") @@ -70,6 +72,8 @@ procedure main qout ("End test of CHAREVEN()") qout ("") + ctexit() + return diff --git a/harbour/contrib/libct/tests/charhist.prg b/harbour/contrib/libct/tests/charhist.prg index 4b10846199..ece59b329e 100644 --- a/harbour/contrib/libct/tests/charhist.prg +++ b/harbour/contrib/libct/tests/charhist.prg @@ -61,6 +61,8 @@ procedure main local aArr local nTotal := 0 + ctinit() + qout ("Begin test of CHARHIST()") qout ("") @@ -74,6 +76,8 @@ local nTotal := 0 qout ("End test of CHARHIST()") qout ("") + ctexit() + return diff --git a/harbour/contrib/libct/tests/charlist.prg b/harbour/contrib/libct/tests/charlist.prg index 8a1909fc77..b444ad5c79 100644 --- a/harbour/contrib/libct/tests/charlist.prg +++ b/harbour/contrib/libct/tests/charlist.prg @@ -58,6 +58,8 @@ procedure main + ctinit() + qout ("Begin test of CHARLIST()") qout ("") @@ -69,6 +71,8 @@ procedure main qout ("End test of CHARLIST()") qout ("") + ctexit() + return diff --git a/harbour/contrib/libct/tests/charmirr.prg b/harbour/contrib/libct/tests/charmirr.prg index 3b49377503..acd5b1307d 100644 --- a/harbour/contrib/libct/tests/charmirr.prg +++ b/harbour/contrib/libct/tests/charmirr.prg @@ -58,6 +58,8 @@ procedure main + ctinit() + qout ("Begin test of CHARMIRR()") qout ("") @@ -70,6 +72,8 @@ procedure main qout ("End test of CHARMIRR()") qout ("") + ctexit() + return diff --git a/harbour/contrib/libct/tests/charmix.prg b/harbour/contrib/libct/tests/charmix.prg index 386e457220..773fa13d2f 100644 --- a/harbour/contrib/libct/tests/charmix.prg +++ b/harbour/contrib/libct/tests/charmix.prg @@ -58,6 +58,8 @@ procedure main + ctinit() + qout ("Begin test of CHARMIX()") qout ("") @@ -73,6 +75,8 @@ procedure main qout ("End test of CHARMIX()") qout ("") + ctexit() + return diff --git a/harbour/contrib/libct/tests/charnlst.prg b/harbour/contrib/libct/tests/charnlst.prg index bcc4d1399f..54c79df531 100644 --- a/harbour/contrib/libct/tests/charnlst.prg +++ b/harbour/contrib/libct/tests/charnlst.prg @@ -58,6 +58,8 @@ procedure main + ctinit() + qout ("Begin test of CHARNOLIST()") qout ("") @@ -70,6 +72,8 @@ procedure main qout ("End test of CHARNOLIST()") qout ("") + ctexit() + return diff --git a/harbour/contrib/libct/tests/charnot.prg b/harbour/contrib/libct/tests/charnot.prg index 6a4f02a628..dc12cff9f5 100644 --- a/harbour/contrib/libct/tests/charnot.prg +++ b/harbour/contrib/libct/tests/charnot.prg @@ -60,6 +60,8 @@ procedure main local ni, cStr + ctinit() + qout ("Begin test of CHARNOT()") qout ("") @@ -86,6 +88,8 @@ local ni, cStr qout ("End test of CHARNOT()") qout ("") + ctexit() + return diff --git a/harbour/contrib/libct/tests/charodd.prg b/harbour/contrib/libct/tests/charodd.prg index bff004610a..aad96bc2a8 100644 --- a/harbour/contrib/libct/tests/charodd.prg +++ b/harbour/contrib/libct/tests/charodd.prg @@ -58,6 +58,8 @@ procedure main + ctinit() + qout ("Begin test of CHARODD()") qout ("") @@ -69,6 +71,8 @@ procedure main qout ("End test of CHARODD()") qout ("") + ctexit() + return diff --git a/harbour/contrib/libct/tests/charone.prg b/harbour/contrib/libct/tests/charone.prg index a948b6d5be..295f6eef95 100644 --- a/harbour/contrib/libct/tests/charone.prg +++ b/harbour/contrib/libct/tests/charone.prg @@ -58,6 +58,8 @@ procedure main + ctinit() + qout ("Begin test of CHARONE()") qout ("") @@ -73,6 +75,8 @@ procedure main qout ("End test of CHARONE()") qout ("") + ctexit() + return diff --git a/harbour/contrib/libct/tests/charonly.prg b/harbour/contrib/libct/tests/charonly.prg index f5fca4d7d8..40596fe218 100644 --- a/harbour/contrib/libct/tests/charonly.prg +++ b/harbour/contrib/libct/tests/charonly.prg @@ -58,6 +58,8 @@ procedure main + ctinit() + qout ("Begin test of CHARONLY()") qout ("") @@ -70,6 +72,8 @@ procedure main qout ("End test of CHARONLY()") qout ("") + ctexit() + return diff --git a/harbour/contrib/libct/tests/charor.prg b/harbour/contrib/libct/tests/charor.prg index b9cbdc2994..ec2f4bded7 100644 --- a/harbour/contrib/libct/tests/charor.prg +++ b/harbour/contrib/libct/tests/charor.prg @@ -58,6 +58,8 @@ procedure main + ctinit() + qout ("Begin test of CHAROR()") qout ("") @@ -70,6 +72,8 @@ procedure main qout ("End test of CHAROR()") qout ("") + ctexit() + return diff --git a/harbour/contrib/libct/tests/charrem.prg b/harbour/contrib/libct/tests/charrem.prg index 32eac318ce..ecd670d612 100644 --- a/harbour/contrib/libct/tests/charrem.prg +++ b/harbour/contrib/libct/tests/charrem.prg @@ -58,6 +58,8 @@ procedure main + ctinit() + qout ("Begin test of CHARREM()") qout ("") @@ -70,6 +72,8 @@ procedure main qout ("End test of CHARREM()") qout ("") + ctexit() + return diff --git a/harbour/contrib/libct/tests/charrepl.prg b/harbour/contrib/libct/tests/charrepl.prg index 8e7d1ddbd0..d831505a16 100644 --- a/harbour/contrib/libct/tests/charrepl.prg +++ b/harbour/contrib/libct/tests/charrepl.prg @@ -58,6 +58,8 @@ procedure main + ctinit() + qout ("Begin test of CHARREPL()") qout ("") @@ -73,6 +75,8 @@ procedure main qout ("End test of CHARREPL()") qout ("") + ctexit() + return diff --git a/harbour/contrib/libct/tests/charrll.prg b/harbour/contrib/libct/tests/charrll.prg index 043634b8eb..803ee8edb4 100644 --- a/harbour/contrib/libct/tests/charrll.prg +++ b/harbour/contrib/libct/tests/charrll.prg @@ -60,6 +60,8 @@ procedure main local ni, cStr + ctinit() + qout ("Begin test of CHARRLL()") qout ("") @@ -82,6 +84,8 @@ local ni, cStr qout ("End test of CHARRLL()") qout ("") + ctexit() + return diff --git a/harbour/contrib/libct/tests/charrlr.prg b/harbour/contrib/libct/tests/charrlr.prg index 9d4c91a5bb..79dbce541e 100644 --- a/harbour/contrib/libct/tests/charrlr.prg +++ b/harbour/contrib/libct/tests/charrlr.prg @@ -60,6 +60,8 @@ procedure main local ni, cStr + ctinit() + qout ("Begin test of CHARRLR()") qout ("") @@ -82,6 +84,8 @@ local ni, cStr qout ("End test of CHARRLR()") qout ("") + ctexit() + return diff --git a/harbour/contrib/libct/tests/charshl.prg b/harbour/contrib/libct/tests/charshl.prg index 8ffc99a43e..22c3a0c04b 100644 --- a/harbour/contrib/libct/tests/charshl.prg +++ b/harbour/contrib/libct/tests/charshl.prg @@ -60,6 +60,8 @@ procedure main local ni, cStr + ctinit() + qout ("Begin test of CHARSHL()") qout ("") @@ -82,6 +84,8 @@ local ni, cStr qout ("End test of CHARSHL()") qout ("") + ctexit() + return diff --git a/harbour/contrib/libct/tests/charshr.prg b/harbour/contrib/libct/tests/charshr.prg index 2cf14771b0..a24adf24cf 100644 --- a/harbour/contrib/libct/tests/charshr.prg +++ b/harbour/contrib/libct/tests/charshr.prg @@ -60,6 +60,8 @@ procedure main local ni, cStr + ctinit() + qout ("Begin test of CHARSHR()") qout ("") @@ -82,6 +84,8 @@ local ni, cStr qout ("End test of CHARSHR()") qout ("") + ctexit() + return diff --git a/harbour/contrib/libct/tests/charslst.prg b/harbour/contrib/libct/tests/charslst.prg index 4249e5451d..ceaff9f015 100644 --- a/harbour/contrib/libct/tests/charslst.prg +++ b/harbour/contrib/libct/tests/charslst.prg @@ -58,6 +58,8 @@ procedure main + ctinit() + qout ("Begin test of CHARSLIST()") qout ("") @@ -69,6 +71,8 @@ procedure main qout ("End test of CHARSLIST()") qout ("") + ctexit() + return diff --git a/harbour/contrib/libct/tests/charsort.prg b/harbour/contrib/libct/tests/charsort.prg index 96f738da87..e6e5fd712e 100644 --- a/harbour/contrib/libct/tests/charsort.prg +++ b/harbour/contrib/libct/tests/charsort.prg @@ -58,6 +58,8 @@ procedure main + ctinit() + qout ("Begin test of CHARSORT()") qout ("") @@ -77,6 +79,8 @@ procedure main qout ("End test of CHARSORT()") qout ("") + ctexit() + return diff --git a/harbour/contrib/libct/tests/charsub.prg b/harbour/contrib/libct/tests/charsub.prg index 87cdcd3835..977e8714b4 100644 --- a/harbour/contrib/libct/tests/charsub.prg +++ b/harbour/contrib/libct/tests/charsub.prg @@ -58,6 +58,8 @@ procedure main + ctinit() + qout ("Begin test of CHARSUB()") qout ("") @@ -71,6 +73,8 @@ procedure main qout ("End test of CHARSUB()") qout ("") + ctexit() + return diff --git a/harbour/contrib/libct/tests/charswap.prg b/harbour/contrib/libct/tests/charswap.prg index 522158c04c..4ad2f0cec4 100644 --- a/harbour/contrib/libct/tests/charswap.prg +++ b/harbour/contrib/libct/tests/charswap.prg @@ -58,6 +58,8 @@ procedure main + ctinit() + qout ("Begin test of CHARSWAP()") qout ("") @@ -70,6 +72,8 @@ procedure main qout ("End test of CHARSWAP()") qout ("") + ctexit() + return diff --git a/harbour/contrib/libct/tests/charxor.prg b/harbour/contrib/libct/tests/charxor.prg index d3561a7251..a73f38adc6 100644 --- a/harbour/contrib/libct/tests/charxor.prg +++ b/harbour/contrib/libct/tests/charxor.prg @@ -58,6 +58,8 @@ procedure main + ctinit() + qout ("Begin test of CHARXOR()") qout ("") @@ -70,6 +72,8 @@ procedure main qout ("End test of CHARXOR()") qout ("") + ctexit() + return diff --git a/harbour/contrib/libct/tests/csetarge.prg b/harbour/contrib/libct/tests/csetarge.prg new file mode 100644 index 0000000000..050407cc0b --- /dev/null +++ b/harbour/contrib/libct/tests/csetarge.prg @@ -0,0 +1,302 @@ +/* + * $Id$ + */ + +/* + * Harbour Project source code: + * Test CT3 function CSETARGERR() + * + * Copyright 2001 IntTec GmbH, Neunlindenstr 32, 79106 Freiburg, Germany + * Author: Martin Vogel + * + * www - http://www.harbour-project.org + * + * This program is free software; you can redistribute it and/or modify + * it under the terms of the GNU General Public License as published by + * the Free Software Foundation; either version 2, or (at your option) + * any later version. + * + * 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. See the + * GNU General Public License for more details. + * + * You should have received a copy of the GNU General Public License + * along with this software; see the file COPYING. If not, write to + * the Free Software Foundation, Inc., 59 Temple Place, Suite 330, + * Boston, MA 02111-1307 USA (or visit the web site http://www.gnu.org/). + * + * As a special exception, the Harbour Project gives permission for + * additional uses of the text contained in its release of Harbour. + * + * The exception is that, if you link the Harbour libraries with other + * files to produce an executable, this does not by itself cause the + * resulting executable to be covered by the GNU General Public License. + * Your use of that executable is in no way restricted on account of + * linking the Harbour library code into it. + * + * This exception does not however invalidate any other reasons why + * the executable file might be covered by the GNU General Public License. + * + * This exception applies only to the code released by the Harbour + * Project under the name Harbour. If you copy code from other + * Harbour Project or Free Software Foundation releases into a copy of + * Harbour, as the General Public License permits, the exception does + * not apply to the code that you add in this way. To avoid misleading + * anyone as to the status of such modified files, you must delete + * this exception notice from them. + * + * If you write modifications of your own for Harbour, it is your choice + * whether to permit this exception to apply to your modifications. + * If you do not wish that, delete this exception notice. + * + */ + + +#include "../ct.ch" + + +procedure main + +local cRet, olderr + + ctinit() + + qout ("Begin test of CSETARGERR()") + qout ("") + + qout ("") + qout ("Local error handler: ") + + olderr := errorblock ({|oerr|myerrhandler(oerr)}) + + // standard behaviour on argument error + qout ("") + qout ("Standard behaviour") + qout (" Call to addascii (5789676,1,2,.T.):") + cRet := addascii (5789676,1,2,.T.) + qout (" return value was", cRet) + qout ("") + qout (" Call to charadd ('AA',.F.):") + cRet := charadd ("AA",.F.) + qout (" return value was", cRet, "") + qout ("") + inkey (0) + + // CT_ARGERR_WHOCARES on argument error + qout ("") + qout ("CT_ARGERR_WHOCARES behaviour") + CSETARGERR (CT_ARGERR_WHOCARES) + qout (" Call to addascii (5789676,1,2,.T.):") + cRet := addascii (5789676,1,2,.T.) + qout (" return value was", cRet) + qout ("") + qout (" Call to charadd ('AA',.F.):") + cRet := charadd ("AA",.F.) + qout (" return value was", cRet, "") + qout ("") + inkey (0) + + // CT_ARGERR_WARNING on argument error + qout ("") + qout ("CT_ARGERR_WARNING behaviour") + CSETARGERR (CT_ARGERR_WARNING) + qout (" Call to addascii (5789676,1,2,.T.):") + cRet := addascii (5789676,1,2,.T.) + qout (" return value was", cRet) + qout ("") + qout (" Call to charadd ('AA',.F.):") + cRet := charadd ("AA",.F.) + qout (" return value was", cRet, "") + qout ("") + inkey (0) + + // CT_ARGERR_ERROR on argument error + qout ("") + qout ("CT_ARGERR_ERROR behaviour") + CSETARGERR (CT_ARGERR_ERROR) + qout (" Call to addascii (5789676,1,2,.T.):") + cRet := addascii (5789676,1,2,.T.) + qout (" return value was", cRet) + qout ("") + qout (" Call to charadd ('AA',.F.):") + cRet := charadd ("AA",.F.) + qout (" return value was", cRet, "") + qout ("") + inkey (0) + + // CT_ARGERR_CATASTROPHIC on argument error + qout ("") + qout ("CT_ARGERR_CATASTROPHIC behaviour") + CSETARGERR (CT_ARGERR_CATASTROPHIC) + qout (" Call to addascii (5789676,1,2,.T.):") + cRet := addascii (5789676,1,2,.T.) + qout (" return value was", cRet) + qout ("") + qout (" Call to charadd ('AA',.F.):") + cRet := charadd ("AA",.F.) + qout (" return value was", cRet, "") + qout ("") + inkey (0) + + qout ("") + qout ("Standard error handler: ") + errorblock (olderr) + + // standard behaviour on argument error + qout ("") + qout ("Standard behaviour") + qout (" Call to charadd ('AA',.F.):") + cRet := charadd ("AA",.F.) + qout (" return value was", cRet, "") + qout ("") + inkey (0) + + // CT_ARGERR_WHOCARES on argument error + qout ("") + qout ("CT_ARGERR_WHOCARES behaviour") + CSETARGERR (CT_ARGERR_WHOCARES) + qout (" Call to charadd ('AA',.F.):") + cRet := charadd ("AA",.F.) + qout (" return value was", cRet, "") + qout ("") + inkey (0) + + // CT_ARGERR_WARNING on argument error + qout ("") + qout ("CT_ARGERR_WARNING behaviour") + CSETARGERR (CT_ARGERR_WARNING) + qout (" Call to charadd ('AA',.F.):") + cRet := charadd ("AA",.F.) + qout (" return value was", cRet, "") + qout ("") + inkey (0) + + // CT_ARGERR_ERROR on argument error + qout ("") + qout ("CT_ARGERR_ERROR behaviour") + CSETARGERR (CT_ARGERR_ERROR) + qout (" Call to charadd ('AA',.F.):") + cRet := charadd ("AA",.F.) + qout (" return value was", cRet, "") + qout ("") + inkey (0) + + // CT_ARGERR_CATASTROPHIC on argument error + qout ("") + qout ("CT_ARGERR_CATASTROPHIC behaviour") + CSETARGERR (CT_ARGERR_CATASTROPHIC) + qout (" Call to charadd ('AA',.F.):") + cRet := charadd ("AA",.F.) + qout (" return value was", cRet, "") + qout ("") + inkey (0) + + qout ("End test of CSETARGERR()") + + ctexit() + +return + + +function myerrhandler (oerr) + +local ni, nDigit + + memvar Input + + qout (" Error handler called:") + qout (" err:severity.....:",oerr:severity) + qout (" err:subSystem....:",oerr:subSystem) + qout (" err:operation....:",oerr:operation) + qout (" len(err:args)....:",len(oerr:args)) + for ni := 1 to len (oerr:args) + qout (" err:args["+alltrim(str(ni))+"]..:",oerr:args[ni]) + next ni + qout (" err:genCode......:",oerr:genCode) + qout (" err:subCode......:",oerr:subCode) + qout (" err:osCode.......:",oerr:osCode) + qout (" err:filename.....:",oerr:filename) + qout (" err:tries........:",oerr:tries) + qout (" err:cargo........:",oerr:cargo) + qout (" err:canDefault...:",oerr:canDefault) + qout (" err:canRetry.....:",oerr:canRetry) + qout (" err:canSubstitute:",oerr:canSubstitute) + qout() + + if oerr:canSubstitute + + private Input := "" + + qout (" Error handler can substitute return value, so please") + ACCEPT " type in return value : " TO Input + + if empty (Input) + qout (" You have chosen the default return value. Ok, this should ") + qout (" be now problem, since the last digit of err:subCode indicates") + qout (" the type of the return value:") + qout (" 0 is NIL, 1 is String, 2 is Integer,") + qout (" 3 is Float, 4 is Boolean, 5 is Date") + qout (" 6 is Block, 7 is Array, 8 is Object") + qout (" 9 is unknown") + nDigit = int (oerr:subCode%10) + qout (" Here it's a "+alltrim(str(nDigit))+", so I return a ") + do case + case nDigit == 0 + qqout ("NIL.") + Input := NIL + + case nDigit == 1 + qqout ("String.") + Input := "" + + case nDigit == 2 + qqout ("Integer.") + Input := 0 + + case nDigit == 3 + qqout ("Float.") + Input := 0.0 + + case nDigit == 4 + qqout ("Boolean.") + Input := .F. + + case nDigit == 5 + qqout ("Date.") + Input := ctod ("") + + case nDigit == 6 + qqout ("Block.") + Input := {||NIL} + + case nDigit == 7 + qqout ("Array.") + Input := {} + + case nDigit == 8 + qqout ("Object.") + Input := GetNew() + + case nDigit == 9 + qqout ("