Преглед изворни кода

* String -> ShortString/RTLString

Michael VAN CANNEYT пре 2 година
родитељ
комит
b69c78ccce
2 измењених фајлова са 34 додато и 15 уклоњено
  1. 12 8
      rtl/inc/objpas.inc
  2. 22 7
      rtl/inc/objpash.inc

+ 12 - 8
rtl/inc/objpas.inc

@@ -608,11 +608,14 @@
           ClassName := PVmt(Self)^.vClassName^;
         end;
 
-      class function TObject.ClassNameIs(const name : string) : boolean;
+      class function TObject.ClassNameIs(const name : RTLString) : boolean;
 
+        var
+          SS : ShortString;
+          
         begin
-        // call to ClassName inlined here, this eliminates stack and string copying.
-           ClassNameIs:=ShortCompareText(PVmt(Self)^.vClassName^, name) = 0;
+           SS:=ShortString(Name);
+           ClassNameIs:=ShortCompareText(PVmt(Self)^.vClassName^, SS) = 0;
         end;
 
       class function TObject.InheritsFrom(aclass : TClass) : Boolean;
@@ -985,8 +988,9 @@
           getinterfacetable:=PVmt(Self)^.vIntfTable;
         end;
 
-      class function TObject.UnitName : {$ifdef FPC_HAS_FEATURE_ANSISTRINGS}ansistring{$else FPC_HAS_FEATURE_ANSISTRINGS}shortstring{$endif FPC_HAS_FEATURE_ANSISTRINGS};
+      class function TObject.UnitName : RTLString;
 {$ifdef FPC_HAS_FEATURE_RTTI}
+
         type
           TClassTypeInfo = {$ifndef FPC_REQUIRES_PROPER_ALIGNMENT}packed{$endif}record
             Attributes: Pointer;
@@ -1025,9 +1029,9 @@
         end;
 {$endif ndef FPC_HAS_FEATURE_RTTI}
 
-      class function TObject.QualifiedClassName: {$ifdef FPC_HAS_FEATURE_ANSISTRINGS}ansistring{$else FPC_HAS_FEATURE_ANSISTRINGS}shortstring{$endif FPC_HAS_FEATURE_ANSISTRINGS};
+      class function TObject.QualifiedClassName: RTLString;
         var
-          uname: {$ifdef FPC_HAS_FEATURE_ANSISTRINGS}ansistring{$else FPC_HAS_FEATURE_ANSISTRINGS}shortstring{$endif FPC_HAS_FEATURE_ANSISTRINGS};
+          uname: RTLString;
         begin
           uname := UnitName; //TODO: change 'UnitName' to 'UnitScope' as soon as RTL implement it
           if uname='' then
@@ -1046,7 +1050,7 @@
           result:=PtrInt(Self);
         end;
 
-      function TObject.ToString: {$ifdef FPC_HAS_FEATURE_ANSISTRINGS}ansistring{$else FPC_HAS_FEATURE_ANSISTRINGS}shortstring{$endif FPC_HAS_FEATURE_ANSISTRINGS};
+      function TObject.ToString: RTLString;
         begin
           result:=ClassName;
         end;
@@ -1219,7 +1223,7 @@
 
 
 
-    constructor StoredAttribute.Create(Const aName : string);
+    constructor StoredAttribute.Create(Const aName : shortstring);
     begin
       FName:=aName;
     end;

+ 22 - 7
rtl/inc/objpash.inc

@@ -200,6 +200,21 @@
          Data : Pointer;
        end;
 
+       // "Maximum" available stringtype : Shortstring, AnsiString or WideString
+       {$ifdef FPC_HAS_FEATURE_ANSISTRINGS}
+
+       {$IFNDEF UNICODERTL}
+       RTLString = ansistring;
+       {$ELSE UNICODERTL}
+       RTLString = widestring;
+       {$ENDIF UNICODERTL}
+
+       {$else FPC_HAS_FEATURE_ANSISTRINGS}
+
+       RTLString = shortstring;
+
+       {$endif FPC_HAS_FEATURE_ANSISTRINGS}
+
        TObject = class
        public
           { please don't change the order of virtual methods, because
@@ -220,7 +235,7 @@
           class function ClassType : tclass;{$ifdef SYSTEMINLINE}inline;{$endif}
           class function ClassInfo : pointer;
           class function ClassName : shortstring;
-          class function ClassNameIs(const name : string) : boolean;
+          class function ClassNameIs(const name : RTLString) : boolean;
           class function ClassParent : tclass;{$ifdef SYSTEMINLINE}inline;{$endif}
           class function InstanceSize : SizeInt;{$ifdef SYSTEMINLINE}inline;{$endif}
           class function InheritsFrom(aclass : tclass) : boolean;
@@ -251,11 +266,11 @@
           class function GetInterfaceTable : pinterfacetable;
 
           { new since Delphi 2009 }
-          class function UnitName : {$ifdef FPC_HAS_FEATURE_ANSISTRINGS}ansistring{$else FPC_HAS_FEATURE_ANSISTRINGS}shortstring{$endif FPC_HAS_FEATURE_ANSISTRINGS};
-          class function QualifiedClassName: {$ifdef FPC_HAS_FEATURE_ANSISTRINGS}ansistring{$else FPC_HAS_FEATURE_ANSISTRINGS}shortstring{$endif FPC_HAS_FEATURE_ANSISTRINGS};
+          class function UnitName : RTLString;
+          class function QualifiedClassName: RTLString;
           function Equals(Obj: TObject) : boolean;virtual;
           function GetHashCode: PtrInt;virtual;
-          function ToString: {$ifdef FPC_HAS_FEATURE_ANSISTRINGS}ansistring{$else FPC_HAS_FEATURE_ANSISTRINGS}shortstring{$endif FPC_HAS_FEATURE_ANSISTRINGS};virtual;
+          function ToString: RTLString; virtual;
        end;
 
        IUnknown = interface
@@ -478,13 +493,13 @@
        StoredAttribute = Class(TCustomAttribute)
        Private
           FFlag : Boolean;
-          FName : String;
+          FName : ShortString;
        Public
          Constructor Create;
          Constructor Create(Const aFlag : Boolean);
-         Constructor Create(Const aName : String);
+         Constructor Create(Const aName : ShortString);
          Property Flag : Boolean Read FFlag;
-         Property Name : String Read FName;
+         Property Name : ShortString Read FName;
        end;