My code:
function Str2Dbl(const str: string; var v: double): boolean;
var
dp: integer;
cstr: string;
xv: extended;
begin
if FormatSettings.DecimalSeparator <> '.' then
begin
dp := pos('.', str);
if dp <> 0 then
begin
cstr := str;
cstr[dp] := FormatSettings.DecimalSeparator;
end
else
cstr := str;
end
else
cstr := str;
if cstr <> '' then
result := TextToFloat(#cstr[1], xv, fvExtended, FormatSettings)
else
result := false;
if result then
v := xv;
end;
In Delphi 10.2 it gives an error:
[dcc32 Error] commutil.pas(1005): E2251 Ambiguous overloaded call to 'TextToFloat'
System.SysUtils.pas(18332): Related method: function TextToFloat(PWideChar; var; TFloatValue; const TFormatSettings): Boolean;
System.SysUtils.pas(18515): Related method: function TextToFloat(PAnsiChar; var; TFloatValue; const TFormatSettings): Boolean;
I do not understand how to fix this error!!!
The error is because #cstr[1] has type Pointer and the overload resolution does not know which overload (PAnsiChar or PWideChar) you want.
In any case, using #cstr[1] is wrong in general, and will fail with a runtime error if cstr is empty. Use PChar(cstr) instead. This will also allow the overload resolution to work.
I appreciate that you test whether or not cstr is empty, but that test is not necessary if you use the magic of the PChar(...) cast. Even when the string is empty, PChar(...) gives a valid pointer to a null-terminated character array.
The documentation is worth consulting on this subject. The key statement is:
PChar(S) always returns a pointer to a memory block; if S is empty, a pointer to #0 is returned.
So, you will be able to replace:
if cstr <> '' then
result := TextToFloat(#cstr[1], xv, fvExtended, FormatSettings)
else
result := false;
which did not compile anyway, with:
result := TextToFloat(PChar(cstr), xv, fvExtended, FormatSettings)
which does compile and avoids that if statement boiler-plate.
Aside
I initially expected that enabling typed address operator with {$T+} would make #cstr[1] be a typed pointer and help the overload resolution. However, that is not the case. It was surprising to me that this program compiles:
{$T+}
var
PA: PAnsiChar;
PW: PWideChar;
s: string;
begin
PA := #s[1];
PW := #s[1];
end.
The linked documentation says:
When # is applied to a variable reference in the {$T+} state, the type of the result is ^T, where T is compatible only with pointers to the type of the variable.
This seems to be contradicted by
Related
when i migrate from Delphi 6 to Delphi 10.2 Tokyo
i get error when i try to casting pointer of ^PChar to array of PChar
type
PServEnt = ^TServEnt;
TServEnt = packed record
s_name: PChar; // official service name
s_aliases: ^PChar; // alias list
s_port: Smallint; // protocol to use
s_proto: PChar; // port #
end;
function TIdStackWindows.WSGetServByPort(
const APortNumber: Integer): TIdStrings;
var
ps: PServEnt;
i: integer;
p: array of PChar;
begin
Result := TIdStringList.Create;
p := nil;
try
ps := GetServByPort(HToNs(APortNumber), nil);
if ps <> nil then
begin
Result.Add(ps^.s_name);
i := 0;
p := Pointer(ps^.s_aliases); // get error Incompatible types: 'Dynamic array' and 'Pointer'
while p[i] <> nil do
begin
Result.Add(PChar(p[i]));
inc(i);
end;
end;
except
Result.Free;
end;
end;
this code working well at Delphi 2010 ,how to make it correct at Delphi 10.2 Tokyo
The error message is correct, and if the code compiled in earlier versions of Delphi then that was because those earlier versions of the compiler were deficient.
A dynamic array is more than just a pointer to the first element. It also encapsulates the meta data which stores the length of the array, and the reference count. Your cast is therefore not valid. You got away with this invalid code because you did not attempt to access this meta data, but that's as much by chance as through intention.
Don't attempt to cast to a dynamic array. Instead use pointer arithmetic. For instance:
function TIdStackWindows.WSGetServByPort(
const APortNumber: Integer): TIdStrings;
var
ps: PServEnt;
p: PPChar;
begin
Result := TIdStringList.Create;
try
ps := GetServByPort(HToNs(APortNumber), nil);
if ps <> nil then
begin
Result.Add(ps^.s_name);
p := PPChar(ps^.s_aliases); // cast needed due to Indy record type's use of un-nameable type
while p^ <> nil do
begin
Result.Add(p^);
inc(p);
end;
end;
except
Result.Free;
raise;
end;
end;
I changed the type declaration of the alias list to PPChar to avoid incompatible type errors when assigning to the local variable of that type.
Note also that I have corrected your exception handling which was previously swallowing exceptions and returning an invalid object reference.
In Delphi XE4 and above, we may write something like:
function TestAnsiCompatible(const aStr: string): Boolean;
begin
end;
string in Delphi XE4 is declared as UnicodeString. It may hold a unicode string.
If we do some type conversion:
function TestAnsiCompatible(const aStr: string): Boolean;
var a: AnsiString;
begin
a := aStr;
Result := a = aStr;
end;
Some compiler warnings should prompt:
[dcc32 Warning]: W1058 Implicit string cast with potential data loss from 'string' to 'AnsiString'
[dcc32 Warning]: W1057 Implicit string cast from 'AnsiString' to 'string'
Is there a much simple and neat way to test if aStr is fully compatible with AnsiString? Or we shall check character by characters:
function TestAnsiCompatible(const aStr: string): Boolean;
var C: Char;
begin
Result := True;
for C in aStr do begin
if C > #127 then begin
Result := False;
Break;
end;
end;
end;
All you have to do is type-cast away the warnings:
function TestAnsiCompatible(const aStr: string): Boolean;
var
a: AnsiString;
begin
a := AnsiString(aStr);
Result := String(a) = aStr;
end;
Which can be simplified to this:
function TestAnsiCompatible(const aStr: string): Boolean;
begin
Result := String(AnsiString(aStr)) = aStr;
end;
I used to check if String(a) = AnsiString(a), until I had a user who had transferred data from one PC to another, and that had a different codepage. Then the data could not be read back properly. Then I changed my definition of "safe" to "string is code page 1252" (as this is the region where most of my users are). Then when reading back my data, I know I have to convert the string back from code page 1252.
function StringIs1252(const S: UnicodeString): Boolean;
// returns True if a string is in codepage 1252 (Western European (Windows))
// Cyrillic is 1251
const
WC_NO_BEST_FIT_CHARS = $00000400;
var
UsedDefaultChar: BOOL; // not Boolean!!
Len: Integer;
begin
if Length(S) = 0 then
Exit(True);
UsedDefaultChar := False;
Len := WideCharToMultiByte(1252, WC_NO_BEST_FIT_CHARS, PWideChar(S), Length(S), nil, 0, nil, #UsedDefaultChar);
if Len <> 0 then
Result := not UsedDefaultchar
else
Result := False;
end;
But if you want to check if your string can safely be converted to ansi - completely independent of the code page that is used when writing or reading, then you should check if all characters are in the range from #0..#127.
With Delphi XE4, try the following code:
procedure TForm3.Button1Click(Sender: TObject);
var
myStr: string;
begin
Edit1.Text := TPerlRegEx.EscapeRegExChars('test');
end;
The result (Edit1.Text) is empty.
Is this a bug or I'm missing something? I previously had no problem with this TPerlRegEx.EscapeRegExChars function with the version from regular-expressions.info pre-DelphiXE.
Update 2: Just upgrading an app written in D2010 and encountering this bug, but just wondering how such an obvious bug can exist this long... now I'm seriously considering making my code compatible to Free Pascal, but I really like the antonymous method...
Update 1: I'm using Delphi XE4 Update 1.
It appears to be a bug. If that's the case, both the XE4 and XE5 versions contain it. I've opened a QC report to report it for XE4..XE6.
The problem appears to be with the last line of the function:
Result.Create(Tmp, 0, J);
Stepping through in the debugger shows that the Tmp (a TCharArray) correctly contains 't','e','s','t', #0, #0, #0, #0 at that point, yet Result contains '' when the function actually returns, as setting a breakpoint on the end; following that line indicates that result contains '' at that point (and when the function returns).
Providing a replacement version in a class helper with a minor change to actually store the return value from the call to Create fixes the problem:
type
TPerlRegExHelper = class helper for TPerlRegEx
public
class function EscapeRegExCharsEx(const S: string): string; static;
end;
class function TPerlRegExHelper.EscapeRegExCharsEx(const S: string): string;
var
I, J: Integer;
Tmp: TCharArray;
begin
SetLength(Tmp, S.Length * 2);
J := 0;
for I := Low(S) to High(S) do
begin
case S[I] of
'.', '[', ']', '(', ')', '?', '*', '+', '{', '}', '^', '$', '|', '\':
begin
Tmp[J] := '\';
Inc(j);
Tmp[J] := S[I];
end;
#0:
begin
Tmp[J] := '\';
Inc(j);
Tmp[J] := '0';
end;
else
Tmp[J] := S[I];
end;
Inc(J);
end;
{ Result.Create(Tmp, 0, J); } // The problem code from the original
Result := String.Create(Tmp, 0, J);
end;
The XE3 (and the open-source version you mention) implement the logic totally differently, using the more standard manipulation of Result beginning at the first line of the function with Result := S;, and then using System.Insert as needed to add room for the escape characters.
This is a bug introduced in the XE4 release that is still present in XE6. Previous versions were fine. It looks like the changes were made in readiness for some future switch to immutable strings.
Rather ironically the bug is caused by the string never being assigned a value at all. It's one thing to set out not to mutate a string, but quite another never to initialize it!
So to the analysis of the bug. The method in question in TPerlRegEx.EscapeRegExChars defined in the System.RegularExpressionsCore unit. This is a class function that returns a string. Its signature is:
class function EscapeRegExChars(const S: string): string;
The XE4 implementation makes but one reference to the result variable. As follows:
Result.Create(Tmp, 0, J);
Here, Tmp is an array of char containing the escaped text to be returned, and J is the length of that text.
So, it seems clear that the author intended for this code to assign to the function return variable Result. Sadly that does not occur. Why not? Well, the Create method being called is defined in the helper for string. This is TStringHelper defined in the System.SysUtils unit. There are three Create overloads and the one in play here is:
class function Create(const Value: array of Char; StartIndex: Integer;
Length: Integer): string; overload; static;
Note that this is a class static function. That means that it is not an instance method and has no Self pointer. So when called like this:
Result.Create(Tmp, 0, J);
It is simply a function call whose return value is ignored. It might appear that the result variable would be set but remember that this Create is a class static method. It therefore has no instance. The compiler simply uses the type of Result to resolve the method. The code is equivalent to:
string.Create(Tmp, 0, J);
Nothing more exciting than a call to a function whose return value is simply ignored. Defeated by the extended syntax that allows us to ignore function return values.
The fix to the code is simple enough. Replace that final line with
Result := string.Create(Tmp, 0, J);
You could apply the fix in a copy of the unit, and include that unit in your code. An alternative to that, my preferred option, is to use a code hook. Like this:
unit FixTPerlRegExEscapeRegExChars;
interface
implementation
uses
System.SysUtils, Winapi.Windows, System.RegularExpressionsCore;
procedure PatchCode(Address: Pointer; const NewCode; Size: Integer);
var
OldProtect: DWORD;
begin
if VirtualProtect(Address, Size, PAGE_EXECUTE_READWRITE, OldProtect) then
begin
Move(NewCode, Address^, Size);
FlushInstructionCache(GetCurrentProcess, Address, Size);
VirtualProtect(Address, Size, OldProtect, #OldProtect);
end;
end;
type
PInstruction = ^TInstruction;
TInstruction = packed record
Opcode: Byte;
Offset: Integer;
end;
procedure RedirectProcedure(OldAddress, NewAddress: Pointer);
var
NewCode: TInstruction;
begin
NewCode.Opcode := $E9;//jump relative
NewCode.Offset := NativeInt(NewAddress)-NativeInt(OldAddress)-SizeOf(NewCode);
PatchCode(OldAddress, NewCode, SizeOf(NewCode));
end;
function EscapeRegExChars(Self: TPerlRegEx; const S: string): string;
var
I, J: Integer;
Tmp: TCharArray;
begin
SetLength(Tmp, S.Length * 2);
J := 0;
for I := Low(S) to High(S) do
begin
case S[I] of
'.', '[', ']', '(', ')', '?', '*', '+', '{', '}', '^', '$', '|', '\':
begin
Tmp[J] := '\';
Inc(j);
Tmp[J] := S[I];
end;
#0:
begin
Tmp[J] := '\';
Inc(j);
Tmp[J] := '0';
end;
else
Tmp[J] := S[I];
end;
Inc(J);
end;
Result := string.Create(Tmp, 0, J);
end;
initialization
RedirectProcedure(#TPerlRegEx.EscapeRegExChars, #EscapeRegExChars);
end.
Add this unit to your project and the calls to TPerlRegEx.EscapeRegExChars will start working again.
{$APPTYPE CONSOLE}
uses
System.RegularExpressionsCore,
FixTPerlRegExEscapeRegExChars in 'FixTPerlRegExEscapeRegExChars.pas';
begin
Writeln(TPerlRegEx.EscapeRegExChars('test'));
Readln;
end.
Output
test
QC#124091
I have a HashTable and I need some way to return a not_found result.
type
TCell<T> = record
.....
property key: cardinal read FKey write FKey;
property data: T read FData write FData;
end;
THashTable<T> = class(TEnumerable<T>)
private
FCells: array of TCell<T>;
FEmpty: T;
...
constructor Create(InitialSize: cardinal); overload;
function Lookup(key: cardinal): T;
...
end;
constructor THashTable<T>.Create(InitialSize: cardinal);
begin
inherited Create;
// Initialize regular cells
FArraySize:= InitialSize;
Assert((FArraySize and (FArraySize - 1)) = 0); // Must be a power of 2
SetLength(FCells, FArraySize);
FillChar(FEmpty, SizeOf(FEmpty), #0); //Superfluous I know, just there to
//demonstrate the point.
end;
Given the above structure, how do I return a not found result?
If I had pointers, I would return a nil pointer to T.
But pointers to generic types are not allowed.
So I've come up with the solution below:
function THashTable<T>.Lookup(key: cardinal): T;
var
Cell: NativeUInt;
begin
if (key <> 0) then begin
// Check regular cells
Cell:= First_Cell(IntegerHash(key));
while (true) do begin
if (FCells[Cell].key = key) then Exit(FCells[Cell].data);
if not (FCells[Cell].key = 0) then Exit(FEmpty); <<-- is this correct?
Cell:= Circular_Next(Cell);
end;
end else begin
Result:= FEmpty; <<--- Can I return an empty generic like this?
end;
end;
Can I return a zero-initialized generic to mean no result?
Or will I run into problems with structured types of (classes/records/variants/strings etc).
Note that I do understand the ambiguity when T is an integer. Zero might very well be a valid value and it would thus be indistinguishable from not_found.
I'm not worried about those results.
What you're looking for is default(T), which will return a zero value for any type T.
I would suggest changing the function to use an output var parameter for the data, then you can use a Boolean for the Result, eg:
function THashTable<T>.Lookup(key: cardinal; var Value: T): Boolean;
var
Cell: NativeUInt;
begin
Result := False;
if (key <> 0) then begin
// Check regular cells
Cell := First_Cell(IntegerHash(key));
while Cell <> -1 do begin
if (FCells[Cell].key = key) then begin
Value := FCells[Cell].data;
Exit(True);
end;
if (FCells[Cell].key <> 0) then Break;
Cell := Circular_Next(Cell);
end;
end;
end;
#S.MAHDI suggested that you could write this code:
Result := T(nil);
My initial reaction was that this would not compile because the cast is clearly invalid. For example, this code does not compile:
var
P: Pointer;
....
Result := T(P);
For that code the compiler reports: E2089 Invalid typecast.
But the assignment of T(nil) does compile. And when you look at the code generated, for all the cases I investigated, the code was identical to that generated for Default(T).
So, my conclusion is that this apparently undocumented syntax T(nil) is treated specially by the compiler in a generic context, and is an alias for Default(T).
I would be very interested to know if anyone can point to any official documentation for this feature.
I've decided to return a pointer to the generic type instead.
type
//P<T> = ^T;
P<T> = record {holding a pointer to T with some operator overloading}
....
FCells: array of T <<-- holds T directly now.
function THashTable<K,T>.Lookup(const key: K): P<T>;
begin
....
if found then Result:= #FCells[CorrectIndex]
else Result:= nil;
end;
Is there a way that I can declare a variable with an absolute address that has some offset to the variable that it refers to. For instance, instead of:
function RefCount(const s: string): Integer;
begin
Result := PInteger(Integer(s) - 8)^;
end;
is there some way that I can do:
function RefCount(const s: string): Integer;
var
Count: PInteger absolute s {- 8 ?} ;
begin
Result := Count^;
end;
(The example is to illustrate only, it is not necessarily useful..)
No, I don't think there is an 'extended syntax' of the absolute keyword. The documentation is here, and, as far as I know, there are no undocumented features related to this keyword.
There is no syntax for what you ask.
What you can do, however, is use pointer arithmetic (if you are using a version that supports it), eg:
function RefCount(const s: string): Integer;
begin
if s <> '' then
Result := (PInteger(s) - 2)^;
else
Result := 0;
end;
A more reliably approach is to use the StrRec record type instead, which is what a String actually contains internally:
function RefCount(const s: string): Integer;
begin
if s <> '' then
Result := (PStrRec(s) - 1)^.refCnt
else
Result := 0;
end;
Or, the non pointer arithmetic version:
function RefCount(const s: string): Integer;
begin
if s <> '' then
Result := PStrRec(LongInt(s) - SizeOf(StrRec))^.refCnt
else
Result := 0;
end;
BTW, starting with D2009+, the System unit has its own StringRefCount() function that retreive a String's reference count.