From 7b2ce3a1432a2fca35136c33690ae2fae8a8aae9 Mon Sep 17 00:00:00 2001 From: Eddie Runia Date: Wed, 21 Jul 1999 07:05:57 +0000 Subject: [PATCH] see changelog --- harbour/ChangeLog | 14 +++ harbour/source/vm/hvm.c | 87 ++++++++------ harbour/tests/working/inifiles.prg | 181 +++++++++++++++++------------ harbour/tests/working/strsub.prg | 22 ++++ 4 files changed, 195 insertions(+), 109 deletions(-) create mode 100644 harbour/tests/working/strsub.prg diff --git a/harbour/ChangeLog b/harbour/ChangeLog index 51c103a37c..059dbde3e7 100644 --- a/harbour/ChangeLog +++ b/harbour/ChangeLog @@ -1,3 +1,17 @@ +19990721-09:00 CET Jose Lalin + * source/vm/hvm.c + + added support for concatenation operator "-" + + added support to generate correct runtime errors in functions: + And(), Equal(), Greater(), GreaterEqual(), + Inc(), Instring(), Less(), LessEqual(), Not(), + NotEqual(), Minus(), Or(), Plus(), HB_LEN() + + tests/working/strsub.prg + tests for operator "-" on strings + +19990721-09:00 CET Matthew Hamilton + * tests/working/inifiles.prg + * Case sensitive & Speed improvement + 19990720-09:38 Alexander Kresin * source\hbpp\hbpp.c * Fixed bugs related to nested #ifdef, #ifndef diff --git a/harbour/source/vm/hvm.c b/harbour/source/vm/hvm.c index 38d563d580..bcc5c80758 100644 --- a/harbour/source/vm/hvm.c +++ b/harbour/source/vm/hvm.c @@ -615,8 +615,7 @@ void And( void ) { PHB_ITEM pItem2 = stack.pPos - 1; PHB_ITEM pItem1 = stack.pPos - 2; - PHB_ITEM pError; - int iResult; + int iResult; HB_DEBUG( "And\n" ); @@ -629,10 +628,7 @@ void And( void ) } else { - pError = hb_errNew(); - hb_errPutDescription( pError, "Argument error: conditional" ); - hb_errLaunch( pError ); - hb_errRelease( pError ); + hb_errorRT_BASE(EG_ARG, 1066, "Argument error", "conditional"); } } @@ -882,8 +878,7 @@ void Equal( BOOL bExact ) else if( pItem1->type != pItem2->type ) { - printf( "types do not match on equal operation\n" ); - exit( 1 ); + hb_errorRT_BASE(EG_ARG, 1070, "Argument error", "=="); } else @@ -1016,8 +1011,7 @@ void Greater( void ) else if( ( stack.pPos - 2 )->type != ( stack.pPos - 1 )->type ) { - printf( "types do not match on greater operation %d, %d\n", (stack.pPos - 2)->type, (stack.pPos - 1)->type ); - exit( 1 ); + hb_errorRT_BASE(EG_ARG, 1075, "Argument error", ">"); } } @@ -1063,8 +1057,7 @@ void GreaterEqual( void ) else if( ( stack.pPos - 2 )->type != ( stack.pPos - 1 )->type ) { - printf( "types do not match on greaterequal operation\n" ); - exit( 1 ); + hb_errorRT_BASE(EG_ARG, 1076, "Argument error", ">="); } } @@ -1087,10 +1080,7 @@ void Inc( void ) } else { - pError = hb_errNew(); - hb_errPutDescription( pError, "Error BASE/1086 Argument error: ++" ); - hb_errLaunch( pError ); - hb_errRelease( pError ); + hb_errorRT_BASE(EG_ARG, 1086, "Argument error", "++"); } } @@ -1136,11 +1126,7 @@ void Instring( void ) } else { - PHB_ITEM pError = hb_errNew(); - - hb_errPutDescription( pError, "Error BASE/1109 Argument error: $" ); - hb_errLaunch( pError ); - hb_errRelease( pError ); + hb_errorRT_BASE(EG_ARG, 1109, "Argument error", "$"); } } @@ -1252,8 +1238,7 @@ void Less( void ) else if( ( stack.pPos - 2 )->type != ( stack.pPos - 1 )->type ) { - printf( "types do not match on less operation\n" ); - exit( 1 ); + hb_errorRT_BASE(EG_ARG, 1073, "Argument error", "<"); } } @@ -1299,8 +1284,7 @@ void LessEqual( void ) else if( ( stack.pPos - 2 )->type != ( stack.pPos - 1 )->type ) { - printf( "types do not match on lessequal operation\n" ); - exit( 1 ); + hb_errorRT_BASE(EG_ARG, 1074, "Argument error", "<="); } } @@ -1340,7 +1324,7 @@ void Not( void ) if( IS_LOGICAL( pItem ) ) pItem->item.asLogical.value = ! pItem->item.asLogical.value; else - ; /* TODO: Raise an error here ? */ + hb_errorRT_BASE(EG_ARG, 1077, "Argument error", ".NOT."); } void NotEqual( void ) @@ -1383,8 +1367,7 @@ void NotEqual( void ) else if( pItem1->type != pItem2->type ) { - printf( "types do not match on equal operation\n" ); - exit( 1 ); + hb_errorRT_BASE(EG_ARG, 1072, "Argument error", "<>"); } else @@ -1415,11 +1398,45 @@ void Minus( void ) lDate1 = PopDate(); PushDate( lDate1 - dNumber2 ); } + else if( IS_STRING( pItem1 ) && IS_STRING( pItem2 ) ) + { + ULONG lLen = pItem1->item.asString.length; + ULONG lInc = 0; + ULONG i; + + pItem1->item.asString.value = (char*)hb_xrealloc( pItem1->item.asString.value, pItem1->item.asString.length + pItem2->item.asString.length + 1 ); + + while( lLen && pItem1->item.asString.value[lLen - 1] == ' ' ) + { + lLen--; + lInc++; + } + + pItem1->item.asString.length = lLen; + lLen = pItem2->item.asString.length; + pItem2->item.asString.length += lInc; + + for( i = 0; i < lInc; i++) + pItem2->item.asString.value[lLen + i] = ' '; + + memcpy( pItem1->item.asString.value+ pItem1->item.asString.length, + pItem2->item.asString.value, pItem2->item.asString.length ); + + pItem1->item.asString.length += pItem2->item.asString.length; + pItem1->item.asString.value[ pItem1->item.asString.length ] = 0; + if( pItem2->item.asString.value ) + { + hb_xfree( pItem2->item.asString.value ); + pItem2->item.asString.value = NULL; + } + StackPop(); + return; + } else if( IS_OBJECT( stack.pPos - 2 ) && hb_isMessage( stack.pPos - 2, "-" ) ) OperatorCall( stack.pPos - 2, stack.pPos - 1, "-" ); + else + hb_errorRT_BASE(EG_ARG, 1082, "Argument error", "-"); - /* TODO: We should substract strings also ? and generate an error it types - don't match */ } void Modulus( void ) @@ -1464,10 +1481,7 @@ void Or( void ) } else { - pError = hb_errNew(); - hb_errPutDescription( pError, "Argument error: conditional" ); - hb_errLaunch( pError ); - hb_errRelease( pError ); + hb_errorRT_BASE(EG_ARG, 1066, "Argument error", "conditional"); } } @@ -1522,9 +1536,8 @@ void Plus( void ) OperatorCall( pItem1, pItem2, "+" ); else - hb_errorRT_BASE( 1081, 1081, "Types of arguments do not match", "+" ); + hb_errorRT_BASE( EG_ARG, 1081, "Types of arguments do not match", "+" ); - /* TODO: Generate an error if types don't match */ HB_DEBUG( "Plus\n" ); } @@ -2157,7 +2170,7 @@ HARBOUR HB_LEN( void ) break; default: - hb_retni( 0 ); /* QUESTION: Should we raise an error here ? */ + hb_errorRT_BASE(EG_ARG, 1111, "Argument error", "LEN"); break; } } diff --git a/harbour/tests/working/inifiles.prg b/harbour/tests/working/inifiles.prg index 057ca2ddd1..a62be4afea 100644 --- a/harbour/tests/working/inifiles.prg +++ b/harbour/tests/working/inifiles.prg @@ -2,7 +2,7 @@ // $Id$ // -#define IF_BUFFER 65535 +#define CRLF (Chr(13) + Chr(10)) function Main(cFilename, cSection) local oIni := TIniFile():New(Default( cFilename, "harbour.ini" ) ) @@ -75,48 +75,55 @@ static function New(cFileName) hFile := fcreate(cFilename) endif + cLine := '' Done := .f. - cFile := space(1) while !Done - cLine := '' + cFile := space(256) + Done := (fread(hFile, cFile, 256) <= 0) - while !Done - Done := (fread(hFile, @cFile, 1) <= 0) + cFile := strtran(cFile, chr(10), '') // so we can just search for CHR(13) - if !cFile $ chr(10) + chr(13) - cLine += cFile + // prepend last read + cFile := cLine + cFile + while !empty(cFile) + if (nPos := at(chr(13), cFile)) > 0 + cLine := left(cFile, nPos - 1) + cFile := substr(cFile, nPos + 1) + + if !empty(cLine) + if Left(cLine, 1) == '[' // new section + if (nPos := At(']', cLine)) > 1 + cLine := substr(cLine, 2, nPos - 2); + + else + cLine := substr(cLine, 2) + endif + + AAdd(::Contents, { cLine, { /* this will be CurrArray */ } } ) + CurrArray := ::Contents[Len(::Contents)][2] + + elseif Left(cLine, 1) == ';' // preserve comments + AAdd( CurrArray, { NIL, cLine } ) + + else + if (nPos := At('=', cLine)) > 0 + cIdent := Left(cLine, nPos - 1) + cLine := SubStr(cLine, nPos + 1) + + AAdd( CurrArray, { cIdent, cLine } ) + + else + AAdd( CurrArray, { cLine, '' } ) + endif + endif + cLine := '' // to stop prepend later on + endif else - exit + cLine := cFile + cFile := '' endif end - - if !empty(cLine) - if Left(cLine, 1) == '[' // new section - if (nPos := At(']', cLine)) > 1 - cLine := substr(cLine, 2, nPos - 2) - else - cLine := substr(cLine, 2) - endif - - AAdd(::Contents, { cLine, { /* this will be CurrArray */ } } ) - CurrArray := ::Contents[Len(::Contents)][2] - - elseif Left(cLine, 1) == ';' // preserve comments - AAdd( CurrArray, { NIL, cLine } ) - - else - if (nPos := At('=', cLine)) > 0 - cIdent := Left(cLine, nPos - 1) - cLine := SubStr(cLine, nPos + 1) - - AAdd( CurrArray, { cIdent, cLine } ) - - else - AAdd( CurrArray, { cLine, '' } ) - endif - endif - endif end fclose(hFile) @@ -126,26 +133,41 @@ return Self static function ReadString(cSection, cIdent, cDefault) local Self := QSelf() local cResult := cDefault - local j, i := AScan( ::Contents, {|x| x[1] == cSection} ) + local i, j, cFind - if i > 0 - j := AScan( ::Contents[i][2], {|x| x[1] == cIdent} ) + if Empty(cSection) + cFind := lower(cIdent) + j := AScan( ::Contents, {|x| lower(x[1]) == cFind .and. ValType(x[2]) == 'C'} ) if j > 0 - cResult := ::Contents[i][2][j][2] + cResult := ::Contents[j][2] + endif + + else + cFind := lower(cSection) + i := AScan( ::Contents, {|x| lower(x[1]) == cFind} ) + + if i > 0 + cFind := lower(cIdent) + j := AScan( ::Contents[i][2], {|x| lower(x[1]) == cFind} ) + + if j > 0 + cResult := ::Contents[i][2][j][2] + endif endif endif return cResult static procedure WriteString(cSection, cIdent, cString) local Self := QSelf() - local j, i + local i, j, cFind if Empty(cIdent) outerr('Must specify an identifier') elseif Empty(cSection) - j := AScan( ::Contents, {|x| x[1] == cIdent .and. ValType(x[2]) == 'C'} ) + cFind := lower(cIdent) + j := AScan( ::Contents, {|x| lower(x[1]) == cFind .and. ValType(x[2]) == 'C'} ) if j > 0 ::Contents[j][2] := cString @@ -156,21 +178,24 @@ static procedure WriteString(cSection, cIdent, cString) ::Contents[1] := {cIdent, cString} endif - elseif (i := AScan( ::Contents, ; - {|x| x[1] == cSection .and. ValType(x[2]) == 'A'})) > 0 - j := AScan( ::Contents[i][2], {|x| x[1] == cIdent} ) + else + cFind := lower(cSection) + if (i := AScan( ::Contents, {|x| lower(x[1]) == cFind .and. ValType(x[2]) == 'A'})) > 0 + cFind := lower(cIdent) + j := AScan( ::Contents[i][2], {|x| lower(x[1]) == cFind} ) - if j > 0 - ::Contents[i][2][j][2] := cString + if j > 0 + ::Contents[i][2][j][2] := cString + + else + AAdd( ::Contents[i][2], {cIdent, cString} ) + endif else - AAdd( ::Contents[i][2], {cIdent, cString} ) + AAdd( ::Contents, {cSection, {{cIdent, cString}}} ) endif - - else - AAdd( ::Contents, {cSection, {{cIdent, cString}}} ) endif -return +return static function ReadNumber(cSection, cIdent, nDefault) local Self := QSelf() @@ -206,10 +231,14 @@ return static procedure DeleteKey(cSection, cIdent) local Self := QSelf() - local j, i := AScan( ::Contents, {|x| x[1] == cSection} ) + local i, j + cSection := lower(cSection) + i := AScan( ::Contents, {|x| lower(x[1]) == cSection} ) + if i > 0 - j := AScan( ::Contents[i][2], {|x| x[1] == cIdent} ) + cIdent := lower(cIdent) + j := AScan( ::Contents[i][2], {|x| lower(x[1]) == cIdent} ) ADel( ::Contents[i][2], j ) ASize( ::Contents[i][2], Len(::Contents[i][2]) - 1 ) @@ -221,12 +250,17 @@ static procedure EraseSection(cSection) local i if Empty(cSection) - outerr('Must specify a section') + while (i := AScan( ::Contents, {|x| valtype(x[1]) == 'C' .and. ValType(x[2]) == 'C'})) > 0 + ADel( ::Contents, i ) + ASize( ::Contents, len(::Contents) - 1 ) + end - elseif (i := AScan( ::Contents,; - {|x| x[1] == cSection .and. ValType(x[2]) == 'A'})) > 0 - ADel( ::Contents, i ) - ASize( ::Contents, Len(::Contents) - 1 ) + else + cSection := lower(cSection) + if (i := AScan( ::Contents, {|x| lower(x[1]) == cSection .and. ValType(x[2]) == 'A'})) > 0 + ADel( ::Contents, i ) + ASize( ::Contents, Len(::Contents) - 1 ) + endif endif return @@ -235,17 +269,23 @@ static function ReadSection(cSection) local i, j, aSection := {} if Empty(cSection) - outerr('Must specify a section') - - elseif (i := AScan( ::Contents, ; - {|x| x[1] == cSection .and. ValType(x[2]) == 'A'})) > 0 - - for j := 1 to Len(::Contents[i][2]) - - if ::Contents[i][2][j][1] <> NIL - AAdd(aSection, ::Contents[i][2][j][1]) + for i := 1 to len(::Contents) + if valtype(::Contents[i][1]) == 'C' .and. valtype(::Contents[i][2]) == 'C' + aadd(aSection, ::Contents[i][1]) endif next + + else + cSection := lower(cSection) + if (i := AScan( ::Contents, {|x| x[1] == cSection .and. ValType(x[2]) == 'A'})) > 0 + + for j := 1 to Len(::Contents[i][2]) + + if ::Contents[i][2][j][1] <> NIL + AAdd(aSection, ::Contents[i][2][j][1]) + endif + next + endif endif return aSection @@ -279,18 +319,15 @@ static procedure UpdateFile() fwrite(hFile, ::Contents[i][2][j][2] + Chr(13) + Chr(10)) else - fwrite(hFile, ::Contents[i][2][j][1] + '=' + ; - ::Contents[i][2][j][2] + Chr(13) + Chr(10)) + fwrite(hFile, ::Contents[i][2][j][1] + '=' + ::Contents[i][2][j][2] + Chr(13) + Chr(10)) endif next fwrite(hFile, Chr(13) + Chr(10)) elseif ValType(::Contents[i][2]) == 'C' - fwrite(hFile, ::Contents[i][1] + '=' + ::Contents[i][2] + ; - Chr(13) + Chr(10)) + fwrite(hFile, ::Contents[i][1] + '=' + ::Contents[i][2] + Chr(13) + Chr(10)) endif next fclose(hFile) return - diff --git a/harbour/tests/working/strsub.prg b/harbour/tests/working/strsub.prg new file mode 100644 index 0000000000..b251fe693b --- /dev/null +++ b/harbour/tests/working/strsub.prg @@ -0,0 +1,22 @@ + +// Testing strings concat + +function main() + + LOCAL a := "STRINGS " + LOCAL b := "CONCAT" + LOCAL c + LOCAL i + + for i := 1 to 3 + a += " " + c := a + c -= b + QOut( "[" + c + "]" ) + next + + QOut() + __Accept( "Press a key to raise an error!" ) + QOut( a - i ) + +return nil