paweld/fpc
1
0
Fork 0
mirror of https://gitlab.com/freepascal.org/fpc/source.git synced 2025-12-05 11:47:17 +01:00
Code Issues Packages Projects Releases Wiki Activity

fcl-passrc: resolver: typecast string(unicodestring), unicodestring(string)

Browse Source 
git-svn-id: trunk@41223 -
This commit is contained in:
Mattias Gaertner 2019-02-04 16:02:28 +00:00
parent 26486bbaea
commit cfe65c8cd8
3 changed files with 72 additions and 0 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

30
packages/fcl-passrc/src/pasresolveeval.pas
View File

@ -181,6 +181,7 @@ const
nDefaultPropertyNotAllowedInHelperForX = 3115;
nHelpersCannotBeUsedAsTypes = 3116;
nBitWiseOperationsAre32Bit = 3117;
nImplictConversionUnicodeToAnsi = 3118;
// using same IDs as FPC
nVirtualMethodXHasLowerVisibility = 3250; // was 3050
@ -309,6 +310,7 @@ resourcestring
sDefaultPropertyNotAllowedInHelperForX = 'Default property not allowed in helper for %s';
sHelpersCannotBeUsedAsTypes = 'helpers cannot be used as types';
sBitWiseOperationsAre32Bit = 'Bitwise operations are 32-bit';
sImplictConversionUnicodeToAnsi = 'Implicit string type conversion with potential data loss from "UnicodeString" to "AnsiString"';
type
{ TResolveData - base class for data stored in TPasElement.CustomData }
@ -721,6 +723,7 @@ type
{$ifdef FPC_HAS_CPSTRING}
function CheckValidUTF8(const s: RawByteString; ErrorEl: TPasElement): boolean;
function GetCodePage(const s: RawByteString): TSystemCodePage;
function GetRawByteString(const s: UnicodeString; CodePage: TSystemCodePage; ErrorEl: TPasElement): RawByteString;
function GetUTF8Str(const s: RawByteString; ErrorEl: TPasElement): String;
function GetUnicodeStr(const s: RawByteString; ErrorEl: TPasElement): UnicodeString;
function GetWideChar(const s: RawByteString; out w: WideChar): boolean;
@ -4957,6 +4960,33 @@ begin
end;
end;
function TResExprEvaluator.GetRawByteString(const s: UnicodeString;
CodePage: TSystemCodePage; ErrorEl: TPasElement): RawByteString;
var
ok: Boolean;
begin
Result:=UTF8Encode(s);
if (CodePage=CP_UTF8)
or ((DefaultSystemCodePage=CP_UTF8) and ((CodePage=CP_ACP) or (CodePage=CP_NONE))) then
begin
// to UTF-8
SetCodePage(Result,CodePage,false);
end
else
begin
// to non UTF-8 -> possible loss
ok:=false;
try
SetCodePage(Result,CodePage,true);
ok:=true;
except
end;
if (not ok) or (GetUnicodeStr(Result,ErrorEl)<>s) then
LogMsg(20190204165110,mtWarning,nImplictConversionUnicodeToAnsi,
sImplictConversionUnicodeToAnsi,[],ErrorEl);
end;
end;
function TResExprEvaluator.GetUTF8Str(const s: RawByteString;
ErrorEl: TPasElement): String;
var

40
packages/fcl-passrc/src/pasresolver.pp
View File

@ -13122,6 +13122,7 @@ begin
begin
if (bt=btAnsiChar) or ((bt=btChar) and (BaseTypeChar=btWideChar)) then
begin
// ansichar(ansistring)
if fExprEvaluator.StringToOrd(Value,nil)>$ffff then
RaiseXExpectedButYFound(20181005141025,'char','string',Params);
Result:=Value;
@ -13129,6 +13130,7 @@ begin
end
else if (bt=btWideChar) or ((bt=btChar) and (BaseTypeChar=btWideChar)) then
begin
// widechar(ansistring)
if fExprEvaluator.GetWideChar(TResEvalString(Value).S,w) then
begin
Result:=Value;
@ -13136,6 +13138,24 @@ begin
end
else
RaiseXExpectedButYFound(20181005141058,'char','string',Params);
end
else if (bt=btAnsiString) or ((bt=btString) and (BaseTypeString=btAnsiString)) then
begin
// ansistring(ansistring)
Result:=Value;
Value:=nil;
end
else if (bt=btUnicodeString) or (bt=btWideString)
or ((bt=btString) and (BaseTypeString=btUnicodeString)) then
begin
// unicodestring(ansistring)
Result:=TResEvalUTF16.CreateValue(
fExprEvaluator.GetUnicodeStr(TResEvalString(Value).S,Params));
end
else if bt=btRawByteString then
begin
// rawbytestring(ansistring)
SetCodePage(TResEvalString(Value).S,CP_NONE,false);
end;
end;
{$endif}
@ -13146,6 +13166,7 @@ begin
{$ifdef FPC_HAS_CPSTRING}
if (bt=btAnsiChar) or ((bt=btChar) and (BaseTypeChar=btAnsiChar)) then
begin
// ansichar(unicodestring)
if ord(w)<=255 then
begin
Result:=Value;
@ -13158,9 +13179,28 @@ begin
{$endif}
if (bt=btWideChar) or ((bt=btChar) and (BaseTypeChar=btWideChar)) then
begin
// widechar(unicodestring)
Result:=Value;
Value:=nil;
end;
end
else if (bt=btAnsiString) or ((bt=btString) and (BaseTypeString=btAnsiString)) then
begin
// ansistring(unicodestring)
Result:=TResEvalString.CreateValue(
fExprEvaluator.GetRawByteString(TResEvalUTF16(Value).S,CP_ACP,Params));
end
else if (bt=btUnicodeString) or ((bt=btString) and (BaseTypeString=btUnicodeString)) then
begin
// unicodestring(unicodestring)
Result:=Value;
Value:=nil;
end
else if bt=btRawByteString then
begin
// rawbytestring(unicodestring)
Result:=TResEvalString.CreateValue(
fExprEvaluator.GetRawByteString(TResEvalUTF16(Value).S,CP_NONE,Params));
end;
revkExternal:
exit;

2
packages/fcl-passrc/tests/tcresolver.pas
View File

@ -3399,6 +3399,8 @@ begin
' k=chr(97);',
' l=ord(a[1]);',
' m=low(char)+high(char);',
' n = string(''A'');',
' o = UnicodeString(''A'');',
'begin']);
ParseProgram;
CheckResolverUnexpectedHints;