paweld/fpc
1
0
Fork 0
mirror of https://gitlab.com/freepascal.org/fpc/source.git synced 2025-08-22 20:29:16 +02:00
Code Issues Packages Projects Releases Wiki Activity

* String -> ShortString/RTLString

Browse Source
This commit is contained in:
Michael VAN CANNEYT 2023-01-06 12:05:12 +01:00 committed by Michaël Van Canneyt
parent 3085eac501
commit b69c78ccce
2 changed files with 34 additions and 15 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

20
rtl/inc/objpas.inc
View File

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

29
rtl/inc/objpash.inc
View File

@ -200,6 +200,21 @@
Data : Pointer; Data : Pointer;
end; 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 TObject = class
public public
{ please don't change the order of virtual methods, because { please don't change the order of virtual methods, because
@ -220,7 +235,7 @@
class function ClassType : tclass;{$ifdef SYSTEMINLINE}inline;{$endif} class function ClassType : tclass;{$ifdef SYSTEMINLINE}inline;{$endif}
class function ClassInfo : pointer; class function ClassInfo : pointer;
class function ClassName : shortstring; 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 ClassParent : tclass;{$ifdef SYSTEMINLINE}inline;{$endif}
class function InstanceSize : SizeInt;{$ifdef SYSTEMINLINE}inline;{$endif} class function InstanceSize : SizeInt;{$ifdef SYSTEMINLINE}inline;{$endif}
class function InheritsFrom(aclass : tclass) : boolean; class function InheritsFrom(aclass : tclass) : boolean;
@ -251,11 +266,11 @@
class function GetInterfaceTable : pinterfacetable; class function GetInterfaceTable : pinterfacetable;
{ new since Delphi 2009 } { 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 UnitName : RTLString;
class function QualifiedClassName: {$ifdef FPC_HAS_FEATURE_ANSISTRINGS}ansistring{$else FPC_HAS_FEATURE_ANSISTRINGS}shortstring{$endif FPC_HAS_FEATURE_ANSISTRINGS}; class function QualifiedClassName: RTLString;
function Equals(Obj: TObject) : boolean;virtual; function Equals(Obj: TObject) : boolean;virtual;
function GetHashCode: PtrInt;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; end;
IUnknown = interface IUnknown = interface
@ -478,13 +493,13 @@
StoredAttribute = Class(TCustomAttribute) StoredAttribute = Class(TCustomAttribute)
Private Private
FFlag : Boolean; FFlag : Boolean;
FName : String; FName : ShortString;
Public Public
Constructor Create; Constructor Create;
Constructor Create(Const aFlag : Boolean); Constructor Create(Const aFlag : Boolean);
Constructor Create(Const aName : String); Constructor Create(Const aName : ShortString);
Property Flag : Boolean Read FFlag; Property Flag : Boolean Read FFlag;
Property Name : String Read FName; Property Name : ShortString Read FName;
end; end;