fivedev/harbour-core
1
0
Fork 0
Code Issues Pull Requests Actions Packages Projects Releases Wiki Activity

19990914-01:00 GMT+1

Browse Source
This commit is contained in:
Viktor Szakats
1999-09-13 23:13:32 +00:00
parent eeb5147b8e
commit c7f7909be2
5 changed files with 78 additions and 38 deletions
Download Patch File Download Diff File Expand all files Collapse all files

17
harbour/ChangeLog
View File

@@ -1,3 +1,20 @@
19990914-01:00 GMT+1 Victor Szel <info@szelvesz.hu>
* 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 <info@szelvesz.hu>
* source/vm/hvm.c
+ hb_vmInString() - Added support for overloading the "$" operator.

7
harbour/include/ctoharb.h
View File

@@ -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 */

48
harbour/source/vm/hvm.c
View File

@@ -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 )

27
harbour/tests/working/overload.prg
View File

@@ -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 ) } )

17
harbour/tests/working/rtl_test.prg
View File

@@ -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 ) } )