Browse Source

* synchronized with trunk

git-svn-id: branches/wasm@47937 -
nickysn 4 years ago
parent
commit
f87f9969a7

+ 1 - 0
.gitattributes

@@ -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

+ 4 - 1
compiler/avr/aoptcpu.pas

@@ -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

+ 89 - 87
compiler/nadd.pas

@@ -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;
@@ -708,9 +776,9 @@ implementation
           end;
           end;
 
 
         { 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
-                case nodetype of
-                  muln:
-                   result := left.getcopy;
-                  else
-                    ;
-                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
+
+            else if (tordconstnode(right).value = 1) and (nodetype=muln) then
+              result := left.getcopy
+
+            else if (tordconstnode(right).value = -1) and (nodetype=muln) then
+              result := ctypeconvnode.create_internal(cunaryminusnode.create(left.getcopy),left.resultdef)
+
             { try to fold
             { try to fold
                           op                         op
                           op                         op
                          /  \                       /  \
                          /  \                       /  \
@@ -763,20 +820,7 @@ implementation
                       andn,
                       andn,
                       orn,
                       orn,
                       muln:
                       muln:
-                        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;
+                        Result:=SwapRightWithLeftRight;
                       else
                       else
                         ;
                         ;
                     end;
                     end;
@@ -789,26 +833,7 @@ implementation
                       andn,
                       andn,
                       orn,
                       orn,
                       muln:
                       muln:
-                        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;
+                        Result:=SwapRightWithLeftLeft;
                       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
-                case nodetype of
-                  muln:
-                   result := right.getcopy;
-                  else
-                    ;
-                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
+
+            else if (tordconstnode(left).value = 1) and (nodetype=muln) then
+              result := right.getcopy
+
+            else if (tordconstnode(left).value = -1) and (nodetype=muln) then
+              result := ctypeconvnode.create_internal(cunaryminusnode.create(right.getcopy),right.resultdef)
+
             { try to fold
             { try to fold
                           op
                           op
                          /  \
                          /  \
@@ -874,13 +888,7 @@ implementation
                       andn,
                       andn,
                       orn,
                       orn,
                       muln:
                       muln:
-                        begin
-                          hp:=left;
-                          left:=taddnode(right).right;
-                          taddnode(right).right:=hp;
-                          right:=right.simplify(false);
-                          result:=GetCopyAndTypeCheck;
-                        end;
+                        Result:=SwapLeftWithRightRight;
                       else
                       else
                         ;
                         ;
                     end;
                     end;
@@ -893,13 +901,7 @@ implementation
                       andn,
                       andn,
                       orn,
                       orn,
                       muln:
                       muln:
-                        begin
-                          hp:=left;
-                          left:=taddnode(right).left;
-                          taddnode(right).left:=hp;
-                          right:=right.simplify(false);
-                          result:=GetCopyAndTypeCheck;
-                        end;
+                        Result:=SwapLeftWithRightLeft;
                       else
                       else
                         ;
                         ;
                     end;
                     end;

+ 5 - 2
compiler/optdfa.pas

@@ -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  }
-                if not(Result) and not(is_void(current_procinfo.procdef.returndef)) and
+                  it can be only the resultnode
+
+                  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

+ 260 - 28
packages/chm/src/chmls.lpi

@@ -1,57 +1,289 @@
-<?xml version="1.0"?>
+<?xml version="1.0" encoding="UTF-8"?>
 <CONFIG>
 <CONFIG>
   <ProjectOptions>
   <ProjectOptions>
-    <PathDelim Value="/"/>
-    <Version Value="5"/>
+    <Version Value="12"/>
     <General>
     <General>
-      <MainUnit Value="0"/>
-      <IconPath Value="./"/>
-      <TargetFileExt Value=""/>
-      <ActiveEditorIndexAtStart Value="1"/>
+      <Flags>
+        <MainUnitHasCreateFormStatements Value="False"/>
+        <MainUnitHasTitleStatement Value="False"/>
+        <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"/>
-        <LaunchingApplication PathPlusParams="/usr/X11R6/bin/xterm -T 'Lazarus Run Output' -e $(LazarusDir)/tools/runwait.sh $(TargetCmdLine)"/>
+        <CommandLineParams Value="extractindex D:/src/chm/chmlaptop500gb/testproject/5/chmtest.chm"/>
+        <LaunchingApplication PathPlusParams="/usr/X11R6/bin/xterm -T &apos;Lazarus Run Output&apos; -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 &apos;Lazarus Run Output&apos; -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"/>
-        <CursorPos X="22" Y="66"/>
-        <TopLine Value="41"/>
-        <EditorIndex Value="0"/>
-        <UsageCount Value="29"/>
+        <IsVisibleTab Value="True"/>
+        <TopLine Value="45"/>
+        <CursorPos X="24" Y="104"/>
+        <UsageCount Value="192"/>
         <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>
-      <Generate Value="Faster"/>
-    </CodeGeneration>
-    <Other>
-      <CompilerPath Value="$(CompPath)"/>
-    </Other>
+    <Parsing>
+      <SyntaxOptions>
+        <UseAnsiStrings Value="False"/>
+      </SyntaxOptions>
+    </Parsing>
   </CompilerOptions>
   </CompilerOptions>
   <Debugging>
   <Debugging>
     <Exceptions Count="2">
     <Exceptions Count="2">

+ 22 - 4
packages/chm/src/chmls.lpr

@@ -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('      ');
-      WriteStrAdj(IntToStr(Offset), 10);
-      Write('  ');
+      if not donotshowoffset then
+        begin
+          WriteStrAdj(IntToStr(Offset), 10);
+          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;

+ 109 - 0
packages/fcl-passrc/src/pasresolveeval.pas

@@ -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}

+ 30 - 0
packages/fcl-passrc/src/pasresolver.pp

@@ -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

+ 1 - 0
packages/fcl-passrc/src/pastree.pp

@@ -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 }
 
 

+ 1 - 0
packages/fcl-passrc/src/pparser.pp

@@ -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;
 
 

+ 131 - 36
packages/fcl-passrc/tests/tcresolver.pas

@@ -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;
-  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);
+  ParseMain(TPasModule);
   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]);
 
 

+ 13 - 8
tests/webtbs/tw38259.pp

@@ -1,16 +1,21 @@
-{ %OPT=-O3 -Sew -vw }
 {$mode objfpc}
 {$mode objfpc}
 {$inline on}
 {$inline on}
 
 
-procedure test; inline;
-begin
-  exit;
-end;
+procedure mymove(var src,dst; len: ptrint); inline;
+  begin
+    if len<=0 then
+      exit;
+  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
-  result:=4;
+  getmem(p,length1+length2+1);
+  mymove(p1[0],p[0],length1);
+  mymove(p2[0],p[length1],length2+1);
+  concatansistrings:=p;
 end;
 end;
 
 
 begin
 begin

+ 43 - 0
tests/webtbs/tw38267a.pp

@@ -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.
+