paweld/fpc
1
0
Fork 0
mirror of https://gitlab.com/freepascal.org/fpc/source.git synced 2025-04-07 02:48:07 +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^;
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;

29
rtl/inc/objpash.inc
View File

@ -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;