fcl-passrc: resolver: pass static array to open array

git-svn-id: trunk@37467 -

packages/fcl-passrc/src/pasresolver.pp

@@ -1379,7 +1379,7 @@ type
     function GetNewInstanceExpr(El: TPasExpr): TPasExpr;
     function ParentNeedsExprResult(El: TPasExpr): boolean;
     function GetReference_NewInstanceClass(Ref: TResolvedReference): TPasClassType;
-    function IsDynArray(TypeEl: TPasType): boolean;
+    function IsDynArray(TypeEl: TPasType; OptionalOpenArray: boolean = true): boolean;
     function IsOpenArray(TypeEl: TPasType): boolean;
     function IsDynOrOpenArray(TypeEl: TPasType): boolean;
     function IsVarInit(Expr: TPasExpr): boolean;
@@ -6013,7 +6013,7 @@ end;
 procedure TPasResolver.AccessExpr(Expr: TPasExpr;
   Access: TResolvedRefAccess);
 // called after a call target was found, called for each element
-// to set the rraParamToUnknownProc to Access
+// to change the rraParamToUnknownProc value to Access
 var
   Ref: TResolvedReference;
   Bin: TBinaryExpr;
@@ -6046,8 +6046,11 @@ begin
     pekArrayParams:
       begin
       ComputeElement(Params.Value,ValueResolved,[]);
-      if not IsDynArray(ValueResolved.TypeEl) then
+      if IsDynArray(ValueResolved.TypeEl,false) then
+        // an element of a dynamic array is independ of the array variable
+      else
         AccessExpr(Params.Value,Access);
+      // Note: an element of an open or static array or a string is connected to the variable
       end;
     pekSet:
       if Access<>rraRead then
@@ -7478,7 +7481,7 @@ begin
         end
       else if RBT=btContext then
        begin
-       C:=RHS.TypeEl.ClassType;
+       C:=ResolveAliasType(RHS.TypeEl).ClassType;
        if (C=TPasClassType)
            or (C=TPasClassOfType)
            or (C=TPasPointerType)
@@ -8251,7 +8254,7 @@ begin
       Result:=cExact
     else if ParamResolved.BaseType=btContext then
       begin
-      if IsDynArray(ParamResolved.TypeEl) and not IsOpenArray(ParamResolved.TypeEl) then
+      if IsDynArray(ParamResolved.TypeEl,false) then
         begin
         Result:=cExact;
         DynArr:=NoNil(ParamResolved.TypeEl) as TPasArrayType;
@@ -12132,7 +12135,7 @@ function TPasResolver.GetTypeDescription(aType: TPasType; AddPath: boolean): str
       begin
       s:=aType.FullPath;
       if (s<>'') and (s<>'.') then
-        Result:=s+'.'+Result;
+        Result:=s+':'+Result;
       end;
   end;
 
@@ -12141,17 +12144,13 @@ var
 begin
   if aType=nil then exit('untyped');
   C:=aType.ClassType;
+  Result:=GetName;
   if (C=TPasUnresolvedSymbolRef) then
     begin
-    Result:=GetName;
     if TPasUnresolvedSymbolRef(aType).CustomData is TResElDataBuiltInProc then
       Result:=Result+'()';
     exit;
-    end
-  else if (C=TPasUnresolvedTypeRef) then
-    Result:=GetName
-  else
-    Result:=GetName;
+    end;
 end;
 
 function TPasResolver.GetTypeDescription(const R: TPasResolverResult;
@@ -12368,8 +12367,8 @@ begin
     RaiseInternalError(20160922163645);
   if (LHS.TypeEl=nil) then
     RaiseInternalError(20160922163648);
-  LTypeEl:=LHS.TypeEl;
-  RTypeEl:=RHS.TypeEl;
+  LTypeEl:=ResolveAliasType(LHS.TypeEl);
+  RTypeEl:=ResolveAliasType(RHS.TypeEl);
   if LTypeEl=RTypeEl then
     exit(cExact);
 
@@ -12444,7 +12443,9 @@ begin
       begin
       LArray:=TPasArrayType(LTypeEl);
       RArray:=TPasArrayType(RTypeEl);
-      if length(LArray.Ranges)=length(RArray.Ranges) then
+      if (length(RArray.Ranges)=1)
+          or ((proOpenAsDynArrays in Options) and (length(RArray.Ranges)=0))
+          or IsOpenArray(RTypeEl) then
         begin
         if CheckProcArgTypeCompatibility(LArray.ElType,RArray.ElType) then
           Result:=cExact
@@ -13912,12 +13913,14 @@ begin
   Result:=(Ref.Context as TResolvedRefCtxConstructor).Typ as TPasClassType;
 end;
 
-function TPasResolver.IsDynArray(TypeEl: TPasType): boolean;
+function TPasResolver.IsDynArray(TypeEl: TPasType; OptionalOpenArray: boolean
+  ): boolean;
 begin
+  TypeEl:=ResolveAliasType(TypeEl);
   if (TypeEl=nil) or (TypeEl.ClassType<>TPasArrayType)
       or (length(TPasArrayType(TypeEl).Ranges)<>0) then
     exit(false);
-  if proOpenAsDynArrays in Options then
+  if OptionalOpenArray and (proOpenAsDynArrays in Options) then
     Result:=true
   else
     Result:=(TypeEl.Parent=nil) or (TypeEl.Parent.ClassType<>TPasArgument);
@@ -13934,6 +13937,7 @@ end;
 
 function TPasResolver.IsDynOrOpenArray(TypeEl: TPasType): boolean;
 begin
+  TypeEl:=ResolveAliasType(TypeEl);
   Result:=(TypeEl<>nil) and (TypeEl.ClassType=TPasArrayType)
       and (length(TPasArrayType(TypeEl).Ranges)=0);
 end;

packages/fcl-passrc/tests/tcresolver.pas

@@ -9202,19 +9202,20 @@ end;
 procedure TTestResolver.TestArray_OpenArrayOfString;
 begin
   StartProgram(false);
-  Add('procedure DoIt(const a: array of String);');
-  Add('var');
-  Add('  i: longint;');
-  Add('  s: string;');
-  Add('begin');
-  Add('  for i:=low(a) to high(a) do s:=a[length(a)-i-1];');
-  Add('end;');
-  Add('const arr: array[0..1] of string = (''A'', ''B'');');
-  Add('var s: string;');
-  Add('begin');
-  Add('  DoIt([]);');
-  Add('  DoIt([s,''foo'','''',s+s]);');
-  Add('  DoIt(arr);');
+  Add([
+  'procedure DoIt(const a: array of String);',
+  'var',
+  '  i: longint;',
+  '  s: string;',
+  'begin',
+  '  for i:=low(a) to high(a) do s:=a[length(a)-i-1];',
+  'end;',
+  'const arr: array[0..1] of string = (''A'', ''B'');',
+  'var s: string;',
+  'begin',
+  '  DoIt([]);',
+  '  DoIt([s,''foo'','''',s+s]);',
+  '  DoIt(arr);']);
   ParseProgram;
 end;