mirror of
https://gitlab.com/freepascal.org/fpc/source.git
synced 2025-08-17 21:29:31 +02:00
* synchronized with trunk
git-svn-id: branches/wasm@47937 -
This commit is contained in:
commit
f87f9969a7
1
.gitattributes
vendored
1
.gitattributes
vendored
@ -18659,6 +18659,7 @@ tests/webtbs/tw38225.pp svneol=native#text/pascal
|
|||||||
tests/webtbs/tw38238.pp svneol=native#text/pascal
|
tests/webtbs/tw38238.pp svneol=native#text/pascal
|
||||||
tests/webtbs/tw38249.pp svneol=native#text/pascal
|
tests/webtbs/tw38249.pp svneol=native#text/pascal
|
||||||
tests/webtbs/tw38259.pp svneol=native#text/pascal
|
tests/webtbs/tw38259.pp svneol=native#text/pascal
|
||||||
|
tests/webtbs/tw38267a.pp svneol=native#text/pascal
|
||||||
tests/webtbs/tw3827.pp svneol=native#text/plain
|
tests/webtbs/tw3827.pp svneol=native#text/plain
|
||||||
tests/webtbs/tw3829.pp svneol=native#text/plain
|
tests/webtbs/tw3829.pp svneol=native#text/plain
|
||||||
tests/webtbs/tw3833.pp svneol=native#text/plain
|
tests/webtbs/tw3833.pp svneol=native#text/plain
|
||||||
|
@ -423,7 +423,7 @@ Implementation
|
|||||||
|
|
||||||
DebugMsg('Peephole LdiOp2Opi performed', p);
|
DebugMsg('Peephole LdiOp2Opi performed', p);
|
||||||
|
|
||||||
RemoveCurrentP(p);
|
result:=RemoveCurrentP(p);
|
||||||
end;
|
end;
|
||||||
end;
|
end;
|
||||||
end;
|
end;
|
||||||
@ -447,6 +447,7 @@ Implementation
|
|||||||
taicpu(p).loadconst(0,taicpu(p).oper[0]^.ref^.offset)
|
taicpu(p).loadconst(0,taicpu(p).oper[0]^.ref^.offset)
|
||||||
else
|
else
|
||||||
taicpu(p).loadconst(0,taicpu(p).oper[0]^.ref^.offset-32);
|
taicpu(p).loadconst(0,taicpu(p).oper[0]^.ref^.offset-32);
|
||||||
|
result:=true;
|
||||||
end;
|
end;
|
||||||
A_LDS:
|
A_LDS:
|
||||||
if (taicpu(p).oper[1]^.ref^.symbol=nil) and
|
if (taicpu(p).oper[1]^.ref^.symbol=nil) and
|
||||||
@ -468,6 +469,8 @@ Implementation
|
|||||||
taicpu(p).loadconst(1,taicpu(p).oper[1]^.ref^.offset)
|
taicpu(p).loadconst(1,taicpu(p).oper[1]^.ref^.offset)
|
||||||
else
|
else
|
||||||
taicpu(p).loadconst(1,taicpu(p).oper[1]^.ref^.offset-32);
|
taicpu(p).loadconst(1,taicpu(p).oper[1]^.ref^.offset-32);
|
||||||
|
|
||||||
|
result:=true;
|
||||||
end;
|
end;
|
||||||
A_IN:
|
A_IN:
|
||||||
if GetNextInstruction(p,hp1) then
|
if GetNextInstruction(p,hp1) then
|
||||||
|
@ -489,6 +489,74 @@ implementation
|
|||||||
end;
|
end;
|
||||||
|
|
||||||
|
|
||||||
|
function SwapRightWithLeftRight : tnode;
|
||||||
|
var
|
||||||
|
hp : tnode;
|
||||||
|
begin
|
||||||
|
hp:=right;
|
||||||
|
right:=taddnode(left).right;
|
||||||
|
taddnode(left).right:=hp;
|
||||||
|
left:=left.simplify(forinline);
|
||||||
|
if resultdef.typ<>pointerdef then
|
||||||
|
begin
|
||||||
|
{ ensure that the constant is not expanded to a larger type due to overflow,
|
||||||
|
but this is only useful if no pointer operation is done }
|
||||||
|
left:=ctypeconvnode.create_internal(left,resultdef);
|
||||||
|
do_typecheckpass(left);
|
||||||
|
end;
|
||||||
|
result:=GetCopyAndTypeCheck;
|
||||||
|
end;
|
||||||
|
|
||||||
|
|
||||||
|
function SwapRightWithLeftLeft : tnode;
|
||||||
|
var
|
||||||
|
hp,hp2 : tnode;
|
||||||
|
begin
|
||||||
|
{ keep the order of val+const else pointer operations might cause an error }
|
||||||
|
hp:=taddnode(left).left;
|
||||||
|
taddnode(left).left:=right;
|
||||||
|
left.resultdef:=nil;
|
||||||
|
do_typecheckpass(left);
|
||||||
|
hp2:=left.simplify(forinline);
|
||||||
|
if assigned(hp2) then
|
||||||
|
left:=hp2;
|
||||||
|
if resultdef.typ<>pointerdef then
|
||||||
|
begin
|
||||||
|
{ ensure that the constant is not expanded to a larger type due to overflow,
|
||||||
|
but this is only useful if no pointer operation is done }
|
||||||
|
left:=ctypeconvnode.create_internal(left,resultdef);
|
||||||
|
do_typecheckpass(left);
|
||||||
|
end;
|
||||||
|
right:=left;
|
||||||
|
left:=hp;
|
||||||
|
result:=GetCopyAndTypeCheck;
|
||||||
|
end;
|
||||||
|
|
||||||
|
|
||||||
|
function SwapLeftWithRightRight : tnode;
|
||||||
|
var
|
||||||
|
hp: tnode;
|
||||||
|
begin
|
||||||
|
hp:=left;
|
||||||
|
left:=taddnode(right).right;
|
||||||
|
taddnode(right).right:=hp;
|
||||||
|
right:=right.simplify(false);
|
||||||
|
result:=GetCopyAndTypeCheck;
|
||||||
|
end;
|
||||||
|
|
||||||
|
|
||||||
|
function SwapLeftWithRightLeft : tnode;
|
||||||
|
var
|
||||||
|
hp: tnode;
|
||||||
|
begin
|
||||||
|
hp:=left;
|
||||||
|
left:=taddnode(right).left;
|
||||||
|
taddnode(right).left:=hp;
|
||||||
|
right:=right.simplify(false);
|
||||||
|
result:=GetCopyAndTypeCheck;
|
||||||
|
end;
|
||||||
|
|
||||||
|
|
||||||
var
|
var
|
||||||
t,vl,hp,lefttarget,righttarget, hp2: tnode;
|
t,vl,hp,lefttarget,righttarget, hp2: tnode;
|
||||||
lt,rt : tnodetype;
|
lt,rt : tnodetype;
|
||||||
@ -710,7 +778,7 @@ implementation
|
|||||||
{ Add,Sub,Mul,Or,Xor,Andn with constant 0, 1 or -1? }
|
{ Add,Sub,Mul,Or,Xor,Andn with constant 0, 1 or -1? }
|
||||||
if is_constintnode(right) and (is_integer(left.resultdef) or is_pointer(left.resultdef)) then
|
if is_constintnode(right) and (is_integer(left.resultdef) or is_pointer(left.resultdef)) then
|
||||||
begin
|
begin
|
||||||
if tordconstnode(right).value = 0 then
|
if (tordconstnode(right).value = 0) and (nodetype in [addn,subn,orn,xorn,andn,muln]) then
|
||||||
begin
|
begin
|
||||||
case nodetype of
|
case nodetype of
|
||||||
addn,subn,orn,xorn:
|
addn,subn,orn,xorn:
|
||||||
@ -725,24 +793,13 @@ implementation
|
|||||||
;
|
;
|
||||||
end;
|
end;
|
||||||
end
|
end
|
||||||
else if tordconstnode(right).value = 1 then
|
|
||||||
begin
|
else if (tordconstnode(right).value = 1) and (nodetype=muln) then
|
||||||
case nodetype of
|
result := left.getcopy
|
||||||
muln:
|
|
||||||
result := left.getcopy;
|
else if (tordconstnode(right).value = -1) and (nodetype=muln) then
|
||||||
else
|
result := ctypeconvnode.create_internal(cunaryminusnode.create(left.getcopy),left.resultdef)
|
||||||
;
|
|
||||||
end;
|
|
||||||
end
|
|
||||||
else if tordconstnode(right).value = -1 then
|
|
||||||
begin
|
|
||||||
case nodetype of
|
|
||||||
muln:
|
|
||||||
result := ctypeconvnode.create_internal(cunaryminusnode.create(left.getcopy),left.resultdef);
|
|
||||||
else
|
|
||||||
;
|
|
||||||
end;
|
|
||||||
end
|
|
||||||
{ try to fold
|
{ try to fold
|
||||||
op op
|
op op
|
||||||
/ \ / \
|
/ \ / \
|
||||||
@ -763,20 +820,7 @@ implementation
|
|||||||
andn,
|
andn,
|
||||||
orn,
|
orn,
|
||||||
muln:
|
muln:
|
||||||
begin
|
Result:=SwapRightWithLeftRight;
|
||||||
hp:=right;
|
|
||||||
right:=taddnode(left).right;
|
|
||||||
taddnode(left).right:=hp;
|
|
||||||
left:=left.simplify(forinline);
|
|
||||||
if resultdef.typ<>pointerdef then
|
|
||||||
begin
|
|
||||||
{ ensure that the constant is not expanded to a larger type due to overflow,
|
|
||||||
but this is only useful if no pointer operation is done }
|
|
||||||
left:=ctypeconvnode.create_internal(left,resultdef);
|
|
||||||
do_typecheckpass(left);
|
|
||||||
end;
|
|
||||||
result:=GetCopyAndTypeCheck;
|
|
||||||
end;
|
|
||||||
else
|
else
|
||||||
;
|
;
|
||||||
end;
|
end;
|
||||||
@ -789,26 +833,7 @@ implementation
|
|||||||
andn,
|
andn,
|
||||||
orn,
|
orn,
|
||||||
muln:
|
muln:
|
||||||
begin
|
Result:=SwapRightWithLeftLeft;
|
||||||
{ keep the order of val+const else pointer operations might cause an error }
|
|
||||||
hp:=taddnode(left).left;
|
|
||||||
taddnode(left).left:=right;
|
|
||||||
left.resultdef:=nil;
|
|
||||||
do_typecheckpass(left);
|
|
||||||
hp2:=left.simplify(forinline);
|
|
||||||
if assigned(hp2) then
|
|
||||||
left:=hp2;
|
|
||||||
if resultdef.typ<>pointerdef then
|
|
||||||
begin
|
|
||||||
{ ensure that the constant is not expanded to a larger type due to overflow,
|
|
||||||
but this is only useful if no pointer operation is done }
|
|
||||||
left:=ctypeconvnode.create_internal(left,resultdef);
|
|
||||||
do_typecheckpass(left);
|
|
||||||
end;
|
|
||||||
right:=left;
|
|
||||||
left:=hp;
|
|
||||||
result:=GetCopyAndTypeCheck;
|
|
||||||
end;
|
|
||||||
else
|
else
|
||||||
;
|
;
|
||||||
end;
|
end;
|
||||||
@ -819,7 +844,7 @@ implementation
|
|||||||
end;
|
end;
|
||||||
if is_constintnode(left) and (is_integer(right.resultdef) or is_pointer(right.resultdef)) then
|
if is_constintnode(left) and (is_integer(right.resultdef) or is_pointer(right.resultdef)) then
|
||||||
begin
|
begin
|
||||||
if tordconstnode(left).value = 0 then
|
if (tordconstnode(left).value = 0) and (nodetype in [addn,orn,xorn,subn,andn,muln]) then
|
||||||
begin
|
begin
|
||||||
case nodetype of
|
case nodetype of
|
||||||
addn,orn,xorn:
|
addn,orn,xorn:
|
||||||
@ -836,24 +861,13 @@ implementation
|
|||||||
;
|
;
|
||||||
end;
|
end;
|
||||||
end
|
end
|
||||||
else if tordconstnode(left).value = 1 then
|
|
||||||
begin
|
else if (tordconstnode(left).value = 1) and (nodetype=muln) then
|
||||||
case nodetype of
|
result := right.getcopy
|
||||||
muln:
|
|
||||||
result := right.getcopy;
|
else if (tordconstnode(left).value = -1) and (nodetype=muln) then
|
||||||
else
|
result := ctypeconvnode.create_internal(cunaryminusnode.create(right.getcopy),right.resultdef)
|
||||||
;
|
|
||||||
end;
|
|
||||||
end
|
|
||||||
else if tordconstnode(left).value = -1 then
|
|
||||||
begin
|
|
||||||
case nodetype of
|
|
||||||
muln:
|
|
||||||
result := ctypeconvnode.create_internal(cunaryminusnode.create(right.getcopy),right.resultdef);
|
|
||||||
else
|
|
||||||
;
|
|
||||||
end;
|
|
||||||
end
|
|
||||||
{ try to fold
|
{ try to fold
|
||||||
op
|
op
|
||||||
/ \
|
/ \
|
||||||
@ -874,13 +888,7 @@ implementation
|
|||||||
andn,
|
andn,
|
||||||
orn,
|
orn,
|
||||||
muln:
|
muln:
|
||||||
begin
|
Result:=SwapLeftWithRightRight;
|
||||||
hp:=left;
|
|
||||||
left:=taddnode(right).right;
|
|
||||||
taddnode(right).right:=hp;
|
|
||||||
right:=right.simplify(false);
|
|
||||||
result:=GetCopyAndTypeCheck;
|
|
||||||
end;
|
|
||||||
else
|
else
|
||||||
;
|
;
|
||||||
end;
|
end;
|
||||||
@ -893,13 +901,7 @@ implementation
|
|||||||
andn,
|
andn,
|
||||||
orn,
|
orn,
|
||||||
muln:
|
muln:
|
||||||
begin
|
Result:=SwapLeftWithRightLeft;
|
||||||
hp:=left;
|
|
||||||
left:=taddnode(right).left;
|
|
||||||
taddnode(right).left:=hp;
|
|
||||||
right:=right.simplify(false);
|
|
||||||
result:=GetCopyAndTypeCheck;
|
|
||||||
end;
|
|
||||||
else
|
else
|
||||||
;
|
;
|
||||||
end;
|
end;
|
||||||
|
@ -940,8 +940,11 @@ unit optdfa;
|
|||||||
MaybeSearchIn(texitnode(node).left);
|
MaybeSearchIn(texitnode(node).left);
|
||||||
{ exit uses the resultnode implicitly, so searching for a matching node is
|
{ exit uses the resultnode implicitly, so searching for a matching node is
|
||||||
useless, if we reach the exit node and found the living node not in left, then
|
useless, if we reach the exit node and found the living node not in left, then
|
||||||
it can be only the resultnode }
|
it can be only the resultnode
|
||||||
if not(Result) and not(is_void(current_procinfo.procdef.returndef)) and
|
|
||||||
|
successor might be assigned in case of an inlined exit node, in this case we do not warn about an unassigned
|
||||||
|
result as this had happened already when the routine has been compiled }
|
||||||
|
if not(assigned(node.successor)) and not(Result) and not(is_void(current_procinfo.procdef.returndef)) and
|
||||||
not(assigned(texitnode(node).resultexpr)) and
|
not(assigned(texitnode(node).resultexpr)) and
|
||||||
{ don't warn about constructors }
|
{ don't warn about constructors }
|
||||||
not(current_procinfo.procdef.proctypeoption in [potype_class_constructor,potype_constructor]) then
|
not(current_procinfo.procdef.proctypeoption in [potype_class_constructor,potype_constructor]) then
|
||||||
|
@ -1,57 +1,289 @@
|
|||||||
<?xml version="1.0"?>
|
<?xml version="1.0" encoding="UTF-8"?>
|
||||||
<CONFIG>
|
<CONFIG>
|
||||||
<ProjectOptions>
|
<ProjectOptions>
|
||||||
<PathDelim Value="/"/>
|
<Version Value="12"/>
|
||||||
<Version Value="5"/>
|
|
||||||
<General>
|
<General>
|
||||||
<MainUnit Value="0"/>
|
<Flags>
|
||||||
<IconPath Value="./"/>
|
<MainUnitHasCreateFormStatements Value="False"/>
|
||||||
<TargetFileExt Value=""/>
|
<MainUnitHasTitleStatement Value="False"/>
|
||||||
<ActiveEditorIndexAtStart Value="1"/>
|
<MainUnitHasScaledStatement Value="False"/>
|
||||||
|
<LRSInOutputDirectory Value="False"/>
|
||||||
|
<CompatibilityMode Value="True"/>
|
||||||
|
</Flags>
|
||||||
</General>
|
</General>
|
||||||
<VersionInfo>
|
<VersionInfo>
|
||||||
<ProjectVersion Value=""/>
|
|
||||||
<Language Value=""/>
|
<Language Value=""/>
|
||||||
<CharSet Value=""/>
|
<CharSet Value=""/>
|
||||||
</VersionInfo>
|
</VersionInfo>
|
||||||
|
<BuildModes Count="1">
|
||||||
|
<Item1 Name="default" Default="True"/>
|
||||||
|
</BuildModes>
|
||||||
<PublishOptions>
|
<PublishOptions>
|
||||||
<Version Value="2"/>
|
<Version Value="2"/>
|
||||||
<IgnoreBinaries Value="False"/>
|
|
||||||
<IncludeFileFilter Value="*.(pas|pp|inc|lfm|lpr|lrs|lpi|lpk|sh|xml)"/>
|
|
||||||
<ExcludeFileFilter Value="*.(bak|ppu|ppw|o|so);*~;backup"/>
|
|
||||||
</PublishOptions>
|
</PublishOptions>
|
||||||
<RunParams>
|
<RunParams>
|
||||||
<local>
|
<local>
|
||||||
<FormatVersion Value="1"/>
|
<CommandLineParams Value="extractindex D:/src/chm/chmlaptop500gb/testproject/5/chmtest.chm"/>
|
||||||
<LaunchingApplication PathPlusParams="/usr/X11R6/bin/xterm -T 'Lazarus Run Output' -e $(LazarusDir)/tools/runwait.sh $(TargetCmdLine)"/>
|
<LaunchingApplication PathPlusParams="/usr/X11R6/bin/xterm -T 'Lazarus Run Output' -e $(LazarusDir)/tools/runwait.sh $(TargetCmdLine)"/>
|
||||||
|
<WorkingDirectory Value="D:/src/chm/chmlaptop500gb/testproject/5"/>
|
||||||
</local>
|
</local>
|
||||||
|
<FormatVersion Value="2"/>
|
||||||
|
<Modes Count="1">
|
||||||
|
<Mode0 Name="default">
|
||||||
|
<local>
|
||||||
|
<CommandLineParams Value="extractindex D:/src/chm/chmlaptop500gb/testproject/5/chmtest.chm"/>
|
||||||
|
<LaunchingApplication PathPlusParams="/usr/X11R6/bin/xterm -T 'Lazarus Run Output' -e $(LazarusDir)/tools/runwait.sh $(TargetCmdLine)"/>
|
||||||
|
<WorkingDirectory Value="D:/src/chm/chmlaptop500gb/testproject/5"/>
|
||||||
|
</local>
|
||||||
|
</Mode0>
|
||||||
|
</Modes>
|
||||||
</RunParams>
|
</RunParams>
|
||||||
<Units Count="1">
|
<Units Count="14">
|
||||||
<Unit0>
|
<Unit0>
|
||||||
<Filename Value="chmls.lpr"/>
|
<Filename Value="chmls.lpr"/>
|
||||||
<IsPartOfProject Value="True"/>
|
<IsPartOfProject Value="True"/>
|
||||||
<UnitName Value="chmls"/>
|
<IsVisibleTab Value="True"/>
|
||||||
<CursorPos X="22" Y="66"/>
|
<TopLine Value="45"/>
|
||||||
<TopLine Value="41"/>
|
<CursorPos X="24" Y="104"/>
|
||||||
<EditorIndex Value="0"/>
|
<UsageCount Value="192"/>
|
||||||
<UsageCount Value="29"/>
|
|
||||||
<Loaded Value="True"/>
|
<Loaded Value="True"/>
|
||||||
|
<LoadedDesigner Value="True"/>
|
||||||
</Unit0>
|
</Unit0>
|
||||||
|
<Unit1>
|
||||||
|
<Filename Value="chmreader.pas"/>
|
||||||
|
<EditorIndex Value="1"/>
|
||||||
|
<TopLine Value="1580"/>
|
||||||
|
<CursorPos X="91" Y="1669"/>
|
||||||
|
<UsageCount Value="91"/>
|
||||||
|
<Loaded Value="True"/>
|
||||||
|
</Unit1>
|
||||||
|
<Unit2>
|
||||||
|
<Filename Value="chmsitemap.pas"/>
|
||||||
|
<EditorIndex Value="6"/>
|
||||||
|
<TopLine Value="464"/>
|
||||||
|
<CursorPos X="14" Y="509"/>
|
||||||
|
<UsageCount Value="91"/>
|
||||||
|
<Loaded Value="True"/>
|
||||||
|
</Unit2>
|
||||||
|
<Unit3>
|
||||||
|
<Filename Value="../../../../lazarus/components/lazutils/utf8process.pp"/>
|
||||||
|
<UnitName Value="UTF8Process"/>
|
||||||
|
<EditorIndex Value="12"/>
|
||||||
|
<TopLine Value="170"/>
|
||||||
|
<CursorPos X="69" Y="209"/>
|
||||||
|
<UsageCount Value="87"/>
|
||||||
|
<Loaded Value="True"/>
|
||||||
|
</Unit3>
|
||||||
|
<Unit4>
|
||||||
|
<Filename Value="htmlutil.pas"/>
|
||||||
|
<UnitName Value="HTMLUtil"/>
|
||||||
|
<EditorIndex Value="11"/>
|
||||||
|
<TopLine Value="175"/>
|
||||||
|
<CursorPos X="3" Y="175"/>
|
||||||
|
<UsageCount Value="84"/>
|
||||||
|
<Loaded Value="True"/>
|
||||||
|
</Unit4>
|
||||||
|
<Unit5>
|
||||||
|
<Filename Value="../../rtl-generics/src/inc/generics.dictionariesh.inc"/>
|
||||||
|
<EditorIndex Value="10"/>
|
||||||
|
<TopLine Value="566"/>
|
||||||
|
<CursorPos X="44" Y="614"/>
|
||||||
|
<UsageCount Value="84"/>
|
||||||
|
<Loaded Value="True"/>
|
||||||
|
</Unit5>
|
||||||
|
<Unit6>
|
||||||
|
<Filename Value="../../rtl-generics/src/generics.collections.pas"/>
|
||||||
|
<UnitName Value="Generics.Collections"/>
|
||||||
|
<EditorIndex Value="9"/>
|
||||||
|
<TopLine Value="400"/>
|
||||||
|
<CursorPos X="18" Y="470"/>
|
||||||
|
<UsageCount Value="81"/>
|
||||||
|
<Loaded Value="True"/>
|
||||||
|
</Unit6>
|
||||||
|
<Unit7>
|
||||||
|
<Filename Value="../../../rtl/win32/classes.pp"/>
|
||||||
|
<UnitName Value="Classes"/>
|
||||||
|
<EditorIndex Value="7"/>
|
||||||
|
<CursorPos X="15" Y="44"/>
|
||||||
|
<UsageCount Value="81"/>
|
||||||
|
<Loaded Value="True"/>
|
||||||
|
</Unit7>
|
||||||
|
<Unit8>
|
||||||
|
<Filename Value="../../../rtl/objpas/classes/classesh.inc"/>
|
||||||
|
<EditorIndex Value="8"/>
|
||||||
|
<TopLine Value="195"/>
|
||||||
|
<CursorPos X="8" Y="272"/>
|
||||||
|
<UsageCount Value="81"/>
|
||||||
|
<Loaded Value="True"/>
|
||||||
|
</Unit8>
|
||||||
|
<Unit9>
|
||||||
|
<Filename Value="chmwriter.pas"/>
|
||||||
|
<EditorIndex Value="4"/>
|
||||||
|
<TopLine Value="1179"/>
|
||||||
|
<CursorPos X="40" Y="1258"/>
|
||||||
|
<UsageCount Value="68"/>
|
||||||
|
<Loaded Value="True"/>
|
||||||
|
</Unit9>
|
||||||
|
<Unit10>
|
||||||
|
<Filename Value="../../../utils/fpdoc/dw_html.pp"/>
|
||||||
|
<EditorIndex Value="5"/>
|
||||||
|
<TopLine Value="161"/>
|
||||||
|
<CursorPos Y="198"/>
|
||||||
|
<UsageCount Value="66"/>
|
||||||
|
<Loaded Value="True"/>
|
||||||
|
</Unit10>
|
||||||
|
<Unit11>
|
||||||
|
<Filename Value="../../../utils/fpdoc/dw_htmlchm.inc"/>
|
||||||
|
<EditorIndex Value="-1"/>
|
||||||
|
<TopLine Value="177"/>
|
||||||
|
<CursorPos X="17" Y="219"/>
|
||||||
|
<UsageCount Value="66"/>
|
||||||
|
</Unit11>
|
||||||
|
<Unit12>
|
||||||
|
<Filename Value="chmtypes.pas"/>
|
||||||
|
<EditorIndex Value="3"/>
|
||||||
|
<UsageCount Value="59"/>
|
||||||
|
<Loaded Value="True"/>
|
||||||
|
</Unit12>
|
||||||
|
<Unit13>
|
||||||
|
<Filename Value="../../../rtl/objpas/classes/lists.inc"/>
|
||||||
|
<EditorIndex Value="2"/>
|
||||||
|
<TopLine Value="635"/>
|
||||||
|
<CursorPos Y="680"/>
|
||||||
|
<UsageCount Value="33"/>
|
||||||
|
<Loaded Value="True"/>
|
||||||
|
</Unit13>
|
||||||
</Units>
|
</Units>
|
||||||
<JumpHistory Count="0">
|
<JumpHistory Count="30" HistoryIndex="29">
|
||||||
|
<Position1>
|
||||||
|
<Filename Value="chmreader.pas"/>
|
||||||
|
<Caret Line="1291" Column="34" TopLine="1211"/>
|
||||||
|
</Position1>
|
||||||
|
<Position2>
|
||||||
|
<Filename Value="chmreader.pas"/>
|
||||||
|
<Caret Line="1366" Column="12" TopLine="1314"/>
|
||||||
|
</Position2>
|
||||||
|
<Position3>
|
||||||
|
<Filename Value="chmreader.pas"/>
|
||||||
|
<Caret Line="1376" Column="50" TopLine="1314"/>
|
||||||
|
</Position3>
|
||||||
|
<Position4>
|
||||||
|
<Filename Value="chmreader.pas"/>
|
||||||
|
<Caret Line="1325" Column="5" TopLine="1280"/>
|
||||||
|
</Position4>
|
||||||
|
<Position5>
|
||||||
|
<Filename Value="chmreader.pas"/>
|
||||||
|
<Caret Line="91" Column="14" TopLine="46"/>
|
||||||
|
</Position5>
|
||||||
|
<Position6>
|
||||||
|
<Filename Value="chmreader.pas"/>
|
||||||
|
<Caret Line="933" Column="3" TopLine="926"/>
|
||||||
|
</Position6>
|
||||||
|
<Position7>
|
||||||
|
<Filename Value="chmreader.pas"/>
|
||||||
|
<Caret Line="937" Column="21" TopLine="926"/>
|
||||||
|
</Position7>
|
||||||
|
<Position8>
|
||||||
|
<Filename Value="chmreader.pas"/>
|
||||||
|
<Caret Line="1313" Column="17" TopLine="1266"/>
|
||||||
|
</Position8>
|
||||||
|
<Position9>
|
||||||
|
<Filename Value="chmreader.pas"/>
|
||||||
|
<Caret Line="91" Column="15" TopLine="46"/>
|
||||||
|
</Position9>
|
||||||
|
<Position10>
|
||||||
|
<Filename Value="chmreader.pas"/>
|
||||||
|
<Caret Line="934" Column="3" TopLine="926"/>
|
||||||
|
</Position10>
|
||||||
|
<Position11>
|
||||||
|
<Filename Value="chmreader.pas"/>
|
||||||
|
<Caret Line="1322" Column="17" TopLine="1273"/>
|
||||||
|
</Position11>
|
||||||
|
<Position12>
|
||||||
|
<Filename Value="chmreader.pas"/>
|
||||||
|
<Caret Line="1360" Column="28" TopLine="1312"/>
|
||||||
|
</Position12>
|
||||||
|
<Position13>
|
||||||
|
<Filename Value="chmreader.pas"/>
|
||||||
|
</Position13>
|
||||||
|
<Position14>
|
||||||
|
<Filename Value="chmreader.pas"/>
|
||||||
|
<Caret Line="53" Column="64"/>
|
||||||
|
</Position14>
|
||||||
|
<Position15>
|
||||||
|
<Filename Value="chmreader.pas"/>
|
||||||
|
<Caret Line="80" Column="38"/>
|
||||||
|
</Position15>
|
||||||
|
<Position16>
|
||||||
|
<Filename Value="chmreader.pas"/>
|
||||||
|
<Caret Line="81" Column="48"/>
|
||||||
|
</Position16>
|
||||||
|
<Position17>
|
||||||
|
<Filename Value="chmreader.pas"/>
|
||||||
|
<Caret Line="944" Column="83" TopLine="862"/>
|
||||||
|
</Position17>
|
||||||
|
<Position18>
|
||||||
|
<Filename Value="chmreader.pas"/>
|
||||||
|
<Caret Line="1503" Column="12" TopLine="1421"/>
|
||||||
|
</Position18>
|
||||||
|
<Position19>
|
||||||
|
<Filename Value="chmreader.pas"/>
|
||||||
|
<Caret Line="1554" Column="41" TopLine="1472"/>
|
||||||
|
</Position19>
|
||||||
|
<Position20>
|
||||||
|
<Filename Value="chmls.lpr"/>
|
||||||
|
<Caret Line="492" Column="38" TopLine="482"/>
|
||||||
|
</Position20>
|
||||||
|
<Position21>
|
||||||
|
<Filename Value="chmls.lpr"/>
|
||||||
|
</Position21>
|
||||||
|
<Position22>
|
||||||
|
<Filename Value="chmls.lpr"/>
|
||||||
|
<Caret Line="47" Column="58"/>
|
||||||
|
</Position22>
|
||||||
|
<Position23>
|
||||||
|
<Filename Value="chmls.lpr"/>
|
||||||
|
<Caret Line="189" Column="3" TopLine="186"/>
|
||||||
|
</Position23>
|
||||||
|
<Position24>
|
||||||
|
<Filename Value="chmls.lpr"/>
|
||||||
|
<Caret Line="1009" Column="33" TopLine="983"/>
|
||||||
|
</Position24>
|
||||||
|
<Position25>
|
||||||
|
<Filename Value="chmls.lpr"/>
|
||||||
|
<Caret Line="140" Column="21" TopLine="64"/>
|
||||||
|
</Position25>
|
||||||
|
<Position26>
|
||||||
|
<Filename Value="chmls.lpr"/>
|
||||||
|
<Caret Line="1011" Column="20" TopLine="989"/>
|
||||||
|
</Position26>
|
||||||
|
<Position27>
|
||||||
|
<Filename Value="chmls.lpr"/>
|
||||||
|
<Caret Line="199" Column="64" TopLine="173"/>
|
||||||
|
</Position27>
|
||||||
|
<Position28>
|
||||||
|
<Filename Value="chmls.lpr"/>
|
||||||
|
</Position28>
|
||||||
|
<Position29>
|
||||||
|
<Filename Value="chmls.lpr"/>
|
||||||
|
<Caret Line="197" Column="85" TopLine="146"/>
|
||||||
|
</Position29>
|
||||||
|
<Position30>
|
||||||
|
<Filename Value="chmls.lpr"/>
|
||||||
|
<Caret Line="462" TopLine="373"/>
|
||||||
|
</Position30>
|
||||||
</JumpHistory>
|
</JumpHistory>
|
||||||
</ProjectOptions>
|
</ProjectOptions>
|
||||||
<CompilerOptions>
|
<CompilerOptions>
|
||||||
<Version Value="5"/>
|
<Version Value="11"/>
|
||||||
<SearchPaths>
|
<SearchPaths>
|
||||||
<OtherUnitFiles Value="/home/andrew/programming/lazarus/components/chmhelp/packages/chm/"/>
|
<UnitOutputDirectory Value="../units/$(TargetCPU)-$(TargetOS)"/>
|
||||||
</SearchPaths>
|
</SearchPaths>
|
||||||
<CodeGeneration>
|
<Parsing>
|
||||||
<Generate Value="Faster"/>
|
<SyntaxOptions>
|
||||||
</CodeGeneration>
|
<UseAnsiStrings Value="False"/>
|
||||||
<Other>
|
</SyntaxOptions>
|
||||||
<CompilerPath Value="$(CompPath)"/>
|
</Parsing>
|
||||||
</Other>
|
|
||||||
</CompilerOptions>
|
</CompilerOptions>
|
||||||
<Debugging>
|
<Debugging>
|
||||||
<Exceptions Count="2">
|
<Exceptions Count="2">
|
||||||
|
@ -61,7 +61,7 @@ Const
|
|||||||
CmdNames : array [TCmdEnum] of String = ('LIST','EXTRACT','EXTRACTALL','UNBLOCK','EXTRACTALIAS','EXTRACTTOC','EXTRACTINDEX','PRINTIDXHDR','PRINTSYSTEM','PRINTWINDOWS','PRINTTOPICS','');
|
CmdNames : array [TCmdEnum] of String = ('LIST','EXTRACT','EXTRACTALL','UNBLOCK','EXTRACTALIAS','EXTRACTTOC','EXTRACTINDEX','PRINTIDXHDR','PRINTSYSTEM','PRINTWINDOWS','PRINTTOPICS','');
|
||||||
|
|
||||||
var
|
var
|
||||||
theopts : array[1..4] of TOption;
|
theopts : array[1..5] of TOption;
|
||||||
|
|
||||||
|
|
||||||
Procedure Usage;
|
Procedure Usage;
|
||||||
@ -72,6 +72,7 @@ begin
|
|||||||
writeln(stderr,'Switches : ');
|
writeln(stderr,'Switches : ');
|
||||||
writeln(stderr,' -h, --help : this screen');
|
writeln(stderr,' -h, --help : this screen');
|
||||||
writeln(stderr,' -p, --no-page : do not page list output');
|
writeln(stderr,' -p, --no-page : do not page list output');
|
||||||
|
writeln(stderr,' --no-offset : do not show "offset" column in list output');
|
||||||
writeln(stderr,' -n,--name-only : only show "name" column in list output');
|
writeln(stderr,' -n,--name-only : only show "name" column in list output');
|
||||||
writeln(stderr);
|
writeln(stderr);
|
||||||
writeln(stderr,'Where command is one of the following or if omitted, equal to LIST.');
|
writeln(stderr,'Where command is one of the following or if omitted, equal to LIST.');
|
||||||
@ -136,6 +137,12 @@ begin
|
|||||||
flag:=nil;
|
flag:=nil;
|
||||||
end;
|
end;
|
||||||
with theopts[4] do
|
with theopts[4] do
|
||||||
|
begin
|
||||||
|
name:='no-offset';
|
||||||
|
has_arg:=0;
|
||||||
|
flag:=nil;
|
||||||
|
end;
|
||||||
|
with theopts[5] do
|
||||||
begin
|
begin
|
||||||
name:='';
|
name:='';
|
||||||
has_arg:=0;
|
has_arg:=0;
|
||||||
@ -183,20 +190,30 @@ begin
|
|||||||
end;
|
end;
|
||||||
|
|
||||||
|
|
||||||
|
var donotshowoffset : boolean=false;
|
||||||
|
|
||||||
procedure TListObject.OnFileEntry(Name: String; Offset, UncompressedSize,
|
procedure TListObject.OnFileEntry(Name: String; Offset, UncompressedSize,
|
||||||
ASection: Integer);
|
ASection: Integer);
|
||||||
begin
|
begin
|
||||||
Inc(Count);
|
Inc(Count);
|
||||||
if (Section > -1) and (ASection <> Section) then Exit;
|
if (Section > -1) and (ASection <> Section) then Exit;
|
||||||
if (Count = 1) or ((Count mod 40 = 0) and not donotpage) then
|
if (Count = 1) or ((Count mod 40 = 0) and not donotpage) then
|
||||||
WriteLn(StdErr, '<Section> <Offset> <UnCompSize> <Name>');
|
begin
|
||||||
|
Write(StdErr, '<Section> ');
|
||||||
|
if not donotshowoffset then
|
||||||
|
Write(StdErr, '<Offset> ');
|
||||||
|
Writeln(StdErr, '<UnCompSize> <Name>');
|
||||||
|
end;
|
||||||
if not nameonly then
|
if not nameonly then
|
||||||
begin
|
begin
|
||||||
Write(' ');
|
Write(' ');
|
||||||
Write(ASection);
|
Write(ASection);
|
||||||
Write(' ');
|
Write(' ');
|
||||||
|
if not donotshowoffset then
|
||||||
|
begin
|
||||||
WriteStrAdj(IntToStr(Offset), 10);
|
WriteStrAdj(IntToStr(Offset), 10);
|
||||||
Write(' ');
|
Write(' ');
|
||||||
|
end;
|
||||||
WriteStrAdj(IntToStr(UncompressedSize), 11);
|
WriteStrAdj(IntToStr(UncompressedSize), 11);
|
||||||
Write(' ');
|
Write(' ');
|
||||||
end;
|
end;
|
||||||
@ -1003,6 +1020,7 @@ begin
|
|||||||
end;
|
end;
|
||||||
1 : name_only:=true;
|
1 : name_only:=true;
|
||||||
2 : donotpage:=true;
|
2 : donotpage:=true;
|
||||||
|
3 : donotshowoffset:=true;
|
||||||
|
|
||||||
end;
|
end;
|
||||||
end;
|
end;
|
||||||
|
@ -435,6 +435,7 @@ type
|
|||||||
revkSetOfInt, // set of enum, int, char, widechar, e.g. [1,2..3]
|
revkSetOfInt, // set of enum, int, char, widechar, e.g. [1,2..3]
|
||||||
revkExternal // TResEvalExternal: an external const
|
revkExternal // TResEvalExternal: an external const
|
||||||
);
|
);
|
||||||
|
TREVKinds = set of TREVKind;
|
||||||
const
|
const
|
||||||
revkAllStrings = [{$ifdef FPC_HAS_CPSTRING}revkString,{$endif}revkUnicodeString];
|
revkAllStrings = [{$ifdef FPC_HAS_CPSTRING}revkString,{$endif}revkUnicodeString];
|
||||||
type
|
type
|
||||||
@ -447,6 +448,7 @@ type
|
|||||||
function Clone: TResEvalValue; virtual;
|
function Clone: TResEvalValue; virtual;
|
||||||
function AsDebugString: string; virtual;
|
function AsDebugString: string; virtual;
|
||||||
function AsString: string; virtual;
|
function AsString: string; virtual;
|
||||||
|
function TypeAsString: string; virtual;
|
||||||
end;
|
end;
|
||||||
TResEvalValueClass = class of TResEvalValue;
|
TResEvalValueClass = class of TResEvalValue;
|
||||||
|
|
||||||
@ -459,6 +461,7 @@ type
|
|||||||
constructor CreateValue(const aValue: boolean);
|
constructor CreateValue(const aValue: boolean);
|
||||||
function Clone: TResEvalValue; override;
|
function Clone: TResEvalValue; override;
|
||||||
function AsString: string; override;
|
function AsString: string; override;
|
||||||
|
function TypeAsString: string; override;
|
||||||
end;
|
end;
|
||||||
|
|
||||||
TResEvalTypedInt = (
|
TResEvalTypedInt = (
|
||||||
@ -520,6 +523,7 @@ type
|
|||||||
function Clone: TResEvalValue; override;
|
function Clone: TResEvalValue; override;
|
||||||
function AsString: string; override;
|
function AsString: string; override;
|
||||||
function AsDebugString: string; override;
|
function AsDebugString: string; override;
|
||||||
|
function TypeAsString: string; override;
|
||||||
end;
|
end;
|
||||||
|
|
||||||
{ TResEvalUInt }
|
{ TResEvalUInt }
|
||||||
@ -531,6 +535,7 @@ type
|
|||||||
constructor CreateValue(const aValue: TMaxPrecUInt);
|
constructor CreateValue(const aValue: TMaxPrecUInt);
|
||||||
function Clone: TResEvalValue; override;
|
function Clone: TResEvalValue; override;
|
||||||
function AsString: string; override;
|
function AsString: string; override;
|
||||||
|
function TypeAsString: string; override;
|
||||||
end;
|
end;
|
||||||
|
|
||||||
{ TResEvalFloat }
|
{ TResEvalFloat }
|
||||||
@ -543,6 +548,7 @@ type
|
|||||||
function Clone: TResEvalValue; override;
|
function Clone: TResEvalValue; override;
|
||||||
function AsString: string; override;
|
function AsString: string; override;
|
||||||
function IsInt(out Int: TMaxPrecInt): boolean;
|
function IsInt(out Int: TMaxPrecInt): boolean;
|
||||||
|
function TypeAsString: string; override;
|
||||||
end;
|
end;
|
||||||
|
|
||||||
{ TResEvalCurrency }
|
{ TResEvalCurrency }
|
||||||
@ -556,6 +562,7 @@ type
|
|||||||
function AsString: string; override;
|
function AsString: string; override;
|
||||||
function IsInt(out Int: TMaxPrecInt): boolean;
|
function IsInt(out Int: TMaxPrecInt): boolean;
|
||||||
function AsInt: TMaxPrecInt; // value * 10.000
|
function AsInt: TMaxPrecInt; // value * 10.000
|
||||||
|
function TypeAsString: string; override;
|
||||||
end;
|
end;
|
||||||
|
|
||||||
{$ifdef FPC_HAS_CPSTRING}
|
{$ifdef FPC_HAS_CPSTRING}
|
||||||
@ -569,6 +576,7 @@ type
|
|||||||
constructor CreateValue(const aValue: RawByteString);
|
constructor CreateValue(const aValue: RawByteString);
|
||||||
function Clone: TResEvalValue; override;
|
function Clone: TResEvalValue; override;
|
||||||
function AsString: string; override;
|
function AsString: string; override;
|
||||||
|
function TypeAsString: string; override;
|
||||||
end;
|
end;
|
||||||
{$endif}
|
{$endif}
|
||||||
|
|
||||||
@ -581,6 +589,7 @@ type
|
|||||||
constructor CreateValue(const aValue: UnicodeString);
|
constructor CreateValue(const aValue: UnicodeString);
|
||||||
function Clone: TResEvalValue; override;
|
function Clone: TResEvalValue; override;
|
||||||
function AsString: string; override;
|
function AsString: string; override;
|
||||||
|
function TypeAsString: string; override;
|
||||||
end;
|
end;
|
||||||
|
|
||||||
{ TResEvalEnum - Kind=revkEnum, Value.Int }
|
{ TResEvalEnum - Kind=revkEnum, Value.Int }
|
||||||
@ -596,6 +605,7 @@ type
|
|||||||
function Clone: TResEvalValue; override;
|
function Clone: TResEvalValue; override;
|
||||||
function AsDebugString: string; override;
|
function AsDebugString: string; override;
|
||||||
function AsString: string; override;
|
function AsString: string; override;
|
||||||
|
function TypeAsString: string; override;
|
||||||
end;
|
end;
|
||||||
|
|
||||||
TRESetElKind = (
|
TRESetElKind = (
|
||||||
@ -620,6 +630,7 @@ type
|
|||||||
function AsString: string; override;
|
function AsString: string; override;
|
||||||
function AsDebugString: string; override;
|
function AsDebugString: string; override;
|
||||||
function ElementAsString(El: TMaxPrecInt): string; virtual;
|
function ElementAsString(El: TMaxPrecInt): string; virtual;
|
||||||
|
function TypeAsString: string; override;
|
||||||
end;
|
end;
|
||||||
|
|
||||||
{ TResEvalRangeUInt }
|
{ TResEvalRangeUInt }
|
||||||
@ -631,6 +642,7 @@ type
|
|||||||
constructor CreateValue(const aRangeStart, aRangeEnd: TMaxPrecUInt);
|
constructor CreateValue(const aRangeStart, aRangeEnd: TMaxPrecUInt);
|
||||||
function Clone: TResEvalValue; override;
|
function Clone: TResEvalValue; override;
|
||||||
function AsString: string; override;
|
function AsString: string; override;
|
||||||
|
function TypeAsString: string; override;
|
||||||
end;
|
end;
|
||||||
|
|
||||||
{ TResEvalSet - Kind=revkSetOfInt }
|
{ TResEvalSet - Kind=revkSetOfInt }
|
||||||
@ -652,6 +664,7 @@ type
|
|||||||
const aRangeStart, aRangeEnd: TMaxPrecInt); override;
|
const aRangeStart, aRangeEnd: TMaxPrecInt); override;
|
||||||
function Clone: TResEvalValue; override;
|
function Clone: TResEvalValue; override;
|
||||||
function AsString: string; override;
|
function AsString: string; override;
|
||||||
|
function TypeAsString: string; override;
|
||||||
function Add(aRangeStart, aRangeEnd: TMaxPrecInt): boolean; // false if duplicate ignored
|
function Add(aRangeStart, aRangeEnd: TMaxPrecInt): boolean; // false if duplicate ignored
|
||||||
function IndexOfRange(Index: TMaxPrecInt; FindInsertPos: boolean = false): integer;
|
function IndexOfRange(Index: TMaxPrecInt; FindInsertPos: boolean = false): integer;
|
||||||
function Intersects(aRangeStart, aRangeEnd: TMaxPrecInt): integer; // returns index of first intersecting range
|
function Intersects(aRangeStart, aRangeEnd: TMaxPrecInt): integer; // returns index of first intersecting range
|
||||||
@ -665,6 +678,7 @@ type
|
|||||||
constructor Create; override;
|
constructor Create; override;
|
||||||
function Clone: TResEvalValue; override;
|
function Clone: TResEvalValue; override;
|
||||||
function AsString: string; override;
|
function AsString: string; override;
|
||||||
|
function TypeAsString: string; override;
|
||||||
end;
|
end;
|
||||||
|
|
||||||
TResEvalFlag = (
|
TResEvalFlag = (
|
||||||
@ -1188,6 +1202,11 @@ begin
|
|||||||
Result:=inherited AsString;
|
Result:=inherited AsString;
|
||||||
end;
|
end;
|
||||||
|
|
||||||
|
function TResEvalExternal.TypeAsString: string;
|
||||||
|
begin
|
||||||
|
Result:='external value';
|
||||||
|
end;
|
||||||
|
|
||||||
{ TResEvalCurrency }
|
{ TResEvalCurrency }
|
||||||
|
|
||||||
constructor TResEvalCurrency.Create;
|
constructor TResEvalCurrency.Create;
|
||||||
@ -1231,6 +1250,11 @@ begin
|
|||||||
{$endif};
|
{$endif};
|
||||||
end;
|
end;
|
||||||
|
|
||||||
|
function TResEvalCurrency.TypeAsString: string;
|
||||||
|
begin
|
||||||
|
Result:='currency';
|
||||||
|
end;
|
||||||
|
|
||||||
{ TResEvalBool }
|
{ TResEvalBool }
|
||||||
|
|
||||||
constructor TResEvalBool.Create;
|
constructor TResEvalBool.Create;
|
||||||
@ -1259,6 +1283,11 @@ begin
|
|||||||
Result:='false';
|
Result:='false';
|
||||||
end;
|
end;
|
||||||
|
|
||||||
|
function TResEvalBool.TypeAsString: string;
|
||||||
|
begin
|
||||||
|
Result:='boolean';
|
||||||
|
end;
|
||||||
|
|
||||||
{ TResEvalRangeUInt }
|
{ TResEvalRangeUInt }
|
||||||
|
|
||||||
constructor TResEvalRangeUInt.Create;
|
constructor TResEvalRangeUInt.Create;
|
||||||
@ -1287,6 +1316,11 @@ begin
|
|||||||
Result:=IntToStr(RangeStart)+'..'+IntToStr(RangeEnd);
|
Result:=IntToStr(RangeStart)+'..'+IntToStr(RangeEnd);
|
||||||
end;
|
end;
|
||||||
|
|
||||||
|
function TResEvalRangeUInt.TypeAsString: string;
|
||||||
|
begin
|
||||||
|
Result:='unsigned integer range';
|
||||||
|
end;
|
||||||
|
|
||||||
{ TResExprEvaluator }
|
{ TResExprEvaluator }
|
||||||
|
|
||||||
procedure TResExprEvaluator.LogMsg(const id: TMaxPrecInt; MsgType: TMessageType;
|
procedure TResExprEvaluator.LogMsg(const id: TMaxPrecInt; MsgType: TMessageType;
|
||||||
@ -5615,6 +5649,15 @@ begin
|
|||||||
end;
|
end;
|
||||||
end;
|
end;
|
||||||
|
|
||||||
|
function TResEvalValue.TypeAsString: string;
|
||||||
|
begin
|
||||||
|
case Kind of
|
||||||
|
revkNil: Result:='nil';
|
||||||
|
else
|
||||||
|
Result:='';
|
||||||
|
end;
|
||||||
|
end;
|
||||||
|
|
||||||
{ TResEvalUInt }
|
{ TResEvalUInt }
|
||||||
|
|
||||||
constructor TResEvalUInt.Create;
|
constructor TResEvalUInt.Create;
|
||||||
@ -5640,6 +5683,11 @@ begin
|
|||||||
Result:=IntToStr(UInt);
|
Result:=IntToStr(UInt);
|
||||||
end;
|
end;
|
||||||
|
|
||||||
|
function TResEvalUInt.TypeAsString: string;
|
||||||
|
begin
|
||||||
|
Result:='unsigned int';
|
||||||
|
end;
|
||||||
|
|
||||||
{ TResEvalInt }
|
{ TResEvalInt }
|
||||||
|
|
||||||
constructor TResEvalInt.Create;
|
constructor TResEvalInt.Create;
|
||||||
@ -5697,6 +5745,24 @@ begin
|
|||||||
end;
|
end;
|
||||||
end;
|
end;
|
||||||
|
|
||||||
|
function TResEvalInt.TypeAsString: string;
|
||||||
|
begin
|
||||||
|
case Typed of
|
||||||
|
reitByte: Result:='byte';
|
||||||
|
reitShortInt: Result:='shortint';
|
||||||
|
reitWord: Result:='word';
|
||||||
|
reitSmallInt: Result:='smallint';
|
||||||
|
reitUIntSingle: Result:='unsinged int single';
|
||||||
|
reitIntSingle: Result:='int single';
|
||||||
|
reitLongWord: Result:='longword';
|
||||||
|
reitLongInt: Result:='longint';
|
||||||
|
reitUIntDouble: Result:='unsigned int double';
|
||||||
|
reitIntDouble: Result:='int double';
|
||||||
|
else
|
||||||
|
Result:='int';
|
||||||
|
end;
|
||||||
|
end;
|
||||||
|
|
||||||
{ TResEvalFloat }
|
{ TResEvalFloat }
|
||||||
|
|
||||||
constructor TResEvalFloat.Create;
|
constructor TResEvalFloat.Create;
|
||||||
@ -5732,6 +5798,11 @@ begin
|
|||||||
Result:=true;
|
Result:=true;
|
||||||
end;
|
end;
|
||||||
|
|
||||||
|
function TResEvalFloat.TypeAsString: string;
|
||||||
|
begin
|
||||||
|
Result:='float';
|
||||||
|
end;
|
||||||
|
|
||||||
{$ifdef FPC_HAS_CPSTRING}
|
{$ifdef FPC_HAS_CPSTRING}
|
||||||
{ TResEvalString }
|
{ TResEvalString }
|
||||||
|
|
||||||
@ -5759,6 +5830,15 @@ function TResEvalString.AsString: string;
|
|||||||
begin
|
begin
|
||||||
Result:=RawStrToCaption(S,60);
|
Result:=RawStrToCaption(S,60);
|
||||||
end;
|
end;
|
||||||
|
|
||||||
|
function TResEvalString.TypeAsString: string;
|
||||||
|
begin
|
||||||
|
if OnlyASCII then
|
||||||
|
Result:='string'
|
||||||
|
else
|
||||||
|
Result:='ansistring';
|
||||||
|
end;
|
||||||
|
|
||||||
{$endif}
|
{$endif}
|
||||||
|
|
||||||
{ TResEvalUTF16 }
|
{ TResEvalUTF16 }
|
||||||
@ -5786,6 +5866,11 @@ begin
|
|||||||
Result:=String(UnicodeStrToCaption(S,60));
|
Result:=String(UnicodeStrToCaption(S,60));
|
||||||
end;
|
end;
|
||||||
|
|
||||||
|
function TResEvalUTF16.TypeAsString: string;
|
||||||
|
begin
|
||||||
|
Result:='unicodestring';
|
||||||
|
end;
|
||||||
|
|
||||||
{ TResEvalEnum }
|
{ TResEvalEnum }
|
||||||
|
|
||||||
constructor TResEvalEnum.Create;
|
constructor TResEvalEnum.Create;
|
||||||
@ -5849,6 +5934,13 @@ begin
|
|||||||
Result:=ElType.Name+'('+IntToStr(Index)+')';
|
Result:=ElType.Name+'('+IntToStr(Index)+')';
|
||||||
end;
|
end;
|
||||||
|
|
||||||
|
function TResEvalEnum.TypeAsString: string;
|
||||||
|
begin
|
||||||
|
Result:=ElType.Name;
|
||||||
|
if Result='' then
|
||||||
|
Result:='enum';
|
||||||
|
end;
|
||||||
|
|
||||||
{ TResEvalRangeInt }
|
{ TResEvalRangeInt }
|
||||||
|
|
||||||
constructor TResEvalRangeInt.Create;
|
constructor TResEvalRangeInt.Create;
|
||||||
@ -5920,6 +6012,18 @@ begin
|
|||||||
end;
|
end;
|
||||||
end;
|
end;
|
||||||
|
|
||||||
|
function TResEvalRangeInt.TypeAsString: string;
|
||||||
|
begin
|
||||||
|
case ElKind of
|
||||||
|
revskEnum: Result:='enum range';
|
||||||
|
revskInt: Result:='integer range';
|
||||||
|
revskChar: Result:='char range';
|
||||||
|
revskBool: Result:='boolean range';
|
||||||
|
else
|
||||||
|
Result:='integer range';
|
||||||
|
end;
|
||||||
|
end;
|
||||||
|
|
||||||
{ TResEvalSet }
|
{ TResEvalSet }
|
||||||
|
|
||||||
constructor TResEvalSet.Create;
|
constructor TResEvalSet.Create;
|
||||||
@ -5980,6 +6084,11 @@ begin
|
|||||||
Result:=Result+']';
|
Result:=Result+']';
|
||||||
end;
|
end;
|
||||||
|
|
||||||
|
function TResEvalSet.TypeAsString: string;
|
||||||
|
begin
|
||||||
|
Result:='set';
|
||||||
|
end;
|
||||||
|
|
||||||
function TResEvalSet.Add(aRangeStart, aRangeEnd: TMaxPrecInt): boolean;
|
function TResEvalSet.Add(aRangeStart, aRangeEnd: TMaxPrecInt): boolean;
|
||||||
|
|
||||||
{$IF FPC_FULLVERSION<30101}
|
{$IF FPC_FULLVERSION<30101}
|
||||||
|
@ -1698,6 +1698,7 @@ type
|
|||||||
procedure FinishAncestors(aClass: TPasClassType); virtual;
|
procedure FinishAncestors(aClass: TPasClassType); virtual;
|
||||||
procedure FinishMethodResolution(El: TPasMethodResolution); virtual;
|
procedure FinishMethodResolution(El: TPasMethodResolution); virtual;
|
||||||
procedure FinishAttributes(El: TPasAttributes); virtual;
|
procedure FinishAttributes(El: TPasAttributes); virtual;
|
||||||
|
procedure FinishExportSymbol(El: TPasExportSymbol); virtual;
|
||||||
procedure FinishProcParamAccess(ProcType: TPasProcedureType; Params: TParamsExpr); virtual;
|
procedure FinishProcParamAccess(ProcType: TPasProcedureType; Params: TParamsExpr); virtual;
|
||||||
procedure FinishPropertyParamAccess(Params: TParamsExpr;
|
procedure FinishPropertyParamAccess(Params: TParamsExpr;
|
||||||
Prop: TPasProperty); virtual;
|
Prop: TPasProperty); virtual;
|
||||||
@ -5826,6 +5827,7 @@ begin
|
|||||||
FinishSection(TPasLibrary(CurModule).LibrarySection);
|
FinishSection(TPasLibrary(CurModule).LibrarySection);
|
||||||
// resolve begin..end block
|
// resolve begin..end block
|
||||||
ResolveImplBlock(CurModule.InitializationSection);
|
ResolveImplBlock(CurModule.InitializationSection);
|
||||||
|
ResolveImplBlock(CurModule.FinalizationSection);
|
||||||
end
|
end
|
||||||
else if (CurModuleClass=TPasModule) then
|
else if (CurModuleClass=TPasModule) then
|
||||||
begin
|
begin
|
||||||
@ -7776,6 +7778,8 @@ begin
|
|||||||
FinishMethodResolution(TPasMethodResolution(El))
|
FinishMethodResolution(TPasMethodResolution(El))
|
||||||
else if C=TPasAttributes then
|
else if C=TPasAttributes then
|
||||||
FinishAttributes(TPasAttributes(El))
|
FinishAttributes(TPasAttributes(El))
|
||||||
|
else if C=TPasExportSymbol then
|
||||||
|
FinishExportSymbol(TPasExportSymbol(El))
|
||||||
else
|
else
|
||||||
begin
|
begin
|
||||||
{$IFDEF VerbosePasResolver}
|
{$IFDEF VerbosePasResolver}
|
||||||
@ -9133,6 +9137,31 @@ begin
|
|||||||
end;
|
end;
|
||||||
end;
|
end;
|
||||||
|
|
||||||
|
procedure TPasResolver.FinishExportSymbol(El: TPasExportSymbol);
|
||||||
|
|
||||||
|
procedure CheckExpExpr(Expr: TPasExpr; Kinds: TREVKinds; const Expected: string);
|
||||||
|
var
|
||||||
|
Value: TResEvalValue;
|
||||||
|
ResolvedEl: TPasResolverResult;
|
||||||
|
begin
|
||||||
|
if Expr=nil then exit;
|
||||||
|
ResolveExpr(Expr,rraRead);
|
||||||
|
Value:=Eval(Expr,[refConst]);
|
||||||
|
if (Value<>nil) and (Value.Kind in Kinds) then
|
||||||
|
begin
|
||||||
|
ReleaseEvalValue(Value);
|
||||||
|
exit;
|
||||||
|
end;
|
||||||
|
ReleaseEvalValue(Value);
|
||||||
|
ComputeElement(Expr,ResolvedEl,[rcConstant]);
|
||||||
|
RaiseXExpectedButYFound(20210101194628,Expected,GetTypeDescription(ResolvedEl),Expr);
|
||||||
|
end;
|
||||||
|
|
||||||
|
begin
|
||||||
|
CheckExpExpr(El.ExportIndex,[revkInt,revkUInt],'integer');
|
||||||
|
CheckExpExpr(El.ExportName,[revkString,revkUnicodeString],'string');
|
||||||
|
end;
|
||||||
|
|
||||||
procedure TPasResolver.FinishProcParamAccess(ProcType: TPasProcedureType;
|
procedure TPasResolver.FinishProcParamAccess(ProcType: TPasProcedureType;
|
||||||
Params: TParamsExpr);
|
Params: TParamsExpr);
|
||||||
var
|
var
|
||||||
@ -20836,6 +20865,7 @@ begin
|
|||||||
else if AClass.InheritsFrom(TPasImplBlock) then
|
else if AClass.InheritsFrom(TPasImplBlock) then
|
||||||
// resolved when finished
|
// resolved when finished
|
||||||
else if AClass=TPasAttributes then
|
else if AClass=TPasAttributes then
|
||||||
|
else if AClass=TPasExportSymbol then
|
||||||
else if AClass=TPasUnresolvedUnitRef then
|
else if AClass=TPasUnresolvedUnitRef then
|
||||||
RaiseMsg(20171018121900,nCantFindUnitX,sCantFindUnitX,[AName],El)
|
RaiseMsg(20171018121900,nCantFindUnitX,sCantFindUnitX,[AName],El)
|
||||||
else
|
else
|
||||||
|
@ -447,6 +447,7 @@ type
|
|||||||
PackageName: string;
|
PackageName: string;
|
||||||
Filename : String; // the IN filename, only written when not empty.
|
Filename : String; // the IN filename, only written when not empty.
|
||||||
end;
|
end;
|
||||||
|
TPasModuleClass = class of TPasModule;
|
||||||
|
|
||||||
{ TPasUnitModule }
|
{ TPasUnitModule }
|
||||||
|
|
||||||
|
@ -4360,6 +4360,7 @@ begin
|
|||||||
end;
|
end;
|
||||||
if not (CurToken in [tkComma,tkSemicolon]) then
|
if not (CurToken in [tkComma,tkSemicolon]) then
|
||||||
ParseExc(nParserExpectedCommaSemicolon,SParserExpectedCommaSemicolon);
|
ParseExc(nParserExpectedCommaSemicolon,SParserExpectedCommaSemicolon);
|
||||||
|
Engine.FinishScope(stDeclaration,E);
|
||||||
until (CurToken=tkSemicolon);
|
until (CurToken=tkSemicolon);
|
||||||
end;
|
end;
|
||||||
|
|
||||||
|
@ -142,7 +142,9 @@ type
|
|||||||
Procedure TearDown; override;
|
Procedure TearDown; override;
|
||||||
procedure CreateEngine(var TheEngine: TPasTreeContainer); override;
|
procedure CreateEngine(var TheEngine: TPasTreeContainer); override;
|
||||||
procedure ParseModule; override;
|
procedure ParseModule; override;
|
||||||
|
procedure ParseMain(ExpectedModuleClass: TPasModuleClass); virtual;
|
||||||
procedure ParseProgram; virtual;
|
procedure ParseProgram; virtual;
|
||||||
|
procedure ParseLibrary; virtual;
|
||||||
procedure ParseUnit; virtual;
|
procedure ParseUnit; virtual;
|
||||||
procedure CheckReferenceDirectives; virtual;
|
procedure CheckReferenceDirectives; virtual;
|
||||||
procedure CheckResolverHint(MsgType: TMessageType; MsgNumber: integer;
|
procedure CheckResolverHint(MsgType: TMessageType; MsgNumber: integer;
|
||||||
@ -172,6 +174,7 @@ type
|
|||||||
ImplementationSrc: string): TTestEnginePasResolver;
|
ImplementationSrc: string): TTestEnginePasResolver;
|
||||||
procedure AddSystemUnit(Parts: TSystemUnitParts = []);
|
procedure AddSystemUnit(Parts: TSystemUnitParts = []);
|
||||||
procedure StartProgram(NeedSystemUnit: boolean; SystemUnitParts: TSystemUnitParts = []);
|
procedure StartProgram(NeedSystemUnit: boolean; SystemUnitParts: TSystemUnitParts = []);
|
||||||
|
procedure StartLibrary(NeedSystemUnit: boolean; SystemUnitParts: TSystemUnitParts = []);
|
||||||
procedure StartUnit(NeedSystemUnit: boolean);
|
procedure StartUnit(NeedSystemUnit: boolean);
|
||||||
property Modules[Index: integer]: TTestEnginePasResolver read GetModules;
|
property Modules[Index: integer]: TTestEnginePasResolver read GetModules;
|
||||||
property ModuleCount: integer read GetModuleCount;
|
property ModuleCount: integer read GetModuleCount;
|
||||||
@ -975,6 +978,15 @@ type
|
|||||||
Procedure TestAttributes_NonConstParam_Fail;
|
Procedure TestAttributes_NonConstParam_Fail;
|
||||||
Procedure TestAttributes_UnknownAttrWarning;
|
Procedure TestAttributes_UnknownAttrWarning;
|
||||||
Procedure TestAttributes_Members;
|
Procedure TestAttributes_Members;
|
||||||
|
|
||||||
|
// library
|
||||||
|
Procedure TestLibrary_Empty;
|
||||||
|
Procedure TestLibrary_ExportFunc;
|
||||||
|
Procedure TestLibrary_ExportFunc_NameIntFail;
|
||||||
|
Procedure TestLibrary_ExportFunc_IndexStringFail;
|
||||||
|
Procedure TestLibrary_ExportVar; // ToDo
|
||||||
|
Procedure TestLibrary_Initialization_Finalization;
|
||||||
|
// ToDo Procedure TestLibrary_UnitExports;
|
||||||
end;
|
end;
|
||||||
|
|
||||||
function LinesToStr(Args: array of const): string;
|
function LinesToStr(Args: array of const): string;
|
||||||
@ -1193,7 +1205,7 @@ begin
|
|||||||
end;
|
end;
|
||||||
end;
|
end;
|
||||||
|
|
||||||
procedure TCustomTestResolver.ParseProgram;
|
procedure TCustomTestResolver.ParseMain(ExpectedModuleClass: TPasModuleClass);
|
||||||
var
|
var
|
||||||
aFilename: String;
|
aFilename: String;
|
||||||
aRow, aCol: Integer;
|
aRow, aCol: Integer;
|
||||||
@ -1208,7 +1220,7 @@ begin
|
|||||||
aRow:=E.Row;
|
aRow:=E.Row;
|
||||||
aCol:=E.Column;
|
aCol:=E.Column;
|
||||||
WriteSources(aFilename,aRow,aCol);
|
WriteSources(aFilename,aRow,aCol);
|
||||||
writeln('ERROR: TTestResolver.ParseProgram Parser: '+E.ClassName+':'+E.Message,
|
writeln('ERROR: TTestResolver.ParseMain ',ExpectedModuleClass.ClassName,' Parser: '+E.ClassName+':'+E.Message,
|
||||||
' Scanner at'
|
' Scanner at'
|
||||||
+' '+aFilename+'('+IntToStr(aRow)+','+IntToStr(aCol)+')'
|
+' '+aFilename+'('+IntToStr(aRow)+','+IntToStr(aCol)+')'
|
||||||
+' Line="'+Scanner.CurLine+'"');
|
+' Line="'+Scanner.CurLine+'"');
|
||||||
@ -1225,17 +1237,22 @@ begin
|
|||||||
ResolverEngine.UnmangleSourceLineNumber(E.PasElement.SourceLinenumber,aRow,aCol);
|
ResolverEngine.UnmangleSourceLineNumber(E.PasElement.SourceLinenumber,aRow,aCol);
|
||||||
end;
|
end;
|
||||||
WriteSources(aFilename,aRow,aCol);
|
WriteSources(aFilename,aRow,aCol);
|
||||||
writeln('ERROR: TTestResolver.ParseProgram PasResolver: '+E.ClassName+':'+E.Message
|
writeln('ERROR: TTestResolver.ParseMain ',ExpectedModuleClass.ClassName,' PasResolver: '+E.ClassName+':'+E.Message
|
||||||
+' at '+aFilename+'('+IntToStr(aRow)+','+IntToStr(aCol)+')');
|
+' at '+aFilename+'('+IntToStr(aRow)+','+IntToStr(aCol)+')');
|
||||||
Fail(E.Message);
|
Fail(E.Message);
|
||||||
end;
|
end;
|
||||||
on E: Exception do
|
on E: Exception do
|
||||||
begin
|
begin
|
||||||
writeln('ERROR: TTestResolver.ParseProgram Exception: '+E.ClassName+':'+E.Message);
|
writeln('ERROR: TTestResolver.ParseMain ',ExpectedModuleClass.ClassName,' Exception: '+E.ClassName+':'+E.Message);
|
||||||
Fail(E.Message);
|
Fail(E.Message);
|
||||||
end;
|
end;
|
||||||
end;
|
end;
|
||||||
TAssert.AssertSame('Has resolver',ResolverEngine,Parser.Engine);
|
TAssert.AssertSame('Has resolver',ResolverEngine,Parser.Engine);
|
||||||
|
end;
|
||||||
|
|
||||||
|
procedure TCustomTestResolver.ParseProgram;
|
||||||
|
begin
|
||||||
|
ParseMain(TPasProgram);
|
||||||
AssertEquals('Has program',TPasProgram,Module.ClassType);
|
AssertEquals('Has program',TPasProgram,Module.ClassType);
|
||||||
AssertNotNull('Has program section',PasProgram.ProgramSection);
|
AssertNotNull('Has program section',PasProgram.ProgramSection);
|
||||||
AssertNotNull('Has initialization section',PasProgram.InitializationSection);
|
AssertNotNull('Has initialization section',PasProgram.InitializationSection);
|
||||||
@ -1245,39 +1262,18 @@ begin
|
|||||||
CheckReferenceDirectives;
|
CheckReferenceDirectives;
|
||||||
end;
|
end;
|
||||||
|
|
||||||
|
procedure TCustomTestResolver.ParseLibrary;
|
||||||
|
begin
|
||||||
|
ParseMain(TPasLibrary);
|
||||||
|
AssertEquals('Has library',TPasLibrary,Module.ClassType);
|
||||||
|
AssertNotNull('Has library section',PasLibrary.LibrarySection);
|
||||||
|
AssertNotNull('Has initialization section',PasLibrary.InitializationSection);
|
||||||
|
CheckReferenceDirectives;
|
||||||
|
end;
|
||||||
|
|
||||||
procedure TCustomTestResolver.ParseUnit;
|
procedure TCustomTestResolver.ParseUnit;
|
||||||
begin
|
begin
|
||||||
FFirstStatement:=nil;
|
ParseMain(TPasModule);
|
||||||
try
|
|
||||||
ParseModule;
|
|
||||||
except
|
|
||||||
on E: EParserError do
|
|
||||||
begin
|
|
||||||
writeln('ERROR: TTestResolver.ParseUnit Parser: '+E.ClassName+':'+E.Message
|
|
||||||
+' File='+Scanner.CurFilename
|
|
||||||
+' LineNo='+IntToStr(Scanner.CurRow)
|
|
||||||
+' Col='+IntToStr(Scanner.CurColumn)
|
|
||||||
+' Line="'+Scanner.CurLine+'"'
|
|
||||||
);
|
|
||||||
Fail(E.Message);
|
|
||||||
end;
|
|
||||||
on E: EPasResolve do
|
|
||||||
begin
|
|
||||||
writeln('ERROR: TTestResolver.ParseUnit PasResolver: '+E.ClassName+':'+E.Message
|
|
||||||
+' File='+Scanner.CurFilename
|
|
||||||
+' LineNo='+IntToStr(Scanner.CurRow)
|
|
||||||
+' Col='+IntToStr(Scanner.CurColumn)
|
|
||||||
+' Line="'+Scanner.CurLine+'"'
|
|
||||||
);
|
|
||||||
Fail(E.Message);
|
|
||||||
end;
|
|
||||||
on E: Exception do
|
|
||||||
begin
|
|
||||||
writeln('ERROR: TTestResolver.ParseUnit Exception: '+E.ClassName+':'+E.Message);
|
|
||||||
Fail(E.Message);
|
|
||||||
end;
|
|
||||||
end;
|
|
||||||
TAssert.AssertSame('Has resolver',ResolverEngine,Parser.Engine);
|
|
||||||
AssertEquals('Has unit',TPasModule,Module.ClassType);
|
AssertEquals('Has unit',TPasModule,Module.ClassType);
|
||||||
AssertNotNull('Has interface section',Module.InterfaceSection);
|
AssertNotNull('Has interface section',Module.InterfaceSection);
|
||||||
AssertNotNull('Has implementation section',Module.ImplementationSection);
|
AssertNotNull('Has implementation section',Module.ImplementationSection);
|
||||||
@ -2333,6 +2329,16 @@ begin
|
|||||||
Add('program '+ExtractFileUnitName(MainFilename)+';');
|
Add('program '+ExtractFileUnitName(MainFilename)+';');
|
||||||
end;
|
end;
|
||||||
|
|
||||||
|
procedure TCustomTestResolver.StartLibrary(NeedSystemUnit: boolean;
|
||||||
|
SystemUnitParts: TSystemUnitParts);
|
||||||
|
begin
|
||||||
|
if NeedSystemUnit then
|
||||||
|
AddSystemUnit(SystemUnitParts)
|
||||||
|
else
|
||||||
|
Parser.ImplicitUses.Clear;
|
||||||
|
Add('library '+ExtractFileUnitName(MainFilename)+';');
|
||||||
|
end;
|
||||||
|
|
||||||
procedure TCustomTestResolver.StartUnit(NeedSystemUnit: boolean);
|
procedure TCustomTestResolver.StartUnit(NeedSystemUnit: boolean);
|
||||||
begin
|
begin
|
||||||
if NeedSystemUnit then
|
if NeedSystemUnit then
|
||||||
@ -3623,7 +3629,7 @@ begin
|
|||||||
' m=low(char)+high(char);',
|
' m=low(char)+high(char);',
|
||||||
' n = string(''A'');',
|
' n = string(''A'');',
|
||||||
' o = UnicodeString(''A'');',
|
' o = UnicodeString(''A'');',
|
||||||
//' p = ^C''bird'';',
|
' p = ^C''bird'';',
|
||||||
'begin']);
|
'begin']);
|
||||||
ParseProgram;
|
ParseProgram;
|
||||||
CheckResolverUnexpectedHints;
|
CheckResolverUnexpectedHints;
|
||||||
@ -18738,6 +18744,95 @@ begin
|
|||||||
CheckAttributeMarkers;
|
CheckAttributeMarkers;
|
||||||
end;
|
end;
|
||||||
|
|
||||||
|
procedure TTestResolver.TestLibrary_Empty;
|
||||||
|
begin
|
||||||
|
StartLibrary(false);
|
||||||
|
Add(['begin']);
|
||||||
|
ParseLibrary;
|
||||||
|
end;
|
||||||
|
|
||||||
|
procedure TTestResolver.TestLibrary_ExportFunc;
|
||||||
|
begin
|
||||||
|
StartLibrary(false);
|
||||||
|
Add([
|
||||||
|
'procedure Run;',
|
||||||
|
'begin',
|
||||||
|
'end;',
|
||||||
|
'procedure Fly;',
|
||||||
|
'begin',
|
||||||
|
'end;',
|
||||||
|
'exports',
|
||||||
|
' Run,',
|
||||||
|
' Fly name ''FlyHi'';',
|
||||||
|
'exports',
|
||||||
|
' Run index 3+4;',
|
||||||
|
'begin',
|
||||||
|
'']);
|
||||||
|
ParseLibrary;
|
||||||
|
end;
|
||||||
|
|
||||||
|
procedure TTestResolver.TestLibrary_ExportFunc_NameIntFail;
|
||||||
|
begin
|
||||||
|
StartLibrary(false);
|
||||||
|
Add([
|
||||||
|
'procedure Run;',
|
||||||
|
'begin',
|
||||||
|
'end;',
|
||||||
|
'exports',
|
||||||
|
' Run name 4;',
|
||||||
|
'begin',
|
||||||
|
'']);
|
||||||
|
CheckResolverException('string expected, but Longint found',nXExpectedButYFound);
|
||||||
|
end;
|
||||||
|
|
||||||
|
procedure TTestResolver.TestLibrary_ExportFunc_IndexStringFail;
|
||||||
|
begin
|
||||||
|
StartLibrary(false);
|
||||||
|
Add([
|
||||||
|
'procedure Run;',
|
||||||
|
'begin',
|
||||||
|
'end;',
|
||||||
|
'exports',
|
||||||
|
' Run index ''abc'';',
|
||||||
|
'begin',
|
||||||
|
'']);
|
||||||
|
CheckResolverException('integer expected, but String found',nXExpectedButYFound);
|
||||||
|
end;
|
||||||
|
|
||||||
|
procedure TTestResolver.TestLibrary_ExportVar;
|
||||||
|
begin
|
||||||
|
exit;
|
||||||
|
|
||||||
|
StartLibrary(false);
|
||||||
|
Add([
|
||||||
|
'var',
|
||||||
|
' Size: word; export name ''size'';',
|
||||||
|
'exports',
|
||||||
|
' Size,',
|
||||||
|
' Fly as ''FlyHi'',',
|
||||||
|
' Run index 3+4;',
|
||||||
|
'begin',
|
||||||
|
'']);
|
||||||
|
ParseLibrary;
|
||||||
|
end;
|
||||||
|
|
||||||
|
procedure TTestResolver.TestLibrary_Initialization_Finalization;
|
||||||
|
begin
|
||||||
|
StartLibrary(false);
|
||||||
|
Add([
|
||||||
|
'procedure Run(w: word);',
|
||||||
|
'begin',
|
||||||
|
'end;',
|
||||||
|
'exports',
|
||||||
|
' Run;',
|
||||||
|
'initialization',
|
||||||
|
' Run(3);',
|
||||||
|
'finalization',
|
||||||
|
' Run(4);',
|
||||||
|
'']);
|
||||||
|
ParseLibrary;
|
||||||
|
end;
|
||||||
|
|
||||||
initialization
|
initialization
|
||||||
RegisterTests([TTestResolver]);
|
RegisterTests([TTestResolver]);
|
||||||
|
|
||||||
|
@ -1,16 +1,21 @@
|
|||||||
{ %OPT=-O3 -Sew -vw }
|
|
||||||
{$mode objfpc}
|
{$mode objfpc}
|
||||||
{$inline on}
|
{$inline on}
|
||||||
|
|
||||||
procedure test; inline;
|
procedure mymove(var src,dst; len: ptrint); inline;
|
||||||
begin
|
begin
|
||||||
|
if len<=0 then
|
||||||
exit;
|
exit;
|
||||||
end;
|
end;
|
||||||
|
|
||||||
function f: longint;
|
|
||||||
|
function concatansistrings(p1,p2 : pchar;length1,length2 : longint) : pchar;
|
||||||
|
var
|
||||||
|
p : pchar;
|
||||||
begin
|
begin
|
||||||
test; // tt.pp(11,3) Warning: Function result variable does not seem to be initialized
|
getmem(p,length1+length2+1);
|
||||||
result:=4;
|
mymove(p1[0],p[0],length1);
|
||||||
|
mymove(p2[0],p[length1],length2+1);
|
||||||
|
concatansistrings:=p;
|
||||||
end;
|
end;
|
||||||
|
|
||||||
begin
|
begin
|
||||||
|
43
tests/webtbs/tw38267a.pp
Normal file
43
tests/webtbs/tw38267a.pp
Normal file
@ -0,0 +1,43 @@
|
|||||||
|
{ %OPT=-O3 }
|
||||||
|
{$goto on}
|
||||||
|
label start0, end0, start1, end1;
|
||||||
|
|
||||||
|
var
|
||||||
|
x: int16;
|
||||||
|
|
||||||
|
begin
|
||||||
|
x := random(2);
|
||||||
|
writeln('x := ', x);
|
||||||
|
writeln;
|
||||||
|
|
||||||
|
start0:
|
||||||
|
x :=
|
||||||
|
1+1+1+1+1+1+1+1+1+1+1+1+1+1+1+1+1+1+1+1+1+1+1+1+1+
|
||||||
|
1+1+1+1+1+1+1+1+1+1+1+1+1+1+1+1+1+1+1+1+1+1+1+1+1+
|
||||||
|
1+1+1+1+1+1+1+1+1+1+1+1+1+1+1+1+1+1+1+1+1+1+1+1+1+
|
||||||
|
1+1+1+1+1+1+1+1+1+1+1+1+1+1+1+1+1+1+1+1+1+1+1+1+1+x;
|
||||||
|
end0:
|
||||||
|
writeln('x := 1 + 1 + ...100 times ... + x, x = ', x, ': ');
|
||||||
|
writeln(SizeUint(CodePointer(@end0) - CodePointer(@start0)), ' b of code');
|
||||||
|
{ hundred is actually arbitrarily chosen but should be sufficient for all targets
|
||||||
|
to show that constant folding works }
|
||||||
|
if SizeUint(CodePointer(@end0) - CodePointer(@start0))>100 then
|
||||||
|
halt(1);
|
||||||
|
writeln;
|
||||||
|
|
||||||
|
start1:
|
||||||
|
x := x+
|
||||||
|
1+1+1+1+1+1+1+1+1+1+1+1+1+1+1+1+1+1+1+1+1+1+1+1+1+
|
||||||
|
1+1+1+1+1+1+1+1+1+1+1+1+1+1+1+1+1+1+1+1+1+1+1+1+1+
|
||||||
|
1+1+1+1+1+1+1+1+1+1+1+1+1+1+1+1+1+1+1+1+1+1+1+1+1+
|
||||||
|
1+1+1+1+1+1+1+1+1+1+1+1+1+1+1+1+1+1+1+1+1+1+1+1+1;
|
||||||
|
end1:
|
||||||
|
writeln('x := x + 1 + 1 + ...100 times ..., x = ', x, ': ');
|
||||||
|
{ hundred is actually arbitrarily chosen but should be sufficient for all targets
|
||||||
|
to show that constant folding works }
|
||||||
|
writeln(SizeUint(CodePointer(@end1) - CodePointer(@start1)), ' b of code');
|
||||||
|
if SizeUint(CodePointer(@end1) - CodePointer(@start1))>100 then
|
||||||
|
halt(2);
|
||||||
|
writeln('ok');
|
||||||
|
end.
|
||||||
|
|
Loading…
Reference in New Issue
Block a user