2009-11-10 13:34 UTC+0100 Przemyslaw Czerpak (druzus/at/priv.onet.pl)

* harbour/tests/cpinfo.prg + added additional information that binary tables generated by cpinfo.prg have to be used instead of human readable form when such situation can be easy detected * harbour/src/codepage/cpsvclip.c * replaced old definition with binary tables generated by cpinfo.prg to fully replicate wrong Clipper NTXSWE.OBJ definition.
2009-11-10 12:34:49 +00:00
parent e607a388df
commit 24e09f396f
3 changed files with 78 additions and 15 deletions
--- a/harbour/ChangeLog
+++ b/harbour/ChangeLog
@@ -17,6 +17,16 @@
   past entries belonging to author(s): Viktor Szakats.
 */

+2009-11-10 13:34 UTC+0100 Przemyslaw Czerpak (druzus/at/priv.onet.pl)
+  * harbour/tests/cpinfo.prg
+    + added additional information that binary tables generated by cpinfo.prg
+      have to be used instead of human readable form when such situation can
+      be easy detected
+
+  * harbour/src/codepage/cpsvclip.c
+    * replaced old definition with binary tables generated by cpinfo.prg
+      to fully replicate wrong Clipper NTXSWE.OBJ definition.
+
 2009-11-10 13:00 UTC+0200 Mindaugas Kavaliauskas (dbtopas/at/dbtopas.lt)
  * harbour/src/rtl/cdpapi.c
    * removed unnecessary assignment to pacify BCC warning
--- a/harbour/src/codepage/cpsvclip.c
+++ b/harbour/src/codepage/cpsvclip.c
@@ -76,12 +76,48 @@
   not be Clipper compatible.
 */

+/* NOTE2: due to above conditions human readable form of SVCLIP definition
+          has been replaced with binary tables generated by tests/cpinfo.prg
+          compiled by Clipper and linked with NTXSWE.OBJ so now SVCLIP is
+          _fully_ Clipper compatible and should be used when data is shared
+          between Clipper and Harbour applications.
+ */
+
+/*
 #define HB_CP_ID        SVCLIP
 #define HB_CP_INFO      "Swedish CP-437"
 #define HB_CP_UNITB     HB_UNITB_437
 #define HB_CP_ACSORT    HB_CDP_ACSORT_NONE
 #define HB_CP_UPPER     "ABCDE<44>FGHIJKLMNOPQRSTUVWXYšZ<C5A1>Ž™"
 #define HB_CP_LOWER     "abcdeŠfghijklmnopqrstuvwxy<78>z†„”"
+*/
+
+#include "hbapicdp.h"
+
+#define HB_CP_RAW       &s_codePage
+
+static const unsigned char s_flags[ 256 ] = { 0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,1,1,1,1,1,1,1,1,1,1,0,0,0,0,0,0,0,10,10,10,10,10,10,10,10,10,10,10,10,10,10,10,10,10,10,10,10,10,10,10,10,10,10,0,0,0,0,0,0,6,6,6,6,6,6,6,6,6,6,6,6,6,6,6,6,6,6,6,6,6,6,6,6,6,6,0,0,0,0,0,0,6,0,0,6,0,6,0,0,0,6,0,0,0,10,10,10,0,0,0,6,0,0,0,0,10,10,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0 };
+static const unsigned char s_upper[ 256 ] = { 0,1,2,3,4,5,6,7,8,9,10,11,12,13,14,15,16,17,18,19,20,21,22,23,24,25,26,27,28,29,30,31,32,33,34,35,36,37,38,39,40,41,42,43,44,45,46,47,48,49,50,51,52,53,54,55,56,57,58,59,60,61,62,63,64,65,66,67,68,69,70,71,72,73,74,75,76,77,78,79,80,81,82,83,84,85,86,87,88,89,90,91,92,93,94,95,96,65,66,67,68,69,70,71,72,73,74,75,76,77,78,79,80,81,82,83,84,85,86,87,88,89,90,123,124,125,126,127,128,154,130,131,142,133,143,135,136,137,144,139,140,141,142,143,144,145,146,147,153,149,150,151,152,153,154,155,156,157,158,159,160,161,162,163,164,165,166,167,168,169,170,171,172,173,174,175,176,177,178,179,180,181,182,183,184,185,186,187,188,189,190,191,192,193,194,195,196,197,198,199,200,201,202,203,204,205,206,207,208,209,210,211,212,213,214,215,216,217,218,219,220,221,222,223,224,225,226,227,228,229,230,231,232,233,234,235,236,237,238,239,240,241,242,243,244,245,246,247,248,249,250,251,252,253,254,255 };
+static const unsigned char s_lower[ 256 ] = { 0,1,2,3,4,5,6,7,8,9,10,11,12,13,14,15,16,17,18,19,20,21,22,23,24,25,26,27,28,29,30,31,32,33,34,35,36,37,38,39,40,41,42,43,44,45,46,47,48,49,50,51,52,53,54,55,56,57,58,59,60,61,62,63,64,97,98,99,100,101,102,103,104,105,106,107,108,109,110,111,112,113,114,115,116,117,118,119,120,121,122,91,92,93,94,95,96,97,98,99,100,101,102,103,104,105,106,107,108,109,110,111,112,113,114,115,116,117,118,119,120,121,122,123,124,125,126,127,128,129,130,131,132,133,134,135,136,137,138,139,140,141,132,134,130,145,146,147,148,149,150,151,152,148,129,155,156,157,158,159,160,161,162,163,164,165,166,167,168,169,170,171,172,173,174,175,176,177,178,179,180,181,182,183,184,185,186,187,188,189,190,191,192,193,194,195,196,197,198,199,200,201,202,203,204,205,206,207,208,209,210,211,212,213,214,215,216,217,218,219,220,221,222,223,224,225,226,227,228,229,230,231,232,233,234,235,236,237,238,239,240,241,242,243,244,245,246,247,248,249,250,251,252,253,254,255 };
+static const unsigned char s_sort [ 256 ] = { 0,1,2,3,4,5,6,7,8,9,10,11,12,13,14,15,16,17,18,19,20,21,22,23,24,25,26,27,28,29,30,31,32,33,34,35,36,37,38,39,40,41,42,43,44,45,46,47,48,49,50,51,52,53,54,55,56,57,58,59,60,61,62,63,64,65,66,67,68,69,71,72,73,74,75,76,77,78,79,80,81,82,83,84,85,86,87,88,89,90,92,96,97,98,99,100,101,102,103,104,105,106,108,109,110,111,112,113,114,115,116,117,118,119,120,121,122,123,124,125,126,127,129,133,134,135,136,137,138,128,139,140,131,141,130,142,145,146,107,147,148,149,94,93,70,144,143,150,132,151,152,153,154,95,91,155,156,157,158,159,160,161,162,163,164,165,166,167,168,169,170,171,172,173,174,175,176,177,178,179,180,181,182,183,184,185,186,187,188,189,190,191,192,193,194,195,196,197,198,199,200,201,202,203,204,205,206,207,208,209,210,211,212,213,214,215,216,217,218,219,220,221,222,223,224,225,226,227,228,229,230,231,232,233,234,235,236,237,238,239,240,241,242,243,244,245,246,247,248,249,250,251,252,253,254,255 };
+
+static HB_CODEPAGE s_codePage =
+{
+   "SVCLIP",
+   "Swedish CP-437 (ntxswe.obj compatible)",
+   HB_UNITB_437,
+   s_flags,
+   s_upper,
+   s_lower,
+   s_sort,
+   NULL,
+   0,
+   0,
+   0,
+   NULL,
+   NULL,
+   NULL,
+};

 /* include CP registration code */
 #include "hbcdpreg.h"
--- a/harbour/tests/cpinfo.prg
+++ b/harbour/tests/cpinfo.prg
@@ -17,7 +17,7 @@


 proc main( cdp, info, unicode )
-   local cUp, cLo, cOrd, cOrd2, c, i, a, lWarn, lEqual
+   local cUp, cLo, cOrd, cOrd2, c, i, a, lWarn, lBin, lEqual

   set alternate to cpinfo.txt additive
   set alternate on
@@ -48,17 +48,17 @@ proc main( cdp, info, unicode )
   ? "Character encoding: " + _natSortVersion()
 #endif
   ? repl( "=", 50 )
-   lWarn := .t.
+   lBin := .t.
   for i := 1 to len( a ) - 1
      if a[ i ] > a[ i + 1 ]
-         lWarn := .f.
+         lBin := .f.
         exit
      endif
   next
-   if lWarn
+   if lBin
      ? "simple byte sorting !!!"
-      lWarn := .f.
   endif
+   lBin := lWarn := .f.
   cUp := cLo := cOrd := ""
   for i := 1 to len( a )
      if i < len(a) .and. a[i] > a[ i + 1 ] .and. !isalpha( chr( a[ i ] ) )
@@ -70,7 +70,7 @@ proc main( cdp, info, unicode )
      if i < len(a)
         if c + chr( 0 ) > chr( a[ i + 1 ] ) + chr( 0 )
            ? "character " + charis( c ) + " is wrongly sorted"
-            lWarn := .t.
+            lBin := lWarn := .t.
         elseif !lEqual .and. c + chr( 0 ) = chr( a[ i + 1 ] ) + chr( 0 )
            ? "character " + charis( c ) + " and " + chr( a[ i + 1 ] ) + ;
              " have the same weight"
@@ -81,11 +81,11 @@ proc main( cdp, info, unicode )
      if isdigit( c )
         if asc( c ) < asc( "0" ) .or. asc( c ) > asc( "9" )
            ? "character " + charis( c ) + " defined as digit"
-            lWarn := .t.
+            lBin := lWarn := .t.
         endif
      elseif asc( c ) >= asc( "0" ) .and. asc( c ) <= asc( "9" )
         ? "character " + charis( c ) + " is not defined as digit"
-         lWarn := .t.
+         lBin := lWarn := .t.
      endif
      if isalpha( c )
         if isupper( c )
@@ -98,6 +98,11 @@ proc main( cdp, info, unicode )
               ? "character " + charis( c ) + ;
                 " is the same as upper and lower"
               lWarn := .t.
+            elseif !islower( lower( c ) )
+               ? "character " + charis( c ) + ;
+                 " has lower character " + charis( lower( c ) ) + ;
+                 " not marked as lower"
+               lBin := lWarn := .t.
            endif
         elseif islower( c )
            cLo += c
@@ -109,22 +114,31 @@ proc main( cdp, info, unicode )
               ? "character " + charis( c ) + ;
                 " is the same as upper and lower"
               lWarn := .t.
+            elseif !isupper( upper( c ) )
+               ? "character " + charis( c ) + ;
+                 " has upper character " + charis( upper( c ) ) + ;
+                 " not marked as upper"
+               lBin := lWarn := .t.
            endif
         else
            ? "character " + charis( c ) + " not defined as upper or lower"
-            lWarn := .t.
+            lBin := lWarn := .t.
         endif
      else
         if islower( c ) .or. isupper( c )
            ? "wrongly defined character " + ;
              charval( c ) + ":" + charinfo( c )
-            lWarn := .t.
+            lBin := lWarn := .t.
         endif
-         if ! lower( c ) == upper( c )
-            ? "non alpha character has corresponding " + ;
-              iif( c == lower( c ), "upper", "lower" ) + " character " + ;
-              charval( c ) + ":" + charinfo( c )
-            lWarn := .t.
+         if ! c == lower( c )
+            ? "non alpha character " + charis( c ) + " has corresponding " + ;
+              "lower character " + charis( lower( c ) )
+            lBin := lWarn := .t.
+         endif
+         if ! c == upper( c )
+            ? "non alpha character " + charis( c ) + " has corresponding " + ;
+              "upper character " + charis( upper( c ) )
+            lBin := lWarn := .t.
         endif
      endif
   next
@@ -164,6 +178,9 @@ proc main( cdp, info, unicode )
   endif
   if lWarn
      ? "Warning: irregular CP which needs special definition in Harbour"
+      if lBin
+         ? "         using binary tables generated by this program"
+      endif
   endif
   ? '      upper: "' + cUp + '"'
   ? '      lower: "' + cLo + '"'