+ Mantis #19651: Generate table of typed string constants which are initialized with resourcestrings, so they are updated when SetResourceStrings or SetUnitResourceStrings is called.

git-svn-id: trunk@18968 -

.gitattributes

@@ -11739,6 +11739,7 @@ tests/webtbs/tw1950.pp svneol=native#text/plain
 tests/webtbs/tw19548.pp svneol=native#text/pascal
 tests/webtbs/tw19555.pp svneol=native#text/pascal
 tests/webtbs/tw1964.pp svneol=native#text/plain
+tests/webtbs/tw19651.pp svneol=native#text/plain
 tests/webtbs/tw19700.pp svneol=native#text/plain
 tests/webtbs/tw19851a.pp svneol=native#text/pascal
 tests/webtbs/tw19851b.pp svneol=native#text/pascal

compiler/aasmdata.pas

@@ -155,6 +155,7 @@ interface
         AsmLists      : array[TAsmListType] of TAsmList;
         CurrAsmList   : TAsmList;
         WideInits     : TLinkedList;
+        ResStrInits   : TLinkedList;
         { hash tables for reusing constant storage }
         ConstPools    : array[TConstPoolType] of THashSet;
         constructor create(const n:string);
@@ -180,8 +181,8 @@ interface
       TTCInitItem = class(TLinkedListItem)
         sym: tsym;
         offset: aint;
-        datalabel: TAsmLabel;
+        datalabel: TAsmSymbol;
-        constructor Create(asym: tsym; aoffset: aint; alabel: TAsmLabel);
+        constructor Create(asym: tsym; aoffset: aint; alabel: TAsmSymbol);
       end;
 
     var
@@ -256,7 +257,7 @@ implementation
 *****************************************************************************}
 
 
-    constructor TTCInitItem.Create(asym: tsym; aoffset: aint; alabel: TAsmLabel);
+    constructor TTCInitItem.Create(asym: tsym; aoffset: aint; alabel: TAsmSymbol);
       begin
         inherited Create;
         sym:=asym;
@@ -334,6 +335,7 @@ implementation
         for hal:=low(TAsmListType) to high(TAsmListType) do
           AsmLists[hal]:=TAsmList.create;
         WideInits :=TLinkedList.create;
+        ResStrInits:=TLinkedList.create;
         { CFI }
         FAsmCFI:=CAsmCFI.Create;
       end;
@@ -365,6 +367,7 @@ implementation
 {$ifdef MEMDEBUG}
          memasmlists.start;
 {$endif}
+        ResStrInits.free;
         WideInits.free;
          for hal:=low(TAsmListType) to high(TAsmListType) do
            AsmLists[hal].free;

compiler/options.pas

@@ -2488,6 +2488,7 @@ begin
   def_system_macro('FPC_HAS_RIP_RELATIVE');
 {$endif x86_64}
   def_system_macro('FPC_HAS_CEXTENDED');
+  def_system_macro('FPC_HAS_RESSTRINITS');
 
 { these cpus have an inline rol/ror implementaion }
 {$if defined(x86) or defined(arm) or defined(powerpc) or defined(powerpc64)}

compiler/pmodules.pas

@@ -230,15 +230,15 @@ implementation
          ltvTable.Free;
       end;
 
-    procedure InsertWideInits;
+    procedure InsertRuntimeInits(const prefix:string;list:TLinkedList;unitflag:cardinal);
       var
         s: string;
         item: TTCInitItem;
       begin
-        item:=TTCInitItem(current_asmdata.WideInits.First);
+        item:=TTCInitItem(list.First);
         if item=nil then
           exit;
-        s:=make_mangledname('WIDEINITS',current_module.localsymtable,'');
+        s:=make_mangledname(prefix,current_module.localsymtable,'');
         maybe_new_object_file(current_asmdata.asmlists[al_globals]);
         new_section(current_asmdata.asmlists[al_globals],sec_data,s,sizeof(pint));
         current_asmdata.asmlists[al_globals].concat(Tai_symbol.Createname_global(s,AT_DATA,0));
@@ -256,44 +256,63 @@ implementation
         { end-of-list marker }
         current_asmdata.asmlists[al_globals].concat(Tai_const.Create_sym(nil));
         current_asmdata.asmlists[al_globals].concat(Tai_symbol_end.Createname(s));
-        current_module.flags:=current_module.flags or uf_wideinits;
+        current_module.flags:=current_module.flags or unitflag;
       end;
 
-    procedure InsertWideInitsTablesTable;
+    procedure InsertRuntimeInitsTablesTable(const prefix,tablename:string;unitflag:cardinal);
       var
         hp: tused_unit;
-        lwiTables: TAsmList;
+        hlist: TAsmList;
         count: longint;
       begin
-        lwiTables:=TAsmList.Create;
+        hlist:=TAsmList.Create;
         count:=0;
         hp:=tused_unit(usedunits.first);
         while assigned(hp) do
          begin
-           if (hp.u.flags and uf_wideinits)=uf_wideinits then
+           if (hp.u.flags and unitflag)=unitflag then
             begin
-              lwiTables.concat(Tai_const.Createname(make_mangledname('WIDEINITS',hp.u.globalsymtable,''),0));
+              hlist.concat(Tai_const.Createname(make_mangledname(prefix,hp.u.globalsymtable,''),0));
               inc(count);
             end;
            hp:=tused_unit(hp.next);
          end;
-        { Add program widestring consts, if any }
+        { Add items from program, if any }
-        if (current_module.flags and uf_wideinits)=uf_wideinits then
+        if (current_module.flags and unitflag)=unitflag then
          begin
-           lwiTables.concat(Tai_const.Createname(make_mangledname('WIDEINITS',current_module.localsymtable,''),0));
+           hlist.concat(Tai_const.Createname(make_mangledname(prefix,current_module.localsymtable,''),0));
            inc(count);
          end;
         { Insert TableCount at start }
-        lwiTables.insert(Tai_const.Create_32bit(count));
+        hlist.insert(Tai_const.Create_32bit(count));
         { insert in data segment }
         maybe_new_object_file(current_asmdata.asmlists[al_globals]);
-        new_section(current_asmdata.asmlists[al_globals],sec_data,'FPC_WIDEINITTABLES',sizeof(pint));
+        new_section(current_asmdata.asmlists[al_globals],sec_data,tablename,sizeof(pint));
-        current_asmdata.asmlists[al_globals].concat(Tai_symbol.Createname_global('FPC_WIDEINITTABLES',AT_DATA,0));
+        current_asmdata.asmlists[al_globals].concat(Tai_symbol.Createname_global(tablename,AT_DATA,0));
-        current_asmdata.asmlists[al_globals].concatlist(lwiTables);
+        current_asmdata.asmlists[al_globals].concatlist(hlist);
-        current_asmdata.asmlists[al_globals].concat(Tai_symbol_end.Createname('FPC_WIDEINITTABLES'));
+        current_asmdata.asmlists[al_globals].concat(Tai_symbol_end.Createname(tablename));
-        lwiTables.free;
+        hlist.free;
       end;
 
+    procedure InsertWideInits;
+      begin
+        InsertRuntimeInits('WIDEINITS',current_asmdata.WideInits,uf_wideinits);
+      end;
+
+    procedure InsertResStrInits;
+      begin
+        InsertRuntimeInits('RESSTRINITS',current_asmdata.ResStrInits,uf_resstrinits);
+      end;
+
+    procedure InsertWideInitsTablesTable;
+      begin
+        InsertRuntimeInitsTablesTable('WIDEINITS','FPC_WIDEINITTABLES',uf_wideinits);
+      end;
+
+    procedure InsertResStrTablesTable;
+      begin
+        InsertRuntimeInitsTablesTable('RESSTRINITS','FPC_RESSTRINITTABLES',uf_resstrinits);
+      end;
 
     Function CheckResourcesUsed : boolean;
     var
@@ -1387,6 +1406,9 @@ implementation
          { Widestring typed constants }
          InsertWideInits;
 
+         { Resourcestring references }
+         InsertResStrInits;
+
          { generate debuginfo }
          if (cs_debuginfo in current_settings.moduleswitches) then
            current_debuginfo.inserttypeinfo;
@@ -2395,11 +2417,15 @@ implementation
          { Windows widestring needing initialization }
          InsertWideInits;
 
+         { Resourcestring references (const foo:string=someresourcestring) }
+         InsertResStrInits;
+
          { insert Tables and StackLength }
          InsertInitFinalTable;
          InsertThreadvarTablesTable;
          InsertResourceTablesTable;
          InsertWideInitsTablesTable;
+         InsertResStrTablesTable;
          InsertMemorySizes;
 
 {$ifdef FPC_HAS_SYSTEMS_INTERRUPT_TABLE}

compiler/ppu.pas

@@ -160,6 +160,7 @@ const
   uf_has_dwarf_debuginfo = $200000; { this unit has dwarf debuginfo generated }
   uf_wideinits           = $400000; { this unit has winlike widestring typed constants }
   uf_classinits          = $800000; { this unit has class constructors/destructors }
+  uf_resstrinits        = $1000000; { this unit has string consts referencing resourcestrings }
 
 type
   { bestreal is defined based on the target architecture }

compiler/ptconst.pas

@@ -656,6 +656,7 @@ implementation
           ll        : tasmlabel;
           ca        : pchar;
           winlike   : boolean;
+          hsym      : tconstsym;
         begin
           n:=comp_expr(true,false);
           { load strval and strlength of the constant tree }
@@ -691,8 +692,21 @@ implementation
             end
           else if is_constresourcestringnode(n) then
             begin
-              strval:=pchar(tconstsym(tloadnode(n).symtableentry).value.valueptr);
+              hsym:=tconstsym(tloadnode(n).symtableentry);
-              strlength:=tconstsym(tloadnode(n).symtableentry).value.len;
+              strval:=pchar(hsym.value.valueptr);
+              strlength:=hsym.value.len;
+              { Link the string constant to its initializing resourcestring,
+                enabling it to be (re)translated at runtime.
+              }
+              if (hr.origsym.owner.symtablelevel<=main_program_level) or
+                 (hr.origblock=bt_const) then
+                begin
+                  current_asmdata.ResStrInits.Concat(
+                    TTCInitItem.Create(hr.origsym,hr.offset,
+                    current_asmdata.RefAsmSymbol(make_mangledname('RESSTR',hsym.owner,hsym.name)))
+                  );
+                  Include(hr.origsym.varoptions,vo_force_finalize);
+                end;
             end
           else
             begin

compiler/utils/ppudump.pp

@@ -270,7 +270,7 @@ type
     str  : string[30];
   end;
 const
-  flagopts=23;
+  flagopts=24;
   flagopt : array[1..flagopts] of tflagopt=(
     (mask: $1    ;str:'init'),
     (mask: $2    ;str:'final'),
@@ -296,7 +296,8 @@ const
     (mask: $80000  ;str:'has_resourcefiles'),
     (mask: $100000  ;str:'has_exports'),
     (mask: $400000  ;str:'has_wideinits'),
-    (mask: $800000  ;str:'has_classinits')
+    (mask: $800000  ;str:'has_classinits'),
+    (mask: $1000000 ;str:'has_resstrinits')
   );
 var
   i,ntflags : longint;

rtl/objpas/objpas.pp

@@ -312,6 +312,39 @@ Type
      end;
    end;
 
+{ Support for string constants initialized with resourcestrings }
+{$ifdef FPC_HAS_RESSTRINITS}
+   PResStrInitEntry = ^TResStrInitEntry;
+   TResStrInitEntry = record
+     Addr: PPointer;
+     Data: PResourceStringRecord;
+   end;
+
+   TResStrInitTable = packed record
+     Count: longint;
+     Tables: packed array[1..32767] of PResStrInitEntry;
+   end;
+
+var
+  ResStrInitTable : TResStrInitTable; external name 'FPC_RESSTRINITTABLES';
+
+procedure UpdateResourceStringRefs;
+var
+  i: Longint;
+  ptable: PResStrInitEntry;
+begin
+  for i:=1 to ResStrInitTable.Count do
+    begin
+      ptable:=ResStrInitTable.Tables[i];
+      while Assigned(ptable^.Addr) do
+        begin
+          AnsiString(ptable^.Addr^):=ptable^.Data^.CurrentValue;
+          Inc(ptable);
+        end;
+    end;
+end;
+{$endif FPC_HAS_RESSTRINITS}
+
 Var
   ResourceStringTable : TResourceStringTableList; External Name 'FPC_RESOURCESTRINGTABLES';
 
@@ -337,6 +370,9 @@ begin
             end;
         end;
     end;
+{$ifdef FPC_HAS_RESSTRINITS}
+  UpdateResourceStringRefs;
+{$endif FPC_HAS_RESSTRINITS}
 end;
 
 
@@ -366,6 +402,11 @@ begin
             end;
         end;
     end;
+{$ifdef FPC_HAS_RESSTRINITS}
+  { Resourcestrings of one unit may be referenced from other units,
+    so updating everything is the only option. }
+  UpdateResourceStringRefs;
+{$endif FPC_HAS_RESSTRINITS}
 end;
 
 

tests/webtbs/tw19651.pp

@@ -0,0 +1,24 @@
+{$mode objfpc}{$h+}
+{$APPTYPE CONSOLE}
+
+uses
+  SysUtils;
+
+resourcestring
+  SSunday = 'Sunday';
+
+const
+  SDays: array[0..0] of string = (SSunday);
+
+function Translate(Name,Value : AnsiString; Hash : Longint; arg:pointer) : AnsiString;
+begin
+  Result := 'dimanche';
+end;
+
+begin
+  SetResourceStrings(@Translate, nil);
+  WriteLn(SSunday);
+  WriteLn(SDays[0]);
+  if SDays[0]<>'dimanche' then
+    Halt(1);
+end.