From 9e8e013eb994c8f430dc0584d072a3dc5d59db3d Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Przemys=C5=82aw=20Czerpak?= Date: Wed, 29 Mar 2017 19:50:33 +0200 Subject: [PATCH] 2017-03-29 19:50 UTC+0200 Przemyslaw Czerpak (druzus/at/poczta.onet.pl) * src/compiler/hbgenerr.c * changed "with object" in last error message to upper cases * src/rdd/dbf1.c + added assigned value to error object ARGS array when data type or data width error is generated inside PUTVALUE() method * utils/hbtest/hbtest.prg * utils/hbtest/rt_array.prg * utils/hbtest/rt_hvma.prg * utils/hbtest/rt_main.ch * utils/hbtest/rt_math.prg * utils/hbtest/rt_misc.prg + added support for alternative results to HBTEST code. It's enabled by default and can be turned off by -noalt hbtest parameter. + added alternative results for tests which return different then Cl*pper results but they are expected and not Harbour bugs. --- ChangeLog.txt | 20 ++++++++++++++++ src/compiler/hbgenerr.c | 2 +- src/rdd/dbf1.c | 1 + utils/hbtest/hbtest.prg | 50 +++++++++++++++++++++++++++------------ utils/hbtest/rt_array.prg | 20 ++++++++-------- utils/hbtest/rt_hvma.prg | 8 +++---- utils/hbtest/rt_main.ch | 2 +- utils/hbtest/rt_math.prg | 2 +- utils/hbtest/rt_misc.prg | 4 ++-- 9 files changed, 75 insertions(+), 34 deletions(-) diff --git a/ChangeLog.txt b/ChangeLog.txt index 2100bb40e9..c043e1b491 100644 --- a/ChangeLog.txt +++ b/ChangeLog.txt @@ -10,6 +10,26 @@ * Change, ! Fix, % Optimization, + Addition, - Removal, ; Comment */ +2017-03-29 19:50 UTC+0200 Przemyslaw Czerpak (druzus/at/poczta.onet.pl) + * src/compiler/hbgenerr.c + * changed "with object" in last error message to upper cases + + * src/rdd/dbf1.c + + added assigned value to error object ARGS array when data type or + data width error is generated inside PUTVALUE() method + + * utils/hbtest/hbtest.prg + * utils/hbtest/rt_array.prg + * utils/hbtest/rt_hvma.prg + * utils/hbtest/rt_main.ch + * utils/hbtest/rt_math.prg + * utils/hbtest/rt_misc.prg + + added support for alternative results to HBTEST code. + It's enabled by default and can be turned off by -noalt hbtest + parameter. + + added alternative results for tests which return different then + Cl*pper results but they are expected and not Harbour bugs. + 2017-03-28 23:02 UTC+0200 Przemyslaw Czerpak (druzus/at/poczta.onet.pl) * include/hbcomp.h * include/hbcompdf.h diff --git a/src/compiler/hbgenerr.c b/src/compiler/hbgenerr.c index a71aae096a..4f59299520 100644 --- a/src/compiler/hbgenerr.c +++ b/src/compiler/hbgenerr.c @@ -98,7 +98,7 @@ const char * const hb_comp_szErrors[] = "ENDWITH does not match WITH OBJECT", "ENDSWITCH does not match SWITCH", "END SEQUENCE does not match BEGIN SEQUENCE", - "Code block contains both macro and with object messages ':%s'", + "Code block contains both macro and WITH OBJECT messages ':%s'", /* Some historical, funny sounding error messages from original CA-Cl*pper. They serve no purpose whatsoever. [vszakats] */ "END wreaks terrible vengeance on control stack", diff --git a/src/rdd/dbf1.c b/src/rdd/dbf1.c index 7bcc9035e3..297e4c57c5 100644 --- a/src/rdd/dbf1.c +++ b/src/rdd/dbf1.c @@ -2857,6 +2857,7 @@ static HB_ERRCODE hb_dbfPutValue( DBFAREAP pArea, HB_USHORT uiIndex, PHB_ITEM pI hb_errPutOperation( pError, hb_dynsymName( ( PHB_DYNS ) pField->sym ) ); hb_errPutSubCode( pError, errCode ); hb_errPutFlags( pError, EF_CANDEFAULT ); + hb_errPutArgs( pError, 1, pItem ); errCode = SELF_ERROR( &pArea->area, pError ); hb_itemRelease( pError ); return errCode == E_DEFAULT ? HB_SUCCESS : HB_FAILURE; diff --git a/utils/hbtest/hbtest.prg b/utils/hbtest/hbtest.prg index 4d25004bb1..b60ccb5388 100644 --- a/utils/hbtest/hbtest.prg +++ b/utils/hbtest/hbtest.prg @@ -86,6 +86,7 @@ STATIC s_nFail STATIC s_nFhnd STATIC s_nCount STATIC s_lShowAll +STATIC s_lNoAltResult STATIC s_lShortcut STATIC s_aSkipList STATIC s_nStartTime @@ -99,7 +100,7 @@ STATIC s_lDBFAvail := .F. REQUEST HB_GT_CGI_DEFAULT #endif -PROCEDURE Main( cPar1, cPar2 ) +PROCEDURE Main( cPar1, cPar2, cPar3 ) OutStd( "Harbour Regression Test Suite" + hb_eol() +; "Copyright (c) 1999-2016, Viktor Szakats" + hb_eol() +; @@ -111,6 +112,9 @@ PROCEDURE Main( cPar1, cPar2 ) IF cPar2 == NIL cPar2 := "" ENDIF + IF cPar3 == NIL + cPar3 := "" + ENDIF IF "/?" $ Lower( cPar1 ) .OR. ; "/h" $ Lower( cPar1 ) .OR. ; @@ -124,6 +128,7 @@ PROCEDURE Main( cPar1, cPar2 ) hb_eol() +; "Options: -h, -? Display this help." + hb_eol() +; " -all Display all tests, not only the failures." + hb_eol() +; + " -noalt Ignore alternative results." + hb_eol() +; " -skip: Skip the listed test numbers." + hb_eol() ) RETURN @@ -131,7 +136,7 @@ PROCEDURE Main( cPar1, cPar2 ) /* Initialize test */ - TEST_BEGIN( cPar1 + " " + cPar2 ) + TEST_BEGIN( cPar1 + " " + cPar2 + " " + cPar3 ) Main_HVM() Main_HVMA() @@ -214,6 +219,10 @@ STATIC PROCEDURE TEST_BEGIN( cParam ) "/all" $ Lower( cParam ) .OR. ; "-all" $ Lower( cParam ) + s_lNoAltResult := ; + "/noalt" $ Lower( cParam ) .OR. ; + "-noalt" $ Lower( cParam ) + s_aSkipList := ListToNArray( CMDLGetValue( Lower( cParam ), "/skip:", "" ) ) IF Empty( s_aSkipList ) s_aSkipList := ListToNArray( CMDLGetValue( Lower( cParam ), "-skip:", "" ) ) @@ -331,7 +340,7 @@ STATIC PROCEDURE TEST_BEGIN( cParam ) FUNCTION TEST_DBFAvail() RETURN s_lDBFAvail -PROCEDURE TEST_CALL( cBlock, bBlock, xResultExpected ) +PROCEDURE TEST_CALL( cBlock, bBlock, xResultExpected, xResultAlter ) LOCAL xResult LOCAL oError @@ -371,18 +380,9 @@ PROCEDURE TEST_CALL( cBlock, bBlock, xResultExpected ) ErrorBlock( bOldError ) - IF lRTE - lFailed := !( XToStr( xResult ) == XToStr( xResultExpected ) ) - ELSE - IF !( ValType( xResult ) == ValType( xResultExpected ) ) - IF ValType( xResultExpected ) == "C" .AND. ValType( xResult ) $ "ABMO" - lFailed := !( XToStr( xResult ) == xResultExpected ) - ELSE - lFailed := .T. - ENDIF - ELSE - lFailed := !( xResult == xResultExpected ) - ENDIF + lFailed := ResultCompare( lRTE, xResult, xResultExpected ) + IF lFailed .AND. ! s_lNoAltResult .AND. PCount() >= 4 + lFailed := ResultCompare( lRTE, xResult, xResultAlter ) ENDIF ENDIF @@ -460,6 +460,26 @@ STATIC PROCEDURE TEST_END() RETURN +FUNCTION ResultCompare( lRTE, xResult, xResultExpected ) + + LOCAL lFailed + + IF lRTE + lFailed := !( XToStr( xResult ) == XToStr( xResultExpected ) ) + ELSE + IF !( ValType( xResult ) == ValType( xResultExpected ) ) + IF ValType( xResultExpected ) == "C" .AND. ValType( xResult ) $ "ABMO" + lFailed := !( XToStr( xResult ) == xResultExpected ) + ELSE + lFailed := .T. + ENDIF + ELSE + lFailed := !( xResult == xResultExpected ) + ENDIF + ENDIF + + RETURN lFailed + FUNCTION XToStr( xValue ) LOCAL cType := ValType( xValue ) diff --git a/utils/hbtest/rt_array.prg b/utils/hbtest/rt_array.prg index 4f59764b0d..b67e78f094 100644 --- a/utils/hbtest/rt_array.prg +++ b/utils/hbtest/rt_array.prg @@ -155,9 +155,9 @@ PROCEDURE Main_ARRAY() #ifndef __XPP__ #ifdef HB_COMPAT_C53 HBTEST ASize() IS "E 1 BASE 2023 Argument error (ASIZE) OS:0 #:0 " - HBTEST ASize( NIL ) IS "E 1 BASE 2023 Argument error (ASIZE) OS:0 #:0 " - HBTEST ASize( {} ) IS "E 1 BASE 2023 Argument error (ASIZE) OS:0 #:0 " - HBTEST ASize( ErrorNew() ) IS "E 1 BASE 2023 Argument error (ASIZE) OS:0 #:0 " + HBTEST ASize( NIL ) IS "E 1 BASE 2023 Argument error (ASIZE) OS:0 #:0 ", "E 1 BASE 2023 Argument error (ASIZE) OS:0 #:0 A:1:U:NIL " + HBTEST ASize( {} ) IS "E 1 BASE 2023 Argument error (ASIZE) OS:0 #:0 ", "E 1 BASE 2023 Argument error (ASIZE) OS:0 #:0 A:1:A:{.[0].} " + HBTEST ASize( ErrorNew() ) IS "E 1 BASE 2023 Argument error (ASIZE) OS:0 #:0 ", "E 1 BASE 2023 Argument error (ASIZE) OS:0 #:0 A:1:O:ERROR Object " #else HBTEST ASize() IS NIL HBTEST ASize( NIL ) IS NIL @@ -166,9 +166,9 @@ PROCEDURE Main_ARRAY() #endif #endif #ifdef HB_COMPAT_C53 - HBTEST ASize( NIL, 0 ) IS "E 1 BASE 2023 Argument error (ASIZE) OS:0 #:0 " - HBTEST ASize( NIL, 1 ) IS "E 1 BASE 2023 Argument error (ASIZE) OS:0 #:0 " - HBTEST ASize( NIL, -1 ) IS "E 1 BASE 2023 Argument error (ASIZE) OS:0 #:0 " + HBTEST ASize( NIL, 0 ) IS "E 1 BASE 2023 Argument error (ASIZE) OS:0 #:0 ", "E 1 BASE 2023 Argument error (ASIZE) OS:0 #:0 A:2:U:NIL;N:0 " + HBTEST ASize( NIL, 1 ) IS "E 1 BASE 2023 Argument error (ASIZE) OS:0 #:0 ", "E 1 BASE 2023 Argument error (ASIZE) OS:0 #:0 A:2:U:NIL;N:1 " + HBTEST ASize( NIL, -1 ) IS "E 1 BASE 2023 Argument error (ASIZE) OS:0 #:0 ", "E 1 BASE 2023 Argument error (ASIZE) OS:0 #:0 A:2:U:NIL;N:-1 " #else HBTEST ASize( NIL, 0 ) IS NIL HBTEST ASize( NIL, 1 ) IS NIL @@ -210,7 +210,7 @@ PROCEDURE Main_ARRAY() /* disable Harbour extended optimizations to test correct RTE message */ #pragma -ko- #endif - HBTEST Array( 1, 0, -10 ) IS "E 2 BASE 1131 Bound error (array dimension) OS:0 #:0 " + HBTEST Array( 1, 0, -10 ) IS "E 2 BASE 1131 Bound error (array dimension) OS:0 #:0 ", "E 2 BASE 1131 Bound error (array dimension) OS:0 #:0 A:3:N:1;N:0;N:-10 " HBTEST Array( 1, 0, "A" ) IS NIL #ifdef __HARBOUR__ #pragma -ko+ @@ -393,9 +393,9 @@ PROCEDURE Main_ARRAY() HBTEST AScan( saAllTypes, scStringZ ) IS 3 SET EXACT OFF - HBTEST TAEVSM() IS "N10N 9N 8N 7N 6N 5N 4N 3N 2N 1 0" /* Bug in CA-Cl*pper 5.x */ - HBTEST TASOSM1() IS "NN 5NN 4NN 3NN 2NN 1NN 0NN 0NN 0NN 0NN 0NN 0NN 0 0{ }" - HBTEST TASOSM2() IS "NN 5NN 4NN 3NN 2NN 1NN 0NN 0NN 0NN 0NN 0 0{ }" + HBTEST TAEVSM() IS "N10N 9N 8N 7N 6N 5N 4N 3N 2N 1 0" /* Bug in CA-Cl*pper 5.x */, "N10N 9N 8N 7N 6 5" + HBTEST TASOSM1() IS "NN 5NN 4NN 3NN 2NN 1NN 0NN 0NN 0NN 0NN 0NN 0NN 0 0{ }" , "NN 5NN 4 3{ 2, 1, 3 }" + HBTEST TASOSM2() IS "NN 5NN 4NN 3NN 2NN 1NN 0NN 0NN 0NN 0NN 0 0{ }" , "NN 5NN 4 3{ 2, 1, 3 }" RETURN diff --git a/utils/hbtest/rt_hvma.prg b/utils/hbtest/rt_hvma.prg index 93fa33acb3..a0bf5eb6a6 100644 --- a/utils/hbtest/rt_hvma.prg +++ b/utils/hbtest/rt_hvma.prg @@ -365,8 +365,8 @@ PROCEDURE Main_HVMA() HBTEST saArray[ 0 ] IS "E 2 BASE 1132 Bound error (array access) OS:0 #:0 " HBTEST saArray[ 0 ] := 1 IS "E 2 BASE 1133 Bound error (array assign) OS:0 #:0 " #endif - HBTEST saArray[ 1000 ] IS "E 2 BASE 1132 Bound error (array access) OS:0 #:0 " - HBTEST saArray[ 1000 ] := 1 IS "E 2 BASE 1133 Bound error (array assign) OS:0 #:0 " + HBTEST saArray[ 1000 ] IS "E 2 BASE 1132 Bound error (array access) OS:0 #:0 ", "E 2 BASE 1132 Bound error (array access) OS:0 #:0 A:2:A:{.[1].};N:1000 " + HBTEST saArray[ 1000 ] := 1 IS "E 2 BASE 1133 Bound error (array assign) OS:0 #:0 ", "E 2 BASE 1133 Bound error (array assign) OS:0 #:0 A:1:N:1000 " #ifndef __HARBOUR__ // this error is reported at compile time HBTEST saArray[ -1 ] IS "E 2 BASE 1132 Bound error (array access) OS:0 #:0 " @@ -538,8 +538,8 @@ PROCEDURE Main_HVMA() HBTEST RTSTR( 50000000000000 ) IS " 15 50000000000000" HBTEST RTSTR( 500000000000000 ) IS " 16 500000000000000" HBTEST RTSTR( 00000000000005 ) IS " 10 5" - HBTEST RTSTR( 00000500000000000000 ) IS " 21 500000000000000" - HBTEST RTSTR( 0500000000000000 ) IS " 17 500000000000000" + HBTEST RTSTR( 00000500000000000000 ) IS " 21 500000000000000", " 16 500000000000000" + HBTEST RTSTR( 0500000000000000 ) IS " 17 500000000000000" , " 16 500000000000000" HBTEST RTSTR( 0500000000000000.5 ) IS " 18 500000000000000.5" HBTEST RTSTR( 5000000000000000 ) IS " 17 5000000000000000" HBTEST RTSTR( 50000000000000000 ) IS " 18 50000000000000000" diff --git a/utils/hbtest/rt_main.ch b/utils/hbtest/rt_main.ch index b121787056..c482b25827 100644 --- a/utils/hbtest/rt_main.ch +++ b/utils/hbtest/rt_main.ch @@ -44,7 +44,7 @@ * */ -#translate HBTEST IS => TEST_CALL( #, {|| }, ) +#translate HBTEST IS => TEST_CALL( #, {|| }, ) #ifndef __HARBOUR__ #ifndef __XPP__ diff --git a/utils/hbtest/rt_math.prg b/utils/hbtest/rt_math.prg index 49d809fc20..c6c819357c 100644 --- a/utils/hbtest/rt_math.prg +++ b/utils/hbtest/rt_math.prg @@ -351,7 +351,7 @@ PROCEDURE Main_MATH() HBTEST Str( 100.00 / 10.0 ) IS " 10.00" HBTEST Str( sdDate - sdDateE ) IS " 2445785" HBTEST Str( sdDate - sdDate ) IS " 0" - HBTEST Str( 1234567890 * 1234567890 ) IS " 1524157875019052000" /* real val is 1524157875019052100 */ + HBTEST Str( 1234567890 * 1234567890 ) IS " 1524157875019052000" /* real val is 1524157875019052100 */, " 1524157875019052100" /* Mod() */ diff --git a/utils/hbtest/rt_misc.prg b/utils/hbtest/rt_misc.prg index 740730244b..20a36ee1f3 100644 --- a/utils/hbtest/rt_misc.prg +++ b/utils/hbtest/rt_misc.prg @@ -84,7 +84,7 @@ PROCEDURE Main_MISC() #ifdef HB_COMPAT_C53 HBTEST Set( _SET_EVENTMASK ) IS 128 - HBTEST Set( _SET_VIDEOMODE ) IS NIL + HBTEST Set( _SET_VIDEOMODE ) IS NIL, 0 HBTEST Set( _SET_MBLOCKSIZE ) IS 64 HBTEST Set( _SET_MFILEEXT ) IS "" HBTEST Set( _SET_STRICTREAD ) IS .F. @@ -94,7 +94,7 @@ PROCEDURE Main_MISC() HBTEST Set( _SET_AUTOSHARE ) IS 0 HBTEST Set( _SET_EVENTMASK , -1 ) IS "E 1 BASE 2020 Argument error (SET) OS:0 #:0 A:2:N:39;N:-1 " - HBTEST Set( _SET_VIDEOMODE , -1 ) IS NIL + HBTEST Set( _SET_VIDEOMODE , -1 ) IS NIL, 0 HBTEST Set( _SET_MBLOCKSIZE, -1 ) IS "E 1 BASE 2020 Argument error (SET) OS:0 #:0 A:2:N:41;N:-1 " HBTEST Set( _SET_MFILEEXT , {} ) IS "" HBTEST Set( _SET_STRICTREAD, {} ) IS .F.