Browse Source

fcl-pasrc: error if exports section inside inside procedure

mattias 3 years ago
parent
commit
2fa60d1af3
2 changed files with 19 additions and 1 deletions
  1. 4 1
      packages/fcl-passrc/src/pparser.pp
  2. 15 0
      packages/fcl-passrc/tests/tcresolver.pas

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

@@ -3618,7 +3618,10 @@ begin
     tkConst:
     tkConst:
       SetBlock(declConst);
       SetBlock(declConst);
     tkexports:
     tkexports:
-      SetBlock(declExports);
+      if Declarations is TPasSection then
+        SetBlock(declExports)
+      else
+        ParseExcTokenError(TokenInfos[tkbegin]);
     tkResourcestring:
     tkResourcestring:
       if Declarations is TPasSection then
       if Declarations is TPasSection then
         SetBlock(declResourcestring)
         SetBlock(declResourcestring)

+ 15 - 0
packages/fcl-passrc/tests/tcresolver.pas

@@ -986,6 +986,7 @@ type
     Procedure TestLibrary_ExportFunc_NameIntFail;
     Procedure TestLibrary_ExportFunc_NameIntFail;
     Procedure TestLibrary_ExportFunc_IndexStringFail;
     Procedure TestLibrary_ExportFunc_IndexStringFail;
     Procedure TestLibrary_ExportVar; // ToDo
     Procedure TestLibrary_ExportVar; // ToDo
+    Procedure TestLibrary_ExportLocFuncFail;
     Procedure TestLibrary_Initialization_Finalization;
     Procedure TestLibrary_Initialization_Finalization;
     Procedure TestLibrary_ExportFuncOverloadFail;
     Procedure TestLibrary_ExportFuncOverloadFail;
     Procedure TestLibrary_UnitExports;
     Procedure TestLibrary_UnitExports;
@@ -18852,6 +18853,20 @@ begin
   ParseLibrary;
   ParseLibrary;
 end;
 end;
 
 
+procedure TTestResolver.TestLibrary_ExportLocFuncFail;
+begin
+  StartLibrary(false);
+  Add([
+  'procedure Run;',
+  'exports',
+  '  Run;',
+  'begin',
+  'end;',
+  'begin',
+  '']);
+  CheckParserException('Expected "begin"',nParserExpectTokenError);
+end;
+
 procedure TTestResolver.TestLibrary_Initialization_Finalization;
 procedure TTestResolver.TestLibrary_Initialization_Finalization;
 begin
 begin
   StartLibrary(false);
   StartLibrary(false);