diff --git a/harbour/source/compiler/harbour.y b/harbour/source/compiler/harbour.y index 028d2cbf90..27374321cf 100644 --- a/harbour/source/compiler/harbour.y +++ b/harbour/source/compiler/harbour.y @@ -393,6 +393,7 @@ Statement : ExecFlow Crlf {} | VarId ArrayIndex '=' Expression Crlf { GenPCode1( _ARRAYPUT ); GenPCode1( _POP ); } | FunCall ArrayIndex '=' Expression Crlf { Do( $1 ); GenPCode1( _ARRAYPUT ); } | IdSend IDENTIFIER '=' { Message( SetData( $2 ) ); } Expression Crlf { Function( 1 ); } + | IdSend IDENTIFIER INASSIGN { Message( SetData( $2 ) ); } Expression Crlf { Function( 1 ); } | ObjectData ArrayIndex '=' Expression Crlf {} | ObjectMethod ArrayIndex '=' Expression Crlf {} @@ -560,7 +561,6 @@ VarAssign : IDENTIFIER INASSIGN Expression { PopId( $1 ); PushId( $1 ); } | FunCall ArrayIndex DIVEQ Expression {} | FunCall ArrayIndex EXPEQ Expression {} | FunCall ArrayIndex MODEQ Expression {} - | ObjectData INASSIGN Expression {} | ObjectData PLUSEQ Expression {} | ObjectData MINUSEQ Expression {} | ObjectData MULTEQ Expression {} diff --git a/harbour/tests/broken/strip.prg b/harbour/tests/broken/strip.prg new file mode 100644 index 0000000000..fe8419d259 --- /dev/null +++ b/harbour/tests/broken/strip.prg @@ -0,0 +1,315 @@ +// +// Strip +// +// The Harbour stripping command +// +// Date : 04/05/1999 +// +// Usage : Strip( FileFrom, FileTo ) +// +// The output from FileFrom is copied to FileTo except for the empty lines +// +// Default files : From = strip.prg To = strip.out +// + +function Main( cFrom, cTo ) + + local oFrom + local oTo + local cOut + + static oTrick1, oTrick2 // Dirty trick + + cFrom := Default( cFrom, "strip.prg" ) + cTo := Default( cTo, "strip.out" ) + + oFrom := TDosFile(oTrick1):Stew( cFrom, "R" ) + oTo := TDosFile(oTrick2):Stew( cTo , "W" ) + + do while !oFrom:lEoF + cOut := oFrom:Run() + if alltrim(cOut) != "" + oTo:Run( cOut ) + endif + enddo + QOut( "Number of lines", oTo:nLine ) + oFrom:Dispose() + oTo:Dispose() +return nil + + +// +// Generic DOS file handler +// +function TDosFile( oGoneFile ) // Parameter = dirty + + static oFile + local oRet + + if oFile == NIL // Second instance not correct + QOut("Here") + oFile := TClass():New( "TDosFile" ) // Create a new class def + + oFile:AddData( "cFileName" ) // Filename spec. by user + oFile:AddData( "hFile" ) // File handle + oFile:AddData( "nLine" ) // Current linenumber + oFile:AddData( "nError" ) // Last error + oFile:AddData( "lEoF" ) // End of file + oFile:AddData( "cBlock" ) // Storage block + oFile:AddData( "nBlockSize" ) // Size of read-ahead buffer + oFile:AddData( "cMode" ) // Mode of file use + // R = read, W = write + + oFile:AddMethod( "Stew" , @Stew() ) // Constructor + oFile:AddMethod( "Run" , @Run() ) // Get/set data + oFile:AddMethod( "Dispose", @Dispose() ) // Clean up code + 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() + endif + oRet := oFile:Instance() + +return oRet + + +// +// Method DosFile:Stew -> Create a new dosfile +// +// file name. No wild characters +// mode for opening. Default "R" +// Optional maximum blocksize +// +function Stew( cFileName, cMode, nBlock ) + + local self := QSelf() // Get self + + ::nLine := 0 + ::lEoF := .F. + ::cBlock := "" + ::cFileName := cFileName + ::cMode := Default( cMode, "R" ) + + if ::cMode == "R" + ::hFile := fOpen( cFileName ) + elseif ::cMode == "W" + ::hFile := fCreate( cFileName ) + else + QOut( "DosFile Init: Unknown file mode:", ::cMode ) + endif + + ::nError := fError() + if ::nError != 0 + ::lEoF := .T. + QOut( "Error ", ::nError) + endif + ::nBlockSize := Default( nBlock, 4096 ) + +return self + + +function Run( xTxt, lCRLF ) + + local self := QSelf() + local xRet + + if ::cMode == "R" + xRet := ::Read() + else + xRet := ::WriteLn( xTxt, lCRLF ) + endif +return xRet + + +// +// Dispose -> Close the file handle +// +function Dispose() + + local self := QSelf() + + ::cBlock := NIL + if ::hFile != -1 + if ::cMode == "W" .and. ::nError != 0 + ::Write( Chr(26) ) // Do not forget EOF marker + endif + if !fClose(::hFile) + ::nError := fError() + QOut( "Dos Error closing ", ::cFileName, " Code ", ::nError) + endif + endif +return self + + +// +// Read a single line +// +function Read() + + local self := QSelf() + local cRet := "" + local cBlock + local nCrPos + local nEoFPos + local nRead + + if ::hFile == -1 + QOut( "DosFile:Read : No file open" ) + elseif ::cMode != "R" + QOut( "File ", cFileName, " not open for reading" ) + elseif !::lEoF + + if Len(::cBlock) == 0 // Read new block + cBlock := fReadStr( ::hFile, ::nBlockSize ) + if len(cBlock) == 0 + ::nError := fError() // Error or EOF + ::lEoF := .T. + else + ::cBlock := cBlock + endif + endif + + if !::lEoF + ::nLine := ::nLine + 1 // ++ not available + nCRPos := At(Chr(10), ::cBlock) + if nCRPos != 0 // More than one line read + cRet := Substr( ::cBlock, 1, nCRPos - 1) + ::cBlock := Substr( ::cBlock, nCRPos + 1) + else // No complete line + cRet := ::cBlock + ::cBlock := "" + cRet += ::Read() // Read the rest + if !::lEoF + ::nLine := ::nLine - 1 // Adjust erroneous line count + endif + endif + nEoFPos := At( Chr(26), cRet ) + if nEoFPos != 0 // End of file read + cRet := Substr( cRet, 1, nEoFPos-1 ) + ::lEoF := .T. + endif + cRet := Strtran( cRet, Chr(13), "" ) // Remove CR + endif + endif +return cRet + + +// +// WriteLn -> Write a line to a file +// +// Text to write. May be any type. May also be an array containing +// one or more strings +// End with Carriage Return/Line Feed (Default == TRUE) +// +function WriteLn( xTxt, lCRLF ) + + local self := QSelf() + local cBlock + + if ::hFile == -1 + QOut( "DosFile:Write : No file open" ) + elseif ::cMode != 'W' + QOut( "File ",cFileName," not opened for writing" ) + else + cBlock := ToChar( xTxt ) // Convert to string + if Default( lCRLF, .T. ) + cBlock += Chr(10) // +chr(13) ?? + endif + fWrite( ::hFile, cBlock, len(cBlock) ) + if fError() != 0 + ::nError := fError() // Not completely written ! + endif + ::nLine := ::nLine + 1 + endif +return self + + +function Write( xTxt ) + + local self := QSelf() + +return ::WriteLn( xTxt, .F. ) + + +&&function EoF() +&& +&& local self := QSelf() +&&return ::lEoF + + +// +// Go to a specified line number +// +function Goto( nLine ) + + local self := QSelf() + local nWhere := 1 + + if Empty(::hFile) + QOut( "DosFile:Goto : No file open" ) + elseif ::cMode != "R" + QOut( "File ", cName, " not open for reading" ) + else + ::lEoF := .F. // Clear (old) End of file + ::nLine := 0 // Start at beginning + ::cBlock := "" + fSeek(::hFile, 0) // Go top + do while !::lEoF .and. nWhere < nLine + nWhere++ + ::Run() + enddo + endif +return !lEoF + + +// +// Always return a correct value +// +function Default( xArg, xDef ) +return if( ValType(xArg) != ValType(xDef), xDef, xArg ) + + +// +// ToChar -> Convert xTxt to character +// +function ToChar( xTxt, cSeparator ) + + local cValTxt + local cOut + + cValTxt := ValType( xTxt ) + do case + case cValTxt=="C" .or. cValTxt=="M" // Character + cOut := xTxt + + case cValTxt=="N" // Numeric + cOut := Alltrim(Str(xTxt)) + + case cValTxt=="U" // Nothing to write + cOut := "" + + case cValTxt=="D" // Date + cOut := TransForm(xTxt, "") + + case cValTxt=="L" // Logical + cOut := if( xTxt, "True", "False" ) + + case cValTxt=="A" // Array + cOut := "" + aEval( xTxt, {|xItem| cOut += ToChar( xItem, cSeparator )+; + Default( cSeparator, " " ) }) + cOut := Substr( cOut, 1, Len(cOut) - ; + Len( Default( cSeparator, " " ))) + + case cValTxt=="B" // Code block (??) + cOut := Eval( xTxt ) + + case cValTxt=="O" // Object (??) + cOut := xTxt:Run() + + endcase +return cOut + diff --git a/harbour/tests/broken/strip.txt b/harbour/tests/broken/strip.txt new file mode 100644 index 0000000000..b671eb470a --- /dev/null +++ b/harbour/tests/broken/strip.txt @@ -0,0 +1,16 @@ +There are two strip files here : + +#1 : strip.prg This one is broken +#2 : strip2.prg This one works + +You'll need to the latest FILES.C for this + my harbour.y patch. + +The first one uses the TClass(). + +The second one uses the Class functions. + +The STATIC which is used, is removed (set to NIL) once you are done. + +Good luck + +Eddie diff --git a/harbour/tests/broken/strip2.prg b/harbour/tests/broken/strip2.prg new file mode 100644 index 0000000000..c735b855df --- /dev/null +++ b/harbour/tests/broken/strip2.prg @@ -0,0 +1,331 @@ +// +// Strip +// +// The Harbour stripping command +// +// Date : 04/05/1999 +// +// Usage : Strip( FileFrom, FileTo ) +// +// The output from FileFrom is copied to FileTo except for the empty lines +// +// Default files : From = strip.prg To = strip.out +// + +#define MET_METHOD 0 +#define MET_DATA 1 +#define MET_CLASSDATA 2 +#define MET_INLINE 3 +#define MET_VIRTUAL 4 + +function Main( cFrom, cTo ) + + local oFrom + local oTo + local cOut + + static oTrick1, oTrick2 // Dirty trick + + cFrom := Default( cFrom, "strip.prg" ) + cTo := Default( cTo, "strip.out" ) + + oFrom := TDosFile(oTrick1):New( cFrom, "R" ) + QOut("Next") + oTo := TDosFile(oTrick2):New( cTo , "W" ) + + do while !oFrom:lEoF + cOut := oFrom:Run() + if alltrim(cOut) != "" + oTo:Run( cOut ) + endif + enddo + QOut( "Number of lines", oTo:nLine ) + oFrom:Dispose() + oTo:Dispose() +return nil + + +// +// Generic DOS file handler +// +function TDosFile( oShitFile ) // Parameter = dirty + + static hFile + + QOut("In") + QOut(ValType(hFile)) + + if hFile == NIL // Second instance not correct + hFile := ClassCreate( "TDOSFILE", 9 ) // Create a new class def + + ClassAdd( hFile, "New" , @New() ,MET_METHOD) // Constructor + ClassAdd( hFile, "Run" , @Run() ,MET_METHOD) // Get/set data + ClassAdd( hFile, "Dispose", @Dispose() ,MET_METHOD) // Clean up code + ClassAdd( hFile, "Read" , @Read() ,MET_METHOD) // Read line + ClassAdd( hFile, "WriteLn", @WriteLn() ,MET_METHOD) // Write line + ClassAdd( hFile, "Write" , @Write() ,MET_METHOD) // Write without CR +// ClassAdd( hFile, "EoF" , @EoF() ,MET_METHOD) // End of file as function + ClassAdd( hFile, "Goto" , @Goto() ,MET_METHOD) // Go to line + ClassAdd( hFile, "hClass" ,1 ,MET_DATA ) + ClassAdd( hFile, "_hClass" ,1 ,MET_DATA ) + ClassAdd( hFile, "cFileName" ,2 ,MET_DATA ) // Filename spec. by user + ClassAdd( hFile, "_cFileName",2 ,MET_DATA ) // Filename spec. by user + ClassAdd( hFile, "hFile" ,3 ,MET_DATA ) // File handle + ClassAdd( hFile, "_hFile" ,3 ,MET_DATA ) // File handle + ClassAdd( hFile, "nLine" ,4 ,MET_DATA ) // Current linenumber + ClassAdd( hFile, "_nLine" ,4 ,MET_DATA ) // Current linenumber + ClassAdd( hFile, "nError" ,5 ,MET_DATA ) // Last error + ClassAdd( hFile, "_nError" ,5 ,MET_DATA ) // Last error + ClassAdd( hFile, "lEoF" ,6 ,MET_DATA ) // End of file + ClassAdd( hFile, "_lEoF" ,6 ,MET_DATA ) // End of file + ClassAdd( hFile, "cBlock" ,7 ,MET_DATA ) // Storage block + ClassAdd( hFile, "_cBlock" ,7 ,MET_DATA ) // Storage block + ClassAdd( hFile, "nBlockSize",8 ,MET_DATA ) // Size of read-ahead buffer + ClassAdd( hFile, "_nBlockSize",8 ,MET_DATA ) // Size of read-ahead buffer + ClassAdd( hFile, "cMode" ,9 ,MET_DATA ) // Mode of file use + ClassAdd( hFile, "_cMode" ,9 ,MET_DATA ) // Mode of file use + // R = read, W = write + + endif + QOut("Out") + QOut( ValType(hFile), hFile ) + +return ClassInstance( hFile ) + + +// +// Method DosFile:New -> Create a new dosfile +// +// file name. No wild characters +// mode for opening. Default "R" +// Optional maximum blocksize +// +function New( cFileName, cMode, nBlock ) + + local self := QSelf() // Get self + + ::nLine := 0 + ::lEoF := .F. + ::cBlock := "" + ::cFileName := cFileName + ::cMode := Default( cMode, "R" ) + + if ::cMode == "R" + ::hFile := fOpen( cFileName ) + elseif ::cMode == "W" + ::hFile := fCreate( cFileName ) + else + QOut( "DosFile Init: Unknown file mode:", ::cMode ) + endif + + ::nError := fError() + if ::nError != 0 + ::lEoF := .T. + QOut( "Error ", ::nError) + endif + ::nBlockSize := Default( nBlock, 4096 ) + +return self + + +function Run( xTxt, lCRLF ) + + local self := QSelf() + local xRet + + if ::cMode == "R" + xRet := ::Read() + else + xRet := ::WriteLn( xTxt, lCRLF ) + endif +return xRet + + +// +// Dispose -> Close the file handle +// +function Dispose() + + local self := QSelf() + + ::cBlock := NIL + if ::hFile != -1 + if ::cMode == "W" .and. ::nError != 0 + ::Write( Chr(26) ) // Do not forget EOF marker + endif + if !fClose(::hFile) + ::nError := fError() + QOut( "Dos Error closing ", ::cFileName, " Code ", ::nError) + endif + endif +return self + + +// +// Read a single line +// +function Read() + + local self := QSelf() + local cRet := "" + local cBlock + local nCrPos + local nEoFPos + local nRead + + if ::hFile == -1 + QOut( "DosFile:Read : No file open" ) + elseif ::cMode != "R" + QOut( "File ", cFileName, " not open for reading" ) + elseif !::lEoF + if Len(::cBlock) == 0 // Read new block + cBlock := fReadStr( ::hFile, ::nBlockSize ) + if len(cBlock) == 0 + ::nError := fError() // Error or EOF + ::lEoF := .T. + else + ::cBlock := cBlock + endif + endif + + if !::lEoF + ::nLine := ::nLine + 1 // ++ not available + nCRPos := At(Chr(10), ::cBlock) + if nCRPos != 0 // More than one line read + cRet := Substr( ::cBlock, 1, nCRPos - 1) + ::cBlock := Substr( ::cBlock, nCRPos + 1) + else // No complete line + cRet := ::cBlock + ::cBlock := "" + cRet += ::Read() // Read the rest + if !::lEoF + ::nLine := ::nLine - 1 // Adjust erroneous line count + endif + endif + nEoFPos := At( Chr(26), cRet ) + if nEoFPos != 0 // End of file read + cRet := Substr( cRet, 1, nEoFPos-1 ) + ::lEoF := .T. + endif + cRet := Strtran( cRet, Chr(13), "" ) // Remove CR + endif + endif +return cRet + + +// +// WriteLn -> Write a line to a file +// +// Text to write. May be any type. May also be an array containing +// one or more strings +// End with Carriage Return/Line Feed (Default == TRUE) +// +function WriteLn( xTxt, lCRLF ) + + local self := QSelf() + local cBlock + + if ::hFile == -1 + QOut( "DosFile:Write : No file open" ) + elseif ::cMode != 'W' + QOut( "File ",cFileName," not opened for writing" ) + else + cBlock := ToChar( xTxt ) // Convert to string + if Default( lCRLF, .T. ) + cBlock += Chr(10) // +chr(13) ?? + endif + fWrite( ::hFile, cBlock, len(cBlock) ) + if fError() != 0 + ::nError := fError() // Not completely written ! + endif + ::nLine := ::nLine + 1 + endif +return self + + +function Write( xTxt ) + + local self := QSelf() + +return ::WriteLn( xTxt, .F. ) + + +&&function EoF() +&& +&& local self := QSelf() +&&return ::lEoF + + +// +// Go to a specified line number +// +function Goto( nLine ) + + local self := QSelf() + local nWhere := 1 + + if Empty(::hFile) + QOut( "DosFile:Goto : No file open" ) + elseif ::cMode != "R" + QOut( "File ", cName, " not open for reading" ) + else + ::lEoF := .F. // Clear (old) End of file + ::nLine := 0 // Start at beginning + ::cBlock := "" + fSeek(::hFile, 0) // Go top + do while !::lEoF .and. nWhere < nLine + nWhere++ + ::Run() + enddo + endif +return !lEoF + + +// +// Always return a correct value +// +function Default( xArg, xDef ) +return if( ValType(xArg) != ValType(xDef), xDef, xArg ) + + +// +// ToChar -> Convert xTxt to character +// +function ToChar( xTxt, cSeparator ) + + local cValTxt + local cOut + + cValTxt := ValType( xTxt ) + do case + case cValTxt=="C" .or. cValTxt=="M" // Character + cOut := xTxt + + case cValTxt=="N" // Numeric + cOut := Alltrim(Str(xTxt)) + + case cValTxt=="U" // Nothing to write + cOut := "" + + case cValTxt=="D" // Date + cOut := TransForm(xTxt, "") + + case cValTxt=="L" // Logical + cOut := if( xTxt, "True", "False" ) + + case cValTxt=="A" // Array + cOut := "" + aEval( xTxt, {|xItem| cOut += ToChar( xItem, cSeparator )+; + Default( cSeparator, " " ) }) + cOut := Substr( cOut, 1, Len(cOut) - ; + Len( Default( cSeparator, " " ))) + + case cValTxt=="B" // Code block (??) + cOut := Eval( xTxt ) + + case cValTxt=="O" // Object (??) + cOut := xTxt:Run() + + endcase +return cOut +