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

fcl-passrc: fixed parent of var init expression

Browse Source 
git-svn-id: trunk@38021 -
This commit is contained in:
Mattias Gaertner 2018-01-23 10:39:04 +00:00
parent f61b074912
commit c456aac8e5
2 changed files with 31 additions and 10 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

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

@ -290,7 +290,8 @@ type
btNil, // nil = pointer, class, procedure, method, ...
btProc, // TPasProcedure
btBuiltInProc,
btSet, // [] see SubType, can also be round bracket in var a:arraytype = (x,y)
btSet, // [] see SubType
//btArrayLit, // [] array literal, can also be round bracket in var a:arraytype = (x,y)
btRange // a..b see SubType
);
TResolveBaseTypes = set of TResolverBaseType;
@ -5784,14 +5785,15 @@ begin
else
Access:=rraReadAndAssign;
ResolveExpr(El.left,Access);
ResolveExpr(El.right,rraRead);
{$IFDEF VerbosePasResolver}
writeln('TPasResolver.ResolveImplAssign Kind=',El.Kind,' left=',GetObjName(El.left),' right=',GetObjName(el.right));
{$ENDIF}
// check LHS can be assigned
ComputeElement(El.left,LeftResolved,[rcSkipTypeAlias,rcNoImplicitProc,rcSetReferenceFlags]);
CheckCanBeLHS(LeftResolved,true,El.left);
// compute RHS
ResolveExpr(El.right,rraRead); // ToDo: btArrayLit: if LHS is array then pass ArrType and Dim
Flags:=[rcSkipTypeAlias,rcSetReferenceFlags];
if IsProcedureType(LeftResolved,true) then
if (msDelphi in CurrentParser.CurrentModeswitches) then
@ -13761,7 +13763,7 @@ begin
Include(RHSFlags,rcNoImplicitProcType);
if SetReferenceFlags then
Include(RHSFlags,rcSetReferenceFlags);
ComputeElement(Expr,ExprResolved,RHSFlags);
ComputeElement(Expr,ExprResolved,RHSFlags); // ToDo: btArrayLit: if ParamResolved is array then pass ArrType and Dim
{$IFDEF VerbosePasResolver}
writeln('TPasResolver.CheckParamCompatibility Expr=',GetTreeDbg(Expr,2),' ResolvedExpr=',GetResolverResultDbg(ExprResolved),' RHSFlags=',dbgs(RHSFlags));
@ -14024,6 +14026,7 @@ function TPasResolver.CheckAssignCompatibilityArrayType(const LHS,
i, Count: Integer;
IsLastRange: Boolean;
ArrayValues: TPasExprArray;
Impl: TPasElement;
begin
Expr:=Values.ExprEl;
if (Expr=nil) and (Values.IdentEl is TPasVariable) then
@ -14117,10 +14120,28 @@ function TPasResolver.CheckAssignCompatibilityArrayType(const LHS,
end
else if Values.BaseType=btSet then
begin
// common mistake: const requires () instead of []
if RaiseOnIncompatible then
RaiseMsg(20170913181208,nXExpectedButYFound,sXExpectedButYFound,
['(','['],ErrorEl);
if ErrorEl.Parent is TPasVariable then
begin
// common mistake: const requires () instead of []
if RaiseOnIncompatible then
RaiseMsg(20170913181208,nXExpectedButYFound,sXExpectedButYFound,
['(','['],ErrorEl);
exit;
end;
Impl:=ErrorEl;
while (Impl<>nil) and not (Impl is TPasImplBlock) do
begin
if Impl is TPasProcedure then
begin
Impl:=nil;
break;
end;
Impl:=Impl.Parent;
end;
if Impl=nil then
exit;
// ToDo: const array in implblock, e.g. arr:=[1,2,3]
exit;
end
else
@ -14177,8 +14198,8 @@ begin
exit;
if IsEmptySet(RHS) then
begin
if length(LArrType.Ranges)=0 then
exit(cExact); // empty set fits dyn and open array
if (length(LArrType.Ranges)=0) then
exit(cExact); // empty set fits open and dyn array
end;
CheckRange(LArrType,0,RHS,ErrorEl);

2
packages/fcl-passrc/src/pparser.pp
View File

@ -3930,7 +3930,7 @@ begin
H:=CheckHint(Nil,False);
If Full then
GetVariableValueAndLocation(Parent,Value,AbsoluteExpr,AbsoluteLocString);
GetVariableValueAndLocation(VarEl,Value,AbsoluteExpr,AbsoluteLocString);
if (VarList.Count>OldListCount+1) then
begin
// multiple variables