From 700a198a278d85188820f2047dc2fa418a4c5c5d Mon Sep 17 00:00:00 2001 From: Eddie Runia Date: Tue, 1 Jun 1999 17:27:54 +0000 Subject: [PATCH] see changelog --- harbour/ChangeLog | 4 ++ harbour/source/rtl/classes.c | 17 +++++++ harbour/source/rtl/tclass.prg | 37 +++++++++----- harbour/tests/working/inherit.prg | 82 ++++++++++++++++++------------- harbour/tests/working/run_exp.h | 4 +- 5 files changed, 98 insertions(+), 46 deletions(-) diff --git a/harbour/ChangeLog b/harbour/ChangeLog index 3559b8680b..5f01a8037d 100644 --- a/harbour/ChangeLog +++ b/harbour/ChangeLog @@ -1,3 +1,7 @@ +19990601-18:15 CET Eddie Runia + * tests/working/inherit.prg, source/rtl/classes.c, source/rtl/tclass.prg + version correct release (+ super ) + 19990601-12:00 EDT David G. Holm * makefile.b31 - Ran into problems using GT API with tests\working\mathtest, so removed diff --git a/harbour/source/rtl/classes.c b/harbour/source/rtl/classes.c index eb76a5781a..e572311d95 100644 --- a/harbour/source/rtl/classes.c +++ b/harbour/source/rtl/classes.c @@ -17,6 +17,7 @@ void Function( WORD wParams ); #define MET_CLASSDATA 2 #define MET_INLINE 3 #define MET_VIRTUAL 4 +#define MET_SUPER 5 typedef struct { @@ -217,6 +218,17 @@ static HARBOUR Virtual( void ) _ret(); } +static HARBOUR SelectSuper( void ) +{ + PITEM pObject = stack.pBase + 1; + PITEM pSuper = hb_arrayClone( pObject ); + WORD wSuperCls = pMethod->wData; + + ItemCopy( &stack.Return, pSuper ); + ( (PBASEARRAY) (stack.Return.value.pBaseArray) )->wClass = wSuperCls; + hb_itemRelease( pSuper ); +} + static HARBOUR ClassName( void ) { WORD wClass = IS_ARRAY( stack.pBase + 1 ) ? @@ -398,6 +410,11 @@ HARBOUR CLASSADD() /* hClass, cMessage, pFunction, nType, xInit */ pClass->pMethods[ wAt ].pFunction = Virtual; break; + case MET_SUPER: + pClass->pMethods[ wAt ].wData = _parnl( 3 ); + pClass->pMethods[ wAt ].pFunction = SelectSuper; + break; + default: printf( "Invalid method type from ClassAdd\n" ); exit( 1 ); diff --git a/harbour/source/rtl/tclass.prg b/harbour/source/rtl/tclass.prg index d102f8681e..d08539099c 100644 --- a/harbour/source/rtl/tclass.prg +++ b/harbour/source/rtl/tclass.prg @@ -5,6 +5,7 @@ #define MET_CLASSDATA 2 #define MET_INLINE 3 #define MET_VIRTUAL 4 +#define MET_SUPER 5 #define DAT_SYMBOL 1 #define DAT_INITVAL 2 @@ -41,15 +42,15 @@ function TClass() ClassAdd( hClass, "_aInlines", 6, MET_DATA ) ClassAdd( hClass, "aVirtuals", 7, MET_DATA ) ClassAdd( hClass, "_aVirtuals", 7, MET_DATA ) - ClassAdd( hClass, "hSuper", 8, MET_DATA ) - ClassAdd( hClass, "_hSuper", 8, MET_DATA ) + ClassAdd( hClass, "xSuper", 8, MET_DATA ) + ClassAdd( hClass, "_xSuper", 8, MET_DATA ) endif return ClassInstance( hClass ) //----------------------------------------------------------------------------// -static function New( cClassName, cSuperClass ) +static function New( cClassName, xSuper ) local Self := QSelf() @@ -59,11 +60,8 @@ static function New( cClassName, cSuperClass ) ::aClsDatas = {} ::aInlines = {} ::aVirtuals = {} - if ValType( cSuperClass ) != "C" - ::hSuper = 0 - else - ::hSuper = __InstSuper( Upper ( cSuperClass ) ) - // Instance super class and return class handle + if ValType( xSuper ) $ "CA" + ::xSuper = xSuper endif return Self @@ -74,13 +72,28 @@ static function Create() local Self := QSelf() local n, nLen := Len( ::aDatas ) - local hClass := ClassCreate( ::cName, nLen, ::hSuper ) - local nDataBegin := If( !Empty( ::hSuper ), __WDatas( ::hSuper ), 0 ) + local hClass + local nDataBegin := 0 + local hSuper + + if ::xSuper == NIL + hClass := ClassCreate( ::cName, nLen ) + + elseif ValType(::xSuper) == "A" // Multiple inheritance + QOut( "Sorry, not supported yet :-)" ) + + elseif ValType(::xSuper) == "C" // Single inheritance + hSuper := __InstSuper( Upper( ::xSuper ) ) + hClass := ClassCreate( ::cName, nLen, hSuper ) + // Add class casts + ClassAdd( hClass, Upper( ::xSuper ), hSuper, MET_SUPER ) + ClassAdd( hClass, "SUPER", hSuper, MET_SUPER ) + + nDataBegin := __WDatas( hSuper ) // Get offset for new DATAs + endif ::hClass = hClass - - for n = 1 to nLen ClassAdd( hClass, ::aDatas[ n ][ DAT_SYMBOL ], n + nDataBegin, MET_DATA, ; ::aDatas[ n ][ DAT_INITVAL ] ) diff --git a/harbour/tests/working/inherit.prg b/harbour/tests/working/inherit.prg index f9a7670996..80a300107f 100644 --- a/harbour/tests/working/inherit.prg +++ b/harbour/tests/working/inherit.prg @@ -8,32 +8,43 @@ // Date : 30/05/1999 // -function Main( cFrom, cTo ) +function Main() local oFrom local oTo local cOut set( _SET_EXACT, .T.) - cFrom := Default( cFrom, "strip.prg" ) - cTo := Default( cTo, "strip.out" ) - oFrom := TTextFile():New( cFrom, "R" ) + oFrom := TOnTop() :New( "hello.prg", "R" ) + oTo := TTextFile():New( "hello.out", "W" ) + + QOut( "What's in oFrom" ) HBDebug( { oFrom, aoMethod( oFrom ) } ) -// oFrom:Super:Run() - oFrom:Set( "DoIt !" ) - QOut( oFrom:Out ) - oTo := TTextFile():New( cTo, "W" ) + QOut() + QOut( "What's in oFrom:TEmpty" ) + HBDebug( { oFrom:TEmpty, aoMethod( oFrom:TEmpty ) } ) + + QOut() + QOut( "Let's call Run() from TEmpty : " ) + oFrom:TEmpty:Run() + + QOut() + QOut( "Let's call a method from TEmpty and one from TOnTop" ) + oFrom:Set( "Done !" ) + oFrom:Say( "Out" ) + + QOut() + QOut( "Basic copy loop using the default Run() from TTextFile" ) do while !oFrom:lEoF cOut := oFrom:Run() - if alltrim(cOut) != "" - oTo:Run( cOut ) - endif + QOut( cOut ) + oTo:Run( cOut ) enddo - QOut( "Number of lines", oTo:nLine ) oFrom:Dispose() oTo:Dispose() + return nil // @@ -44,16 +55,14 @@ function TEmpty() static oEmpty if oEmpty == NIL - QOut( "I am being called indirectly" ) - oEmpty := TClass():New( "TEmpty" ) // Create a new class def oEmpty:AddInline( "New", {|self|self} ) - oEmpty:AddInline( "Run", {||QOut( "Run!" ) } ) // Test command + oEmpty:AddInline( "Run", {||QOut( "Run !" )}) // Test command // oEmpty:AddInline( "Set", {|self,xParam|::Out := xParam } ) oEmpty:AddInline( "Set", {|self,xParam| oSend(self,"_Out",xParam) } ) - oEmpty:AddData( "Out", 1 ) // Test command + oEmpty:AddData( "Out", "Hi there" ) // Test command oEmpty:AddVirtual( "Dispose" ) // Clean up code oEmpty:Create() @@ -61,9 +70,23 @@ function TEmpty() return oEmpty:Instance() +// +// Let's add another one on top +// +function TOnTop() + + static oOnTop + + if oOnTop == NIL + oOnTop := TClass():New( "TOnTop", "TTextFile" ) + oOnTop:AddInline( "Say", {|self, cArg| QOut( oSend(self, cArg) ) } ) + oOnTop:Create() + endif +return oOnTop:Instance() + // -// Generic DOS file handler +// Generic Text file handler // function TTextFile() @@ -90,7 +113,6 @@ function TTextFile() oFile:AddMethod( "Read" , @Read() ) // Read line oFile:AddMethod( "WriteLn", @WriteLn() ) // Write line oFile:AddMethod( "Write" , @Write() ) // Write without CR -// oFile:AddMethod( "EoF" , @EoF() ) // End of file as function oFile:AddMethod( "Goto" , @Goto() ) // Go to line oFile:Create() @@ -105,7 +127,7 @@ return oFile:Instance() // mode for opening. Default "R" // Optional maximum blocksize // -static function New( cFileName, cMode, nBlock ) +function New( cFileName, cMode, nBlock ) local self := QSelf() // Get self @@ -133,7 +155,7 @@ static function New( cFileName, cMode, nBlock ) return self -static function Run( xTxt, lCRLF ) +function Run( xTxt, lCRLF ) local self := QSelf() local xRet @@ -149,7 +171,7 @@ return xRet // // Dispose -> Close the file handle // -static function Dispose() +function Dispose() local self := QSelf() @@ -169,7 +191,7 @@ return self // // Read a single line // -static function Read() +function Read() local self := QSelf() local cRet := "" @@ -195,7 +217,7 @@ static function Read() endif if !::lEoF - ::nLine := ::nLine + 1 // ++ not available + ::nLine++ nCRPos := At(Chr(10), ::cBlock) if nCRPos != 0 // More than one line read cRet := Substr( ::cBlock, 1, nCRPos - 1) @@ -205,7 +227,7 @@ static function Read() ::cBlock := "" cRet += ::Read() // Read the rest if !::lEoF - ::nLine := ::nLine - 1 // Adjust erroneous line count + ::nLine-- // Adjust erroneous line count endif endif nEoFPos := At( Chr(26), cRet ) @@ -226,7 +248,7 @@ return cRet // one or more strings // End with Carriage Return/Line Feed (Default == TRUE) // -static function WriteLn( xTxt, lCRLF ) +function WriteLn( xTxt, lCRLF ) local self := QSelf() local cBlock @@ -249,19 +271,13 @@ static function WriteLn( xTxt, lCRLF ) return self -static function Write( xTxt ) +function Write( xTxt ) local self := QSelf() return ::WriteLn( xTxt, .F. ) -//function EoF() -// -// local self := QSelf() -//return ::lEoF - - // // Go to a specified line number // @@ -281,7 +297,7 @@ static function Goto( nLine ) fSeek(::hFile, 0) // Go top do while !::lEoF .and. nWhere < nLine nWhere++ - ::Run() + ::Read() enddo endif return !lEoF diff --git a/harbour/tests/working/run_exp.h b/harbour/tests/working/run_exp.h index 3b3165fe5a..9b3653755e 100644 --- a/harbour/tests/working/run_exp.h +++ b/harbour/tests/working/run_exp.h @@ -130,6 +130,7 @@ HARBOUR HB_FEOF(); HARBOUR HB_FREADLN(); HARBOUR HB_FSKIP(); HARBOUR GETENV(); +HARBOUR DIRECTORY(); /* Same story. @@ -262,7 +263,8 @@ static SYMBOL symbols[] = { { "HB_FEOF", FS_PUBLIC, HB_FEOF , 0 }, { "HB_FREADLN", FS_PUBLIC, HB_FREADLN , 0 }, { "HB_FSKIP", FS_PUBLIC, HB_FSKIP , 0 }, -{ "GETENV", FS_PUBLIC, GETENV , 0 } +{ "GETENV", FS_PUBLIC, GETENV , 0 }, +{ "DIRECTORY", FS_PUBLIC, DIRECTORY , 0 } };