diff --git a/harbour/ChangeLog b/harbour/ChangeLog index 904030df9e..2000f73d0c 100644 --- a/harbour/ChangeLog +++ b/harbour/ChangeLog @@ -8,6 +8,24 @@ 2002-12-01 13:30 UTC+0100 Foo Bar */ + - 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() diff --git a/harbour/include/common.ch b/harbour/include/common.ch index e6ee61c003..c25b2c84fe 100644 --- a/harbour/include/common.ch +++ b/harbour/include/common.ch @@ -69,6 +69,7 @@ #translate ISMEMO( ) => ( ValType( ) == "M" ) #translate ISNUMBER( ) => ( ValType( ) == "N" ) #translate ISOBJECT( ) => ( ValType( ) == "O" ) +#translate ISSYMBOL( ) => ( ValType( ) == "S" ) /* DEFAULT and UPDATE commands */ #xcommand DEFAULT TO [, TO ] => ; diff --git a/harbour/include/hbclass.ch b/harbour/include/hbclass.ch index 7565d26f04..a0b1aced9b 100644 --- a/harbour/include/hbclass.ch +++ b/harbour/include/hbclass.ch @@ -116,10 +116,12 @@ DECLARE HBClass ; #xtranslate )() => ) #ifdef HB_CLS_NOTOBJECT - #define __HB_CLS_PAR __CLS_PAR00 + #xtranslate __HB_CLS_PAR([]) => { [] } #else - #define __HB_CLS_PAR __CLS_PARAM + #xtranslate __HB_CLS_PAR([]) => ; + iif( <.cls.>, { }, { @HBObject() } ) #endif +#xtranslate __HB_CLS_PAR0([]) => { [] } #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 ( [ ():class ] [ ,():class ] ) ) ;; + Metaclass := HBClass():new( <(ClassName)>+" class", __HB_CLS_PAR0( [ ():class ] [ ,():class ] ) ) ;; endif ;; #undef _CLASS_NAME_ ;; #define _CLASS_NAME_ ;; @@ -190,8 +192,7 @@ DECLARE HBClass ; [ ; #translate Super( ) : => ::: ] ; [ ; #translate Super() : => ::: ] ; [ ; #translate Super : => ::: ] ; - [ ; #translate ::Super : => ::: ] ; - [ ; REQUEST ] [ , ] + [ ; #translate ::Super : => ::: ] #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 ( [ ():class ] [ ,():class ] ) ) ;; + Metaclass := HBClass():new( <(ClassName)>+" class", __HB_CLS_PAR0( [ ():class ] [ ,():class ] ) ) ;; endif ;; #undef _CLASS_NAME_ ;; #define _CLASS_NAME_ ;; @@ -219,8 +220,7 @@ DECLARE HBClass ; [ ; #translate Super( ) : => ::: ] ; [ ; #translate Super() : => ::: ] ; [ ; #translate Super : => ::: ] ; - [ ; #translate ::Super : => ::: ] ; - [ ; REQUEST ] [ , ] + [ ; #translate ::Super : => ::: ] #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( [ @() ] [ , @() ] ), @_HB_CLS_FUNCNAME() [, <.modulfriend.> ] ) ) ;; #undef _CLASS_NAME_ ;; #define _CLASS_NAME_ ;; #undef _CLASS_MODE_ ;; @@ -253,8 +253,7 @@ DECLARE HBClass ; [ ; #translate Super( ) : => ::: ] ; [ ; #translate Super() : => ::: ] ; [ ; #translate Super : => ::: ] ; - [ ; #translate ::Super : => ::: ] ; - [ ; REQUEST ] [ , ] + [ ; #translate ::Super : => ::: ] #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_ ;; #undef _CLASS_MODE_ ;; @@ -280,8 +279,7 @@ DECLARE HBClass ; [ ; #translate Super( ) : => ::: ] ; [ ; #translate Super() : => ::: ] ; [ ; #translate Super : => ::: ] ; - [ ; #translate ::Super : => ::: ] ; - [ ; REQUEST ] [ , ] + [ ; #translate ::Super : => ::: ] #endif /* HB_SHORTNAMES */ diff --git a/harbour/include/hbextern.ch b/harbour/include/hbextern.ch index dee706bb8b..630d96cbcb 100644 --- a/harbour/include/hbextern.ch +++ b/harbour/include/hbextern.ch @@ -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 diff --git a/harbour/source/rtl/tclass.prg b/harbour/source/rtl/tclass.prg index 7e51af6b46..c9668baa60 100644 --- a/harbour/source/rtl/tclass.prg +++ b/harbour/source/rtl/tclass.prg @@ -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 diff --git a/harbour/source/vm/classes.c b/harbour/source/vm/classes.c index 5cbf56f7ca..c0bc637085 100644 --- a/harbour/source/vm/classes.c +++ b/harbour/source/vm/classes.c @@ -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