Browse Source

* deallocation of translated resourcestrings
* load heaptrc before objpas

git-svn-id: trunk@549 -

florian 20 years ago
parent
commit
f5b9130b98
4 changed files with 66 additions and 13 deletions
  1. 1 0
      .gitattributes
  2. 13 12
      compiler/pmodules.pas
  3. 13 1
      rtl/objpas/objpas.pp
  4. 39 0
      tests/webtbs/tw4098.pp

+ 1 - 0
.gitattributes

@@ -6108,6 +6108,7 @@ tests/webtbs/tw4058.pp svneol=native#text/plain
 tests/webtbs/tw4078.pp svneol=native#text/plain
 tests/webtbs/tw4078.pp svneol=native#text/plain
 tests/webtbs/tw4089.pp svneol=native#text/plain
 tests/webtbs/tw4089.pp svneol=native#text/plain
 tests/webtbs/tw4093.pp svneol=native#text/plain
 tests/webtbs/tw4093.pp svneol=native#text/plain
+tests/webtbs/tw4098.pp svneol=native#text/plain
 tests/webtbs/tw4100.pp svneol=native#text/plain
 tests/webtbs/tw4100.pp svneol=native#text/plain
 tests/webtbs/tw4115.pp svneol=native#text/plain
 tests/webtbs/tw4115.pp svneol=native#text/plain
 tests/webtbs/tw4140.pp svneol=native#text/plain
 tests/webtbs/tw4140.pp svneol=native#text/plain

+ 13 - 12
compiler/pmodules.pas

@@ -445,17 +445,8 @@ implementation
         if (cs_fp_emulation in aktmoduleswitches) then
         if (cs_fp_emulation in aktmoduleswitches) then
           AddUnit('SoftFpu');
           AddUnit('SoftFpu');
 {$endif cpufpemu}
 {$endif cpufpemu}
-        { Objpas unit? }
-        if m_objpas in aktmodeswitches then
-          AddUnit('ObjPas');
-        { Macpas unit? }
-        if m_mac in aktmodeswitches then
-          AddUnit('MacPas');
-        { Profile unit? Needed for go32v2 only }
-        if (cs_profile in aktmoduleswitches) and
-           (target_info.system in [system_i386_go32v2,system_i386_watcom]) then
-          AddUnit('Profile');
         { Units only required for main module }
         { Units only required for main module }
+        { load heaptrace before any other units especially objpas }
         if not(current_module.is_unit) then
         if not(current_module.is_unit) then
          begin
          begin
            { Heaptrc unit }
            { Heaptrc unit }
@@ -468,6 +459,16 @@ implementation
            if (cs_gdb_valgrind in aktglobalswitches) then
            if (cs_gdb_valgrind in aktglobalswitches) then
              AddUnit('CMem');
              AddUnit('CMem');
          end;
          end;
+        { Objpas unit? }
+        if m_objpas in aktmodeswitches then
+          AddUnit('ObjPas');
+        { Macpas unit? }
+        if m_mac in aktmodeswitches then
+          AddUnit('MacPas');
+        { Profile unit? Needed for go32v2 only }
+        if (cs_profile in aktmoduleswitches) and
+           (target_info.system in [system_i386_go32v2,system_i386_watcom]) then
+          AddUnit('Profile');
         { save default symtablestack }
         { save default symtablestack }
         defaultsymtablestack:=symtablestack;
         defaultsymtablestack:=symtablestack;
         defaultmacrosymtablestack:=macrosymtablestack;
         defaultmacrosymtablestack:=macrosymtablestack;
@@ -1447,7 +1448,7 @@ implementation
 
 
          { The program intialization needs an alias, so it can be called
          { The program intialization needs an alias, so it can be called
            from the bootstrap code.}
            from the bootstrap code.}
-         
+
          if islibrary then
          if islibrary then
           begin
           begin
             pd:=create_main_proc(make_mangledname('',current_module.localsymtable,mainaliasname),potype_proginit,st);
             pd:=create_main_proc(make_mangledname('',current_module.localsymtable,mainaliasname),potype_proginit,st);
@@ -1460,7 +1461,7 @@ implementation
            begin
            begin
              pd:=create_main_proc('PASCALMAIN',potype_proginit,st); { main is need by the netware rtl }
              pd:=create_main_proc('PASCALMAIN',potype_proginit,st); { main is need by the netware rtl }
            end
            end
-         else 
+         else
            begin
            begin
              pd:=create_main_proc(mainaliasname,potype_proginit,st);
              pd:=create_main_proc(mainaliasname,potype_proginit,st);
              pd.aliasnames.insert('PASCALMAIN');
              pd.aliasnames.insert('PASCALMAIN');

+ 13 - 1
rtl/objpas/objpas.pp

@@ -303,6 +303,18 @@ begin
             CurrentValue:=DefaultValue;
             CurrentValue:=DefaultValue;
 end;
 end;
 
 
+Procedure FinalizeResourceTables;
+
+Var I,J : longint;
+
+begin
+  With ResourceStringTable do
+  For I:=0 to Count-1 do
+    With Tables[I]^ do
+        For J:=0 to Count-1 do
+          With ResRec[J] do
+            CurrentValue:='';
+end;
 Function ResourceStringTableCount : Longint;
 Function ResourceStringTableCount : Longint;
 
 
 begin
 begin
@@ -383,5 +395,5 @@ end;
 Initialization
 Initialization
   ResetResourceTables;
   ResetResourceTables;
 finalization
 finalization
-
+  FinalizeResourceTables;
 end.
 end.

+ 39 - 0
tests/webtbs/tw4098.pp

@@ -0,0 +1,39 @@
+{ %opt=-gh }
+{ Source provided for Free Pascal Bug Report 4098 }
+{ Submitted by "Vincent Snijders" on  2005-06-19 }
+{ e-mail: [email protected] }
+Program project1;
+
+{ Program to demonstrate the SetResourceStringValue function. }
+{$Mode Delphi}
+
+uses
+  sysutils;
+
+ResourceString
+
+  First  = 'First string';
+  Second = 'Second String';
+
+Var I,J : Longint;
+    S : AnsiString;
+
+begin
+  { Print current values of all resourcestrings }
+  For I:=0 to ResourceStringTableCount-1 do
+    For J:=0 to ResourceStringCount(i)-1 do
+      begin
+      Writeln ('Translate => ',GetResourceStringDefaultValue(I,J));
+      Write   ('->');
+      s:=inttostr(j)+'. Zeichenkette';
+      SetResourceStringValue(I,J,S);
+      end;
+  Writeln ('Translated strings : ');
+  For I:=0 to ResourceStringTableCount-1 do
+    For J:=0 to ResourceStringCount(i)-1 do
+      begin
+      Writeln (GetResourceStringDefaultValue(I,J));
+      Writeln ('Translates to : ');
+      Writeln (GetResourceStringCurrentValue(I,J));
+      end;
+end.