Parcourir la source

Merged revisions 549 via svnmerge from
/trunk

git-svn-id: branches/fixes_2_0@664 -

peter il y a 20 ans
Parent
commit
0a7ca3e736
4 fichiers modifiés avec 64 ajouts et 11 suppressions
  1. 1 0
      .gitattributes
  2. 11 10
      compiler/pmodules.pas
  3. 13 1
      rtl/objpas/objpas.pp
  4. 39 0
      tests/webtbs/tw4098.pp

+ 1 - 0
.gitattributes

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

+ 11 - 10
compiler/pmodules.pas

@@ -445,17 +445,8 @@ implementation
         if (cs_fp_emulation in aktmoduleswitches) then
           AddUnit('SoftFpu');
 {$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 }
+        { load heaptrace before any other units especially objpas }
         if not(current_module.is_unit) then
          begin
            { Heaptrc unit }
@@ -468,6 +459,16 @@ implementation
            if (cs_gdb_valgrind in aktglobalswitches) then
              AddUnit('CMem');
          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 }
         defaultsymtablestack:=symtablestack;
         defaultmacrosymtablestack:=macrosymtablestack;

+ 13 - 1
rtl/objpas/objpas.pp

@@ -303,6 +303,18 @@ begin
             CurrentValue:=DefaultValue;
 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;
 
 begin
@@ -383,5 +395,5 @@ end;
 Initialization
   ResetResourceTables;
 finalization
-
+  FinalizeResourceTables;
 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.