From c7f7909be21da9f56100ed4f9927f53b4a2c7ab3 Mon Sep 17 00:00:00 2001 From: Viktor Szakats Date: Mon, 13 Sep 1999 23:13:32 +0000 Subject: [PATCH] 19990914-01:00 GMT+1 --- harbour/ChangeLog | 17 +++++++++++ harbour/include/ctoharb.h | 7 +++-- harbour/source/vm/hvm.c | 48 ++++++++++++++++++++++-------- harbour/tests/working/overload.prg | 27 ++++++++--------- harbour/tests/working/rtl_test.prg | 17 ++++++----- 5 files changed, 78 insertions(+), 38 deletions(-) diff --git a/harbour/ChangeLog b/harbour/ChangeLog index b0b957d860..e8758b1c81 100644 --- a/harbour/ChangeLog +++ b/harbour/ChangeLog @@ -1,3 +1,20 @@ +19990914-01:00 GMT+1 Victor Szel + * source/vm/hvm.c + include/ctoharb.h + + hb_vmEqual() - Added support for alternate equal operator: "=" + Currently they are exact synonyms. + + hb_vmInc()/hb_vmDec() - "++", "--" operator overloading support added. + + hb_stackDispLocal() - More values are printed, the format changed. + * tests/working/rtl_test.prg + tests/working/overload.prg + ! The tests fixed again, "+="/"-=" operators removed from the class + declaration. + * "+"/"-" implementation changed to not modify the original value, since + the expression "oString + 'A'" in itself in one line is not valid anyway. + + "++", "--" operator overloading added. + - Removed the "<>" and "#" overloading methods since they were not needed + in this case. + 19990913-23:45 GMT+1 Victor Szel * source/vm/hvm.c + hb_vmInString() - Added support for overloading the "$" operator. diff --git a/harbour/include/ctoharb.h b/harbour/include/ctoharb.h index 6437630bd1..c249dcf07d 100644 --- a/harbour/include/ctoharb.h +++ b/harbour/include/ctoharb.h @@ -51,8 +51,8 @@ extern WORD hb_vmRequestQuery( void ); extern void hb_vmQuit( void ); /* Immediately quits the virtual machine */ /* Return values of hb_vmRequestQuery() */ -#define HB_QUIT_REQUESTED 1 /* immediately quit the application */ -#define HB_BREAK_REQUESTED 2 /* break to nearest RECOVER/END sequence */ +#define HB_QUIT_REQUESTED 1 /* immediately quit the application */ +#define HB_BREAK_REQUESTED 2 /* break to nearest RECOVER/END sequence */ /* PCode functions */ @@ -90,7 +90,8 @@ extern void hb_vmGenArray( WORD wElements ); /* generates a wElements Array a /* Object */ extern void hb_vmMessage( PHB_SYMB pSymMsg ); /* sends a message to an object */ -extern void hb_vmOperatorCall( PHB_ITEM, PHB_ITEM, char *); /* call an overloaded operator */ +extern void hb_vmOperatorCall( PHB_ITEM, PHB_ITEM, char * ); /* call an overloaded operator */ +extern void hb_vmOperatorCallUnary( PHB_ITEM, char * ); /* call an overloaded unary operator */ /* Execution */ extern void hb_vmFrame( BYTE bLocals, BYTE bParams ); /* increases the stack pointer for the amount of locals and params suplied */ diff --git a/harbour/source/vm/hvm.c b/harbour/source/vm/hvm.c index b8e6544e17..584f3de526 100644 --- a/harbour/source/vm/hvm.c +++ b/harbour/source/vm/hvm.c @@ -903,6 +903,9 @@ void hb_vmDec( void ) else if( IS_DATE( stack.pPos - 1 ) ) hb_vmPushDate( hb_vmPopDate() - 1 ); + else if( IS_OBJECT( stack.pPos - 1 ) && hb_objHasMsg( stack.pPos - 1, "--" ) ) + hb_vmOperatorCallUnary( stack.pPos - 1, "--" ); + else { PHB_ITEM pResult = hb_errRT_BASE_Subst( EG_ARG, 1087, NULL, "--" ); @@ -1195,6 +1198,9 @@ void hb_vmEqual( BOOL bExact ) else if( IS_OBJECT( pItem1 ) && hb_objHasMsg( pItem1, "==" ) ) hb_vmOperatorCall( pItem1, pItem2, "==" ); + else if( IS_OBJECT( pItem1 ) && hb_objHasMsg( pItem1, "=" ) ) + hb_vmOperatorCall( pItem1, pItem2, "=" ); + else if( bExact && IS_ARRAY( pItem1 ) && IS_ARRAY( pItem2 ) ) { BOOL bResult = pItem1->item.asArray.value->pItems && pItem2->item.asArray.value->pItems && @@ -1415,6 +1421,9 @@ void hb_vmInc( void ) else if( IS_DATE( stack.pPos - 1 ) ) hb_vmPushDate( hb_vmPopDate() + 1 ); + else if( IS_OBJECT( stack.pPos - 1 ) && hb_objHasMsg( stack.pPos - 1, "++" ) ) + hb_vmOperatorCallUnary( stack.pPos - 1, "++" ); + else { PHB_ITEM pResult = hb_errRT_BASE_Subst( EG_ARG, 1086, NULL, "++" ); @@ -1833,7 +1842,7 @@ void hb_vmMult( void ) } } -void hb_vmOperatorCall( PHB_ITEM pItem1, PHB_ITEM pItem2, char *szSymbol ) +void hb_vmOperatorCall( PHB_ITEM pItem1, PHB_ITEM pItem2, char * szSymbol ) { hb_vmPush( pItem1 ); /* Push object */ hb_vmMessage( hb_dynsymGet( szSymbol )->pSymbol ); /* Push operation */ @@ -1841,6 +1850,13 @@ void hb_vmOperatorCall( PHB_ITEM pItem1, PHB_ITEM pItem2, char *szSymbol ) hb_vmFunction( 1 ); } +void hb_vmOperatorCallUnary( PHB_ITEM pItem1, char * szSymbol ) +{ + hb_vmPush( pItem1 ); /* Push object */ + hb_vmMessage( hb_dynsymGet( szSymbol )->pSymbol ); /* Push operation */ + hb_vmFunction( 0 ); +} + void hb_vmOr( void ) { PHB_ITEM pItem2 = stack.pPos - 1; @@ -2452,8 +2468,15 @@ void hb_stackDispLocal( void ) { PHB_ITEM pBase; + printf( hb_consoleGetNewLine() ); + printf( "Virtual Maching Stack Dump:" ); + printf( hb_consoleGetNewLine() ); + printf( "---------------------------" ); + for( pBase = stack.pBase; pBase <= stack.pPos; pBase++ ) { + printf( hb_consoleGetNewLine() ); + switch( hb_itemType( pBase ) ) { case IT_NIL: @@ -2461,7 +2484,10 @@ void hb_stackDispLocal( void ) break; case IT_ARRAY: - printf( hb_arrayIsObject( pBase ) ? "OBJECT " : "ARRAY " ); + if( hb_arrayIsObject( pBase ) ) + printf( "OBJECT = %s ", hb_objGetClsName( pBase ) ); + else + printf( "ARRAY " ); break; case IT_BLOCK: @@ -2469,40 +2495,38 @@ void hb_stackDispLocal( void ) break; case IT_DATE: - printf( "DATE " ); + printf( "DATE = \"%s\" ", hb_itemGetDS( pBase, stack.szDate ) ); break; case IT_DOUBLE: - printf( "DOUBLE " ); + printf( "DOUBLE = %f ", hb_itemGetND( pBase ) ); break; case IT_LOGICAL: - printf( "LOGICAL[%c] ", hb_itemGetL( pBase ) ? 'T' : 'F' ); + printf( "LOGICAL = %s ", hb_itemGetL( pBase ) ? ".T." : ".F." ); break; case IT_LONG: - printf( "LONG" ); + printf( "LONG = %lu ", hb_itemGetNL( pBase ) ); break; case IT_INTEGER: - printf( "INTEGER[%i] ", hb_itemGetNI( pBase ) ); + printf( "INTEGER = %i ", hb_itemGetNI( pBase ) ); break; case IT_STRING: - printf( "STRING " ); + printf( "STRING = \"%s\" ", hb_itemGetCPtr( pBase ) ); break; case IT_SYMBOL: - printf( "SYMBOL(%s) ", pBase->item.asSymbol.value->szName ); + printf( "SYMBOL = %s ", pBase->item.asSymbol.value->szName ); break; default: - printf( "UNKNOWN[%i] ", hb_itemType( pBase ) ); + printf( "UNKNOWN = TYPE %i ", hb_itemType( pBase ) ); break; } } - - printf( hb_consoleGetNewLine() ); } void hb_stackDispCall( void ) diff --git a/harbour/tests/working/overload.prg b/harbour/tests/working/overload.prg index dd30147f3f..c66f473a51 100644 --- a/harbour/tests/working/overload.prg +++ b/harbour/tests/working/overload.prg @@ -23,7 +23,9 @@ function Main() QOut( "Testing TString with Operator Overloading" ) QOut( oString:cValue ) - QOut() + QOut( "---" ) + + ? ValType( oString ) QOut( "Equal........:", oString = "Hello" ) QOut( "Exactly Equal:", oString == "Hello" ) @@ -51,20 +53,15 @@ function TString() oClass:AddMethod( "New", @New() ) - oClass:AddInline( "=", {| self, cTest | ::cValue = cTest } ) - oClass:AddInline( "==", {| self, cTest | ::cValue == cTest } ) - oClass:AddInline( "!=", {| self, cTest | ::cValue != cTest } ) - oClass:AddInline( "<>", {| self, cTest | ::cValue <> cTest } ) - oClass:AddInline( "#", {| self, cTest | ::cValue # cTest } ) - oClass:AddInline( "+=", {| self, cTest | ::cValue += cTest } ) - oClass:AddInline( "-=", {| self, cTest | ::cValue -= cTest } ) - oClass:AddInline( "+", {| self, cTest | ::cValue := ::cValue + cTest } ) - oClass:AddInline( "-", {| self, cTest | ::cValue := ::cValue - cTest } ) - oClass:AddInline( "$", {| self, cTest | ::cValue $ cTest } ) - oClass:AddInline( "<", {| self, cTest | ::cValue < cTest } ) - oClass:AddInline( "<=", {| self, cTest | ::cValue <= cTest } ) - oClass:AddInline( ">", {| self, cTest | ::cValue > cTest } ) - oClass:AddInline( ">=", {| self, cTest | ::cValue >= cTest } ) + oClass:AddInline( "==", {| self, cTest | ::cValue == cTest } ) + oClass:AddInline( "!=", {| self, cTest | ::cValue != cTest } ) + oClass:AddInline( "<" , {| self, cTest | ::cValue < cTest } ) + oClass:AddInline( "<=", {| self, cTest | ::cValue <= cTest } ) + oClass:AddInline( ">" , {| self, cTest | ::cValue > cTest } ) + oClass:AddInline( ">=", {| self, cTest | ::cValue >= cTest } ) + oClass:AddInline( "+" , {| self, cTest | ::cValue + cTest } ) + oClass:AddInline( "-" , {| self, cTest | ::cValue - cTest } ) + oClass:AddInline( "$" , {| self, cTest | ::cValue $ cTest } ) oClass:AddInline( "HasMsg", {| self, cMsg | __ObjHasMsg( QSelf(), cMsg ) } ) diff --git a/harbour/tests/working/rtl_test.prg b/harbour/tests/working/rtl_test.prg index 6d7df1655d..0553bedb0f 100644 --- a/harbour/tests/working/rtl_test.prg +++ b/harbour/tests/working/rtl_test.prg @@ -1967,6 +1967,10 @@ STATIC FUNCTION Main_OPOVERL() TEST_LINE( oString <= "Hello" , .T. ) TEST_LINE( oString + "Hello" , "HelloHello" ) TEST_LINE( oString - "Hello" , "HelloHello" ) + TEST_LINE( oString++ , "TSTRING Object" ) + TEST_LINE( oString:cValue , "Hello " ) + TEST_LINE( oString-- , "TSTRING Object" ) + TEST_LINE( oString:cValue , "Hello" ) RETURN NIL @@ -1979,20 +1983,17 @@ STATIC FUNCTION TString() oClass:AddData( "cValue" ) - oClass:AddInline( "=" , {| self, cTest | ::cValue = cTest } ) oClass:AddInline( "==", {| self, cTest | ::cValue == cTest } ) oClass:AddInline( "!=", {| self, cTest | ::cValue != cTest } ) - oClass:AddInline( "<>", {| self, cTest | ::cValue <> cTest } ) - oClass:AddInline( "#" , {| self, cTest | ::cValue # cTest } ) - oClass:AddInline( "+=", {| self, cTest | ::cValue += cTest } ) - oClass:AddInline( "-=", {| self, cTest | ::cValue -= cTest } ) - oClass:AddInline( "+" , {| self, cTest | ::cValue := ::cValue + cTest } ) - oClass:AddInline( "-" , {| self, cTest | ::cValue := ::cValue - cTest } ) - oClass:AddInline( "$" , {| self, cTest | ::cValue $ cTest } ) oClass:AddInline( "<" , {| self, cTest | ::cValue < cTest } ) oClass:AddInline( "<=", {| self, cTest | ::cValue <= cTest } ) oClass:AddInline( ">" , {| self, cTest | ::cValue > cTest } ) oClass:AddInline( ">=", {| self, cTest | ::cValue >= cTest } ) + oClass:AddInline( "+" , {| self, cTest | ::cValue + cTest } ) + oClass:AddInline( "-" , {| self, cTest | ::cValue - cTest } ) + oClass:AddInline( "++", {| self | ::cValue += " ", self } ) + oClass:AddInline( "--", {| self | iif( Len( ::cValue ) > 0, ::cValue := Left( ::cValue, Len( ::cValue ) - 1 ), ::cValue ), self } ) + oClass:AddInline( "$" , {| self, cTest | ::cValue $ cTest } ) oClass:AddInline( "HasMsg", {| self, cMsg | __ObjHasMsg( QSelf(), cMsg ) } )