Browse Source

fcl-passrc: resolver: totherarray(array):=

git-svn-id: trunk@41278 -
Mattias Gaertner 6 years ago
parent
commit
60976ab94d
2 changed files with 56 additions and 10 deletions
  1. 27 10
      packages/fcl-passrc/src/pasresolver.pp
  2. 29 0
      packages/fcl-passrc/tests/tcresolver.pas

+ 27 - 10
packages/fcl-passrc/src/pasresolver.pp

@@ -6269,8 +6269,8 @@ begin
       if (ClassOrRecScope is TPasClassScope)
           and (TPasClassScope(ClassOrRecScope).CanonicalClassOf<>nil) then
         begin
-        // 'Self' in a class method is the hidden classtype argument
-        // Note: this is true in classes and helpers
+        // 'Self' in a method is the hidden classtype argument
+        // Note: this is true in classes, adv records and helpers
         SelfArg:=TPasArgument.Create('Self',DeclProc);
         ImplProcScope.SelfArg:=SelfArg;
         {$IFDEF CheckPasTreeRefCount}SelfArg.RefIds.Add('TPasProcedureScope.SelfArg');{$ENDIF}
@@ -8962,15 +8962,19 @@ begin
         end;
       end;
     // default: search for type helpers
-    DotScope:=PushHelperDotScope(LeftResolved.HiTypeEl);
-    if DotScope<>nil then
+    if (LeftResolved.BaseType in btAllStandardTypes)
+        or (LeftResolved.BaseType=btContext) then
       begin
-      if LeftResolved.IdentEl is TPasType then
-        // e.g. TSet.HelperProc
-        DotScope.OnlyTypeMembers:=true;
-      ResolveExpr(El.right,Access);
-      PopScope;
-      exit;
+      DotScope:=PushHelperDotScope(LeftResolved.HiTypeEl);
+      if DotScope<>nil then
+        begin
+        if LeftResolved.IdentEl is TPasType then
+          // e.g. TSet.HelperProc
+          DotScope.OnlyTypeMembers:=true;
+        ResolveExpr(El.right,Access);
+        PopScope;
+        exit;
+        end;
       end;
     end;
 
@@ -11682,6 +11686,12 @@ begin
         else if (ToLoType.ClassType=TPasRecordType)
             and (ParamResolved.LoTypeEl.ClassType=TPasRecordType) then
           // typecast record
+          KeepWriteFlags:=true
+        else if (ToLoType.ClassType=TPasArrayType)
+            and (ParamResolved.LoTypeEl.ClassType=TPasArrayType)
+            and IsDynArray(ToLoType)
+            and IsDynArray(ParamResolved.LoTypeEl) then
+          // typecast array
           KeepWriteFlags:=true;
         end
       else
@@ -17001,6 +17011,13 @@ begin
   if TypeEl=nil then
     RaiseMsg(20170216152004,nExprTypeMustBeClassOrRecordTypeGot,sExprTypeMustBeClassOrRecordTypeGot,
       [BaseTypeNames[ExprResolved.BaseType]],ErrorEl);
+  if (ExprResolved.BaseType in btAllStandardTypes) then
+    // ok
+  else if (ExprResolved.BaseType=btContext) then
+    // ok
+  else
+    RaiseMsg(20190210143257,nExprTypeMustBeClassOrRecordTypeGot,sExprTypeMustBeClassOrRecordTypeGot,
+      [BaseTypeNames[ExprResolved.BaseType]],ErrorEl);
 
   Flags:=[];
   CheckUseAsType(TypeEl,20190123113957,Expr);

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

@@ -914,6 +914,7 @@ type
     Procedure TestTypeHelper_Enum;
     Procedure TestTypeHelper_EnumDotValueFail;
     Procedure TestTypeHelper_EnumHelperDotProcFail;
+    Procedure TestTypeHelper_Set;
     Procedure TestTypeHelper_Enumerator;
     Procedure TestTypeHelper_String;
     Procedure TestTypeHelper_Boolean;
@@ -17006,6 +17007,8 @@ begin
   '  f: TFlag;',
   'begin',
   '  f.toString;',
+  '  green.toString;',
+  '  TFlag.green.toString;',
   '  TFlag.Fly;',
   '']);
   ParseProgram;
@@ -17047,6 +17050,32 @@ begin
   CheckResolverException('Cannot access this member from a type helper',nCannotAccessThisMemberFromAX);
 end;
 
+procedure TTestResolver.TestTypeHelper_Set;
+begin
+  StartProgram(false);
+  Add([
+  '{$modeswitch typehelpers}',
+  'type',
+  '  TEnum = (Red, Green, Blue);',
+  '  TSetOfEnum = set of TEnum;',
+  '  THelper = type helper for TSetOfEnum',
+  '    procedure Fly;',
+  '  end;',
+  'procedure THelper.Fly;',
+  'begin',
+  '  Self:=[];',
+  '  Self:=[green];',
+  '  Include(Self,blue);',
+  'end;',
+  'var s: TSetOfEnum;',
+  'begin',
+  // todo: '  s.Fly;',
+  // not supported: [green].Fly
+  // todo: with s do Fly
+  '']);
+  ParseProgram;
+end;
+
 procedure TTestResolver.TestTypeHelper_Enumerator;
 begin
   StartProgram(false);