* Patch from Mattias Gaertner, implementing

*  with..do
  * is and as operator for class
  * inherited call
  * basic type checks for binary operators
  * type checks for if..then, while..do, repeat..until, on..do, raise

git-svn-id: trunk@34569 -

packages/fcl-passrc/src/pparser.pp

@@ -73,6 +73,7 @@ const
   nParserDuplicateIdentifier = 2046;
   nParserDefaultParameterRequiredFor = 2047;
   nParserOnlyOneVariableCanBeInitialized = 2048;
+  nParserExpectedTypeButGot = 2049;
 
 
 // resourcestring patterns of messages
@@ -125,6 +126,7 @@ resourcestring
   SParserDuplicateIdentifier = 'Duplicate identifier "%s"';
   SParserDefaultParameterRequiredFor = 'Default parameter required for "%s"';
   SParserOnlyOneVariableCanBeInitialized = 'Only one variable can be initialized';
+  SParserExpectedTypeButGot = 'Expected type, but got %s';
 
 type
   TPasScopeType = (
@@ -1088,7 +1090,21 @@ begin
       Ref:=Nil;
       SS:=(not (po_resolvestandardtypes in FOptions)) and isSimpleTypeToken(Name);
       if not SS then
+        begin
         Ref:=Engine.FindElement(Name);
+        if Ref=nil then
+          begin
+          {$IFDEF VerbosePasResolver}
+          if po_resolvestandardtypes in FOptions then
+            begin
+            writeln('ERROR: TPasParser.ParseSimpleType resolver failed to raise an error');
+            ParseExcExpectedIdentifier;
+            end;
+          {$ENDIF}
+          end
+        else if not (Ref is TPasType) then
+          ParseExc(nParserExpectedTypeButGot,SParserExpectedTypeButGot,[Ref.ElementTypeName]);
+        end;
       if (Ref=Nil) then
         Ref:=TPasUnresolvedTypeRef(CreateElement(TPasUnresolvedTypeRef,Name,Parent))
       else
@@ -2341,7 +2357,8 @@ begin
                 if Assigned(TypeEl) then        // !!!
                 begin
                   Declarations.Declarations.Add(TypeEl);
-                  if TypeEl.ClassType = TPasClassType then
+                  if (TypeEl.ClassType = TPasClassType)
+                      and (not (po_keepclassforward in Options)) then
                   begin
                     // Remove previous forward declarations, if necessary
                     for i := 0 to Declarations.Classes.Count - 1 do
@@ -2407,7 +2424,7 @@ begin
               begin
               PropEl:=ParseProperty(Declarations,CurtokenString,visDefault);
               Declarations.Declarations.Add(PropEl);
-              Declarations.properties.add(PropEl);
+              Declarations.properties.Add(PropEl);
               end;
           else
             ParseExcSyntaxError;
@@ -3666,6 +3683,9 @@ var
   ak : TAssignKind;
   lt : TLoopType;
   ok: Boolean;
+  SrcPos: TPasSourcePos;
+  Name: String;
+  TypeEl: TPasType;
 
 begin
   NewImplElement:=nil;
@@ -3819,10 +3839,11 @@ begin
       begin
         // with Expr do
         // with Expr, Expr do
+        SrcPos:=Scanner.CurSourcePos;
         NextToken;
         Left:=DoParseExpression(Parent);
         //writeln(i,'WITH Expr="',Expr,'" Token=',CurTokenText);
-        El:=TPasImplWithDo(CreateElement(TPasImplWithDo,'',CurBlock));
+        El:=TPasImplWithDo(CreateElement(TPasImplWithDo,'',CurBlock,SrcPos));
         TPasImplWithDo(El).AddExpression(Left);
         CreateBlock(TPasImplWithDo(El));
         repeat
@@ -3955,23 +3976,28 @@ begin
         // on Exception do
         if CurBlock is TPasImplTryExcept then
         begin
+          ExpectIdentifier;
+          El:=TPasImplExceptOn(CreateElement(TPasImplExceptOn,'',CurBlock));
+          SrcPos:=Scanner.CurSourcePos;
+          Name:=CurTokenString;
           NextToken;
-          Left:=Nil;
+          //writeln('ON t=',Name,' Token=',CurTokenText);
-          Right:=DoParseExpression(Parent);
-          //writeln(i,'ON t=',TypeName,' Token=',CurTokenText);
-  //        NextToken;
           if CurToken=tkColon then
             begin
+            // the first expression was the variable name
             NextToken;
-            Left:=Right;
+            TypeEl:=ParseSimpleType(El,SrcPos,'');
-            Right:=DoParseExpression(Parent);
+            TPasImplExceptOn(El).TypeEl:=TypeEl;
-            //writeln(i,'ON v=',VarName,' t=',TypeName,' Token=',CurTokenText);
+            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;
-//          else
-          UngetToken;
-          El:=TPasImplExceptOn(CreateElement(TPasImplExceptOn,'',CurBlock));
-          TPasImplExceptOn(El).VarExpr:=Left;
-          TPasImplExceptOn(El).TypeExpr:=Right;
           Engine.FinishScope(stExceptOnExpr,El);
           CurBlock.AddElement(El);
           CurBlock:=TPasImplExceptOn(El);

packages/fcl-passrc/src/pscanner.pp

@@ -330,7 +330,8 @@ type
     po_cassignments,  // allow C-operators += -= *= /=
     po_resolvestandardtypes, // search for 'longint', 'string', etc., do not use dummies, TPasResolver sets this to use its declarations
     po_asmwhole,  // store whole text between asm..end in TPasImplAsmStatement.Tokens
-    po_nooverloadedprocs  // do not create TPasOverloadedProc for procs with same name
+    po_nooverloadedprocs,  // do not create TPasOverloadedProc for procs with same name
+    po_keepclassforward    // default: delete class fowards when there is a class declaration
     );
   TPOptions = set of TPOption;
 
@@ -849,7 +850,8 @@ Procedure TStreamLineReader.InitFromStream(AStream : TStream);
 
 begin
   SetLength(FContent,AStream.Size);
-  AStream.Read(FContent[1],AStream.Size);
+  if FContent<>'' then
+    AStream.Read(FContent[1],length(FContent));
   FPos:=0;
 end;
 

packages/fcl-passrc/tests/tcbaseparser.pas

@@ -599,6 +599,8 @@ end;
 
 procedure TTestParser.StartParsing;
 
+var
+  i: Integer;
 begin
   If FIsUnit then
     StartImplementation;
@@ -608,7 +610,8 @@ begin
   FResolver.AddStream(FFileName,TStringStream.Create(FSource.Text));
   FScanner.OpenFile(FFileName);
   Writeln('// Test : ',Self.TestName);
-  Writeln(FSource.Text);
+  for i:=0 to FSource.Count-1 do
+    Writeln(Format('%:4d: ',[i+1]),FSource[i]);
 end;
 
 procedure TTestParser.ParseDeclarations;

packages/fcl-passrc/tests/tcclasstype.pas

@@ -763,28 +763,28 @@ procedure TTestClassType.TestConstructor;
 begin
   AddMember('Constructor Create');
   ParseClass;
-  AssertEquals('1 members',1,TheClass.members.Count);
+  AssertEquals('1 members',1,TheClass.Members.Count);
-  AssertEquals('1 class procedure',TPasConstructor,members[0].ClassType);
+  AssertEquals('1 class procedure',TPasConstructor,Members[0].ClassType);
   AssertEquals('Default visibility',visDefault,Members[0].Visibility);
   AssertMemberName('Create');
-  AssertEquals('No modifiers',[],TPasClassProcedure(Members[0]).Modifiers);
+  AssertEquals('No modifiers',[],TPasConstructor(Members[0]).Modifiers);
-  AssertEquals('Default calling convention',ccDefault, TPasClassProcedure(Members[0]).ProcType.CallingConvention);
+  AssertEquals('Default calling convention',ccDefault, TPasConstructor(Members[0]).ProcType.CallingConvention);
-  AssertNotNull('Method proc type',TPasClassProcedure(Members[0]).ProcType);
+  AssertNotNull('Method proc type',TPasConstructor(Members[0]).ProcType);
-  AssertEquals('No arguments',0,TPasClassProcedure(Members[0]).ProcType.Args.Count)
+  AssertEquals('No arguments',0,TPasConstructor(Members[0]).ProcType.Args.Count)
 end;
 
 procedure TTestClassType.TestClassConstructor;
 begin
   AddMember('Class Constructor Create');
   ParseClass;
-  AssertEquals('1 members',1,TheClass.members.Count);
+  AssertEquals('1 members',1,TheClass.Members.Count);
-  AssertEquals('1 class procedure',TPasClassConstructor,members[0].ClassType);
+  AssertEquals('1 class procedure',TPasClassConstructor,Members[0].ClassType);
   AssertEquals('Default visibility',visDefault,Members[0].Visibility);
   AssertMemberName('Create');
-  AssertEquals('No modifiers',[],TPasClassProcedure(Members[0]).Modifiers);
+  AssertEquals('No modifiers',[],TPasClassConstructor(Members[0]).Modifiers);
-  AssertEquals('Default calling convention',ccDefault, TPasClassProcedure(Members[0]).ProcType.CallingConvention);
+  AssertEquals('Default calling convention',ccDefault, TPasClassConstructor(Members[0]).ProcType.CallingConvention);
-  AssertNotNull('Method proc type',TPasClassProcedure(Members[0]).ProcType);
+  AssertNotNull('Method proc type',TPasClassConstructor(Members[0]).ProcType);
-  AssertEquals('No arguments',0,TPasClassProcedure(Members[0]).ProcType.Args.Count)
+  AssertEquals('No arguments',0,TPasClassConstructor(Members[0]).ProcType.Args.Count)
 end;
 
 procedure TTestClassType.TestDestructor;
@@ -795,24 +795,24 @@ begin
   AssertEquals('1 class procedure',TPasDestructor,members[0].ClassType);
   AssertEquals('Default visibility',visDefault,Members[0].Visibility);
   AssertMemberName('Destroy');
-  AssertEquals('No modifiers',[],TPasClassProcedure(Members[0]).Modifiers);
+  AssertEquals('No modifiers',[],TPasDestructor(Members[0]).Modifiers);
-  AssertEquals('Default calling convention',ccDefault, TPasClassProcedure(Members[0]).ProcType.CallingConvention);
+  AssertEquals('Default calling convention',ccDefault, TPasDestructor(Members[0]).ProcType.CallingConvention);
-  AssertNotNull('Method proc type',TPasClassProcedure(Members[0]).ProcType);
+  AssertNotNull('Method proc type',TPasDestructor(Members[0]).ProcType);
-  AssertEquals('No arguments',0,TPasClassProcedure(Members[0]).ProcType.Args.Count)
+  AssertEquals('No arguments',0,TPasDestructor(Members[0]).ProcType.Args.Count)
 end;
 
 procedure TTestClassType.TestClassDestructor;
 begin
   AddMember('Class Destructor Destroy');
   ParseClass;
-  AssertEquals('1 members',1,TheClass.members.Count);
+  AssertEquals('1 members',1,TheClass.Members.Count);
-  AssertEquals('1 class procedure',TPasClassDestructor,members[0].ClassType);
+  AssertEquals('1 class procedure',TPasClassDestructor,Members[0].ClassType);
   AssertEquals('Default visibility',visDefault,Members[0].Visibility);
   AssertMemberName('Destroy');
-  AssertEquals('No modifiers',[],TPasClassProcedure(Members[0]).Modifiers);
+  AssertEquals('No modifiers',[],TPasClassDestructor(Members[0]).Modifiers);
-  AssertEquals('Default calling convention',ccDefault, TPasClassProcedure(Members[0]).ProcType.CallingConvention);
+  AssertEquals('Default calling convention',ccDefault, TPasClassDestructor(Members[0]).ProcType.CallingConvention);
-  AssertNotNull('Method proc type',TPasClassProcedure(Members[0]).ProcType);
+  AssertNotNull('Method proc type',TPasClassDestructor(Members[0]).ProcType);
-  AssertEquals('No arguments',0,TPasClassProcedure(Members[0]).ProcType.Args.Count)
+  AssertEquals('No arguments',0,TPasClassDestructor(Members[0]).ProcType.Args.Count)
 end;
 
 procedure TTestClassType.TestFunctionMethodSimple;

packages/fcl-passrc/tests/tcstatements.pas

@@ -1326,8 +1326,8 @@ begin
   O:=TPasImplExceptOn(E.Elements[0]);
   AssertEquals(1,O.Elements.Count);
   AssertEquals('Simple statement',TPasImplSimple,TPasElement(O.Elements[0]).ClassType);
-  AssertExpression('Exception Variable name',O.VarExpr,pekIdent,'E');
+  AssertEquals('Exception Variable name','E',O.VariableName);
-  AssertExpression('Exception Type name',O.TypeExpr,pekIdent,'Exception');
+  AssertEquals('Exception Type name','Exception',O.TypeName);
   S:=TPasImplSimple(O.Elements[0]);
   AssertExpression('DoSomethingElse call',S.Expr,pekIdent,'DoSomethingElse');
 //  AssertEquals('Variable name',
@@ -1364,8 +1364,8 @@ begin
   O:=TPasImplExceptOn(E.Elements[0]);
   AssertEquals(1,O.Elements.Count);
   AssertEquals('Simple statement',TPasImplSimple,TPasElement(O.Elements[0]).ClassType);
-  AssertExpression('Exception Variable name',O.VarExpr,pekIdent,'E');
+  AssertEquals('Exception Variable name','E',O.VariableName);
-  AssertExpression('Exception Type name',O.TypeExpr,pekIdent,'Exception');
+  AssertEquals('Exception Type name','Exception',O.TypeName);
   S:=TPasImplSimple(O.Elements[0]);
   AssertExpression('DoSomethingElse call',S.Expr,pekIdent,'DoSomethingElse');
   // Exception handler 2
@@ -1373,8 +1373,8 @@ begin
   O:=TPasImplExceptOn(E.Elements[1]);
   AssertEquals(1,O.Elements.Count);
   AssertEquals('Simple statement',TPasImplSimple,TPasElement(O.Elements[0]).ClassType);
-  AssertExpression('Exception Variable name',O.VarExpr,pekIdent,'Y');
+  AssertEquals('Exception Variable name','Y',O.VariableName);
-  AssertExpression('Exception Type name',O.TypeExpr,pekIdent,'Exception2');
+  AssertEquals('Exception Type name','Exception2',O.TypeName);
   S:=TPasImplSimple(O.Elements[0]);
   AssertExpression('DoSomethingElse call',S.Expr,pekIdent,'DoSomethingElse2');
 end;
@@ -1407,8 +1407,8 @@ begin
   AssertEquals(1,E.Elements.Count);
   AssertEquals('Except on handler',TPasImplExceptOn,TPasElement(E.Elements[0]).ClassType);
   O:=TPasImplExceptOn(E.Elements[0]);
-  AssertExpression('Exception Variable name',O.VarExpr,pekIdent,'E');
+  AssertEquals('Exception Variable name','E',O.VariableName);
-  AssertExpression('Exception Type name',O.TypeExpr,pekIdent,'Exception');
+  AssertEquals('Exception Type name','Exception',O.TypeName);
   AssertEquals(1,O.Elements.Count);
   AssertEquals('Simple statement',TPasImplIfElse,TPasElement(O.Elements[0]).ClassType);
   I:=TPasImplIfElse(O.Elements[0]);
@@ -1450,8 +1450,8 @@ begin
   AssertEquals(1,E.Elements.Count);
   AssertEquals('Except on handler',TPasImplExceptOn,TPasElement(E.Elements[0]).ClassType);
   O:=TPasImplExceptOn(E.Elements[0]);
-  AssertExpression('Exception Variable name',O.VarExpr,pekIdent,'E');
+  AssertEquals('Exception Variable name','E',O.VariableName);
-  AssertExpression('Exception Type name',O.TypeExpr,pekIdent,'Exception');
+  AssertEquals('Exception Type name','Exception',O.TypeName);
   AssertEquals(1,O.Elements.Count);
   AssertEquals('Simple statement',TPasImplSimple,TPasElement(O.Elements[0]).ClassType);
   S:=TPasImplSimple(O.Elements[0]);

packages/pastojs/tests/tcconverter.pp

@@ -644,7 +644,7 @@ begin
   T:=TPasImplTry.Create('',Nil);
   T.AddElement(CreateAssignStatement('a','b'));
   F:=T.AddExcept;
-  O:=F.AddExceptOn(CreateIdent('E'),CreateIdent('Exception'));
+  O:=F.AddExceptOn('E','Exception');
   O.Body:=CreateAssignStatement('b','c');
   // Convert
   El:=TJSTryFinallyStatement(Convert(T,TJSTryCatchStatement));
@@ -692,7 +692,7 @@ begin
   T:=TPasImplTry.Create('',Nil);
   T.AddElement(CreateAssignStatement('a','b'));
   F:=T.AddExcept;
-  O:=F.AddExceptOn(CreateIdent('E'),CreateIdent('Exception'));
+  O:=F.AddExceptOn('E','Exception');
   O.Body:=TPasImplRaise.Create('',Nil);
   // Convert
   El:=TJSTryFinallyStatement(Convert(T,TJSTryCatchStatement));