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

2013-02-26 23:53 UTC+0100 Viktor Szakats (harbour syenar.net)

Browse Source 
* utils/hbmk2/hbmk2.prg
    + disable VM internals (__dbg*() API) on hbmk2/hbrun
      startup, unless built in debug mode
      Will break scripts that exploited VM internals
      via internal __dbg*() API calls.

  * tests/boxtest.prg
  * tests/regex.prg
  * tests/sbartest.prg
  * tests/mousetst.prg
  * contrib/hbodbc/tests/odbcdemo.prg
    ! fixed to not assume 80x25 screen layout

  * tests/regextst.prg
    ! fixed wrong error checking (RTE)

  * contrib/hbodbc/tests/odbcdemo.prg
    ! misc fixes/cleanups

  * tests/brwpos.prg
    ! fixed to use K_* values

  * website/menu/harbour-menu.js
    ! fixed missed reference to deleted license.html

  * contrib/hbodbc/todbc.prg
    * spaces
This commit is contained in:
Viktor Szakats
2013-02-26 22:54:47 +00:00
parent 175f05df56
commit 9494153d8b
11 changed files with 100 additions and 81 deletions
Download Patch File Download Diff File Expand all files Collapse all files

30
harbour/ChangeLog.txt
View File

@@ -10,6 +10,35 @@
* Change, ! Fix, % Optimization, + Addition, - Removal, ; Comment
*/
2013-02-26 23:53 UTC+0100 Viktor Szakats (harbour syenar.net)
* utils/hbmk2/hbmk2.prg
+ disable VM internals (__dbg*() API) on hbmk2/hbrun
startup, unless built in debug mode
Will break scripts that exploited VM internals
via internal __dbg*() API calls.
* tests/boxtest.prg
* tests/regex.prg
* tests/sbartest.prg
* tests/mousetst.prg
* contrib/hbodbc/tests/odbcdemo.prg
! fixed to not assume 80x25 screen layout
* tests/regextst.prg
! fixed wrong error checking (RTE)
* contrib/hbodbc/tests/odbcdemo.prg
! misc fixes/cleanups
* tests/brwpos.prg
! fixed to use K_* values
* website/menu/harbour-menu.js
! fixed missed reference to deleted license.html
* contrib/hbodbc/todbc.prg
* spaces
2013-02-26 14:41 UTC+0100 Viktor Szakats (harbour syenar.net)
* utils/hbmk2/hbmk2.*.po
* utils/hbmk2/hbmk2.prg
@@ -29,7 +58,6 @@
+ clarified in help that .hbp references are handled as
sub-projects
+ clarification to command substitution macro
+ clarification to filter syntax note
! strict parameter checks in all public shell APIs to
avoid RTEs inside hbmk2 due to faulty API usage by scripts

42
harbour/contrib/hbodbc/tests/odbcdemo.prg
View File

@@ -6,20 +6,18 @@
PROCEDURE Main()
LOCAL dsFunctions := TODBC():New( "DBQ=" + hb_FNameMerge( hb_DirBase(), "test.mdb" ) + ";Driver={Microsoft Access Driver (*.mdb)}" )
LOCAL aOrders
LOCAL nOp
LOCAL dsFunctions
LOCAL i
dsFunctions := TODBC():New( "DBQ=" + hb_FNameMerge( hb_DirBase(), "test.mdb" ) + ";Driver={Microsoft Access Driver (*.mdb)}" )
SET COLOR TO "W+/B"
CLS
DO WHILE .T.
@ 0, 0 SAY PadC( "- TODBC Demonstration -", 80 ) COLOR "B/W"
@ 0, 0 SAY PadC( "- TODBC Demonstration -", MaxCol() + 1 ) COLOR "B/W"
dsFunctions:SetSQL( "SELECT * FROM test" )
dsFunctions:Open()
@@ -28,10 +26,8 @@ PROCEDURE Main()
aOrders := {}
FOR i := 1 TO Len( dsFunctions:Fields )
AAdd( aOrders, dsFunctions:Fields[ i ] :FieldName )
AAdd( aOrders, dsFunctions:Fields[ i ]:FieldName )
@ i + 3, 25 PROMPT PadC( "ORDER BY " + aOrders[ i ], 30 )
NEXT
MENU TO nOp
@@ -45,34 +41,28 @@ PROCEDURE Main()
dsFunctions:SetSQL( "SELECT * FROM test ORDER BY " + aOrders[ nOp ] )
dsFunctions:Open()
FOR i := 11 TO 24
@ i, 0 SAY Replicate( " ", 80 )
NEXT
@ 10, 0 TO 10, 79
@ 24, 0 TO 24, 79
@ 12, 0 TO 12, 79
@ 11, 0 SAY ""
@ 11, 2 SAY "Statement:" COLOR "GR+/B"
@ 11, Col() + 1 SAY dsFunctions:cSQL
@ 14, 5 SAY " " + ;
PadR( dsFunctions:FieldByName( "First" ):FieldName, 3 ) + " " + ;
PadR( dsFunctions:FieldByName( "Last" ):FieldName, 15 ) + " " + ;
PadR( dsFunctions:FieldByName( "Street" ):FieldName, 2 ) + " " + ;
PadR( dsFunctions:FieldByName( "First" ):FieldName, 10 ) + " " + ;
PadR( dsFunctions:FieldByName( "Last" ):FieldName, 10 ) + " " + ;
PadR( dsFunctions:FieldByName( "Street" ):FieldName, 25 ) + " " + ;
PadR( dsFunctions:FieldByName( "City" ):FieldName, 40 ) ;
COLOR "B/W"
dsFunctions:Skip() /* TOFIX: To avoid first record to return NILs. bug in TODBC? */
DO WHILE ! dsFunctions:Eof()
? " " + ;
PadR( dsFunctions:FieldByName( "First" ):Value, 3 ), "|", ;
PadR( dsFunctions:FieldByName( "Last" ):Value, 15 ), "|", ;
PadR( dsFunctions:FieldByName( "Street" ):Value, 2 ), "|", ;
PadR( dsFunctions:FieldByName( "First" ):Value, 10 ), "|", ;
PadR( dsFunctions:FieldByName( "Last" ):Value, 10 ), "|", ;
PadR( dsFunctions:FieldByName( "Street" ):Value, 25 ), "|", ;
PadR( dsFunctions:FieldByName( "City" ):Value, 40 )
dsFunctions:Skip()
ENDDO
@ MaxRow(), 0
@ MaxRow(), 1 SAY "Statement:" COLOR "GR+/B"
@ MaxRow(), Col() + 1 SAY dsFunctions:cSQL
dsFunctions:Close()
ENDDO

8
harbour/contrib/hbodbc/todbc.prg
View File

@@ -169,8 +169,8 @@ METHOD New( cODBCStr, cUserName, cPassword, lCache ) CLASS TODBC
hb_default( @lCache, .T. )
::cODBCStr := cODBCStr
::lCacheRS := lCache
::cODBCStr := cODBCStr
::lCacheRS := lCache
// Allocates SQL Environment
IF ( nRet := SQLAllocEnv( @::hEnv ) ) != SQL_SUCCESS
@@ -178,7 +178,7 @@ METHOD New( cODBCStr, cUserName, cPassword, lCache ) CLASS TODBC
RETURN NIL
ENDIF
SQLAllocConnect( ::hEnv, @::hDbc ) // Allocates SQL Connection
SQLAllocConnect( ::hEnv, @::hDbc ) // Allocates SQL Connection
IF HB_ISSTRING( cUserName )
@@ -467,7 +467,7 @@ METHOD Fetch( nFetchType, nOffset ) CLASS TODBC
EXIT
CASE SQL_FETCH_ABSOLUTE
IF nOffset > ::nRecCount .OR. nOffset < 1 // TODO: Should we go to the first/last row if out of bounds?
IF nOffset > ::nRecCount .OR. nOffset < 1 // TODO: Should we go to the first/last row if out of bounds?
nResult := SQL_ERROR
ELSE
nResult := SQL_SUCCESS

6
harbour/tests/boxtest.prg
View File

@@ -6,8 +6,8 @@ PROCEDURE Main()
CLS
@ 0, 0, 15, 50 BOX " " COLOR "W+/B"
MESSAGE( '@ 0, 0, 15, 50 BOX " " COLOR "W+/B"' )
@ 0, 0, 15, MaxCol() BOX " " COLOR "W+/B"
MESSAGE( '@ 0, 0, 15, MaxCol() BOX " " COLOR "W+/B"' )
__Box( 1, 1, 5, 7 )
MESSAGE( '__Box( 1, 1, 5, 7 )' )
@@ -25,7 +25,7 @@ PROCEDURE Main()
PROCEDURE MESSAGE( cText )
@ 16, 0 CLEAR TO 16, 79
@ 16, 0 CLEAR TO 16, MaxCol()
@ 16, 0 SAY cText
OutStd( Chr( 7 ) )
Inkey( 0 )

31
harbour/tests/brwpos.prg
View File

@@ -2,7 +2,7 @@
* $Id$
*/
/* TEST BROWSE ROWPOS FOR COMPILER IN CLIPPER AND HARBOUR */
/* Test TBrowse :rowPos for compiler in Clipper and Harbour */
#include "inkey.ch"
@@ -15,8 +15,8 @@ PROCEDURE Main()
LOCAL nRow := 1
CLS
@ 0, 4 SAY "Is current RecNo but not repositioned until FixPos .T. <F2> Change FixPos"
@ MaxRow(), 1 SAY "Please press <Intro> to select or <Esc> to exit and <F2> to FixPos is "
@ 0, 4 SAY "Is current RecNo but not repositioned until FixPos .T. <F2> Change FixPos"
@ MaxRow(), 1 SAY "Please press <Enter> to select or <Esc> to exit and <F2> to FixPos is"
WHILE LastKey() != K_ESC
@ 0, 0 SAY s_nRecNo PICTURE "###"
@ MaxRow(), 68 SAY iif( s_lFixPos, ".T.", ".F." )
@@ -42,29 +42,28 @@ FUNCTION TestBrw( nRowIni )
oBrw:rowPos := nRowIni
WHILE .T.
WHILE ! oBrw:stabilize()
ENDDO
oBrw:forceStable()
nKey := Inkey( 0 )
IF nKey == 27 .OR. nKey == 13
IF nKey == K_ESC .OR. nKey == K_ENTER
EXIT
ELSEIF nKey == -1
s_lFixPos := iif( s_lFixPos, .F., .T. )
ELSEIF nKey == K_F2
s_lFixPos := ! s_lFixPos
EXIT
ELSEIF nKey == 24
ELSEIF nKey == K_DOWN
oBrw:Down()
ELSEIF nKey == 5
ELSEIF nKey == K_UP
oBrw:Up()
ELSEIF nKey == 3
ELSEIF nKey == K_PGDN
oBrw:pageDown()
ELSEIF nKey == 18
ELSEIF nKey == K_PGUP
oBrw:pageUp()
ELSEIF nKey == 29 .OR. nKey == 31
ELSEIF nKey == K_CTRL_HOME .OR. nKey == K_CTRL_PGUP
oBrw:goTop()
ELSEIF nKey == 23 .OR. nKey == 30
ELSEIF nKey == K_CTRL_END .OR. nKey == K_CTRL_PGDN
oBrw:goBottom()
ELSEIF nKey == 1
ELSEIF nKey == K_HOME
oBrw:rowPos := 1
ELSEIF nKey == 6
ELSEIF nKey == K_END
oBrw:rowPos := s_nLastRec
ENDIF
ENDDO

33
harbour/tests/mousetst.prg
View File

@@ -26,14 +26,14 @@ PROCEDURE Main()
@ MaxRow() - 1, 2 SAY "Y:"
@ MaxRow() - 1, 10 SAY "X:"
@ nR, 2 SAY "Mouse Type : "
@ nR, 2 SAY "Mouse Type :"
@ nR, 18 SAY "Mouse System"
@ MaxRow() - 2, 68 TO MaxRow(), MaxCol() DOUBLE
@ MaxRow() - 1, 70 SAY "Exit"
@ 10, 2 SAY " -- Checkings -- "
@ 10, 2 SAY " -- Checkings --"
@ 11, 2 SAY "Window Boundaries :"
@ 12, 2 SAY "Press/Release But.:"
@ 13, 2 SAY "Double Click Left :"
@@ -43,7 +43,7 @@ PROCEDURE Main()
TEST2( nR, nC )
@ 24, 0 SAY ""
SetPos( MaxRow(), 0 )
SET CURSOR ON
?
@@ -100,7 +100,6 @@ PROCEDURE TEST1()
ENDIF
ENDDO
@ MaxRow() - 3, 25 SAY "Move the cursor until the LEFT side "
DO WHILE ( nKey := Inkey( 0, INKEY_ALL ) ) != K_TAB
@@ -113,7 +112,6 @@ PROCEDURE TEST1()
ENDIF
ENDDO
@ MaxRow() - 3, 25 SAY "Move the cursor until the RIGHT side "
DO WHILE ( nKey := Inkey( 0, INKEY_ALL ) ) != K_TAB
@@ -137,17 +135,18 @@ PROCEDURE TEST2( nR, nC )
LOCAL cSkip := "", nKey, nPress := 0
@ nR + 0, nC SAY "+---------|---------+"
@ nR + 1, nC SAY "| +===+ +===+ +===+ |"
@ nR + 2, nC SAY "| | | | | | | |"
@ nR + 3, nC SAY "| | | | | | | |"
@ nR + 4, nC SAY "| +===+ +===+ +===+ |"
@ nR + 6, nC SAY "| Up Up Up |"
@ nR + 7, nC SAY "| |"
@ nR + 8, nC SAY "| |"
@ nR + 9, nC SAY "| Harbour |"
@ nR + 10, nC SAY "| mouse |"
@ nR + 11, nC SAY "+-------------------+"
@ nR + 0, nC SAY "+---------|---------+"
@ nR + 1, nC SAY "| +===+ +===+ +===+ |"
@ nR + 2, nC SAY "| | | | | | | |"
@ nR + 3, nC SAY "| | | | | | | |"
@ nR + 4, nC SAY "| +===+ +===+ +===+ |"
@ nR + 5, nC SAY "| |"
@ nR + 6, nC SAY "| Up Up Up |"
@ nR + 7, nC SAY "| |"
@ nR + 8, nC SAY "| |"
@ nR + 9, nC SAY "| Harbour |"
@ nR + 10, nC SAY "| mouse |"
@ nR + 11, nC SAY "+-------------------+"
Set( _SET_EVENTMASK, INKEY_ALL )
@@ -220,7 +219,7 @@ PROCEDURE TEST2( nR, nC )
@ 14, 22 SAY "Pass"
OTHERWISE
@ MaxRow(), 20 SAY "A keyboard key was pressed: "
@ MaxRow(), 20 SAY "A keyboard key was pressed:"
@ MaxRow(), 48 SAY nKey
#ifdef __HARBOUR__
@ MaxRow(), 58 SAY hb_keyChar( nKey )

6
harbour/tests/regex.prg
View File

@@ -83,8 +83,8 @@ PROCEDURE Main()
nRow++
ENDIF
cStr := "Test for RegexAtx"
@ nRow, 5 SAY "RegexAtx test; scanning '" + cStr + "' by 'Reg(.x)'"
cStr := "Test for RegexAtX()"
@ nRow, 5 SAY "RegexAtX() test; scanning '" + cStr + "' by 'Reg(.x)'"
nRow++
aMatch := hb_regexAtX( "Reg(.x)", cStr )
IF Empty( aMatch )
@@ -100,7 +100,7 @@ PROCEDURE Main()
ENDIF
@ nRow, 1
@ 24, 25 SAY "Press a key to continue"
@ MaxRow(), 25 SAY "Press a key to continue"
Inkey( 0 )
RETURN

11
harbour/tests/regextst.prg
View File

@@ -13,7 +13,7 @@ PROCEDURE Main()
LOCAL pCompiled
LOCAL cRegex
LOCAL cSentence
LOCAL nRow, oErr
LOCAL nRow
LOCAL aMatch, cMatch
LOCAL GetList := {}
@@ -36,14 +36,13 @@ PROCEDURE Main()
READ
IF LastKey() != K_ESC
@ 12, 5 CLEAR TO 24, 79
@ 12, 5 CLEAR TO MaxRow(), MaxCol()
BEGIN SEQUENCE WITH {| oErr | Break( oErr ) }
pCompiled := hb_regexComp( RTrim( cRegex ) )
RECOVER USING oErr
pCompiled := hb_regexComp( RTrim( cRegex ) )
IF Empty( pCompiled )
@ 12, 5 SAY "Invalid REGEX expression"
LOOP
END SEQUENCE
ENDIF
aMatch := hb_regex( pCompiled, RTrim( cSentence ) )
IF aMatch != NIL

8
harbour/tests/sbartest.prg
View File

@@ -41,9 +41,9 @@ FUNCTION InitScrlBar()
CLS
SetBlink( .F. )
#ifdef __HARBOUR__
@ 0, 0, 24, 79 BOX Replicate( hb_UTF8ToStrBox( "▓" ), 9 ) COLOR "GR+/W*"
@ 0, 0, MaxRow(), MaxCol() BOX Replicate( hb_UTF8ToStrBox( "▓" ), 9 ) COLOR "GR+/W*"
#else
@ 0, 0, 24, 79 BOX Replicate( Chr( 178 ), 9 ) COLOR "GR+/W*"
@ 0, 0, MaxRow(), MaxCol() BOX Replicate( Chr( 178 ), 9 ) COLOR "GR+/W*"
#endif
@ 4, 28 SAY " Directory " COLOR "W+/B"
@ 5, 28, 15, 60 BOX B_THIN + " " COLOR "W/W*"
@@ -66,9 +66,9 @@ FUNCTION InitScrlBar()
i := AChoice( 6, 29, 14, 59, aFileList, , {| modo | updateFilesScroll( modo, aFileList, filesScroll ) } )
@ 23, 0 SAY iif( i < 1, "", aFileList[ i ] ) COLOR "N/W*"
@ MaxRow() - 1, 0 SAY iif( i < 1, "", aFileList[ i ] ) COLOR "N/W*"
SET COLOR TO
@ 24, 0
@ MaxRow(), 0
RETURN 0

4
harbour/utils/hbmk2/hbmk2.prg
View File

@@ -673,6 +673,10 @@ STATIC PROCEDURE hbmk_local_entry( ... )
LOCAL cParam1L
#if ! __pragma( b )
__vmNoInternals() /* disable access to VM internals */
#endif
/* for temp debug messages */
Set( _SET_DATEFORMAT, "yyyy.mm.dd" )

2
harbour/website/menu/harbour-menu.js
View File

@@ -6,7 +6,7 @@ stm_aix("p0i2","p0i0",[2,"","","",20]);
stm_aix("p0i3","p0i1",[2,"","about.png","about.png",38,65,0,"/about.html","_self","","","","",0,0,0,"","",-1,-1]);
stm_bp("p1",[1,4,0,-3,2,0,0,0,100,"",-2,"",-2,50,0,0,"#999999","#E6EFF9","",3,1,1,"#b0c4d7"]);
stm_aix("p1i0","p0i0",[0," About Harbour ","","",-1,-1,0,"/about.html","_self","","","","",0,0,0,"","",0,0,0,0,1,"#E6EFF9",1,"#FFFFFF",0,"","",3,3,1,1,"#E6EFF9","#CCCCCC","#000000","#000000","bold 8pt Verdana","bold 8pt Verdana"]);
stm_aix("p1i1","p1i0",[0," License ","","",-1,-1,0,"/license.html"]);
stm_aix("p1i1","p1i0",[0," License ","","",-1,-1,0,"http://harbour-project.svn.sourceforge.net/svnroot/harbour-project/trunk/harbour/COPYING.txt"]);
stm_ep();
stm_aix("p0i4","p0i2",[]);
stm_aix("p0i5","p0i1",[2,"","documentation.png","documentation.png",90,65,0,"/doc/harbour.html","_self","","","","",0,0,0,"","",-1,-1,0,0,1,"#E6EFF9",1,"#FFD602"]);