mirror of
https://gitlab.com/freepascal.org/lazarus/lazarus.git
synced 2025-09-11 20:39:15 +02:00
codetools: implemented $if sizeof() for some built-in types
This commit is contained in:
parent
fece524746
commit
1b490d997c
@ -1235,10 +1235,13 @@ var
|
|||||||
end;
|
end;
|
||||||
|
|
||||||
function GetAtom: string;
|
function GetAtom: string;
|
||||||
|
var
|
||||||
|
l: PtrInt;
|
||||||
begin
|
begin
|
||||||
Setlength(Result,p-AtomStart);
|
l:=p-AtomStart;
|
||||||
if Result<>'' then
|
if l=0 then exit('');
|
||||||
System.Move(AtomStart^,Result[1],length(Result));
|
SetLength(Result,l);
|
||||||
|
System.Move(AtomStart^,Result[1],l);
|
||||||
end;
|
end;
|
||||||
|
|
||||||
procedure ReadNextAtom;
|
procedure ReadNextAtom;
|
||||||
@ -1376,7 +1379,7 @@ var
|
|||||||
begin
|
begin
|
||||||
s:=ExpectedStr;
|
s:=ExpectedStr;
|
||||||
if ExprEnd>NewErrorPos then begin
|
if ExprEnd>NewErrorPos then begin
|
||||||
SetLength(f,ExprEnd-NewErrorPos);
|
SetLength(f{%H-},ExprEnd-NewErrorPos);
|
||||||
System.Move(NewErrorPos^,f[1],ExprEnd-NewErrorPos);
|
System.Move(NewErrorPos^,f[1],ExprEnd-NewErrorPos);
|
||||||
Error(NewErrorPos,'expected '+s+', but found '+f);
|
Error(NewErrorPos,'expected '+s+', but found '+f);
|
||||||
end else begin
|
end else begin
|
||||||
@ -1495,6 +1498,105 @@ var
|
|||||||
Result:=true;
|
Result:=true;
|
||||||
end;
|
end;
|
||||||
|
|
||||||
|
function ParseSizeOfParams(var Operand: TEvalOperand): boolean;
|
||||||
|
// p is behind option keyword
|
||||||
|
var
|
||||||
|
Identifier: String;
|
||||||
|
Value: int64;
|
||||||
|
begin
|
||||||
|
Result:=false;
|
||||||
|
ReadNextAtom;
|
||||||
|
if AtomStart>=ExprEnd then begin
|
||||||
|
CharMissing(ExprEnd,'(');
|
||||||
|
exit;
|
||||||
|
end;
|
||||||
|
if AtomStart^<>'(' then begin
|
||||||
|
StrExpectedAtPos(AtomStart,'(');
|
||||||
|
exit;
|
||||||
|
end;
|
||||||
|
ReadNextAtom;
|
||||||
|
if not IsIdentifierChar[AtomStart^] then begin
|
||||||
|
StrExpectedAtPos(AtomStart,'identifier');
|
||||||
|
exit;
|
||||||
|
end;
|
||||||
|
Identifier:=GetAtom;
|
||||||
|
ReadNextAtom;
|
||||||
|
while AtomStart^='.' do begin
|
||||||
|
Identifier:=Identifier+'.';
|
||||||
|
ReadNextAtom;
|
||||||
|
if not IsIdentifierChar[AtomStart^] then begin
|
||||||
|
StrExpectedAtPos(AtomStart,'identifier');
|
||||||
|
exit;
|
||||||
|
end;
|
||||||
|
Identifier:=Identifier+GetAtom;
|
||||||
|
ReadNextAtom;
|
||||||
|
end;
|
||||||
|
if AtomStart>=ExprEnd then begin
|
||||||
|
CharMissing(ExprEnd,')');
|
||||||
|
exit;
|
||||||
|
end;
|
||||||
|
if AtomStart^<>')' then begin
|
||||||
|
StrExpectedAtPos(AtomStart,')');
|
||||||
|
exit;
|
||||||
|
end;
|
||||||
|
|
||||||
|
case lowercase(Identifier) of
|
||||||
|
'boolean',
|
||||||
|
'bytebool',
|
||||||
|
'byte',
|
||||||
|
'shortint': Value:=1;
|
||||||
|
'wordbool',
|
||||||
|
'word',
|
||||||
|
'smallint': Value:=2;
|
||||||
|
'cardinal',
|
||||||
|
'longword',
|
||||||
|
'longbool': Value:=4;
|
||||||
|
'int64',
|
||||||
|
'qword',
|
||||||
|
'qwordbool',
|
||||||
|
'comp': Value:=8;
|
||||||
|
'pointer',
|
||||||
|
'ptrint',
|
||||||
|
'ptruint',
|
||||||
|
'string',
|
||||||
|
'ansistring',
|
||||||
|
'unicodestring',
|
||||||
|
'rawbytestring',
|
||||||
|
'widestring':
|
||||||
|
if IsDefined('CPU16') then
|
||||||
|
Value:=2
|
||||||
|
else if IsDefined('CPU32') then
|
||||||
|
Value:=4
|
||||||
|
else
|
||||||
|
Value:=8;
|
||||||
|
'ansichar': Value:=1;
|
||||||
|
'widechar': Value:=2;
|
||||||
|
'char':
|
||||||
|
if IsDefined('FPC_UNICODESTRINGS') then
|
||||||
|
Value:=2
|
||||||
|
else
|
||||||
|
Value:=1;
|
||||||
|
'single': Value:=4;
|
||||||
|
'double': Value:=8;
|
||||||
|
'extended':
|
||||||
|
if IsDefined('CPU32') then
|
||||||
|
Value:=10
|
||||||
|
else
|
||||||
|
Value:=8;
|
||||||
|
else
|
||||||
|
// default: return default pointer size
|
||||||
|
if IsDefined('CPU16') then
|
||||||
|
Value:=2
|
||||||
|
else if IsDefined('CPU32') then
|
||||||
|
Value:=4
|
||||||
|
else
|
||||||
|
Value:=8;
|
||||||
|
end;
|
||||||
|
SetOperandValueInt64(Operand,Value);
|
||||||
|
|
||||||
|
Result:=true;
|
||||||
|
end;
|
||||||
|
|
||||||
function ReadOperand: boolean;
|
function ReadOperand: boolean;
|
||||||
{ Examples:
|
{ Examples:
|
||||||
Variable
|
Variable
|
||||||
@ -1567,10 +1669,7 @@ var
|
|||||||
end;
|
end;
|
||||||
'S':
|
'S':
|
||||||
if CompareIdentifiers(AtomStart,'SIZEOF')=0 then begin
|
if CompareIdentifiers(AtomStart,'SIZEOF')=0 then begin
|
||||||
ReadNextAtom;
|
if not ParseSizeOfParams(Operand) then exit;
|
||||||
if AtomStart^<>'(' then StrExpectedAtPos(AtomStart,'(');
|
|
||||||
if not ReadTilEndBracket then exit;
|
|
||||||
SetOperandValueChar(Operand,'1');
|
|
||||||
exit(true);
|
exit(true);
|
||||||
end;
|
end;
|
||||||
'U':
|
'U':
|
||||||
@ -1956,7 +2055,7 @@ begin
|
|||||||
if s<>'' then
|
if s<>'' then
|
||||||
inc(TxtLen,length(s)+1);
|
inc(TxtLen,length(s)+1);
|
||||||
end;
|
end;
|
||||||
Setlength(Result,TxtLen);
|
Setlength(Result{%H-},TxtLen);
|
||||||
p:=1;
|
p:=1;
|
||||||
for i:=0 to FCount-1 do begin
|
for i:=0 to FCount-1 do begin
|
||||||
Move(FNames[i][1],Result[p],length(FNames[i]));
|
Move(FNames[i][1],Result[p],length(FNames[i]));
|
||||||
|
@ -58,6 +58,7 @@ type
|
|||||||
procedure TestParseThreadVar;
|
procedure TestParseThreadVar;
|
||||||
procedure TestParseMultilineString;
|
procedure TestParseMultilineString;
|
||||||
procedure TestParseUnderscoreIsSeparator;
|
procedure TestParseUnderscoreIsSeparator;
|
||||||
|
procedure TestParseDirective_IF_SizeOf_Char;
|
||||||
end;
|
end;
|
||||||
|
|
||||||
implementation
|
implementation
|
||||||
@ -649,6 +650,21 @@ begin
|
|||||||
ParseModule;
|
ParseModule;
|
||||||
end;
|
end;
|
||||||
|
|
||||||
|
procedure TTestPascalParser.TestParseDirective_IF_SizeOf_Char;
|
||||||
|
begin
|
||||||
|
Add([
|
||||||
|
'program test1;',
|
||||||
|
'{$modeswitch unicodestrings}',
|
||||||
|
'{$if sizeof(char)=2}',
|
||||||
|
'const t = 2;',
|
||||||
|
'{$else}',
|
||||||
|
'sizeof failed',
|
||||||
|
'{$endif}',
|
||||||
|
'begin',
|
||||||
|
'']);
|
||||||
|
ParseModule;
|
||||||
|
end;
|
||||||
|
|
||||||
initialization
|
initialization
|
||||||
RegisterTest(TTestPascalParser);
|
RegisterTest(TTestPascalParser);
|
||||||
|
|
||||||
|
Loading…
Reference in New Issue
Block a user