From a93942cd272eb048590c7e0ad3a373067853c4da Mon Sep 17 00:00:00 2001
From: Sven/Sarah Barth <pascaldragon@gmail.com>
Date: Sun, 28 Aug 2022 21:39:10 +0200
Subject: [PATCH] * correctly convert a single WideChar to a PChar constant
 with the correct code page + added test

---
 compiler/ngtcon.pas | 16 +++++++++++++---
 tests/tbs/tb0696.pp | 21 +++++++++++++++++++++
 2 files changed, 34 insertions(+), 3 deletions(-)
 create mode 100644 tests/tbs/tb0696.pp

diff --git a/compiler/ngtcon.pas b/compiler/ngtcon.pas
index 49210007fe..18edb80953 100644
--- a/compiler/ngtcon.pas
+++ b/compiler/ngtcon.pas
@@ -149,7 +149,7 @@ uses
    symtable,
    defutil,defcmp,
    { pass 1 }
-   htypechk,procinfo,
+   htypechk,procinfo,pass_1,
    nmem,ncnv,ninl,ncon,nld,nadd,
    { parser specific stuff }
    pbase,pexpr,
@@ -844,10 +844,20 @@ function get_next_varsym(def: tabstractrecorddef; const SymList:TFPHashObjectLis
         { maybe pchar ? }
         else
           if is_char(def.pointeddef) and
-            ((node.nodetype=stringconstn) or is_constcharnode(node)) then
+            ((node.nodetype=stringconstn) or is_constcharnode(node) or is_constwidecharnode(node)) then
             begin
               { ensure that a widestring is converted to the current codepage }
-              if is_wide_or_unicode_string(node.resultdef) then
+              if is_constwidecharnode(node) then
+                begin
+                  initwidestring(pw);
+                  concatwidestringchar(pw,tcompilerwidechar(word(tordconstnode(node).value.svalue)));
+                  hp:=cstringconstnode.createunistr(pw);
+                  donewidestring(pw);
+                  node.free;
+                  do_typecheckpass(hp);
+                  node:=hp;
+                end;
+              if (node.nodetype=stringconstn) and is_wide_or_unicode_string(node.resultdef) then
                 tstringconstnode(node).changestringtype(getansistringdef);
               { create a tcb for the string data (it's placed in a separate
                 asmlist) }
diff --git a/tests/tbs/tb0696.pp b/tests/tbs/tb0696.pp
new file mode 100644
index 0000000000..f4bacd7536
--- /dev/null
+++ b/tests/tbs/tb0696.pp
@@ -0,0 +1,21 @@
+{$codepage utf8}
+program tb0696;
+var
+  ar: PChar = 'Ё';
+  ar2: PChar;
+  l, i: SizeInt;
+begin
+ Writeln(strlen(ar));  //Error
+  Writeln(Length(Ar)); //Error
+  l := Length(ar);
+  ar2 := 'Ё';
+  Writeln(strlen(ar2)); //Ok
+  Writeln(Length(Ar2)); //Ok
+  if l <> Length(ar2) then
+    Halt(1);
+  for i := 0 to l - 1 do
+    if ar[i] <> ar2[i] then
+      Halt(2 + i);
+  //Readln;
+end.
+