Prechádzať zdrojové kódy

* Fix bug #31734

git-svn-id: trunk@36189 -
michael 8 rokov pred
rodič
commit
054d0bc89b

+ 79 - 75
packages/fcl-passrc/src/pparser.pp

@@ -4659,42 +4659,6 @@ begin
         end else
           ParseExcSyntaxError;
       end;
-    tkon:
-      begin
-        // in try except:
-        // on E: Exception do
-        // on Exception do
-        if CurBlock is TPasImplTryExcept then
-        begin
-          ExpectIdentifier;
-          El:=TPasImplExceptOn(CreateElement(TPasImplExceptOn,'',CurBlock));
-          SrcPos:=Scanner.CurSourcePos;
-          Name:=CurTokenString;
-          NextToken;
-          //writeln('ON t=',Name,' Token=',CurTokenText);
-          if CurToken=tkColon then
-            begin
-            // the first expression was the variable name
-            NextToken;
-            TypeEl:=ParseSimpleType(El,SrcPos,'');
-            TPasImplExceptOn(El).TypeEl:=TypeEl;
-            TPasImplExceptOn(El).VarEl:=TPasVariable(CreateElement(TPasVariable,
-                                  Name,El,SrcPos));
-            TPasImplExceptOn(El).VarEl.VarType:=TypeEl;
-            TypeEl.AddRef;
-            end
-          else
-            begin
-            UngetToken;
-            TPasImplExceptOn(El).TypeEl:=ParseSimpleType(El,SrcPos,'');
-            end;
-          Engine.FinishScope(stExceptOnExpr,El);
-          CurBlock.AddElement(El);
-          CurBlock:=TPasImplExceptOn(El);
-          ExpectToken(tkDo);
-        end else
-          ParseExcSyntaxError;
-      end;
     tkraise:
       begin
       El:=TPasImplRaise(CreateElement(TPasImplRaise,'',CurBlock));
@@ -4767,50 +4731,90 @@ begin
 // This should in fact not be checked here.
 //      if (CurToken=tkAt) and not (msDelphi in CurrentModeswitches) then
 //        ParseExc;
-      left:=DoParseExpression(CurBlock);
-      case CurToken of
-        tkAssign,
-        tkAssignPlus,
-        tkAssignMinus,
-        tkAssignMul,
-        tkAssignDivision:
+      // On is usable as an identifier
+      if lowerCase(CurTokenText)='on' then
         begin
-          // assign statement
-          Ak:=TokenToAssignKind(CurToken);
-          NextToken;
-          right:=DoParseExpression(CurBlock); // this may solve TPasImplWhileDo.AddElement BUG
-          El:=TPasImplAssign(CreateElement(TPasImplAssign,'',CurBlock));
-          left.Parent:=El;
-          right.Parent:=El;
-          TPasImplAssign(El).left:=Left;
-          TPasImplAssign(El).right:=Right;
-          TPasImplAssign(El).Kind:=ak;
-          CurBlock.AddElement(El);
-          CmdElem:=TPasImplAssign(El);
-          UngetToken;
-        end;
-        tkColon:
+          // in try except:
+          // on E: Exception do
+          // on Exception do
+          if CurBlock is TPasImplTryExcept then
+          begin
+            ExpectIdentifier;
+            El:=TPasImplExceptOn(CreateElement(TPasImplExceptOn,'',CurBlock));
+            SrcPos:=Scanner.CurSourcePos;
+            Name:=CurTokenString;
+            NextToken;
+            writeln('ON t=',Name,' Token=',CurTokenText);
+            if CurToken=tkColon then
+              begin
+              // the first expression was the variable name
+              NextToken;
+              TypeEl:=ParseSimpleType(El,SrcPos,'');
+              TPasImplExceptOn(El).TypeEl:=TypeEl;
+              TPasImplExceptOn(El).VarEl:=TPasVariable(CreateElement(TPasVariable,
+                                    Name,El,SrcPos));
+              TPasImplExceptOn(El).VarEl.VarType:=TypeEl;
+              TypeEl.AddRef;
+              end
+            else
+              begin
+              UngetToken;
+              TPasImplExceptOn(El).TypeEl:=ParseSimpleType(El,SrcPos,'');
+              end;
+            Engine.FinishScope(stExceptOnExpr,El);
+            CurBlock.AddElement(El);
+            CurBlock:=TPasImplExceptOn(El);
+            ExpectToken(tkDo);
+          end else
+            ParseExcSyntaxError;
+        end
+      else
         begin
-          if not (left is TPrimitiveExpr) then
-            ParseExcTokenError(TokenInfos[tkSemicolon]);
-          // label mark. todo: check mark identifier in the list of labels
-          El:=TPasImplLabelMark(CreateElement(TPasImplLabelMark,'', CurBlock));
-          TPasImplLabelMark(El).LabelId:=TPrimitiveExpr(left).Value;
+        left:=DoParseExpression(CurBlock);
+        case CurToken of
+          tkAssign,
+          tkAssignPlus,
+          tkAssignMinus,
+          tkAssignMul,
+          tkAssignDivision:
+          begin
+            // assign statement
+            Ak:=TokenToAssignKind(CurToken);
+            NextToken;
+            right:=DoParseExpression(CurBlock); // this may solve TPasImplWhileDo.AddElement BUG
+            El:=TPasImplAssign(CreateElement(TPasImplAssign,'',CurBlock));
+            left.Parent:=El;
+            right.Parent:=El;
+            TPasImplAssign(El).left:=Left;
+            TPasImplAssign(El).right:=Right;
+            TPasImplAssign(El).Kind:=ak;
+            CurBlock.AddElement(El);
+            CmdElem:=TPasImplAssign(El);
+            UngetToken;
+          end;
+          tkColon:
+          begin
+            if not (left is TPrimitiveExpr) then
+              ParseExcTokenError(TokenInfos[tkSemicolon]);
+            // label mark. todo: check mark identifier in the list of labels
+            El:=TPasImplLabelMark(CreateElement(TPasImplLabelMark,'', CurBlock));
+            TPasImplLabelMark(El).LabelId:=TPrimitiveExpr(left).Value;
+            CurBlock.AddElement(El);
+            CmdElem:=TPasImplLabelMark(El);
+            left.Free;
+          end;
+        else
+          // simple statement (function call)
+          El:=TPasImplSimple(CreateElement(TPasImplSimple,'',CurBlock));
+          TPasImplSimple(El).expr:=Left;
           CurBlock.AddElement(El);
-          CmdElem:=TPasImplLabelMark(El);
-          left.Free;
+          CmdElem:=TPasImplSimple(El);
+          UngetToken;
         end;
-      else
-        // simple statement (function call)
-        El:=TPasImplSimple(CreateElement(TPasImplSimple,'',CurBlock));
-        TPasImplSimple(El).expr:=Left;
-        CurBlock.AddElement(El);
-        CmdElem:=TPasImplSimple(El);
-        UngetToken;
-      end;
 
-      if not (CmdElem is TPasImplLabelMark) then
-        if NewImplElement=nil then NewImplElement:=CmdElem;
+        if not (CmdElem is TPasImplLabelMark) then
+          if NewImplElement=nil then NewImplElement:=CmdElem;
+        end;
       end;
     else
       ParseExcSyntaxError;

+ 0 - 2
packages/fcl-passrc/src/pscanner.pp

@@ -183,7 +183,6 @@ type
     tknot,
     tkobject,
     tkof,
-    tkon,
     tkoperator,
     tkor,
     tkpacked,
@@ -720,7 +719,6 @@ const
     'not',
     'object',
     'of',
-    'on',
     'operator',
     'or',
     'packed',

+ 1 - 1
packages/fcl-passrc/tests/tcscanner.pas

@@ -1110,7 +1110,7 @@ end;
 procedure TTestScanner.TestOn;
 
 begin
-  TestToken(tkon,'on');
+  TestToken(tkIdentifier,'on');
 end;
 
 

+ 11 - 0
packages/fcl-passrc/tests/tcstatements.pas

@@ -120,6 +120,7 @@ Type
     procedure FinalizationNoSemicolon;
     procedure MacroComment;
     Procedure PLatformIdentifier;
+    Procedure Onidentifier;
   end;
 
 
@@ -1737,6 +1738,16 @@ begin
   ParseModule;
 end;
 
+procedure TTestStatementParser.Onidentifier;
+begin
+  Source.Add('function TryOn(const on: boolean): boolean;');
+  Source.Add('  begin');
+  Source.Add('  end;');
+  Source.Add('  begin');
+  Source.Add('  end.');
+  ParseModule;
+end;
+
 Procedure TTestStatementParser.TestGotoInIfThen;
 
 begin