* Unicode resource strings

compiler/cresstr.pas

@@ -34,7 +34,7 @@ uses
    SysUtils,
    cclasses,widestr,
    cutils,globtype,globals,systems,
-   symbase,symconst,symtype,symdef,symsym,symtable,
+   symbase,symconst,symtype,defutil, symdef,symsym,symtable,
    verbose,fmodule,ppu,
    aasmtai,aasmdata,aasmcnst,
    aasmcpu;
@@ -44,9 +44,11 @@ uses
       TResourceStringItem = class(TLinkedListItem)
         Sym   : TConstSym;
         Name  : String;
-        Value : Pchar;
-        Len   : Longint;
+        AValue : PAnsiChar;
+        WValue : pcompilerwidestring; // just a reference, do not free.
+        Len   : Longint; // in bytes, not characters
         hash  : Cardinal;
+        isUnicode : Boolean;
         constructor Create(asym:TConstsym);
         destructor  Destroy;override;
         procedure CalcHash;
@@ -71,33 +73,67 @@ uses
   ---------------------------------------------------------------------}
 
     constructor TResourceStringItem.Create(asym:TConstsym);
+
+    var
+      pw : pcompilerwidestring;
+      t : TDef;
+
       begin
         inherited Create;
         Sym:=Asym;
         Name:=lower(asym.owner.name^+'.'+asym.Name);
-        Len:=asym.value.len;
-        GetMem(Value,Len);
-        Move(asym.value.valueptr^,Value^,Len);
+        isUnicode:=is_systemunit_unicode;
+        if IsUnicode then
+          begin
+          T:=aSym.constdef;
+          WValue:=pcompilerwidestring(asym.value.valueptr);
+          Len:=WValue^.len*sizeOf(tcompilerwidechar);
+          end
+        else
+          begin
+          Len:=asym.value.len;
+          GetMem(AValue,Len);
+          Move(asym.value.valueptr^,AValue^,Len);
+          end;
         CalcHash;
       end;
 
 
     destructor TResourceStringItem.Destroy;
       begin
-        FreeMem(Value);
+        if Assigned(AValue) then
+          FreeMem(AValue);
       end;
 
 
     procedure TResourceStringItem.CalcHash;
       Var
         g : Cardinal;
-        I : longint;
+        llen,wlen,I : longint;
+        P : PByte;
+        pc : PAnsiChar;
+
       begin
+        pc:=nil;
         hash:=0;
-        For I:=0 to Len-1 do { 0 terminated }
+        if IsUnicode then
+          begin
+          // Need to calculate hash on UTF8 encoded string, GNU gettext.
+          llen:=UnicodeToUtf8(nil,0,PUnicodeChar(wValue^.data),wValue^.len);
+          getmem(pc,llen);
+          UnicodeToUtf8(PC,llen,PUnicodeChar(wValue^.data),len);
+          P:=PByte(pc);
+          llen:=llen-1; // Take of terminating #0
+          end
+        else
+          begin
+          llen:=Len;
+          P:=PByte(AValue);
+          end;
+        For I:=0 to lLen-1 do { 0 terminated }
          begin
            hash:=hash shl 4;
-           inc(Hash,Ord(Value[i]));
+           inc(Hash,P[i]);
            g:=hash and ($f shl 28);
            if g<>0 then
             begin
@@ -105,6 +141,8 @@ uses
               hash:=hash xor g;
             end;
          end;
+        if Assigned(Pc) then
+          FreeMem(PC);
         If Hash=0 then
           Hash:=$ffffffff;
       end;
@@ -133,6 +171,8 @@ uses
         R : TResourceStringItem;
         resstrdef: tdef;
         tcb : ttai_typedconstbuilder;
+        enc : tstringencoding;
+
       begin
         resstrdef:=search_system_type('TRESOURCESTRINGRECORD').typedef;
 
@@ -157,12 +197,20 @@ uses
         while assigned(R) do
           begin
             tcb:=ctai_typedconstbuilder.create([tcalo_vectorized_dead_strip_item,tcalo_data_force_indirect]);
-            if assigned(R.value) and (R.len<>0) then
-              valuelab:=tcb.emit_ansistring_const(current_asmdata.asmlists[al_const],R.Value,R.Len,getansistringcodepage)
-            else
+            valuelab.lab:=nil;
+            valuelab.ofs:=0;
+            if (R.len<>0) then
               begin
-                valuelab.lab:=nil;
-                valuelab.ofs:=0;
+              if R.isUnicode and assigned(R.WValue) then
+                begin
+                enc:=tstringdef(cunicodestringtype).encoding;
+                valuelab:=tcb.emit_unicodestring_const(current_asmdata.asmlists[al_const],R.WValue,enc,False);
+                end
+              else
+                begin
+                if assigned(R.AValue) then
+                  valuelab:=tcb.emit_ansistring_const(current_asmdata.asmlists[al_const],R.AValue,R.Len,getansistringcodepage)
+                end;
               end;
             current_asmdata.asmlists[al_const].concat(cai_align.Create(sizeof(pint)));
             namelab:=tcb.emit_ansistring_const(current_asmdata.asmlists[al_const],@R.Name[1],length(R.name),getansistringcodepage);
@@ -171,7 +219,7 @@ uses
                   TResourceStringRecord = Packed Record
                      Name,
                      CurrentValue,
-                     DefaultValue : AnsiString;
+                     DefaultValue : AnsiString/Widestring;
                      HashValue    : LongWord;
                    end;
             }
@@ -205,9 +253,11 @@ uses
         F: Text;
         R: TResourceStringItem;
         ResFileName: string;
-        I: Integer;
+        I,Len: Integer;
         C: tcompilerwidechar;
         W: pcompilerwidestring;
+        P : PByte;
+
       begin
         ResFileName:=ChangeFileExt(current_module.ppufilename,'.rsj');
         message1 (general_i_writingresourcefile,ExtractFileName(ResFileName));
@@ -229,15 +279,26 @@ uses
         while assigned(R) do
           begin
             write(f, '{"hash":',R.Hash,',"name":"',R.Name,'","sourcebytes":[');
+            if R.isUnicode then
+              P:=PByte(R.WValue^.data)
+            else
+              P:=PByte(R.AValue);
             for i:=0 to R.Len-1 do
               begin
-                write(f,ord(R.Value[i]));
+                write(f,P[i]);
                 if i<>R.Len-1 then
                   write(f,',');
               end;
             write(f,'],"value":"');
-            initwidestring(W);
-            ascii2unicode(R.Value,R.Len,current_settings.sourcecodepage,W);
+            if Not r.isUnicode then
+              begin
+              initwidestring(W);
+              ascii2unicode(R.AValue,R.Len,current_settings.sourcecodepage,W);
+              end
+            else
+              begin
+              W:=R.WValue;
+              end;
             for I := 0 to W^.len - 1 do
               begin
                 C := W^.Data[I];
@@ -261,7 +322,8 @@ uses
                     write(f,Chr(C));
                 end;
               end;
-            donewidestring(W);
+            if W<>R.WValue then
+              donewidestring(W);
             write(f,'"}');
             R:=TResourceStringItem(R.Next);
             if assigned(R) then

compiler/pdecl.pas

@@ -1306,6 +1306,8 @@ implementation
          sym : tsym;
          first,
          isgeneric : boolean;
+         pw : pcompilerwidestring;
+
       begin
          if target_info.system in systems_managed_vm then
            message(parser_e_feature_unsupported_for_vm);
@@ -1345,12 +1347,23 @@ implementation
                       stringconstn:
                         with Tstringconstnode(p) do
                           begin
-                             { resourcestrings are currently always single byte }
-                             if cst_type in [cst_widestring,cst_unicodestring] then
-                               changestringtype(getansistringdef);
-                             getmem(sp,len+1);
-                             move(value_str^,sp^,len+1);
-                             sym:=cconstsym.create_string(orgname,constresourcestring,sp,len,nil);
+                             if not is_systemunit_unicode  then
+                               begin
+                               if cst_type in [cst_widestring,cst_unicodestring] then
+                                 changestringtype(getansistringdef);
+                               getmem(sp,len+1);
+                               move(value_str^,sp^,len+1);
+                               sym:=cconstsym.create_string(orgname,constresourcestring,sp,len,nil);
+                               end
+                             else
+                               begin
+                               // For unicode rtl, resourcestrings are unicodestrings
+                               if cst_type in [cst_conststring,cst_longstring, cst_shortstring,cst_ansistring] then
+                                 changestringtype(cunicodestringtype);
+                               initwidestring(pw);
+                               copywidestring(pcompilerwidestring(value_str),pw);
+                               sym:=cconstsym.create_wstring(orgname,constresourcestring,pw);
+                               end;
                           end;
                       else
                         Message(parser_e_illegal_expression);

compiler/pexpr.pas

@@ -3117,7 +3117,10 @@ implementation
                 begin
                   result:=cloadnode.create(srsym,srsymtable);
                   do_typecheckpass(result);
-                  result.resultdef:=getansistringdef;
+                  if is_systemunit_unicode then
+                    result.resultdef:=cstringdef.createunicode(true)
+                  else
+                    result.resultdef:=getansistringdef;
                 end
               else
                 result:=genconstsymtree(tconstsym(srsym));

compiler/ppcx64.lpi

@@ -22,7 +22,9 @@
     </PublishOptions>
     <RunParams>
       <local>
+        <CommandLineParams Value="-Tlinux -tunicodertl -FUrtl-objpas\units\x86_64-linux-unicodertl\ -Fu\home\tixeo\FPC\FPC\src\rtl\units\x86_64-linux-unicodertl\ -Furtl-objpas\src\inc -Furtl-objpas\src\common -Firtl-objpas\src\inc -Firtl-objpas\src\linux -Firtl-objpas\src\x86_64 -Firtl-objpas\src\common -Fl\usr\lib\gcc\x86_64-linux-gnu\11 -tunicodertl -Cg -Fl\usr\lib\gcc\x86_64-linux-gnu\11 -gl -dx86_64 -Sc -viq rtl-objpas\BuildUnit_rtl_objpas.pp"/>
         <LaunchingApplication PathPlusParams="\usr\X11R6\bin\xterm -T &apos;Lazarus Run Output&apos; -e $(LazarusDir)\tools\runwait.sh $(TargetCmdLine)"/>
+        <WorkingDirectory Value="\home\tixeo\fpc\packages"/>
       </local>
       <FormatVersion Value="2"/>
       <Modes Count="1">

packages/fcl-base/src/gettext.pp

@@ -61,9 +61,9 @@ type
     constructor Create(const AFilename: String);
     constructor Create(AStream: TStream);
     destructor Destroy; override;
-    function Translate(AOrig: PAnsiChar; ALen: Integer; AHash: LongWord): AnsiString;
-    function Translate(const AOrig: AnsiString; AHash: LongWord): AnsiString;
-    function Translate(const AOrig: AnsiString): AnsiString;
+    function Translate(AOrig: PAnsiChar; ALen: Integer; AHash: LongWord): RTLString;
+    function Translate(const AOrig: RTLString; AHash: LongWord): RTLString;
+    function Translate(const AOrig: RTLString): RTLString;
   end;
 
   EMOFileError = class(Exception);
@@ -212,44 +212,46 @@ begin
   inherited Destroy;
 end;
 
-function TMOFile.Translate(AOrig: PAnsiChar; ALen: Integer; AHash: LongWord):AnsiString ;
+function TMOFile.Translate(AOrig: PAnsiChar; ALen: Integer; AHash: LongWord):RTLString;
 var
   idx, incr, nstr: LongWord;
 begin
+  Result := '';
   if AHash = $FFFFFFFF then
-  begin
-    Result := '';
     exit;
-  end;
   idx := AHash mod HashTableSize;
   incr := 1 + (AHash mod (HashTableSize - 2));
   while True do
   begin
     nstr := HashTable^[idx];
     if (nstr = 0) or (nstr > StringCount) then
-    begin
-      Result := '';
-      exit;
-    end;
+      Break;
     if (OrigTable^[nstr - 1].length = LongWord(ALen)) and
        (StrComp(OrigStrings^[nstr - 1], AOrig) = 0) then
     begin
       Result := TranslStrings^[nstr - 1];
-      exit;
+      Break;
     end;
     if idx >= HashTableSize - incr then
       Dec(idx, HashTableSize - incr)
     else
       Inc(idx, incr);
   end;
+  if Result<>'' then
+    exit;
 end;
 
-function TMOFile.Translate(const AOrig:AnsiString ; AHash: LongWord): AnsiString;
+function TMOFile.Translate(const AOrig:RTLString ; AHash: LongWord): RTLString;
+
+Var
+  SOrig : UTF8String;
+
 begin
-  Result := Translate(PAnsiChar(AOrig), Length(AOrig), AHash);
+  SOrig:=UTF8Encode(aOrig);
+  Result := Translate(PAnsiChar(SOrig), Length(AOrig), AHash);
 end;
 
-function TMOFile.Translate(const AOrig:AnsiString ):AnsiString ;
+function TMOFile.Translate(const AOrig:RTLString ):RTLString;
 
 begin
   Result := Translate(AOrig, Hash(AOrig));
@@ -261,7 +263,7 @@ end;
 // -------------------------------------------------------
 
 
-function Translate (Name,Value : AnsiString; Hash : Longint; arg:pointer) : AnsiString;
+function Translate (Name : AnsiString; Value : RTLString; Hash : Longint; arg:pointer) : RTLString;
 var contextempty : boolean;
 begin
   contextempty:=name='';

rtl/inc/objpash.inc

@@ -612,9 +612,9 @@
   type
     PResourceStringRecord = ^TResourceStringRecord;
     TResourceStringRecord = Record
-       Name,
+       Name : AnsiString;
        CurrentValue,
-       DefaultValue : AnsiString;
+       DefaultValue : RTLString;
        HashValue    : LongWord;
      end;
 {$endif FPC_HAS_FEATURE_RESOURCES}

rtl/objpas/objpas.pp

@@ -165,7 +165,7 @@ Var
 
 {$ifdef FPC_HAS_FEATURE_RESOURCES}
    type
-     TResourceIterator = Function (Name,Value : AnsiString; Hash : Longint; arg:pointer) : AnsiString;
+     TResourceIterator = Function (Name : AnsiString; Value : RTLString; Hash : Longint; arg:pointer) : RTLString;
 
    Function Hash(S : AnsiString) : LongWord;
    Procedure ResetResourceTables;
@@ -175,9 +175,9 @@ Var
 
    { Delphi compatibility }
    type
-     PResStringRec=^AnsiString;
-     TResStringRec=AnsiString;
-   Function LoadResString(p:PResStringRec):AnsiString;
+     PResStringRec=^RTLString;
+     TResStringRec=RTLString;
+   Function LoadResString(p:PResStringRec):RTLString;
 {$endif FPC_HAS_FEATURE_RESOURCES}
 
   implementation
@@ -411,7 +411,7 @@ Procedure SetResourceStrings (SetFunction :  TResourceIterator;arg:pointer);
 Var
   ResStr : PResourceStringRecord;
   i      : integer;
-  s      : AnsiString;
+  s      : RTLString;
 begin
   With ResourceStringTable^ do
     begin
@@ -513,7 +513,7 @@ begin
 end;
 
 
-Function LoadResString(p:PResStringRec):AnsiString;
+Function LoadResString(p:PResStringRec):RTLString;
 begin
   Result:=p^;
 end;

rtl/objpas/sysutils/sysutilh.inc

@@ -112,13 +112,13 @@ type
     public
       constructor Create(const msg : string);
       constructor CreateFmt(const msg : string; const args : array of const);
-      constructor CreateRes(ResString: PAnsiString);
-      constructor CreateResFmt(ResString: PAnsiString; const Args: array of const);
+      constructor CreateRes(ResString: PResStringRec);
+      constructor CreateResFmt(ResString: PResStringRec; const Args: array of const);
       constructor CreateHelp(const Msg: string; AHelpContext: Longint);
       constructor CreateFmtHelp(const Msg: string; const Args: array of const;
         AHelpContext: Longint);
-      constructor CreateResHelp(ResString: PAnsiString; AHelpContext: Longint);
-      constructor CreateResFmtHelp(ResString: PAnsiString; const Args: array of const;
+      constructor CreateResHelp(ResString: PResStringRec; AHelpContext: Longint);
+      constructor CreateResFmtHelp(ResString: PResStringRec; const Args: array of const;
         AHelpContext: Longint);
       Function ToString : RTLString; override;
 

rtl/objpas/sysutils/sysutils.inc

@@ -195,7 +195,7 @@ end;
       end;
 
 
-    constructor Exception.CreateRes(ResString: PAnsiString);
+    constructor Exception.CreateRes(ResString: PResStringRec);
 
       begin
          inherited create;
@@ -203,7 +203,7 @@ end;
       end;
 
 
-    constructor Exception.CreateResFmt(ResString: PAnsiString; const Args: array of const);
+    constructor Exception.CreateResFmt(ResString: PResStringRec; const Args: array of const);
 
       begin
          inherited create;
@@ -230,7 +230,7 @@ end;
     end;
 
 
-    constructor Exception.CreateResHelp(ResString: PAnsiString; AHelpContext: Longint);
+    constructor Exception.CreateResHelp(ResString: PResStringRec; AHelpContext: Longint);
 
     begin
        inherited create;
@@ -239,7 +239,7 @@ end;
     end;
 
 
-    constructor Exception.CreateResFmtHelp(ResString: PAnsiString; const Args: array of const;
+    constructor Exception.CreateResFmtHelp(ResString: PResStringRec; const Args: array of const;
       AHelpContext: Longint);
 
     begin
@@ -414,7 +414,7 @@ Var OutOfMemory : EOutOfMemory;
 Procedure RunErrorToExcept (ErrNo : Longint; Address : CodePointer; Frame : Pointer);
 var
   E: Exception;
-  HS: PAnsiString;
+  HS: PResStringRec;
   Entry: PExceptMapEntry;
 begin
   Case Errno of