View Issue Details

IDProjectCategoryView StatusLast Update
0030660FPCRTLpublic2019-12-05 16:00
ReporterMaciej Izak Assigned ToMichael Van Canneyt  
PrioritynormalSeverityminorReproducibilityalways
Status resolvedResolutionfixed 
Product Version3.1.1 
Target Version3.2.0Fixed in Version3.1.1 
Summary0030660: [patch] TLocaleOptions in SysUtils
DescriptionFPC has lack of UpperCase/LowerCase/CompareStr/CompareText/SameText/SameStr with TLocaleOptions parameter. Delphi compatibility:

http://docwiki.embarcadero.com/Libraries/Berlin/en/System.SysUtils.TLocaleOptions

Patch attached.
TagsNo tags attached.
Fixed in Revision34683
FPCOldBugId
FPCTarget-
Attached Files

Activities

Maciej Izak

2016-09-28 12:59

reporter  

rtl_patch_sysutils_TLocaleOptions.patch (5,846 bytes)   
Index: rtl/objpas/sysutils/sysstr.inc
===================================================================
--- rtl/objpas/sysutils/sysstr.inc	(revision 34570)
+++ rtl/objpas/sysutils/sysstr.inc	(working copy)
@@ -112,6 +112,14 @@
   end;
 
 
+function UpperCase(const s: string; LocaleOptions: TLocaleOptions): string; overload;{$ifdef SYSUTILSINLINE}inline;{$endif}
+  begin
+    case LocaleOptions of
+      loInvariantLocale: Result:=UpperCase(s);
+      loUserLocale: Result:=AnsiUpperCase(s);
+    end;
+  end;
+
 {   LowerCase returns a copy of S where all uppercase characters ( from A to Z )
     have been converted to lowercase  }
 Function Lowercase(Const S : AnsiString) : AnsiString;
@@ -120,6 +128,15 @@
   end;
 
 
+function LowerCase(const s: string; LocaleOptions: TLocaleOptions): string; overload;{$ifdef SYSUTILSINLINE}inline;{$endif}
+  begin
+    case LocaleOptions of
+      loInvariantLocale: Result:=LowerCase(s);
+      loUserLocale: Result:=AnsiLowerCase(s);
+    end;
+  end;
+
+
 function LowerCase(const V: variant): string; overload;{$ifdef SYSUTILSINLINE}inline;{$endif}
   begin
     result:=LowerCase(ansistring(V));
@@ -165,6 +182,14 @@
     result:=CAPSIZEINT(Count1-Count2);
 end;
 
+function CompareStr(const S1, S2: string; LocaleOptions: TLocaleOptions): Integer; overload;{$ifdef SYSUTILSINLINE}inline;{$endif}
+begin
+  case LocaleOptions of
+    loInvariantLocale: Result:=CompareStr(S1,S2);
+    loUserLocale: Result:=AnsiCompareStr(S1,S2);
+  end;
+end;
+
 {   CompareMemRange returns the result of comparison of Length bytes at P1 and P2
     case       result
     P1 < P2    < 0
@@ -190,7 +215,7 @@
     S1 > S2  > 0
     S1 = S2  = 0     }
 
-function CompareText(const S1, S2: string): Integer;
+function CompareText(const S1, S2: string): Integer; overload;
 
 var
   i, count, count1, count2: sizeint; 
@@ -231,18 +256,45 @@
     result:=CAPSIZEINT(Count1-Count2);
 end;
 
-function SameText(const s1,s2:String):Boolean;
+function CompareText(const S1, S2: string; LocaleOptions: TLocaleOptions): Integer; overload;{$ifdef SYSUTILSINLINE}inline;{$endif}
 
 begin
+  case LocaleOptions of
+    loInvariantLocale: Result:=CompareText(S1,S2);
+    loUserLocale: Result:=AnsiCompareText(S1,S2);
+  end;
+end;
+
+function SameText(const s1,s2:String):Boolean; overload;{$ifdef SYSUTILSINLINE}inline;{$endif}
+
+begin
  Result:=CompareText(S1,S2)=0;
 end;
 
-function SameStr(const s1,s2:String):Boolean;
+function SameText(const s1,s2:String; LocaleOptions: TLocaleOptions):Boolean; overload;{$ifdef SYSUTILSINLINE}inline;{$endif}
 
 begin
+  case LocaleOptions of
+    loInvariantLocale: Result:=SameText(S1,S2);
+    loUserLocale: Result:=AnsiSameText(S1,S2);
+  end;
+end;
+
+function SameStr(const s1,s2:String):Boolean; overload;{$ifdef SYSUTILSINLINE}inline;{$endif}
+
+begin
  Result:=CompareStr(S1,S2)=0;
 end;
 
+function SameStr(const s1,s2:String; LocaleOptions: TLocaleOptions):Boolean; overload;{$ifdef SYSUTILSINLINE}inline;{$endif}
+
+begin
+  case LocaleOptions of
+    loInvariantLocale: Result:=SameStr(S1,S2);
+    loUserLocale: Result:=AnsiSameStr(S1,S2);
+  end;
+end;
+
 {$ifndef FPC_NOGENERICANSIROUTINES}
 {==============================================================================}
 {   Ansi string functions                                                      }
Index: rtl/objpas/sysutils/sysstrh.inc
===================================================================
--- rtl/objpas/sysutils/sysstrh.inc	(revision 34570)
+++ rtl/objpas/sysutils/sysstrh.inc	(working copy)
@@ -20,6 +20,7 @@
 
 type
    PString = ObjPas.PString;
+   TLocaleOptions = (loInvariantLocale, loUserLocale);
 
    { For FloatToText }
    TFloatFormat = (ffGeneral, ffExponent, ffFixed, ffNumber, ffCurrency);
@@ -69,16 +70,22 @@
 procedure AssignStr(var P: PString; const S: string);
 procedure AppendStr(var Dest: String; const S: string);
 function UpperCase(const s: string): string; overload;
+function UpperCase(const s: string; LocaleOptions: TLocaleOptions): string; overload;{$ifdef SYSUTILSINLINE}inline;{$endif}
 function LowerCase(const s: string): string; overload;
+function LowerCase(const s: string; LocaleOptions: TLocaleOptions): string; overload;{$ifdef SYSUTILSINLINE}inline;{$endif}
 { the compiler can't decide else if it should use the char or the ansistring
   version for a variant }
 function LowerCase(const V: variant): string; overload;{$ifdef SYSUTILSINLINE}inline;{$endif}
 function CompareStr(const S1, S2: string): Integer; overload;
+function CompareStr(const S1, S2: string; LocaleOptions: TLocaleOptions): Integer; overload;{$ifdef SYSUTILSINLINE}inline;{$endif}
 function CompareMemRange(P1, P2: Pointer; Length: PtrUInt): integer;{$ifdef SYSUTILSINLINE}inline;{$endif}
 function CompareMem(P1, P2: Pointer; Length: PtrUInt): Boolean;{$ifdef SYSUTILSINLINE}inline;{$endif}
-function CompareText(const S1, S2: string): Integer;
-function SameText(const s1,s2:String):Boolean;
-function SameStr(const s1,s2:String):Boolean;
+function CompareText(const S1, S2: string): Integer; overload;
+function CompareText(const S1, S2: string; LocaleOptions: TLocaleOptions): Integer; overload;{$ifdef SYSUTILSINLINE}inline;{$endif}
+function SameText(const s1,s2:String):Boolean; overload;{$ifdef SYSUTILSINLINE}inline;{$endif}
+function SameText(const s1,s2:String; LocaleOptions: TLocaleOptions):Boolean; overload;{$ifdef SYSUTILSINLINE}inline;{$endif}
+function SameStr(const s1,s2:String):Boolean; overload;{$ifdef SYSUTILSINLINE}inline;{$endif}
+function SameStr(const s1,s2:String; LocaleOptions: TLocaleOptions):Boolean; overload;{$ifdef SYSUTILSINLINE}inline;{$endif}
 
 function AnsiUpperCase(const s: string): string;{$ifdef SYSUTILSINLINE}inline;{$endif}
 function AnsiLowerCase(const s: string): string;{$ifdef SYSUTILSINLINE}inline;{$endif}

Michael Van Canneyt

2016-10-08 16:30

administrator   ~0095028

I do not think we should apply this patch as it is.

What is the point of adding these options if you ignore them anyway ?

You will fool the users into thinking these options are supported, when they are in fact not supported at all?

Maciej Izak

2016-10-09 00:05

reporter   ~0095034

Each of Ansi* function works in different way than functions without "Ansi" prefix. TLocaleOptions is more generic way to call both:

-> "Ansi" prefixed function for loUserLocale
-> non "Ansi" prefixed function for loInvariantLocale.

Michael Van Canneyt

2016-10-09 00:23

administrator   ~0095035

Indeed;

Amazing how one can fail to see differences in 2 lines of code.
The "Ansi" simply didn't register when I looked at the patch :(
I have applied the patch, thank you very much.

Issue History

Date Modified Username Field Change
2016-09-28 12:59 Maciej Izak New Issue
2016-09-28 12:59 Maciej Izak File Added: rtl_patch_sysutils_TLocaleOptions.patch
2016-10-08 16:28 Michael Van Canneyt Assigned To => Michael Van Canneyt
2016-10-08 16:28 Michael Van Canneyt Status new => assigned
2016-10-08 16:30 Michael Van Canneyt Note Added: 0095028
2016-10-08 16:30 Michael Van Canneyt Status assigned => feedback
2016-10-09 00:05 Maciej Izak Note Added: 0095034
2016-10-09 00:05 Maciej Izak Status feedback => assigned
2016-10-09 00:23 Michael Van Canneyt Fixed in Revision => 34683
2016-10-09 00:23 Michael Van Canneyt Note Added: 0095035
2016-10-09 00:23 Michael Van Canneyt Status assigned => resolved
2016-10-09 00:23 Michael Van Canneyt Fixed in Version => 3.1.1
2016-10-09 00:23 Michael Van Canneyt Resolution open => fixed
2016-10-09 00:23 Michael Van Canneyt Target Version => 4.0.0
2019-12-05 16:00 Michael Van Canneyt Target Version 4.0.0 => 3.2.0
2019-12-05 16:00 Michael Van Canneyt FPCTarget => -