Browse Source

* Patch from Mattias Gaertner:
pscanner:
- fixed reading ^a char literals

pasresolver:
- pred(), succ()
- option for class properties non static
- type cast integer to enum
- <= and >= for sets
- property of type array
- low(), high() for sets
- call constructor in class method
- assign nil to dynamic array
- resolve const expression

git-svn-id: trunk@35415 -

michael 8 years ago
parent
commit
203bd85c38

+ 336 - 128
packages/fcl-passrc/src/pasresolver.pp

@@ -70,13 +70,18 @@
   - enums - TPasEnumType, TPasEnumValue
      - propagate to parent scopes
      - function ord(): integer
+     - function low(ordinal): ordinal
+     - function high(ordinal): ordinal
+     - function pred(ordinal): ordinal
+     - function high(ordinal): ordinal
+     - cast integer to enum
   - sets - TPasSetType
     - set of char
     - set of integer
     - set of boolean
     - set of enum
-    - ranges 'a'..'z'
-    - operators: +, -, *, ><
+    - ranges 'a'..'z'  2..5
+    - operators: +, -, *, ><, <=, >=
     - in-operator
     - assign operators: +=, -=, *=
     - include(), exclude()
@@ -91,11 +96,12 @@
   - function Assigned(Pointer or Class or Class-Of): boolean
   - arrays TPasArrayType
   - check if var initexpr fits vartype: var a: type = expr;
-  - built-in functions high, low for range type and arrays
+  - built-in functions high, low for range types, enums and arrays
   - procedure type
   - method type
   - function without params: mark if call or address, rrfImplicitCallWithoutParams
   - procedure break, procedure continue
+  - built-in functions pred, succ for range type and enums
 
  ToDo:
   - overloads
@@ -202,12 +208,13 @@ const
   nLeftSideOfIsOperatorExpectsAClassButGot = 3037;
   nNotReadable = 3038;
   nClassPropertyAccessorMustBeStatic = 3039;
-  nOnlyOneDefaultPropertyIsAllowed = 3040;
-  nWrongNumberOfParametersForArray = 3041;
-  nCantAssignValuesToAnAddress = 3042;
-  nIllegalExpression = 3043;
-  nCantAccessPrivateMember = 3044;
-  nMustBeInsideALoop = 3045;
+  nClassPropertyAccessorMustNotBeStatic = 3040;
+  nOnlyOneDefaultPropertyIsAllowed = 3041;
+  nWrongNumberOfParametersForArray = 3042;
+  nCantAssignValuesToAnAddress = 3043;
+  nIllegalExpression = 3044;
+  nCantAccessPrivateMember = 3045;
+  nMustBeInsideALoop = 3046;
 
 // resourcestring patterns of messages
 resourcestring
@@ -250,6 +257,7 @@ resourcestring
   sLeftSideOfIsOperatorExpectsAClassButGot = 'left side of is-operator expects a class, but got %s';
   sNotReadable = 'not readable';
   sClassPropertyAccessorMustBeStatic = 'class property accessor must be static';
+  sClassPropertyAccessorMustNotBeStatic = 'class property accessor must not be static';
   sOnlyOneDefaultPropertyIsAllowed = 'Only one default property is allowed';
   sWrongNumberOfParametersForArray = 'Wrong number of parameters for array';
   sCantAssignValuesToAnAddress = 'Can''t assign values to an address';
@@ -398,15 +406,17 @@ type
     bfSetLength,
     bfInclude,
     bfExclude,
-    bfOrd,
     bfBreak,
     bfContinue,
     bfExit,
     bfInc,
     bfDec,
     bfAssigned,
+    bfOrd,
     bfLow,
-    bfHigh
+    bfHigh,
+    bfPred,
+    bfSucc
     );
   TResolverBuiltInProcs = set of TResolverBuiltInProc;
 const
@@ -416,15 +426,17 @@ const
     'SetLength',
     'Include',
     'Exclude',
-    'Ord',
     'Break',
     'Continue',
     'Exit',
     'Inc',
     'Dec',
     'Assigned',
+    'Ord',
     'Low',
-    'High'
+    'High',
+    'Pred',
+    'Succ'
     );
   bfAllStandardProcs = [Succ(bfCustom)..high(TResolverBuiltInProc)];
 
@@ -834,7 +846,8 @@ type
   PPRFindData = ^TPRFindData;
 
   TPasResolverOption = (
-    proFixCaseOfOverrides  // fix Name of overriding procs to the overriden proc
+    proFixCaseOfOverrides,  // fix Name of overriding procs to the overriden proc
+    proClassPropertyNonStatic  // class property accessor must be non static
     );
   TPasResolverOptions = set of TPasResolverOption;
 
@@ -991,10 +1004,6 @@ type
       Expr: TPasExpr; RaiseOnError: boolean): integer; virtual;
     function OnGetCallCompatibility_InExclude(Proc: TResElDataBuiltInProc;
       Expr: TPasExpr; RaiseOnError: boolean): integer; virtual;
-    function OnGetCallCompatibility_Ord(Proc: TResElDataBuiltInProc;
-      Expr: TPasExpr; RaiseOnError: boolean): integer; virtual;
-    procedure OnGetCallResult_Ord(Proc: TResElDataBuiltInProc;
-      {%H-}Params: TParamsExpr; out ResolvedEl: TPasResolverResult); virtual;
     function OnGetCallCompatibility_Break(Proc: TResElDataBuiltInProc;
       Expr: TPasExpr; RaiseOnError: boolean): integer; virtual;
     function OnGetCallCompatibility_Continue(Proc: TResElDataBuiltInProc;
@@ -1007,10 +1016,18 @@ type
       Expr: TPasExpr; RaiseOnError: boolean): integer; virtual;
     procedure OnGetCallResult_Assigned(Proc: TResElDataBuiltInProc;
       {%H-}Params: TParamsExpr; out ResolvedEl: TPasResolverResult); virtual;
+    function OnGetCallCompatibility_Ord(Proc: TResElDataBuiltInProc;
+      Expr: TPasExpr; RaiseOnError: boolean): integer; virtual;
+    procedure OnGetCallResult_Ord(Proc: TResElDataBuiltInProc;
+      {%H-}Params: TParamsExpr; out ResolvedEl: TPasResolverResult); virtual;
     function OnGetCallCompatibility_LowHigh(Proc: TResElDataBuiltInProc;
       Expr: TPasExpr; RaiseOnError: boolean): integer; virtual;
     procedure OnGetCallResult_LowHigh(Proc: TResElDataBuiltInProc;
       {%H-}Params: TParamsExpr; out ResolvedEl: TPasResolverResult); virtual;
+    function OnGetCallCompatibility_PredSucc(Proc: TResElDataBuiltInProc;
+      Expr: TPasExpr; RaiseOnError: boolean): integer; virtual;
+    procedure OnGetCallResult_PredSucc({%H-}Proc: TResElDataBuiltInProc;
+      {%H-}Params: TParamsExpr; out ResolvedEl: TPasResolverResult); virtual;
   public
     constructor Create;
     destructor Destroy; override;
@@ -1127,6 +1144,8 @@ type
     function ExprIsAddrTarget(El: TPasExpr): boolean;
     function GetLastExprIdentifier(El: TPasExpr): TPasExpr;
     function GetReference_NewInstanceClass(Ref: TResolvedReference): TPasClassType;
+    function TypeIsDynArray(TypeEl: TPasType): boolean;
+    function IsClassMethod(El: TPasElement): boolean;
   public
     property BaseType[bt: TResolverBaseType]: TPasUnresolvedSymbolRef read GetBaseType;
     property BaseTypeStringIndex: TResolverBaseType read FBaseTypeStringIndex write FBaseTypeStringIndex;
@@ -2292,6 +2311,17 @@ begin
     {$ENDIF}
     CandidateFound:=true;
     end
+  else if El.ClassType=TPasEnumType then
+    begin
+    // type cast to a enum
+    Abort:=true; // can't be overloaded
+    if Data^.Found<>nil then exit;
+    Distance:=cExact;
+    {$IFDEF VerbosePasResolver}
+    writeln('TPasResolver.OnFindCallElements type cast to enum=',El.Name,' Distance=',Distance);
+    {$ENDIF}
+    CandidateFound:=true;
+    end
   else if El is TPasVariable then
     begin
     Abort:=true; // can't be overloaded
@@ -3069,7 +3099,10 @@ end;
 procedure TPasResolver.FinishVariable(El: TPasVariable);
 begin
   if El.Expr<>nil then
+    begin
+    ResolveExpr(El.Expr);
     CheckAssignCompatibility(El,El.Expr,true);
+    end;
 end;
 
 procedure TPasResolver.FinishPropertyOfClass(PropEl: TPasProperty);
@@ -3256,8 +3289,11 @@ begin
         begin
         if Proc.ClassType<>TPasClassFunction then
           RaiseXExpectedButYFound('class function',Proc.ElementTypeName,PropEl.ReadAccessor);
-        if not Proc.IsStatic then
-          RaiseMsg(nClassPropertyAccessorMustBeStatic,sClassPropertyAccessorMustBeStatic,[],PropEl.ReadAccessor);
+        if Proc.IsStatic=(proClassPropertyNonStatic in Options) then
+          if Proc.IsStatic then
+            RaiseMsg(nClassPropertyAccessorMustNotBeStatic,sClassPropertyAccessorMustNotBeStatic,[],PropEl.ReadAccessor)
+          else
+            RaiseMsg(nClassPropertyAccessorMustBeStatic,sClassPropertyAccessorMustBeStatic,[],PropEl.ReadAccessor);
         end
       else
         begin
@@ -3303,8 +3339,11 @@ begin
         begin
         if Proc.ClassType<>TPasClassProcedure then
           RaiseXExpectedButYFound('class procedure',Proc.ElementTypeName,PropEl.WriteAccessor);
-        if not Proc.IsStatic then
-          RaiseMsg(nClassPropertyAccessorMustBeStatic,sClassPropertyAccessorMustBeStatic,[],PropEl.WriteAccessor);
+          if Proc.IsStatic=(proClassPropertyNonStatic in Options) then
+            if Proc.IsStatic then
+              RaiseMsg(nClassPropertyAccessorMustNotBeStatic,sClassPropertyAccessorMustNotBeStatic,[],PropEl.WriteAccessor)
+            else
+              RaiseMsg(nClassPropertyAccessorMustBeStatic,sClassPropertyAccessorMustBeStatic,[],PropEl.WriteAccessor);
         end
       else
         begin
@@ -5078,27 +5117,51 @@ begin
       eopAdd,
       eopSubtract,
       eopMultiply,
-      eopSymmetricaldifference:
+      eopSymmetricaldifference,
+      eopLessthanEqual,
+      eopGreaterThanEqual:
         begin
         if RightResolved.TypeEl=nil then
           begin
           // right is empty set
-          ResolvedEl:=LeftResolved;
+          if Bin.OpCode in [eopLessthanEqual,eopGreaterThanEqual] then
+            SetBaseType(btBoolean)
+          else
+            begin
+            ResolvedEl:=LeftResolved;
+            ResolvedEl.IdentEl:=nil;
+            ResolvedEl.ExprEl:=Bin;
+            end;
           exit;
-          end;
-        if LeftResolved.TypeEl=nil then
+          end
+        else if LeftResolved.TypeEl=nil then
           begin
           // left is empty set
-          ResolvedEl:=RightResolved;
+          if Bin.OpCode in [eopLessthanEqual,eopGreaterThanEqual] then
+            SetBaseType(btBoolean)
+          else
+            begin
+            ResolvedEl:=RightResolved;
+            ResolvedEl.IdentEl:=nil;
+            ResolvedEl.ExprEl:=Bin;
+            end;
           exit;
-          end;
-        if (LeftResolved.SubType=RightResolved.SubType)
+          end
+        else if (LeftResolved.SubType=RightResolved.SubType)
             or ((LeftResolved.SubType in btAllBooleans)
               and (RightResolved.SubType in btAllBooleans))
             or ((LeftResolved.SubType in btAllInteger)
               and (RightResolved.SubType in btAllInteger)) then
           begin
-          ResolvedEl:=LeftResolved;
+          // compatible set
+          if Bin.OpCode in [eopLessthanEqual,eopGreaterThanEqual] then
+            SetBaseType(btBoolean)
+          else
+            begin
+            ResolvedEl:=LeftResolved;
+            ResolvedEl.IdentEl:=nil;
+            ResolvedEl.ExprEl:=Bin;
+            end;
           exit;
           end;
         {$IFDEF VerbosePasResolver}
@@ -5124,6 +5187,18 @@ end;
 
 procedure TPasResolver.ComputeArrayParams(Params: TParamsExpr; out
   ResolvedEl: TPasResolverResult; Flags: TPasResolverComputeFlags);
+
+  procedure ComputeIndexProperty(Prop: TPasProperty);
+  begin
+    ComputeElement(GetPasPropertyType(Prop),ResolvedEl,Flags-[rcReturnFuncResult]);
+    ResolvedEl.IdentEl:=Prop;
+    ResolvedEl.Flags:=[];
+    if GetPasPropertyGetter(Prop)<>nil then
+      Include(ResolvedEl.Flags,rrfReadable);
+    if GetPasPropertySetter(Prop)<>nil then
+      Include(ResolvedEl.Flags,rrfWritable);
+  end;
+
 var
   TypeEl: TPasType;
   ClassScope: TPasClassScope;
@@ -5151,6 +5226,9 @@ begin
   else
     RaiseNotYetImplemented(20160928174144,Params);
 
+  {$IFDEF VerbosePasResolver}
+  writeln('TPasResolver.ComputeArrayParams ResolvedEl=',GetResolverResultDesc(ResolvedEl));
+  {$ENDIF}
   if ResolvedEl.BaseType in btAllStrings then
     begin
     // stringvar[] => char
@@ -5162,8 +5240,10 @@ begin
     ResolvedEl.TypeEl:=FBaseTypes[ResolvedEl.BaseType];
     ResolvedEl.ExprEl:=Params;
     end
-  else if ResolvedEl.IdentEl is TPasProperty then
+  else if (ResolvedEl.IdentEl is TPasProperty)
+      and (TPasProperty(ResolvedEl.IdentEl).Args.Count>0) then
     // property with args
+    ComputeIndexProperty(TPasProperty(ResolvedEl.IdentEl))
   else if ResolvedEl.BaseType=btContext then
     begin
     TypeEl:=ResolvedEl.TypeEl;
@@ -5172,14 +5252,14 @@ begin
       ClassScope:=TypeEl.CustomData as TPasClassScope;
       if ClassScope.DefaultProperty=nil then
         RaiseInternalError(20161010151747);
-      ComputeElement(ClassScope.DefaultProperty,ResolvedEl,[]);
+      ComputeIndexProperty(ClassScope.DefaultProperty);
       end
     else if TypeEl.ClassType=TPasClassOfType then
       begin
       ClassScope:=TPasClassOfType(TypeEl).DestType.CustomData as TPasClassScope;
       if ClassScope.DefaultProperty=nil then
         RaiseInternalError(20161010174916);
-      ComputeElement(ClassScope.DefaultProperty,ResolvedEl,[]);
+      ComputeIndexProperty(ClassScope.DefaultProperty);
       end
     else if TypeEl.ClassType=TPasArrayType then
       begin
@@ -5288,6 +5368,7 @@ begin
         // type cast
         ResolvedTypeEl:=ResolvedEl;
         ComputeElement(Params.Params[0],ResolvedEl,[rcReturnFuncResult]);
+        ResolvedEl.BaseType:=ResolvedTypeEl.BaseType;
         ResolvedEl.TypeEl:=ResolvedTypeEl.TypeEl;
         end
       else
@@ -5308,6 +5389,9 @@ begin
     ComputeElement(Params.Params[0],ResolvedEl,Flags+[rcReturnFuncResult]);
     if ResolvedEl.BaseType=btRange then
       ConvertRangeToFirstValue(ResolvedEl);
+    ResolvedEl.IdentEl:=nil;
+    if ResolvedEl.ExprEl=nil then
+      ResolvedEl.ExprEl:=Params;
     ResolvedEl.SubType:=ResolvedEl.BaseType;
     ResolvedEl.BaseType:=btSet;
     ResolvedEl.Flags:=[rrfReadable];
@@ -5665,59 +5749,6 @@ begin
   Result:=cExact;
 end;
 
-function TPasResolver.OnGetCallCompatibility_Ord(Proc: TResElDataBuiltInProc;
-  Expr: TPasExpr; RaiseOnError: boolean): integer;
-var
-  Params: TParamsExpr;
-  Param: TPasExpr;
-  ParamResolved: TPasResolverResult;
-begin
-  if (not (Expr is TParamsExpr)) or (length(TParamsExpr(Expr).Params)<1) then
-    begin
-    if RaiseOnError then
-      RaiseMsg(nWrongNumberOfParametersForCallTo,
-        sWrongNumberOfParametersForCallTo,[Proc.Signature],Expr);
-    exit(cIncompatible);
-    end;
-  Params:=TParamsExpr(Expr);
-
-  // first param: enum or char
-  Param:=Params.Params[0];
-  ComputeElement(Param,ParamResolved,[rcReturnFuncResult]);
-  Result:=cIncompatible;
-  if rrfReadable in ParamResolved.Flags then
-    begin
-    if ParamResolved.BaseType=btChar then
-      Result:=cExact
-    else if (ParamResolved.BaseType=btContext) and (ParamResolved.TypeEl is TPasEnumType) then
-      Result:=cExact;
-    end;
-  if Result=cIncompatible then
-    begin
-    if RaiseOnError then
-      RaiseMsg(nIncompatibleTypeArgNo,sIncompatibleTypeArgNo,
-        ['1',GetTypeDesc(ParamResolved.TypeEl),'enum or char'],
-        Param);
-    exit;
-    end;
-
-  if length(Params.Params)>1 then
-    begin
-    if RaiseOnError then
-      RaiseMsg(nWrongNumberOfParametersForCallTo,
-        sWrongNumberOfParametersForCallTo,[Proc.Signature],Params.Params[1]);
-    exit(cIncompatible);
-    end;
-
-  Result:=cExact;
-end;
-
-procedure TPasResolver.OnGetCallResult_Ord(Proc: TResElDataBuiltInProc;
-  Params: TParamsExpr; out ResolvedEl: TPasResolverResult);
-begin
-  SetResolverIdentifier(ResolvedEl,btSmallInt,Proc.Proc,FBaseTypes[btSmallInt],[rrfReadable]);
-end;
-
 function TPasResolver.OnGetCallCompatibility_Break(Proc: TResElDataBuiltInProc;
   Expr: TPasExpr; RaiseOnError: boolean): integer;
 var
@@ -5955,6 +5986,59 @@ begin
   SetResolverIdentifier(ResolvedEl,btBoolean,Proc.Proc,FBaseTypes[btBoolean],[rrfReadable]);
 end;
 
+function TPasResolver.OnGetCallCompatibility_Ord(Proc: TResElDataBuiltInProc;
+  Expr: TPasExpr; RaiseOnError: boolean): integer;
+var
+  Params: TParamsExpr;
+  Param: TPasExpr;
+  ParamResolved: TPasResolverResult;
+begin
+  if (not (Expr is TParamsExpr)) or (length(TParamsExpr(Expr).Params)<1) then
+    begin
+    if RaiseOnError then
+      RaiseMsg(nWrongNumberOfParametersForCallTo,
+        sWrongNumberOfParametersForCallTo,[Proc.Signature],Expr);
+    exit(cIncompatible);
+    end;
+  Params:=TParamsExpr(Expr);
+
+  // first param: enum or char
+  Param:=Params.Params[0];
+  ComputeElement(Param,ParamResolved,[rcReturnFuncResult]);
+  Result:=cIncompatible;
+  if rrfReadable in ParamResolved.Flags then
+    begin
+    if ParamResolved.BaseType=btChar then
+      Result:=cExact
+    else if (ParamResolved.BaseType=btContext) and (ParamResolved.TypeEl is TPasEnumType) then
+      Result:=cExact;
+    end;
+  if Result=cIncompatible then
+    begin
+    if RaiseOnError then
+      RaiseMsg(nIncompatibleTypeArgNo,sIncompatibleTypeArgNo,
+        ['1',GetTypeDesc(ParamResolved.TypeEl),'enum or char'],
+        Param);
+    exit;
+    end;
+
+  if length(Params.Params)>1 then
+    begin
+    if RaiseOnError then
+      RaiseMsg(nWrongNumberOfParametersForCallTo,
+        sWrongNumberOfParametersForCallTo,[Proc.Signature],Params.Params[1]);
+    exit(cIncompatible);
+    end;
+
+  Result:=cExact;
+end;
+
+procedure TPasResolver.OnGetCallResult_Ord(Proc: TResElDataBuiltInProc;
+  Params: TParamsExpr; out ResolvedEl: TPasResolverResult);
+begin
+  SetResolverIdentifier(ResolvedEl,btSmallInt,Proc.Proc,FBaseTypes[btSmallInt],[rrfReadable]);
+end;
+
 function TPasResolver.OnGetCallCompatibility_LowHigh(
   Proc: TResElDataBuiltInProc; Expr: TPasExpr; RaiseOnError: boolean): integer;
 // check params of built in proc 'Low' or 'High'
@@ -5962,6 +6046,7 @@ var
   Params: TParamsExpr;
   Param: TPasExpr;
   ParamResolved: TPasResolverResult;
+  TypeEl: TPasType;
 begin
   if (not (Expr is TParamsExpr)) or (length(TParamsExpr(Expr).Params)<1) then
     begin
@@ -5978,8 +6063,15 @@ begin
   Result:=cIncompatible;
   if CheckIsOrdinal(ParamResolved,Param,false) then
     Result:=cExact
-  else if (ParamResolved.BaseType=btContext) and (ParamResolved.TypeEl.ClassType=TPasArrayType) then
-    Result:=cExact;
+  else if ParamResolved.BaseType=btSet then
+    Result:=cExact
+  else if (ParamResolved.BaseType=btContext) then
+    begin
+    TypeEl:=ParamResolved.TypeEl;
+    if (TypeEl.ClassType=TPasArrayType)
+        or (TypeEl.ClassType=TPasSetType) then
+      Result:=cExact;
+    end;
   if Result=cIncompatible then
     begin
     if RaiseOnError then
@@ -6004,26 +6096,92 @@ procedure TPasResolver.OnGetCallResult_LowHigh(Proc: TResElDataBuiltInProc;
   Params: TParamsExpr; out ResolvedEl: TPasResolverResult);
 var
   ArrayEl: TPasArrayType;
+  Param: TPasExpr;
+  TypeEl: TPasType;
 begin
-  ComputeElement(Params.Params[0],ResolvedEl,[]);
-  if ResolvedEl.TypeEl.ClassType=TPasArrayType then
+  Param:=Params.Params[0];
+  ComputeElement(Param,ResolvedEl,[]);
+  if ResolvedEl.BaseType=btContext then
     begin
-    // array: result type is type of first dimension
-    ArrayEl:=TPasArrayType(ResolvedEl.TypeEl);
-    if length(ArrayEl.Ranges)=0 then
-      SetResolverIdentifier(ResolvedEl,btInt64,Proc.Proc,FBaseTypes[btInt64],[rrfReadable])
-    else
+    TypeEl:=ResolvedEl.TypeEl;
+    if TypeEl.ClassType=TPasArrayType then
       begin
-      ComputeElement(ArrayEl.Ranges[0],ResolvedEl,[rcReturnFuncResult]);
-      if ResolvedEl.BaseType=btRange then
-        ConvertRangeToFirstValue(ResolvedEl);
+      // array: result type is type of first dimension
+      ArrayEl:=TPasArrayType(TypeEl);
+      if length(ArrayEl.Ranges)=0 then
+        SetResolverIdentifier(ResolvedEl,btInt64,Proc.Proc,FBaseTypes[btInt64],[rrfReadable])
+      else
+        begin
+        ComputeElement(ArrayEl.Ranges[0],ResolvedEl,[rcReturnFuncResult]);
+        if ResolvedEl.BaseType=btRange then
+          ConvertRangeToFirstValue(ResolvedEl);
+        end;
+      end
+    else if TypeEl.ClassType=TPasSetType then
+      begin
+      ResolvedEl.TypeEl:=TPasSetType(TypeEl).EnumType;
       end;
     end
+  else if ResolvedEl.BaseType=btSet then
+    begin
+    ResolvedEl.BaseType:=ResolvedEl.SubType;
+    ResolvedEl.SubType:=btNone;
+    end
   else
     ;// ordinal: result type is argument type
   ResolvedEl.Flags:=ResolvedEl.Flags-[rrfWritable];
 end;
 
+function TPasResolver.OnGetCallCompatibility_PredSucc(
+  Proc: TResElDataBuiltInProc; Expr: TPasExpr; RaiseOnError: boolean): integer;
+// check params of built in proc 'Pred' or 'Succ'
+var
+  Params: TParamsExpr;
+  Param: TPasExpr;
+  ParamResolved: TPasResolverResult;
+begin
+  if (not (Expr is TParamsExpr)) or (length(TParamsExpr(Expr).Params)<1) then
+    begin
+    if RaiseOnError then
+      RaiseMsg(nWrongNumberOfParametersForCallTo,
+        sWrongNumberOfParametersForCallTo,[Proc.Signature],Expr);
+    exit(cIncompatible);
+    end;
+  Params:=TParamsExpr(Expr);
+
+  // first param: enum, range, set, char or integer
+  Param:=Params.Params[0];
+  ComputeElement(Param,ParamResolved,[]);
+  Result:=cIncompatible;
+  if CheckIsOrdinal(ParamResolved,Param,false) then
+    Result:=cExact;
+  if Result=cIncompatible then
+    begin
+    if RaiseOnError then
+      RaiseMsg(nIncompatibleTypeArgNo,sIncompatibleTypeArgNo,
+        ['1',GetTypeDesc(ParamResolved.TypeEl),'ordinal'],
+        Param);
+    exit;
+    end;
+
+  if length(Params.Params)>1 then
+    begin
+    if RaiseOnError then
+      RaiseMsg(nWrongNumberOfParametersForCallTo,
+        sWrongNumberOfParametersForCallTo,[Proc.Signature],Params.Params[1]);
+    exit(cIncompatible);
+    end;
+
+  Result:=cExact;
+end;
+
+procedure TPasResolver.OnGetCallResult_PredSucc(Proc: TResElDataBuiltInProc;
+  Params: TParamsExpr; out ResolvedEl: TPasResolverResult);
+begin
+  ComputeElement(Params.Params[0],ResolvedEl,[]);
+  ResolvedEl.Flags:=ResolvedEl.Flags-[rrfWritable];
+end;
+
 constructor TPasResolver.Create;
 begin
   inherited Create;
@@ -6227,7 +6385,7 @@ var
 begin
   StartScope:=FindData.StartScope;
   OnlyTypeMembers:=false;
-  if (StartScope is TPasDotIdentifierScope) then
+  if StartScope is TPasDotIdentifierScope then
     begin
     OnlyTypeMembers:=TPasDotIdentifierScope(StartScope).OnlyTypeMembers;
     Include(Ref.Flags,rrfDotScope);
@@ -6236,6 +6394,13 @@ begin
     begin
     OnlyTypeMembers:=TPasWithExprScope(StartScope).OnlyTypeMembers;
     Include(Ref.Flags,rrfDotScope);
+    end
+  else if StartScope.ClassType=TPasProcedureScope then
+    begin
+    Proc:=TPasProcedureScope(StartScope).Element as TPasProcedure;
+    //writeln('TPasResolver.CheckFoundElement ',GetObjName(Proc),' ',IsClassMethod(Proc),' ElScope=',GetObjName(FindData.ElScope));
+    if (FindData.ElScope<>StartScope) and IsClassMethod(Proc) then
+      OnlyTypeMembers:=true;
     end;
 
   //writeln('TPasResolver.CheckFoundElOnStartScope StartScope=',StartScope.ClassName,
@@ -6250,11 +6415,7 @@ begin
     // only class vars/procs allowed
     if (FindData.Found.ClassType=TPasConstructor) then
       // constructor: ok
-    else if (FindData.Found.ClassType=TPasClassConstructor)
-        or (FindData.Found.ClassType=TPasClassDestructor)
-        or (FindData.Found.ClassType=TPasClassProcedure)
-        or (FindData.Found.ClassType=TPasClassFunction)
-        or (FindData.Found.ClassType=TPasClassOperator)
+    else if IsClassMethod(FindData.Found)
     then
       // class proc: ok
     else if (FindData.Found is TPasVariable)
@@ -6299,8 +6460,11 @@ begin
       Ref.Context:=TResolvedRefCtxConstructor.Create;
       if StartScope is TPasDotClassScope then
         TypeEl:=TPasDotClassScope(StartScope).ClassScope.Element as TPasType
-      else if (StartScope is TPasWithExprScope) and (TPasWithExprScope(StartScope).Scope is TPasClassScope) then
+      else if (StartScope is TPasWithExprScope)
+          and (TPasWithExprScope(StartScope).Scope is TPasClassScope) then
         TypeEl:=TPasClassScope(TPasWithExprScope(StartScope).Scope).Element as TPasType
+      else if (StartScope is TPasProcedureScope) then
+        TypeEl:=TPasProcedureScope(StartScope).ClassScope.Element as TPasType
       else
         RaiseInternalError(20170131150855,GetObjName(StartScope));
       TResolvedRefCtxConstructor(Ref.Context).Typ:=TypeEl;
@@ -6483,9 +6647,6 @@ begin
   if bfExclude in BaseProcs then
     AddBuiltInProc('Exclude','procedure Exclude(var Set of Enum; const Enum)',
         @OnGetCallCompatibility_InExclude,nil,bfExclude);
-  if bfOrd in BaseProcs then
-    AddBuiltInProc('Ord','function Ord(const Enum or Char): integer',
-        @OnGetCallCompatibility_Ord,@OnGetCallResult_Ord,bfOrd);
   if bfBreak in BaseProcs then
     AddBuiltInProc('Break','procedure Break',
         @OnGetCallCompatibility_Break,nil,bfBreak);
@@ -6504,12 +6665,21 @@ begin
   if bfAssigned in BaseProcs then
     AddBuiltInProc('Assigned','function Assigned(const Pointer or Class or Class-of): boolean',
         @OnGetCallCompatibility_Assigned,@OnGetCallResult_Assigned,bfAssigned);
+  if bfOrd in BaseProcs then
+    AddBuiltInProc('Ord','function Ord(const Enum or Char): integer',
+        @OnGetCallCompatibility_Ord,@OnGetCallResult_Ord,bfOrd);
   if bfLow in BaseProcs then
     AddBuiltInProc('Low','function Low(const array or ordinal): ordinal or integer',
         @OnGetCallCompatibility_LowHigh,@OnGetCallResult_LowHigh,bfLow);
   if bfHigh in BaseProcs then
     AddBuiltInProc('High','function High(const array or ordinal): ordinal or integer',
         @OnGetCallCompatibility_LowHigh,@OnGetCallResult_LowHigh,bfHigh);
+  if bfPred in BaseProcs then
+    AddBuiltInProc('Pred','function Pred(const ordinal): ordinal',
+        @OnGetCallCompatibility_PredSucc,@OnGetCallResult_PredSucc,bfPred);
+  if bfSucc in BaseProcs then
+    AddBuiltInProc('Succ','function Succ(const ordinal): ordinal',
+        @OnGetCallCompatibility_PredSucc,@OnGetCallResult_PredSucc,bfSucc);
 end;
 
 function TPasResolver.AddBaseType(aName: shortstring; Typ: TResolverBaseType
@@ -7087,7 +7257,6 @@ begin
       or (Arg1Resolved.TypeEl<>Arg2Resolved.TypeEl) then
     exit;
 
-  // ToDo: check Arg1.ValueExpr
   Result:=true;
 end;
 
@@ -7102,6 +7271,9 @@ begin
     begin
     if ErrorOnFalse then
       begin
+      {$IFDEF VerbosePasResolver}
+      writeln('TPasResolver.CheckCanBeLHS ',GetResolverResultDesc(ResolvedEl));
+      {$ENDIF}
       if (ResolvedEl.TypeEl<>nil) and (ResolvedEl.ExprEl<>nil) then
         RaiseXExpectedButYFound('identifier',ResolvedEl.TypeEl.ElementTypeName,ResolvedEl.ExprEl)
       else
@@ -7134,6 +7306,7 @@ function TPasResolver.CheckAssignCompatibility(const LHS,
   ): integer;
 var
   Expected, Actual: String;
+  TypeEl: TPasType;
 begin
   // check if the RHS can be converted to LHS
   {$IFDEF VerbosePasResolver}
@@ -7185,10 +7358,12 @@ begin
         exit(cExact)
       else if LHS.BaseType=btContext then
         begin
-        if (LHS.TypeEl.ClassType=TPasClassType)
-            or (LHS.TypeEl.ClassType=TPasClassOfType)
-            or (LHS.TypeEl.ClassType=TPasPointerType)
-            or (LHS.TypeEl is TPasProcedureType) then
+        TypeEl:=LHS.TypeEl;
+        if (TypeEl.ClassType=TPasClassType)
+            or (TypeEl.ClassType=TPasClassOfType)
+            or (TypeEl.ClassType=TPasPointerType)
+            or (TypeEl is TPasProcedureType)
+            or TypeIsDynArray(TypeEl) then
           exit(cExact);
         end;
     end
@@ -7242,6 +7417,8 @@ end;
 function TPasResolver.CheckEqualCompatibility(const LHS,
   RHS: TPasResolverResult; ErrorEl: TPasElement; RaiseOnIncompatible: boolean
   ): integer;
+var
+  TypeEl: TPasType;
 begin
   Result:=cIncompatible;
   // check if the RHS is type compatible to LHS
@@ -7270,10 +7447,12 @@ begin
         exit(cExact)
       else if RHS.BaseType=btContext then
         begin
-        if (RHS.TypeEl.ClassType=TPasClassType)
-            or (RHS.TypeEl.ClassType=TPasClassOfType)
-            or (RHS.TypeEl.ClassType=TPasPointerType)
-            or (RHS.TypeEl is TPasProcedureType) then
+        TypeEl:=RHS.TypeEl;
+        if (TypeEl.ClassType=TPasClassType)
+            or (TypeEl.ClassType=TPasClassOfType)
+            or (TypeEl.ClassType=TPasPointerType)
+            or (TypeEl is TPasProcedureType)
+            or TypeIsDynArray(TypeEl) then
           exit(cExact);
         end
       else if RaiseOnIncompatible then
@@ -7288,10 +7467,12 @@ begin
         exit(cExact)
       else if LHS.BaseType=btContext then
         begin
-        if (LHS.TypeEl.ClassType=TPasClassType)
-            or (LHS.TypeEl.ClassType=TPasClassOfType)
-            or (LHS.TypeEl.ClassType=TPasPointerType)
-            or (LHS.TypeEl is TPasProcedureType) then
+        TypeEl:=LHS.TypeEl;
+        if (TypeEl.ClassType=TPasClassType)
+            or (TypeEl.ClassType=TPasClassOfType)
+            or (TypeEl.ClassType=TPasPointerType)
+            or (TypeEl is TPasProcedureType)
+            or TypeIsDynArray(TypeEl) then
           exit(cExact);
         end
       else if RaiseOnIncompatible then
@@ -7816,6 +7997,11 @@ begin
         if Result=cIncompatible then
           Result:=CheckSrcIsADstType(ParamResolved,ResolvedEl,Param);
         end;
+      end
+    else if ResolvedEl.TypeEl.ClassType=TPasEnumType then
+      begin
+      if CheckIsOrdinal(ParamResolved,Param,true) then
+        Result:=cExact;
       end;
     end;
 
@@ -8041,13 +8227,19 @@ begin
     begin
     if rcConstant in Flags then
       RaiseConstantExprExp(El);
-    ComputeElement(GetPasPropertyType(TPasProperty(El)),ResolvedEl,Flags-[rcReturnFuncResult]);
-    ResolvedEl.IdentEl:=El;
-    ResolvedEl.Flags:=[];
-    if GetPasPropertyGetter(TPasProperty(El))<>nil then
-      Include(ResolvedEl.Flags,rrfReadable);
-    if GetPasPropertySetter(TPasProperty(El))<>nil then
-      Include(ResolvedEl.Flags,rrfWritable);
+    if TPasProperty(El).Args.Count=0 then
+      begin
+      ComputeElement(GetPasPropertyType(TPasProperty(El)),ResolvedEl,Flags-[rcReturnFuncResult]);
+      ResolvedEl.IdentEl:=El;
+      ResolvedEl.Flags:=[];
+      if GetPasPropertyGetter(TPasProperty(El))<>nil then
+        Include(ResolvedEl.Flags,rrfReadable);
+      if GetPasPropertySetter(TPasProperty(El))<>nil then
+        Include(ResolvedEl.Flags,rrfWritable);
+      end
+    else
+      // index property
+      SetResolverIdentifier(ResolvedEl,btContext,El,nil,[]);
     end
   else if El.ClassType=TPasArgument then
     begin
@@ -8239,6 +8431,22 @@ begin
   Result:=(Ref.Context as TResolvedRefCtxConstructor).Typ as TPasClassType;
 end;
 
+function TPasResolver.TypeIsDynArray(TypeEl: TPasType): boolean;
+begin
+  Result:=(TypeEl<>nil) and (TypeEl.ClassType=TPasArrayType)
+      and (length(TPasArrayType(TypeEl).Ranges)=0);
+end;
+
+function TPasResolver.IsClassMethod(El: TPasElement): boolean;
+begin
+  Result:=(El<>nil)
+     and ((El.ClassType=TPasClassConstructor)
+       or (El.ClassType=TPasClassDestructor)
+       or (El.ClassType=TPasClassProcedure)
+       or (El.ClassType=TPasClassFunction)
+       or (El.ClassType=TPasClassOperator));
+end;
+
 function TPasResolver.CheckSrcIsADstType(const ResolvedSrcType,
   ResolvedDestType: TPasResolverResult; ErrorEl: TPasElement): integer;
 // finds distance between classes SrcType and DestType

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

@@ -710,7 +710,7 @@ type
   end;
 
   { TPasVariable }
-  TVariableModifier = (vmCVar, vmExternal, vmPublic, vmExport, vmClass,vmStatic);
+  TVariableModifier = (vmCVar, vmExternal, vmPublic, vmExport, vmClass, vmStatic);
   TVariableModifiers = set of TVariableModifier;
 
   TPasVariable = class(TPasElement)
@@ -1392,6 +1392,9 @@ const
                    'static','inline','assembler','varargs', 'public',
                    'compilerproc','external','forward','dispid','noreturn');
 
+  VariableModifierNames : Array[TVariableModifier] of string
+     = ('cvar', 'external', 'public', 'export', 'class', 'static');
+
 procedure ReleaseAndNil(var El: TPasElement); overload;
 
 implementation

+ 12 - 14
packages/fcl-passrc/src/pparser.pp

@@ -2352,7 +2352,7 @@ var
   TypeName: String;
   PT : TProcType;
   NamePos: TPasSourcePos;
-  OldForceCaret,ok: Boolean;
+  ok: Boolean;
 
 begin
   CurBlock := declNone;
@@ -2455,7 +2455,7 @@ begin
               end;
             declType:
               begin
-              OldForceCaret:=Scanner.SetForceCaret(True);
+              Scanner.SetForceCaret(True);
               TypeEl := ParseTypeDecl(Declarations);
               // Scanner.SetForceCaret(OldForceCaret); // It may have been switched off
               if Assigned(TypeEl) then        // !!!
@@ -3940,10 +3940,9 @@ begin
       begin
         NextToken;
         Left:=DoParseExpression(CurBlock);
-        UngetToken;
+        UNgettoken;
         El:=TPasImplIfElse(CreateElement(TPasImplIfElse,'',CurBlock));
         TPasImplIfElse(El).ConditionExpr:=Left;
-        Left.Parent:=El;
         //WriteLn(i,'IF Condition="',Condition,'" Token=',CurTokenText);
         CreateBlock(TPasImplIfElse(El));
         ExpectToken(tkthen);
@@ -4004,8 +4003,8 @@ begin
       begin
         // while Condition do
         NextToken;
-        left:=DoParseExpression(CurBlock);
-        UngetToken;
+        left:=DoParseExpression(Parent);
+        ungettoken;
         //WriteLn(i,'WHILE Condition="',Condition,'" Token=',CurTokenText);
         El:=TPasImplWhileDo(CreateElement(TPasImplWhileDo,'',CurBlock));
         TPasImplWhileDo(El).ConditionExpr:=left;
@@ -4014,7 +4013,7 @@ begin
       end;
     tkgoto:
       begin
-        NextToken;
+        nexttoken;
         curblock.AddCommand('goto '+curtokenstring);
         expecttoken(tkSemiColon);
       end;
@@ -4081,18 +4080,17 @@ begin
         // with Expr, Expr do
         SrcPos:=Scanner.CurSourcePos;
         NextToken;
-        Left:=DoParseExpression(CurBlock);
+        Left:=DoParseExpression(Parent);
         //writeln(i,'WITH Expr="',Expr,'" Token=',CurTokenText);
         El:=TPasImplWithDo(CreateElement(TPasImplWithDo,'',CurBlock,SrcPos));
         TPasImplWithDo(El).AddExpression(Left);
-        Left.Parent:=El;
         CreateBlock(TPasImplWithDo(El));
         repeat
           if CurToken=tkdo then break;
           if CurToken<>tkComma then
             ParseExcTokenError(TokenInfos[tkdo]);
           NextToken;
-          Left:=DoParseExpression(CurBlock);
+          Left:=DoParseExpression(Parent);
           //writeln(i,'WITH ...,Expr="',Expr,'" Token=',CurTokenText);
           TPasImplWithDo(CurBlock).AddExpression(Left);
         until false;
@@ -4100,7 +4098,7 @@ begin
     tkcase:
       begin
         NextToken;
-        Left:=DoParseExpression(CurBlock);
+        Left:=DoParseExpression(Parent);
         UngetToken;
         //writeln(i,'CASE OF Expr="',Expr,'" Token=',CurTokenText);
         ExpectToken(tkof);
@@ -4301,7 +4299,7 @@ begin
         if CurBlock is TPasImplRepeatUntil then
         begin
           NextToken;
-          Left:=DoParseExpression(CurBlock);
+          Left:=DoParseExpression(Parent);
           UngetToken;
           TPasImplRepeatUntil(CurBlock).ConditionExpr:=Left;
           //WriteLn(i,'UNTIL Condition="',Condition,'" Token=',CurTokenString);
@@ -4310,7 +4308,7 @@ begin
           ParseExcSyntaxError;
       end;
     else
-      left:=DoParseExpression(CurBlock);
+      left:=DoParseExpression(Parent);
       case CurToken of
         tkAssign,
         tkAssignPlus,
@@ -4321,7 +4319,7 @@ begin
           // assign statement
           Ak:=TokenToAssignKind(CurToken);
           NextToken;
-          right:=DoParseExpression(CurBlock); // this may solve TPasImplWhileDo.AddElement BUG
+          right:=DoParseExpression(Parent); // this may solve TPasImplWhileDo.AddElement BUG
           El:=TPasImplAssign(CreateElement(TPasImplAssign,'',CurBlock));
           left.Parent:=El;
           right.Parent:=El;

+ 8 - 5
packages/fcl-passrc/src/pscanner.pp

@@ -1409,13 +1409,15 @@ begin
   OldLength:=0;
   FCurTokenString := '';
 
-  while TokenStr[0] in ['^','#', ''''] do
-  begin
+  repeat
     case TokenStr[0] of
       '^' :
         begin
         TokenStart := TokenStr;
         Inc(TokenStr);
+        if TokenStr[0] in ['a'..'z','A'..'Z'] then
+          Inc(TokenStr);
+        if Result=tkEOF then Result := tkChar else Result:=tkString;
         end;
       '#':
         begin
@@ -1465,8 +1467,7 @@ begin
     if SectionLength > 0 then
       Move(TokenStart^, FCurTokenString[OldLength + 1], SectionLength);
     Inc(OldLength, SectionLength);
-  end;
-
+  until false;
 end;
 
 procedure TPascalScanner.PushStackItem;
@@ -1780,8 +1781,9 @@ end;
 Procedure TPascalScanner.HandleELSE(Const AParam : String);
 
 begin
+  if AParam='' then;
   if PPSkipStackIndex = 0 then
-     Error(nErrInvalidPPElse,sErrInvalidPPElse);
+    Error(nErrInvalidPPElse,sErrInvalidPPElse);
   if PPSkipMode = ppSkipIfBranch then
     PPIsSkipping := false
   else if PPSkipMode = ppSkipElseBranch then
@@ -1792,6 +1794,7 @@ end;
 Procedure TPascalScanner.HandleENDIF(Const AParam : String);
 
 begin
+  if AParam='' then;
   if PPSkipStackIndex = 0 then
     Error(nErrInvalidPPEndif,sErrInvalidPPEndif);
   Dec(PPSkipStackIndex);

+ 304 - 22
packages/fcl-passrc/tests/tcresolver.pas

@@ -142,6 +142,7 @@ type
     Procedure TestVarInteger;
     Procedure TestConstInteger;
     Procedure TestDuplicateVar;
+    Procedure TestVarInitConst;
     Procedure TestVarOfVarFail;
     Procedure TestConstOfVarFail;
     Procedure TestTypedConstWrongExprFail;
@@ -150,12 +151,20 @@ type
     Procedure TestIncDec;
     Procedure TestIncStringFail;
 
+    // strings
+    Procedure TestString_SetLength;
+
     // enums
     Procedure TestEnums;
     Procedure TestSets;
+    Procedure TestSetOperators;
     Procedure TestEnumParams;
     Procedure TestSetParams;
+    Procedure TestSetFunctions;
     Procedure TestEnumHighLow;
+    Procedure TestEnumOrd;
+    Procedure TestEnumPredSucc;
+    Procedure TestEnum_CastIntegerToEnum;
 
     // operators
     Procedure TestPrgAssignment;
@@ -223,6 +232,7 @@ type
     Procedure TestUnitIntfMismatchArgName;
     Procedure TestProcOverloadIsNotFunc;
     Procedure TestProcCallMissingParams;
+    Procedure TestProcArgDefaultValueTypeMismatch;
     Procedure TestBuiltInProcCallMissingParams;
     Procedure TestAssignFunctionResult;
     Procedure TestAssignProcResultFail;
@@ -331,7 +341,11 @@ type
     Procedure TestPropertyArgs1;
     Procedure TestPropertyArgs2;
     Procedure TestPropertyArgsWithDefaultsFail;
+    Procedure TestProperty_Index;
+    Procedure TestProperty_WrongTypeAsIndexFail;
+    Procedure TestProperty_Option_ClassPropertyNonStatic;
     Procedure TestDefaultProperty;
+    Procedure TestMissingDefaultProperty;
 
     // with
     Procedure TestWithBlock1;
@@ -345,6 +359,7 @@ type
     Procedure TestArrayOfArray;
     Procedure TestFunctionReturningArray;
     Procedure TestLowHighArray;
+    Procedure TestPropertyOfTypeArray;
 
     // procedure types
     Procedure TestProcTypesAssignObjFPC;
@@ -1475,6 +1490,15 @@ begin
   CheckResolverException('duplicate identifier',PasResolver.nDuplicateIdentifier);
 end;
 
+procedure TTestResolver.TestVarInitConst;
+begin
+  StartProgram(false);
+  Add('const {#c}c=1;');
+  Add('var a: longint = {@c}c;');
+  Add('begin');
+  ParseProgram;
+end;
+
 procedure TTestResolver.TestVarOfVarFail;
 begin
   StartProgram(false);
@@ -1550,13 +1574,24 @@ begin
   CheckResolverException('Incompatible type arg no. 1: Got "String", expected "Longint"',PasResolver.nIncompatibleTypeArgNo);
 end;
 
+procedure TTestResolver.TestString_SetLength;
+begin
+  StartProgram(false);
+  Add('var');
+  Add('  s: string;');
+  Add('begin');
+  Add('  SetLength(s,3);');
+  Add('  SetLength(s,length(s));');
+  ParseProgram;
+end;
+
 procedure TTestResolver.TestEnums;
 begin
   StartProgram(false);
   Add('type {#TFlag}TFlag = ({#Red}Red, {#Green}Green, {#Blue}Blue);');
   Add('var');
   Add('  {#f}{=TFlag}f: TFlag;');
-  Add('  {#v}{=TFlag}v: TFlag;');
+  Add('  {#v}{=TFlag}v: TFlag = Green;');
   Add('begin');
   Add('  {@f}f:={@Red}Red;');
   Add('  {@f}f:={@v}v;');
@@ -1588,7 +1623,7 @@ begin
   Add('var');
   Add('  {#f}{=TFlag}f: TFlag;');
   Add('  {#s}{=TFlags}s: TFlags;');
-  Add('  {#t}{=TFlags}t: TFlags;');
+  Add('  {#t}{=TFlags}t: TFlags = [Green,Gray];');
   Add('  {#Chars}{=TChars}Chars: TChars;');
   Add('  {#MyInts}{=TMyInts}MyInts: TMyInts;');
   Add('  {#MyBools}{=TMyBools}MyBools: TMyBools;');
@@ -1598,6 +1633,40 @@ begin
   Add('  {@s}s:=[{@Red}Red];');
   Add('  {@s}s:=[{@Red}Red,{@Blue}Blue];');
   Add('  {@s}s:=[{@Gray}Gray..{@White}White];');
+  Add('  {@MyInts}MyInts:=[1];');
+  Add('  {@MyInts}MyInts:=[1,2];');
+  Add('  {@MyInts}MyInts:=[1..2];');
+  Add('  {@MyInts}MyInts:=[1..2,3];');
+  Add('  {@MyInts}MyInts:=[1..2,3..4];');
+  Add('  {@MyInts}MyInts:=[1,2..3];');
+  Add('  {@MyBools}MyBools:=[false];');
+  Add('  {@MyBools}MyBools:=[false,true];');
+  Add('  {@MyBools}MyBools:=[true..false];');
+  ParseProgram;
+end;
+
+procedure TTestResolver.TestSetOperators;
+begin
+  StartProgram(false);
+  Add('type');
+  Add('  {#TFlag}TFlag = ({#Red}Red, {#Green}Green, {#Blue}Blue, {#Gray}Gray, {#Black}Black, {#White}White);');
+  Add('  {#TFlags}TFlags = set of TFlag;');
+  Add('  {#TChars}TChars = set of Char;');
+  Add('  {#TMyInt}TMyInt = 0..17;');
+  Add('  {#TMyInts}TMyInts = set of TMyInt;');
+  Add('  {#TMyBools}TMyBools = set of boolean;');
+  Add('const');
+  Add('  {#Colors}Colors = [{@Red}Red..{@Blue}Blue];');
+  Add('  {#ExtColors}ExtColors = {@Colors}Colors+[{@White}White,{@Black}Black];');
+  Add('var');
+  Add('  {#f}{=TFlag}f: TFlag;');
+  Add('  {#s}{=TFlags}s: TFlags;');
+  Add('  {#t}{=TFlags}t: TFlags = [Green,Gray];');
+  Add('  {#Chars}{=TChars}Chars: TChars;');
+  Add('  {#MyInts}{=TMyInts}MyInts: TMyInts;');
+  Add('  {#MyBools}{=TMyBools}MyBools: TMyBools;');
+  Add('begin');
+  Add('  {@s}s:=[];');
   Add('  {@s}s:=[{@Red}Red]+[{@Blue}Blue,{@Gray}Gray];');
   Add('  {@s}s:=[{@Blue}Blue,{@Gray}Gray]-[{@Blue}Blue];');
   Add('  {@s}s:={@t}t+[];');
@@ -1606,32 +1675,38 @@ begin
   Add('  {@s}s:=[{@Red}Red]-{@s}s;');
   Add('  {@s}s:={@s}s-[{@Red}Red];');
   Add('  Include({@s}s,{@Blue}Blue);');
+  Add('  Include({@s}s,{@f}f);');
   Add('  Exclude({@s}s,{@Blue}Blue);');
+  Add('  Exclude({@s}s,{@f}f);');
   Add('  {@s}s:={@s}s+[{@f}f];');
   Add('  if {@Green}Green in {@s}s then ;');
   Add('  if {@Blue}Blue in {@Colors}Colors then ;');
   Add('  if {@f}f in {@ExtColors}ExtColors then ;');
-  Add('  {@s}s:={@s}s * Colors;');
-  Add('  {@s}s:=Colors * {@s}s;');
-  Add('  s:=ExtColors * Colors;');
-  Add('  s:=Colors >< ExtColors;');
-  Add('  s:=s >< ExtColors;');
-  Add('  s:=ExtColors >< s;');
+  Add('  {@s}s:={@s}s * {@Colors}Colors;');
+  Add('  {@s}s:={@Colors}Colors * {@s}s;');
+  Add('  {@s}s:={@ExtColors}ExtColors * {@Colors}Colors;');
+  Add('  {@s}s:=Colors >< {@ExtColors}ExtColors;');
+  Add('  {@s}s:={@s}s >< {@ExtColors}ExtColors;');
+  Add('  {@s}s:={@ExtColors}ExtColors >< s;');
+  Add('  {@s}s:={@s}s >< {@s}s;');
   Add('  if ''p'' in [''a''..''z''] then ; ');
   Add('  if ''p'' in [''a''..''z'',''A''..''Z'',''0''..''9'',''_''] then ; ');
   Add('  if ''p'' in {@Chars}Chars then ; ');
   Add('  if 7 in {@MyInts}MyInts then ; ');
   Add('  if 7 in [1+2,(3*4)+5,(-2+6)..(8-3)] then ; ');
-  Add('  {@MyInts}MyInts:=[1];');
-  Add('  {@MyInts}MyInts:=[1,2];');
-  Add('  {@MyInts}MyInts:=[1..2];');
-  Add('  {@MyInts}MyInts:=[1..2,3];');
-  Add('  {@MyInts}MyInts:=[1..2,3..4];');
-  Add('  {@MyInts}MyInts:=[1,2..3];');
-  Add('  {@MyBools}MyBools:=[false];');
-  Add('  {@MyBools}MyBools:=[false,true];');
-  Add('  {@MyBools}MyBools:=[true..false];');
   Add('  if [red,blue]*s=[red,blue] then ;');
+  Add('  if {@s}s = t then;');
+  Add('  if {@s}s = {@Colors}Colors then;');
+  Add('  if {@Colors}Colors = s then;');
+  Add('  if {@s}s <> t then;');
+  Add('  if {@s}s <> {@Colors}Colors then;');
+  Add('  if {@Colors}Colors <> s then;');
+  Add('  if {@s}s <= t then;');
+  Add('  if {@s}s <= {@Colors}Colors then;');
+  Add('  if {@Colors}Colors <= s then;');
+  Add('  if {@s}s >= t then;');
+  Add('  if {@s}s >= {@Colors}Colors then;');
+  Add('  if {@Colors}Colors >= {@s}s then;');
   ParseProgram;
 end;
 
@@ -1681,6 +1756,23 @@ begin
   ParseProgram;
 end;
 
+procedure TTestResolver.TestSetFunctions;
+begin
+  StartProgram(false);
+  Add('type');
+  Add('  TFlag = (red, green, blue);');
+  Add('  TFlags = set of TFlag;');
+  Add('var');
+  Add('  e: TFlag;');
+  Add('  s: TFlags;');
+  Add('begin');
+  Add('  e:=Low(TFlags);');
+  Add('  e:=Low(s);');
+  Add('  e:=High(TFlags);');
+  Add('  e:=High(s);');
+  ParseProgram;
+end;
+
 procedure TTestResolver.TestEnumHighLow;
 begin
   StartProgram(false);
@@ -1692,6 +1784,52 @@ begin
   ParseProgram;
 end;
 
+procedure TTestResolver.TestEnumOrd;
+begin
+  StartProgram(false);
+  Add('type');
+  Add('  TFlag = (red, green, blue);');
+  Add('var');
+  Add('  f: TFlag;');
+  Add('  i: longint;');
+  Add('begin');
+  Add('  i:=ord(f);');
+  Add('  i:=ord(green);');
+  Add('  if i=ord(f) then ;');
+  Add('  if ord(f)=i then ;');
+  ParseProgram;
+end;
+
+procedure TTestResolver.TestEnumPredSucc;
+begin
+  StartProgram(false);
+  Add('type');
+  Add('  TFlag = (red, green, blue);');
+  Add('var');
+  Add('  f: TFlag;');
+  Add('begin');
+  Add('  f:=Pred(f);');
+  Add('  if Pred(green)=Pred(TFlag.Blue) then;');
+  Add('  f:=Succ(f);');
+  Add('  if Succ(green)=Succ(TFlag.Blue) then;');
+  ParseProgram;
+end;
+
+procedure TTestResolver.TestEnum_CastIntegerToEnum;
+begin
+  StartProgram(false);
+  Add('type');
+  Add('  TFlag = (red, green, blue);');
+  Add('var');
+  Add('  f: TFlag;');
+  Add('  i: longint;');
+  Add('begin');
+  Add('  f:=TFlag(1);');
+  Add('  f:=TFlag(i);');
+  Add('  if TFlag(i)=TFlag(1) then;');
+  ParseProgram;
+end;
+
 procedure TTestResolver.TestPrgAssignment;
 var
   El: TPasElement;
@@ -1914,6 +2052,12 @@ begin
   Add('  i:=j or k;');
   Add('  i:=j and not k;');
   Add('  i:=(j+k) div 3;');
+  Add('  if i=j then;');
+  Add('  if i<>j then;');
+  Add('  if i>j then;');
+  Add('  if i>=j then;');
+  Add('  if i<j then;');
+  Add('  if i<=j then;');
   ParseProgram;
 end;
 
@@ -1931,6 +2075,9 @@ begin
   Add('  i:=(not j) or k;');
   Add('  i:=j or false;');
   Add('  i:=j and true;');
+  Add('  i:=j xor k;');
+  Add('  i:=j=k;');
+  Add('  i:=j<>k;');
   ParseProgram;
 end;
 
@@ -2794,6 +2941,17 @@ begin
     PasResolver.nWrongNumberOfParametersForCallTo);
 end;
 
+procedure TTestResolver.TestProcArgDefaultValueTypeMismatch;
+begin
+  StartProgram(false);
+  Add('procedure Proc1(a: string = 3);');
+  Add('begin');
+  Add('end;');
+  Add('begin');
+  CheckResolverException('Incompatible types: got "Longint" expected "String"',
+    PasResolver.nIncompatibleTypesGotExpected);
+end;
+
 procedure TTestResolver.TestBuiltInProcCallMissingParams;
 begin
   StartProgram(false);
@@ -3958,18 +4116,23 @@ begin
   Add('type');
   Add('  TObject = class');
   Add('    constructor Create;');
+  Add('    class function DoSome: TObject;');
   Add('  end;');
   Add('constructor TObject.Create;');
   Add('begin');
   Add('  {#a}Create; // normal call');
-  Add('  TObject.{#b}Create; // new object');
+  Add('  TObject.{#b}Create; // new instance');
+  Add('end;');
+  Add('class function TObject.DoSome: TObject;');
+  Add('begin');
+  Add('  Result:={#c}Create; // new instance');
   Add('end;');
   Add('var');
   Add('  o: TObject;');
   Add('begin');
-  Add('  TObject.{#c}Create; // new object');
-  Add('  o:=TObject.{#d}Create; // new object');
-  Add('  o.{#e}Create; // normal call');
+  Add('  TObject.{#p}Create; // new object');
+  Add('  o:=TObject.{#q}Create; // new object');
+  Add('  o.{#r}Create; // normal call');
   ParseProgram;
   aMarker:=FirstSrcMarker;
   while aMarker<>nil do
@@ -3995,7 +4158,7 @@ begin
       if not ActualImplicitCallWithoutParams then
         RaiseErrorAtSrcMarker('expected implicit call at "#'+aMarker^.Identifier+', but got function ref"',aMarker);
       case aMarker^.Identifier of
-      'a','e':// should be normal call
+      'a','r':// should be normal call
         if ActualNewInstance then
           RaiseErrorAtSrcMarker('expected normal call at "#'+aMarker^.Identifier+', but got newinstance"',aMarker);
       else // should be newinstance
@@ -4239,6 +4402,8 @@ begin
   Add('begin');
   Add('  c:=nil;');
   Add('  c:=o.ClassType;');
+  Add('  if c=nil then;');
+  Add('  if nil=c then;');
   Add('  if c=o.ClassType then ;');
   Add('  if c<>o.ClassType then ;');
   Add('  if Assigned(o) then ;');
@@ -4892,6 +5057,77 @@ begin
     PParser.nParserPropertyArgumentsCanNotHaveDefaultValues);
 end;
 
+procedure TTestResolver.TestProperty_Index;
+begin
+  StartProgram(false);
+  Add('type');
+  Add('  TObject = class');
+  Add('    {#FItems}FItems: array of string;');
+  Add('    function {#GetItems}GetItems(Index: longint): string;');
+  Add('    procedure {#SetItems}SetItems(Index: longint; Value: string);');
+  Add('    procedure DoIt;');
+  Add('    property {#Items}Items[Index: longint]: string read {@GetItems}getitems write {@SetItems}setitems;');
+  Add('  end;');
+  Add('function tobject.getitems(index: longint): string;');
+  Add('begin');
+  Add('  Result:={@FItems}fitems[index];');
+  Add('end;');
+  Add('procedure tobject.setitems(index: longint; value: string);');
+  Add('begin');
+  Add('  {@FItems}fitems[index]:=value;');
+  Add('end;');
+  Add('procedure tobject.doit;');
+  Add('begin');
+  Add('  {@Items}items[1]:={@Items}items[2];');
+  Add('  self.{@Items}items[3]:=self.{@Items}items[4];');
+  Add('end;');
+  Add('var Obj: tobject;');
+  Add('begin');
+  Add('  obj.{@Items}Items[11]:=obj.{@Items}Items[12];');
+  ParseProgram;
+end;
+
+procedure TTestResolver.TestProperty_WrongTypeAsIndexFail;
+begin
+  StartProgram(false);
+  Add('type');
+  Add('  TObject = class');
+  Add('    function GetItems(Index: string): string;');
+  Add('    property Items[Index: string]: string read getitems;');
+  Add('  end;');
+  Add('function tobject.getitems(index: string): string;');
+  Add('begin');
+  Add('end;');
+  Add('var Obj: tobject;');
+  Add('begin');
+  Add('  obj.Items[3]:=4;');
+  CheckResolverException('Incompatible type arg no. 1: Got "Longint", expected "Index:String"',
+    PasResolver.nIncompatibleTypeArgNo);
+end;
+
+procedure TTestResolver.TestProperty_Option_ClassPropertyNonStatic;
+begin
+  ResolverEngine.Options:=ResolverEngine.Options+[proClassPropertyNonStatic];
+  StartProgram(false);
+  Add('type');
+  Add('  TObject = class');
+  Add('    class function GetB: longint;');
+  Add('    class procedure SetB(Value: longint);');
+  Add('    class property B: longint read GetB write SetB;');
+  Add('  end;');
+  Add('class function TObject.GetB: longint;');
+  Add('begin');
+  Add('end;');
+  Add('class procedure TObject.SetB(Value: longint);');
+  Add('begin');
+  Add('end;');
+  Add('begin');
+  Add('  TObject.B:=4;');
+  Add('  if TObject.B=6 then;');
+  Add('  if 7=TObject.B then;');
+  ParseProgram;
+end;
+
 procedure TTestResolver.TestDefaultProperty;
 begin
   StartProgram(false);
@@ -4915,6 +5151,19 @@ begin
   ParseProgram;
 end;
 
+procedure TTestResolver.TestMissingDefaultProperty;
+begin
+  StartProgram(false);
+  Add('type');
+  Add('  TObject = class');
+  Add('  end;');
+  Add('var o: TObject;');
+  Add('begin');
+  Add('  if o[5]=6 then;');
+  CheckResolverException('illegal qualifier "["',
+    PasResolver.nIllegalQualifier);
+end;
+
 procedure TTestResolver.TestPropertyAssign;
 begin
   StartProgram(false);
@@ -5073,11 +5322,15 @@ begin
   Add('type TIntArray = array of longint;');
   Add('var a: TIntArray;');
   Add('begin');
+  Add('  a:=nil;');
+  Add('  if a=nil then ;');
+  Add('  if nil=a then ;');
   Add('  SetLength(a,3);');
   Add('  a[0]:=1;');
   Add('  a[1]:=length(a);');
   Add('  a[2]:=a[0];');
   Add('  if a[3]=a[4] then ;');
+  Add('  a[a[5]]:=a[a[6]];');
   ParseProgram;
 end;
 
@@ -5150,6 +5403,35 @@ begin
   ParseProgram;
 end;
 
+procedure TTestResolver.TestPropertyOfTypeArray;
+begin
+  StartProgram(false);
+  Add('type');
+  Add('  TArray = array of longint;');
+  Add('  TObject = class');
+  Add('    FItems: TArray;');
+  Add('    function GetItems: TArray;');
+  Add('    procedure SetItems(Value: TArray);');
+  Add('    property Items: TArray read FItems write FItems;');
+  Add('    property Numbers: TArray read GetItems write SetItems;');
+  Add('  end;');
+  Add('function TObject.GetItems: TArray;');
+  Add('begin');
+  Add('  Result:=FItems;');
+  Add('end;');
+  Add('procedure TObject.SetItems(Value: TArray);');
+  Add('begin');
+  Add('  FItems:=Value;');
+  Add('end;');
+  Add('var Obj: TObject;');
+  Add('begin');
+  Add('  Obj.Items[3]:=4;');
+  Add('  if Obj.Items[5]=6 then;');
+  Add('  Obj.Numbers[7]:=8;');
+  Add('  if Obj.Numbers[9]=10 then;');
+  ParseProgram;
+end;
+
 procedure TTestResolver.TestProcTypesAssignObjFPC;
 begin
   StartProgram(false);