paweld/fpc
1
0
Fork 0
mirror of https://gitlab.com/freepascal.org/fpc/source.git synced 2025-08-29 23:20:32 +02:00
Code Issues Packages Projects Releases Wiki Activity

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

Browse Source 
git-svn-id: trunk@37467 -
This commit is contained in:
Mattias Gaertner 2017-10-16 09:25:00 +00:00
parent 69f2055ff3
commit 34c88e6dbc
2 changed files with 35 additions and 30 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

38
packages/fcl-passrc/src/pasresolver.pp
View File

@ -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;

27
packages/fcl-passrc/tests/tcresolver.pas
View File

@ -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;