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

2006-09-28 14:30 UTC+0200 Przemyslaw Czerpak (druzus/at/priv.onet.pl)

Browse Source 
* harbour/include/common.ch
    + added ISSYMBOL()

  * harbour/include/hbextern.ch
    - removed __CLS_PARAM()

  * harbour/include/hbclass.ch
  * harbour/source/rtl/tclass.prg
  * harbour/source/vm/classes.c
    * replaced __CLS_PAR00() and __CLS_PARAM() functions by preprocessor
      rules. These functions are not longer necessary though I left them
      in classes.c for backward binary compatibility. Probably they will
      be removed in the future.
    ! use function pointers (@<funcname>()) instead of function names
      with REQUEST for super classes ID. It fixes using STATIC class
      functions.
This commit is contained in:
Przemyslaw Czerpak
2006-09-28 12:29:24 +00:00
parent 9aaaadbc6f
commit 8deba76fc3
6 changed files with 133 additions and 111 deletions
Download Patch File Download Diff File Expand all files Collapse all files

18
harbour/ChangeLog
View File

@@ -8,6 +8,24 @@
2002-12-01 13:30 UTC+0100 Foo Bar <foo.bar@foobar.org>
*/
- removed ISSYMBOL()
* harbour/source/rtl/tclass.prg
* use valtype() instead of IS*()
* some minor modifications
* harbour/source/vm/hvm.c
* minor modification
2006-09-28 14:40 UTC+0200 Przemyslaw Czerpak (druzus/at/priv.onet.pl)
* harbour/include/hbclass.ch
* updated some not enabled by default rules to use function pointers
instead of function names which I forgot to update in previous
commit
2006-09-28 14:30 UTC+0200 Przemyslaw Czerpak (druzus/at/priv.onet.pl)
* harbour/include/common.ch
+ added ISSYMBOL()
* harbour/include/hbextern.ch
- removed __CLS_PARAM()

1
harbour/include/common.ch
View File

@@ -69,6 +69,7 @@
#translate ISMEMO( <xValue> ) => ( ValType( <xValue> ) == "M" )
#translate ISNUMBER( <xValue> ) => ( ValType( <xValue> ) == "N" )
#translate ISOBJECT( <xValue> ) => ( ValType( <xValue> ) == "O" )
#translate ISSYMBOL( <xValue> ) => ( ValType( <xValue> ) == "S" )
/* DEFAULT and UPDATE commands */
#xcommand DEFAULT <v1> TO <x1> [, <vn> TO <xn> ] => ;

30
harbour/include/hbclass.ch
View File

@@ -116,10 +116,12 @@ DECLARE HBClass ;
#xtranslate )() => )
#ifdef HB_CLS_NOTOBJECT
#define __HB_CLS_PAR __CLS_PAR00
#xtranslate __HB_CLS_PAR([<cls,...>]) => { [<cls>] }
#else
#define __HB_CLS_PAR __CLS_PARAM
#xtranslate __HB_CLS_PAR([<cls,...>]) => ;
iif( <.cls.>, { <cls> }, { @HBObject() } )
#endif
#xtranslate __HB_CLS_PAR0([<cls,...>]) => { [<cls>] }
#ifdef HB_CLS_NOAUTOINIT
#define __HB_CLS_NOINI .T.
@@ -176,9 +178,9 @@ DECLARE HBClass ;
local MetaClass,nScope ;;
nScope := HB_OO_CLSTP_EXPORTED ;;
if s_oClass == NIL ;;
s_oClass := IIF(<.metaClass.>, <(metaClass)>, HBClass():new( <(ClassName)> , __HB_CLS_PAR ( [ <(SuperClass1)> ] [ ,<(SuperClassN)> ] ) ) ) ;;
s_oClass := IIF(<.metaClass.>, <(metaClass)>, HBClass():new( <(ClassName)> , __HB_CLS_PAR( [ <(SuperClass1)> ] [ ,<(SuperClassN)> ] ) ) ) ;;
if ! <.metaClass.> ;;
Metaclass := HBClass():new( <(ClassName)>+" class", __HB_CLS_PAR0 ( [ <SuperClass1>():class ] [ ,<SuperClassN>():class ] ) ) ;;
Metaclass := HBClass():new( <(ClassName)>+" class", __HB_CLS_PAR0( [ <SuperClass1>():class ] [ ,<SuperClassN>():class ] ) ) ;;
endif ;;
#undef _CLASS_NAME_ ;;
#define _CLASS_NAME_ <ClassName> ;;
@@ -190,8 +192,7 @@ DECLARE HBClass ;
[ ; #translate Super( <SuperClass1> ) : => ::<SuperClass1>: ] ;
[ ; #translate Super() : => ::<SuperClass1>: ] ;
[ ; #translate Super : => ::<SuperClass1>: ] ;
[ ; #translate ::Super : => ::<SuperClass1>: ] ;
[ ; REQUEST <SuperClass1> ] [ ,<SuperClassN> ]
[ ; #translate ::Super : => ::<SuperClass1>: ]
#else
@@ -206,9 +207,9 @@ DECLARE HBClass ;
local MetaClass,nScope ;;
nScope := HB_OO_CLSTP_EXPORTED ;;
if s_oClass == NIL ;;
s_oClass := IIF(<.metaClass.>, <(metaClass)>, HBClass():new( <(ClassName)> , __HB_CLS_PAR ( [ <(SuperClass1)> ] [ ,<(SuperClassN)> ] ) ) ) ;;
s_oClass := IIF(<.metaClass.>, <(metaClass)>, HBClass():new( <(ClassName)> , __HB_CLS_PAR( [ <(SuperClass1)> ] [ ,<(SuperClassN)> ] ) ) ) ;;
if ! <.metaClass.> ;;
Metaclass := HBClass():new( <(ClassName)>+" class", __HB_CLS_PAR0 ( [ <SuperClass1>():class ] [ ,<SuperClassN>():class ] ) ) ;;
Metaclass := HBClass():new( <(ClassName)>+" class", __HB_CLS_PAR0( [ <SuperClass1>():class ] [ ,<SuperClassN>():class ] ) ) ;;
endif ;;
#undef _CLASS_NAME_ ;;
#define _CLASS_NAME_ <ClassName> ;;
@@ -219,8 +220,7 @@ DECLARE HBClass ;
[ ; #translate Super( <SuperClass1> ) : => ::<SuperClass1>: ] ;
[ ; #translate Super() : => ::<SuperClass1>: ] ;
[ ; #translate Super : => ::<SuperClass1>: ] ;
[ ; #translate ::Super : => ::<SuperClass1>: ] ;
[ ; REQUEST <SuperClass1> ] [ ,<SuperClassN> ]
[ ; #translate ::Super : => ::<SuperClass1>: ]
#endif /* HB_SHORTNAMES */
@@ -242,7 +242,7 @@ DECLARE HBClass ;
local nScope ;;
nScope := HB_OO_CLSTP_EXPORTED ;;
if s_oClass == NIL ;;
s_oClass := IIF(<.metaClass.>, <(metaClass)>, HBClass():new( <(ClassName)> , __HB_CLS_PAR ( [ <(SuperClass1)> ] [ ,<(SuperClassN)> ] ), @_HB_CLS_FUNCNAME() [, <.modulfriend.> ] ) ) ;;
s_oClass := IIF(<.metaClass.>, <(metaClass)>, HBClass():new( <(ClassName)> , __HB_CLS_PAR( [ @<SuperClass1>() ] [ , @<SuperClassN>() ] ), @_HB_CLS_FUNCNAME() [, <.modulfriend.> ] ) ) ;;
#undef _CLASS_NAME_ ;;
#define _CLASS_NAME_ <ClassName> ;;
#undef _CLASS_MODE_ ;;
@@ -253,8 +253,7 @@ DECLARE HBClass ;
[ ; #translate Super( <SuperClass1> ) : => ::<SuperClass1>: ] ;
[ ; #translate Super() : => ::<SuperClass1>: ] ;
[ ; #translate Super : => ::<SuperClass1>: ] ;
[ ; #translate ::Super : => ::<SuperClass1>: ] ;
[ ; REQUEST <SuperClass1> ] [ ,<SuperClassN> ]
[ ; #translate ::Super : => ::<SuperClass1>: ]
#else
@@ -270,7 +269,7 @@ DECLARE HBClass ;
local nScope ;;
nScope := HB_OO_CLSTP_EXPORTED ;;
if s_oClass == NIL ;;
s_oClass := IIF(<.metaClass.>, <(metaClass)>, HBClass():new( <(ClassName)> , __HB_CLS_PAR ( [ <(SuperClass1)> ] [ ,<(SuperClassN)> ] ), @_HB_CLS_FUNCNAME() [, <.modulfriend.> ] ) ) ;;
s_oClass := IIF(<.metaClass.>, <(metaClass)>, HBClass():new( <(ClassName)> , __HB_CLS_PAR( [ <(SuperClass1)> ] [ ,<(SuperClassN)> ] ), @_HB_CLS_FUNCNAME() [, <.modulfriend.> ] ) ) ;;
#undef _CLASS_NAME_ ;;
#define _CLASS_NAME_ <ClassName> ;;
#undef _CLASS_MODE_ ;;
@@ -280,8 +279,7 @@ DECLARE HBClass ;
[ ; #translate Super( <SuperClass1> ) : => ::<SuperClass1>: ] ;
[ ; #translate Super() : => ::<SuperClass1>: ] ;
[ ; #translate Super : => ::<SuperClass1>: ] ;
[ ; #translate ::Super : => ::<SuperClass1>: ] ;
[ ; REQUEST <SuperClass1> ] [ ,<SuperClassN> ]
[ ; #translate ::Super : => ::<SuperClass1>: ]
#endif /* HB_SHORTNAMES */

1
harbour/include/hbextern.ch
View File

@@ -444,7 +444,6 @@ EXTERNAL __CLS_CNTCLSDATA
EXTERNAL __CLS_CNTDATA
EXTERNAL __CLS_DECDATA
EXTERNAL __CLS_INCDATA
EXTERNAL __CLS_PARAM
EXTERNAL __CLSADDMSG
EXTERNAL __CLSDELMSG
EXTERNAL __CLSINST

55
harbour/source/rtl/tclass.prg
View File

@@ -102,8 +102,7 @@ FUNCTION HBClass()
__clsAddMsg( s_hClass, "SetOnError" , @SetOnError() , HB_OO_MSG_METHOD )
__clsAddMsg( s_hClass, "SetDestructor" , @SetDestructor() , HB_OO_MSG_METHOD )
__clsAddMsg( s_hClass, "InitClass" , @InitClass() , HB_OO_MSG_METHOD )
__clsAddMsg( s_hClass, "cSuper" , {| Self | iif( ::acSuper == NIL .OR. Len( ::acSuper ) == 0, NIL, ::acSuper[ 1 ] ) }, HB_OO_MSG_INLINE )
__clsAddMsg( s_hClass, "_cSuper" , {| Self, xVal | iif( ::acSuper == NIL .OR. Len( ::acSuper ) == 0, ( ::acSuper := { xVal } ), ::acSuper[ 1 ] := xVal ), xVal }, HB_OO_MSG_INLINE )
__clsAddMsg( s_hClass, "cSuper" , {| Self | iif( Empty( ::asSuper ), NIL, ::asSuper[ 1 ]:name ) }, HB_OO_MSG_INLINE )
__clsAddMsg( s_hClass, "hClass" , 1, HB_OO_MSG_ACCESS )
__clsAddMsg( s_hClass, "_hClass" , 1, HB_OO_MSG_ASSIGN )
__clsAddMsg( s_hClass, "cName" , 2, HB_OO_MSG_ACCESS )
@@ -120,8 +119,8 @@ FUNCTION HBClass()
__clsAddMsg( s_hClass, "_aInlines" , 7, HB_OO_MSG_ASSIGN )
__clsAddMsg( s_hClass, "aVirtuals" , 8, HB_OO_MSG_ACCESS )
__clsAddMsg( s_hClass, "_aVirtuals" , 8, HB_OO_MSG_ASSIGN )
__clsAddMsg( s_hClass, "acSuper" , 9, HB_OO_MSG_ACCESS )
__clsAddMsg( s_hClass, "_acSuper" , 9, HB_OO_MSG_ASSIGN )
__clsAddMsg( s_hClass, "asSuper" , 9, HB_OO_MSG_ACCESS )
__clsAddMsg( s_hClass, "_asSuper" , 9, HB_OO_MSG_ASSIGN )
__clsAddMsg( s_hClass, "nOnError" , 10, HB_OO_MSG_ACCESS )
__clsAddMsg( s_hClass, "_nOnError" , 10, HB_OO_MSG_ASSIGN )
__clsAddMsg( s_hClass, "nDestructor" , 11, HB_OO_MSG_ACCESS )
@@ -153,19 +152,31 @@ STATIC FUNCTION New( cClassName, xSuper, sClassFunc, lModuleFriendly )
LOCAL Self := QSelf()
LOCAL nSuper, i
IF ISARRAY( xSuper ) .AND. Len( xSuper ) >= 1
::acSuper := xSuper
DEFAULT lModuleFriendly TO .F.
IF Empty( xSuper )
::asSuper := {}
ELSEIF ISCHARACTER( xSuper )
::asSuper := { __DynsN2Sym( xSuper ) }
ELSEIF ISSYMBOL( xSuper )
::asSuper := { xSuper }
ELSEIF ISARRAY( xSuper )
::asSuper := {}
nSuper := Len( xSuper )
ELSEIF ISCHARACTER( xSuper ) .AND. ! empty( xSuper )
::acSuper := { xSuper }
nSuper := 1
ELSE
::acSuper := {}
nSuper := 0
FOR i := 1 TO nSuper
IF !Empty( xSuper[ i ] )
IF ISCHARACTER( xSuper[ i ] )
AADD( ::asSuper, __DynsN2Sym( xSuper[ i ] ) )
ELSEIF ISSYMBOL( xSuper[ i ] )
AADD( ::asSuper, xSuper[ i ] )
ENDIF
ENDIF
NEXT
ENDIF
::cName := Upper( cClassName )
::sClassFunc := sClassFunc
::lModFriendly := lModuleFriendly
::aDatas := {}
::aMethods := {}
@@ -176,22 +187,6 @@ STATIC FUNCTION New( cClassName, xSuper, sClassFunc, lModuleFriendly )
::asFriendClass := {}
::asFriendFunc := {}
IF ISLOGICAL( lModuleFriendly )
::lModFriendly := lModuleFriendly
ELSE
::lModFriendly := .F.
ENDIF
FOR i := 1 TO nSuper
IF ! ISCHARACTER( ::acSuper[ i ] )
EXIT
ENDIF
NEXT
IF i <= nSuper
nSuper := i - 1
ASize( ::acSuper, nSuper)
ENDIF
RETURN QSelf()
//----------------------------------------------------------------------------//
@@ -210,9 +205,9 @@ STATIC PROCEDURE Create()
/* Self:Class := MetaClass */
nLen := Len( ::acSuper )
nLen := Len( ::asSuper )
FOR n := 1 TO nLen
hClass := __clsInstSuper( Upper( ::acSuper[ n ] ) ) // Super handle available
hClass := __clsInstSuper( ::asSuper[ n ] ) // Super handle available
IF hClass != 0
AAdd( ahSuper, hClass )
ENDIF

139
harbour/source/vm/classes.c
View File

@@ -2857,82 +2857,90 @@ HB_FUNC( __OBJCLONE )
*/
HB_FUNC( __CLSINSTSUPER )
{
char * szString = hb_parc( 1 );
PHB_ITEM pItem = hb_param( 1, HB_IT_STRING | HB_IT_SYMBOL );
USHORT uiClassH = 0, uiClass;
PHB_SYMB pClassFuncSym = NULL;
if( szString && *szString )
if( pItem )
{
PHB_DYNS pDynSym = hb_dynsymFindName( szString );
if( pDynSym )
if( HB_IS_SYMBOL( pItem ) )
pClassFuncSym = hb_itemGetSymbol( pItem );
else if( HB_IS_STRING( pItem ) )
{
for( uiClass = 1; uiClass <= s_uiClasses; uiClass++ )
PHB_DYNS pDynSym = hb_dynsymFindName( hb_itemGetCPtr( pItem ) );
if( pDynSym )
pClassFuncSym = pDynSym->pSymbol;
}
pClassFuncSym = hb_vmGetRealFuncSym( pClassFuncSym );
}
if( pClassFuncSym )
{
for( uiClass = 1; uiClass <= s_uiClasses; uiClass++ )
{
if( s_pClasses[ uiClass ].pClassFuncSym == pClassFuncSym )
{
if( s_pClasses[ uiClass ].pClassSym == pDynSym )
{
uiClassH = uiClass;
break;
}
uiClassH = uiClass;
break;
}
}
if( uiClassH == 0 )
{
hb_vmPushSymbol( pClassFuncSym );
hb_vmPushNil();
hb_vmFunction( 0 ); /* Execute super class */
if( uiClassH == 0 )
if( hb_vmRequestQuery() == 0 )
{
hb_vmPushSymbol( pDynSym->pSymbol ); /* Push function name */
hb_vmPushNil();
hb_vmFunction( 0 ); /* Execute super class */
PHB_ITEM pObject = hb_stackReturnItem();
if( hb_vmRequestQuery() == 0 )
if( HB_IS_OBJECT( pObject ) )
{
PHB_ITEM pObject = hb_stackReturnItem();
uiClass = pObject->item.asArray.value->uiClass;
if( HB_IS_OBJECT( pObject ) )
{
uiClass = pObject->item.asArray.value->uiClass;
if( s_pClasses[ uiClass ].pClassSym == pDynSym )
uiClassH = uiClass;
else
{
for( uiClass = 1; uiClass <= s_uiClasses; uiClass++ )
{
if( s_pClasses[ uiClass ].pClassSym == pDynSym )
{
uiClassH = uiClass;
break;
}
}
/* still not found, try to send NEW() message */
if( uiClassH == 0 )
{
hb_vmPushSymbol( &s___msgNew );
hb_vmPush( pObject );
hb_vmSend( 0 );
pObject = hb_stackReturnItem();
if( HB_IS_OBJECT( pObject ) )
{
uiClass = pObject->item.asArray.value->uiClass;
if( s_pClasses[ uiClass ].pClassSym == pDynSym )
uiClassH = uiClass;
}
}
}
/* This disables destructor execution for this object */
if( uiClassH && HB_IS_OBJECT( pObject ) )
pObject->item.asArray.value->uiClass = 0;
}
if( s_pClasses[ uiClass ].pClassFuncSym == pClassFuncSym )
uiClassH = uiClass;
else
{
hb_errRT_BASE( EG_ARG, 3002, "Super class does not return an object", "__CLSINSTSUPER", 0 );
for( uiClass = 1; uiClass <= s_uiClasses; uiClass++ )
{
if( s_pClasses[ uiClass ].pClassFuncSym == pClassFuncSym )
{
uiClassH = uiClass;
break;
}
}
/* still not found, try to send NEW() message */
if( uiClassH == 0 )
{
hb_vmPushSymbol( &s___msgNew );
hb_vmPush( pObject );
hb_vmSend( 0 );
pObject = hb_stackReturnItem();
if( HB_IS_OBJECT( pObject ) )
{
uiClass = pObject->item.asArray.value->uiClass;
if( s_pClasses[ uiClass ].pClassFuncSym == pClassFuncSym )
uiClassH = uiClass;
}
}
}
}
/* This disables destructor execution for this object */
if( uiClassH && HB_IS_OBJECT( pObject ) )
pObject->item.asArray.value->uiClass = 0;
else if( hb_vmRequestQuery() == 0 )
{
hb_errRT_BASE( EG_ARG, 3002, "Super class does not return an object", "__CLSINSTSUPER", 0 );
}
}
}
else
{
hb_errRT_BASE( EG_ARG, 3003, "Cannot find super class", "__CLSINSTSUPER", 0 );
}
}
else
{
hb_errRT_BASE( EG_ARG, 3003, "Cannot find super class", "__CLSINSTSUPER", 0 );
}
hb_retni( uiClassH );
@@ -3754,11 +3762,14 @@ void hb_clsAssociate( USHORT usClassH )
hb_itemRelease( hb_itemReturnForward( pSelf ) );
}
/* NOTE: Used by the preprocessor to implement Classy compatibility to Harbour
Receive an variable number of param and return an array of it.
No param will return a NULL array */
#if 1
/*
* __CLS_PARAM() and __CLS_PAR00() functions are only for backward binary
* compatibility. They will be removed in the future so please do not use
* them.
*/
HB_FUNC( __CLS_PARAM )
{
PHB_ITEM array;
@@ -3782,8 +3793,6 @@ HB_FUNC( __CLS_PARAM )
hb_itemRelease( hb_itemReturnForward( array ) );
}
/* This one is used when HB_NOTOBJECT is defined before HBCLASS.CH */
/* it will avoid any default object to be inherited */
HB_FUNC( __CLS_PAR00 )
{
PHB_ITEM array;
@@ -3811,3 +3820,5 @@ BOOL hb_objGetpMethod( PHB_ITEM pObject, PHB_SYMB pMessage )
{
return hb_objHasMessage( pObject, pMessage->pDynSym );
}
#endif