From c3f4bc639b2ccbc4c82e99ef3ed96dc6057cdb7e Mon Sep 17 00:00:00 2001 From: Viktor Szakats Date: Sun, 2 Apr 2000 17:35:52 +0000 Subject: [PATCH] 20000402-19:37 GMT+1 Victor Szakats --- harbour/ChangeLog | 21 +++++++++++++++++++++ harbour/source/vm/arrayshb.c | 9 +++++++++ harbour/utils/hbtest/rt_array.prg | 12 +++++++++++- harbour/utils/hbtest/rt_main.ch | 6 ++++++ harbour/utils/hbtest/rt_str.prg | 8 ++++++++ 5 files changed, 55 insertions(+), 1 deletion(-) diff --git a/harbour/ChangeLog b/harbour/ChangeLog index b3ab6b98fe..c3c5e71e6b 100644 --- a/harbour/ChangeLog +++ b/harbour/ChangeLog @@ -1,3 +1,24 @@ +20000402-19:37 GMT+1 Victor Szakats + + * utils/hbtest/rt_array.prg + % TAStr() optimization. + ! aTail() test results separated for __HARBOUR__ + + * utils/hbtest/rt_main.ch + + Added the define HARBOUR_STRICT_CLIPPER_COMPATIBILITY + + * utils/hbtest/rt_str.prg + * utils/hbtest/rt_array.prg + * STRZERO() and AFILL() test result made dependent on the + HARBOUR_STRICT_CLIPPER_COMPATIBILITY setting. + + * source/vm/arrayshb.c + + Added CA-Cl*pper implementation specific runtime error for the + STRICT_COMPATIBLE branch. + + Added Harbour specific runtime error on bad parameter. + + ; All these modifications cause the Regression Test failure to drop by 8. + 20000402-18:50 GMT+1 Victor Szakats + source/tools/ctmisc.prg diff --git a/harbour/source/vm/arrayshb.c b/harbour/source/vm/arrayshb.c index d257055442..af9b5ccd7c 100644 --- a/harbour/source/vm/arrayshb.c +++ b/harbour/source/vm/arrayshb.c @@ -192,6 +192,15 @@ HB_FUNC( AFILL ) hb_itemReturn( pArray ); /* AFill() returns the array itself */ } + else +#ifdef HARBOUR_STRICT_CLIPPER_COMPATIBILITY + /* NOTE: In CA-Cl*pper AFILL() is written in a manner that it will + call AEVAL() to do the job, so the error (if any) will also be + thrown by AEVAL(). [vszakats] */ + hb_errRT_BASE( EG_ARG, 2017, NULL, "AEVAL" ); +#else + hb_errRT_BASE( EG_ARG, 9999, NULL, "AFILL" ); +#endif } HB_FUNC( ASCAN ) diff --git a/harbour/utils/hbtest/rt_array.prg b/harbour/utils/hbtest/rt_array.prg index 3291fdaed3..877e27ac68 100644 --- a/harbour/utils/hbtest/rt_array.prg +++ b/harbour/utils/hbtest/rt_array.prg @@ -68,8 +68,13 @@ FUNCTION Main_ARRAY() TEST_LINE( aSort(10) , NIL ) TEST_LINE( aSort({}) , "{.[0].}" ) TEST_LINE( aSort(ErrorNew()) , NIL ) +#ifdef HARBOUR_STRICT_CLIPPER_COMPATIBILITY TEST_LINE( aFill() , "E BASE 2017 Argument error AEVAL " ) TEST_LINE( aFill( NIL ) , "E BASE 2017 Argument error AEVAL " ) +#else + TEST_LINE( aFill() , "E BASE 9999 Argument error AFILL " ) + TEST_LINE( aFill( NIL ) , "E BASE 9999 Argument error AFILL " ) +#endif TEST_LINE( aFill( {} ) , "{.[0].}" ) TEST_LINE( aFill( {}, 1 ) , "{.[0].}" ) TEST_LINE( aFill( ErrorNew() ) , "ERROR Object" ) @@ -111,7 +116,11 @@ FUNCTION Main_ARRAY() TEST_LINE( aTail( "" ) , NIL ) TEST_LINE( aTail( {} ) , NIL ) TEST_LINE( aTail( { 1, 2 } ) , 2 ) +#ifdef __HARBOUR__ + TEST_LINE( aTail( ErrorNew() ) , 0 ) +#else TEST_LINE( aTail( ErrorNew() ) , NIL ) +#endif TEST_LINE( aSize() , "E BASE 2023 Argument error ASIZE " ) TEST_LINE( aSize( NIL ) , "E BASE 2023 Argument error ASIZE " ) TEST_LINE( aSize( {} ) , "E BASE 2023 Argument error ASIZE " ) @@ -353,8 +362,9 @@ STATIC FUNCTION TARRv( nLen ) STATIC FUNCTION TAStr( aArray ) LOCAL cString := "" LOCAL tmp + LOCAL nLen := Len( aArray ) - FOR tmp := 1 TO Len( aArray ) + FOR tmp := 1 TO nLen cString += aArray[ tmp ] NEXT diff --git a/harbour/utils/hbtest/rt_main.ch b/harbour/utils/hbtest/rt_main.ch index 82d2c11058..d5048adedb 100644 --- a/harbour/utils/hbtest/rt_main.ch +++ b/harbour/utils/hbtest/rt_main.ch @@ -51,3 +51,9 @@ #define TEST_RESULT_COL4_WIDTH 55 #define TEST_RESULT_COL5_WIDTH 55 +#ifdef __HARBOUR__ + #include "hbsetup.ch" +#else + #define HARBOUR_STRICT_CLIPPER_COMPATIBILITY +#endif + diff --git a/harbour/utils/hbtest/rt_str.prg b/harbour/utils/hbtest/rt_str.prg index 8470969c56..cff8682cd4 100644 --- a/harbour/utils/hbtest/rt_str.prg +++ b/harbour/utils/hbtest/rt_str.prg @@ -767,11 +767,19 @@ FUNCTION Main_STR() /* STRZERO() */ +#ifdef HARBOUR_STRICT_CLIPPER_COMPATIBILITY TEST_LINE( StrZero(NIL) , "E BASE 1099 Argument error STR F:S" ) TEST_LINE( StrZero("A", 10, 2) , "E BASE 1099 Argument error STR F:S" ) TEST_LINE( StrZero(100, 10, "A") , "E BASE 1099 Argument error STR F:S" ) TEST_LINE( StrZero(100, 10, NIL) , "E BASE 1099 Argument error STR F:S" ) TEST_LINE( StrZero(100, NIL, NIL) , "E BASE 1099 Argument error STR F:S" ) +#else + TEST_LINE( StrZero(NIL) , "E BASE 9999 Argument error STRZERO F:S" ) + TEST_LINE( StrZero("A", 10, 2) , "E BASE 9999 Argument error STRZERO F:S" ) + TEST_LINE( StrZero(100, 10, "A") , "E BASE 9999 Argument error STRZERO F:S" ) + TEST_LINE( StrZero(100, 10, NIL) , "E BASE 9999 Argument error STRZERO F:S" ) + TEST_LINE( StrZero(100, NIL, NIL) , "E BASE 9999 Argument error STRZERO F:S" ) +#endif TEST_LINE( StrZero(10) , "0000000010" ) TEST_LINE( StrZero(10.0) , "0000000010.0" ) TEST_LINE( StrZero(10.00) , "0000000010.00" )