2009-10-06 14:07 UTC+0200 Przemyslaw Czerpak (druzus/at/priv.onet.pl)

+ harbour/tests/cpinfo.prg
    * modified to show more precise information about code page definition

harbour/ChangeLog

@@ -17,6 +17,10 @@
    past entries belonging to author(s): Viktor Szakats.
 */
 
+2009-10-06 14:07 UTC+0200 Przemyslaw Czerpak (druzus/at/priv.onet.pl)
+  + harbour/tests/cpinfo.prg
+    * modified to show more precise information about code page definition
+
 2009-10-06 11:16 UTC+0200 Przemyslaw Czerpak (druzus/at/priv.onet.pl)
   + harbour/tests/cpinfo.prg
     + added  simple program to generate information for Harbour CP module

harbour/tests/cpinfo.prg

@@ -17,11 +17,17 @@
 
 
 proc main()
-   local cLo, cUp, c, cl, cu, i, a, lWarn
+   local cUp, cLo, cOrd, cOrd2, c, i, a, lWarn
 
    set alternate to cpinfo.txt additive
    set alternate on
 
+#ifdef __HARBOUR__
+   /* for test */
+   REQUEST HB_CODEPAGE_PLMAZ
+   set( _SET_CODEPAGE, "PLMAZ" )
+#endif
+
    a := array( 256 )
    for i := 1 to len( a )
       a[ i ] := i - 1
@@ -29,8 +35,12 @@ proc main()
    asort( a,,, { |x,y| chr( x ) + chr( 0 ) < chr( y ) + chr( 0 ) } )
 
    ? date(), time(), os(), version()
-   ? "Character encoding:"
-   ? "==================="
+#ifdef __HARBOUR__
+   ? "Character encoding: " + Set( _SET_CODEPAGE )
+#else
+   ? "Character encoding: " + _natSortVersion()
+#endif
+   ? repl( "=", 50 )
    lWarn := .t.
    for i := 1 to len( a ) - 1
       if a[ i ] > a[ i + 1 ]
@@ -42,7 +52,7 @@ proc main()
       ? "simple byte sorting !!!"
       lWarn := .f.
    endif
-   cLo := cUp := ""
+   cUp := cLo := cOrd := ""
    for i := 1 to len( a )
       if i < len(a) .and. a[i] > a[ i + 1 ] .and. !isalpha( chr( a[ i ] ) )
          ? "non alpha character " + charval( chr( a[ i ] ) ) + ;
@@ -50,24 +60,41 @@ proc main()
          lWarn := .t.
       endif
       c := chr( a[ i ] )
+      cOrd += c
+      if isdigit( c )
+         if asc( c ) < asc( "0" ) .or. asc( c ) > asc( "9" )
+            ? "character " + charis( c ) + " defined as digit"
+            lWarn := .t.
+         endif
+      elseif asc( c ) >= asc( "0" ) .and. asc( c ) <= asc( "9" )
+         ? "character " + charis( c ) + " is not defined as digit"
+         lWarn := .t.
+      endif
       if isalpha( c )
-         cl := lower( c )
-         cu := upper( c )
-         cLo += cl
-         cUp += cu
-         if cl == cu
-            ? "upper " + charval( cu ) + " and lower " + charval( cl ) + ;
-              " equal"
-            lWarn := .t.
-         elseif !isalpha( cl )
-            ? "wrongly defined character " + ;
-              charval( c ) + ":" + charinfo( c ) + ;
-              ", lower " + charval( cl ) + ":" + charinfo( cl )
-            lWarn := .t.
-         elseif !isalpha( cu )
-            ? "wrongly defined character " + ;
-              charval( c ) + ":" + charinfo( c ) + ;
-              ", upper " + charval( cu ) + ":" + charinfo( cu )
+         if isupper( c )
+            cUp += c
+            if islower( c )
+               ? "character " + charis( c ) + " defined as upper and lower"
+               lWarn := .t.
+            endif
+            if lower( c ) == c
+               ? "character " + charis( c ) + ;
+                 " is the same as upper and lower"
+               lWarn := .t.
+            endif
+         elseif islower( c )
+            cLo += c
+            if isupper( c )
+               ? "character " + charis( c ) + " defined as upper and lower"
+               lWarn := .t.
+            endif
+            if upper( c ) == c
+               ? "character " + charis( c ) + ;
+                 " is the same as upper and lower"
+               lWarn := .t.
+            endif
+         else
+            ? "character " + charis( c ) + " not defined as upper or lower"
             lWarn := .t.
          endif
       elseif islower( c ) .or. isupper( c )
@@ -76,21 +103,49 @@ proc main()
          lWarn := .t.
       endif
    next
+   cOrd2 := ""
+   for i := 0 to 255
+      if i == asc( cUp )
+         cOrd2 += cUp
+      elseif i == asc( cLo )
+         cOrd2 += cLo
+      endif
+      c := chr( i )
+      if ! c $ cUp + cLo
+         cOrd2 += chr( i )
+      endif
+   next
+   if ! len( cUp ) == len( cLo )
+      ? "number of upper and lower characters is different"
+      lWarn := .t.
+   endif
+   if ! cOrd == cOrd2
+      ? "letters are not sorted continuously"
+      lWarn := .t.
+   endif
    if lWarn
       ? "Warning: irregular CP which needs special definition in Harbour"
    endif
    ? 'upper: "' + cUp + '"'
    ? 'lower: "' + cLo + '"'
-   ? "==================="
+   ? repl( "=", 50 )
    ?
 return
 
 static function charval( c )
 return "'" + c + "' (" + ltrim( str( asc( c ) ) ) + ")"
 
+static function charis( c )
+return "'" + c + "' (" + ltrim( str( asc( c ) ) ) + ":" + ;
+       iif( isalpha( c ), "A", " " ) + ;
+       iif( isupper( c ), "U", " " ) + ;
+       iif( islower( c ), "L", " " ) + ;
+       iif( isdigit( c ), "D", " " ) + ")"
+
 static function charinfo( c )
    local cInfo
    cInfo :=   "ISALPHA->" + iif( isalpha( c ), "Y", "N" )
    cInfo += ", ISUPPER->" + iif( isupper( c ), "Y", "N" )
    cInfo += ", ISLOWER->" + iif( islower( c ), "Y", "N" )
+   cInfo += ", ISDIGIT->" + iif( isdigit( c ), "Y", "N" )
 return cInfo