Browse Source

* support for non-ASCII widechar constants (mantis #31605)
* also improved type checking for converting constant strings to integers
in MacPas mode

git-svn-id: trunk@38730 -

Jonas Maebe 7 years ago
parent
commit
1f9d518c57
4 changed files with 44 additions and 2 deletions
  1. 1 0
      .gitattributes
  2. 3 1
      compiler/defcmp.pas
  3. 10 1
      compiler/ncnv.pas
  4. 30 0
      tests/webtbs/tw31605.pp

+ 1 - 0
.gitattributes

@@ -15997,6 +15997,7 @@ tests/webtbs/tw31521.pp svneol=native#text/pascal
 tests/webtbs/tw3157.pp svneol=native#text/plain
 tests/webtbs/tw3157.pp svneol=native#text/plain
 tests/webtbs/tw31589.pp svneol=native#text/pascal
 tests/webtbs/tw31589.pp svneol=native#text/pascal
 tests/webtbs/tw31596.pp svneol=native#text/pascal
 tests/webtbs/tw31596.pp svneol=native#text/pascal
+tests/webtbs/tw31605.pp svneol=native#text/plain
 tests/webtbs/tw3160a.pp svneol=native#text/plain
 tests/webtbs/tw3160a.pp svneol=native#text/plain
 tests/webtbs/tw3160b.pp svneol=native#text/plain
 tests/webtbs/tw3160b.pp svneol=native#text/plain
 tests/webtbs/tw3160c.pp svneol=native#text/plain
 tests/webtbs/tw3160c.pp svneol=native#text/plain

+ 3 - 1
compiler/defcmp.pas

@@ -491,7 +491,9 @@ implementation
                    end;
                    end;
                  arraydef :
                  arraydef :
                    begin
                    begin
-                     if (m_mac in current_settings.modeswitches) and
+                     if (((m_mac in current_settings.modeswitches) and
+                          is_integer(def_to)) or
+                         is_widechar(def_to)) and
                         (fromtreetype=stringconstn) then
                         (fromtreetype=stringconstn) then
                        begin
                        begin
                          eq:=te_convert_l3;
                          eq:=te_convert_l3;

+ 10 - 1
compiler/ncnv.pas

@@ -1624,12 +1624,21 @@ implementation
          result:=nil;
          result:=nil;
          if left.nodetype<>stringconstn then
          if left.nodetype<>stringconstn then
            internalerror(200510012);
            internalerror(200510012);
-         if tstringconstnode(left).len=4 then
+         if (m_mac in current_settings.modeswitches) and
+            is_integer(resultdef) and
+            (tstringconstnode(left).cst_type=cst_conststring) and
+            (tstringconstnode(left).len=4) then
            begin
            begin
              pb:=pbyte(tstringconstnode(left).value_str);
              pb:=pbyte(tstringconstnode(left).value_str);
              fcc:=(pb[0] shl 24) or (pb[1] shl 16) or (pb[2] shl 8) or pb[3];
              fcc:=(pb[0] shl 24) or (pb[1] shl 16) or (pb[2] shl 8) or pb[3];
              result:=cordconstnode.create(fcc,u32inttype,false);
              result:=cordconstnode.create(fcc,u32inttype,false);
            end
            end
+         else if is_widechar(resultdef) and
+            (tstringconstnode(left).cst_type=cst_unicodestring) and
+            (pcompilerwidestring(tstringconstnode(left).value_str)^.len=1) then
+           begin
+             result:=cordconstnode.create(pcompilerwidestring(tstringconstnode(left).value_str)^.data[0], resultdef, false);
+           end
          else
          else
            CGMessage2(type_e_illegal_type_conversion,left.resultdef.typename,resultdef.typename);
            CGMessage2(type_e_illegal_type_conversion,left.resultdef.typename,resultdef.typename);
       end;
       end;

+ 30 - 0
tests/webtbs/tw31605.pp

@@ -0,0 +1,30 @@
+{$codepage utf-8}
+
+const
+  engChar: WideChar = 'r'; // OK
+  rusChar1: WideChar = 'ё'; // Error
+  rusChar2: WideChar = WideChar('ё'); // Error
+  eng: array[0..2] of WideChar = ('u', 'R', 'z'); // OK
+  rus1: array[0..2] of WideChar = ('ё', 'м', 'я'); // Error
+  rus2: array[0..2] of WideChar = (WideChar('ё'), WideChar('м'), WideChar('я')); // Error
+
+  w: unicodestring = 'ёмя';
+
+begin
+  if rusChar1<>w[1] then
+    halt(1);
+
+if rus1[0]<>w[1] then
+    halt(2);
+  if rus1[1]<>w[2] then
+    halt(3);
+  if rus1[2]<>w[3] then
+    halt(4);
+
+  if rus2[0]<>w[1] then
+    halt(5);
+  if rus2[1]<>w[2] then
+    halt(6);
+  if rus2[2]<>w[3] then
+    halt(7);
+end.