Przeglądaj źródła

Merged revisions 7595,7701,7810,7842 via svnmerge from
svn+ssh://[email protected]/FPC/svn/fpc/trunk

........
r7595 | michael | 2007-06-08 09:36:02 +0200 (Fri, 08 Jun 2007) | 1 line

* Russian translation by Maxim Ganetsky
........
r7701 | michael | 2007-06-17 11:58:21 +0200 (Sun, 17 Jun 2007) | 1 line

* Patch from Inoussa OUEDRAOGO to support GUIDs in interface declarations
........
r7810 | michael | 2007-06-25 21:59:58 +0200 (Mon, 25 Jun 2007) | 1 line

* Patch from Mario R. Carro to implement THashedStringList
........
r7842 | michael | 2007-06-28 17:30:00 +0200 (Thu, 28 Jun 2007) | 1 line

* Patch from Graeme Geldenhuys to correct an error message
........

git-svn-id: branches/fixes_2_2@8010 -

joost 18 lat temu
rodzic
commit
f2eaf1c77e

+ 2 - 0
.gitattributes

@@ -3873,6 +3873,8 @@ packages/fcl-base/tests/intl/restest.fr.mo -text
 packages/fcl-base/tests/intl/restest.fr.po svneol=native#text/plain
 packages/fcl-base/tests/intl/restest.nl.mo -text
 packages/fcl-base/tests/intl/restest.nl.po svneol=native#text/plain
+packages/fcl-base/tests/intl/restest.ru.mo -text
+packages/fcl-base/tests/intl/restest.ru.po svneol=native#text/plain
 packages/fcl-base/tests/intl/resttest.po svneol=native#text/plain
 packages/fcl-base/tests/ipcclient.pp svneol=native#text/plain
 packages/fcl-base/tests/ipcserver.pp svneol=native#text/plain

+ 101 - 1
packages/fcl-base/src/inc/inifiles.pp

@@ -53,9 +53,28 @@ unit IniFiles;
 
 interface
 
-uses classes, sysutils;
+uses classes, sysutils, contnrs;
 
 type
+  { THashedStringList }
+
+  THashedStringList = class(TStringList)
+  private
+    FValueHash: TFPHashList;
+    FNameHash: TFPHashList;
+    FValueHashValid: Boolean;
+    FNameHashValid: Boolean;
+    procedure UpdateValueHash;
+    procedure UpdateNameHash;
+  protected
+    procedure Changed; override;
+  public
+    constructor Create;
+    destructor Destroy; override;
+    function IndexOf(const S: String): Integer; override;
+    function IndexOfName(const Name: String): Integer; override;
+  end;
+
   TIniFileKey = class
     FIdent: string;
     FValue: string;
@@ -198,6 +217,87 @@ begin
     Result := (Copy(AString, 1, 1) = Comment);
 end;
 
+{ THashedStringList }
+
+constructor THashedStringList.Create;
+begin
+  inherited;
+  FValueHash := nil;
+  FNameHash := nil;
+  FValueHashValid := False;
+  FNameHashValid := False;
+end;
+
+destructor THashedStringList.Destroy;
+begin
+  if Assigned(FValueHash) then
+    FValueHash.Free;
+  if Assigned(FNameHash) then
+    FNameHash.Free;
+  inherited Destroy;
+end;
+
+function THashedStringList.IndexOf(const S: String): Integer;
+var
+  I: Integer;
+begin
+  if not FValueHashValid then
+    UpdateValueHash;
+
+  I := FValueHash.FindIndexOf(S);
+  if I >= 0 then
+    Result := Integer(FValueHash[I])
+  else
+    Result := -1;
+end;
+
+function THashedStringList.IndexOfName(const Name: String): Integer;
+var
+  I: Integer;
+begin
+  if not FNameHashValid then
+    UpdateNameHash;
+
+  I := FNameHash.FindIndexOf(Name);
+  if I >= 0 then
+    Result := Integer(FNameHash[I])
+  else
+    Result := -1;
+end;
+
+procedure THashedStringList.Changed;
+begin
+  FValueHashValid := False;
+  FNameHashValid := False;
+  inherited Changed;
+end;
+
+procedure THashedStringList.UpdateValueHash;
+var
+  I: Integer;
+begin
+  if not Assigned(FValueHash) then
+    FValueHash := TFPHashList.Create
+  else
+    FValueHash.Clear;
+  for I := 0 to Count - 1 do
+    FValueHash.Add(Strings[I], Pointer(I));
+  FValueHashValid := True;
+end;
+
+procedure THashedStringList.UpdateNameHash;
+var
+  I: Integer;
+begin
+  if not Assigned(FNameHash) then
+    FNameHash := TFPHashList.Create
+  else
+    FNameHash.Clear;
+  for I := 0 to Count - 1 do
+    FNameHash.Add(Names[I], Pointer(I));
+  FNameHashValid := True;
+end;
+
 { TIniFileKey }
 
 constructor TIniFileKey.Create(AIdent, AValue: string);

BIN
packages/fcl-base/tests/intl/restest.ru.mo


+ 27 - 0
packages/fcl-base/tests/intl/restest.ru.po

@@ -0,0 +1,27 @@
+msgid ""
+msgstr ""
+"Project-Id-Version: \n"
+"POT-Creation-Date: \n"
+"PO-Revision-Date: 2007-06-08 00:14+0300\n"
+"Last-Translator: Maxim Ganetsky <[email protected]>\n"
+"Language-Team: \n"
+"MIME-Version: 1.0\n"
+"Content-Type: text/plain; charset=utf-8\n"
+"Content-Transfer-Encoding: 8bit\n"
+
+#: testo:testing
+msgid "Testing :"
+msgstr "Тестируется:"
+
+#: testo:first
+msgid "First"
+msgstr "Первый"
+
+#: testo:second
+msgid "Second"
+msgstr "Второй"
+
+#: testo:third
+msgid "Third"
+msgstr "Третий"
+

+ 2 - 2
packages/fcl-image/src/fpcanvas.inc

@@ -88,7 +88,7 @@ function TFPCustomCanvas.CreateDefaultFont : TFPCustomFont;
 begin
   result := DoCreateDefaultFont;
   if not assigned (result) then
-    raise TFPCanvasException.CreateFmt (ErrCouldNotCreate, [EPen])
+    raise TFPCanvasException.CreateFmt (ErrCouldNotCreate, [EFont])
   else
     begin
     result.AllocateResources (self);
@@ -112,7 +112,7 @@ function TFPCustomCanvas.CreateDefaultBrush : TFPCustomBrush;
 begin
   result := DoCreateDefaultBrush;
   if not assigned (result) then
-    raise TFPCanvasException.CreateFmt (ErrCouldNotCreate, [EPen])
+    raise TFPCanvasException.CreateFmt (ErrCouldNotCreate, [EBrush])
   else
     begin
     result.AllocateResources (self);

+ 1 - 0
packages/fcl-passrc/src/pastree.pp

@@ -248,6 +248,7 @@ type
     AncestorType: TPasType;     // TPasClassType or TPasUnresolvedTypeRef
     IsPacked: Boolean;        // 12/04/04 - Dave - Added
     Members: TList;     // array of TPasElement objects
+    InterfaceGUID : string; // 15/06/07 - Inoussa
   end;
 
   TArgumentAccess = (argDefault, argConst, argVar, argOut);

+ 6 - 0
packages/fcl-passrc/src/pparser.pp

@@ -2018,6 +2018,12 @@ begin
 
     if CurToken <> tkSemicolon then
     begin
+      if ( AObjKind = okInterface ) and ( CurToken = tkSquaredBraceOpen ) then
+      begin
+        ExpectToken(tkString);
+        TPasClassType(Result).InterfaceGUID := CurTokenString;
+        ExpectToken(tkSquaredBraceClose);
+      end;    
       CurVisibility := visDefault;
       while CurToken <> tkEnd do
       begin