paweld/fpc
1
0
Fork 0
mirror of https://gitlab.com/freepascal.org/fpc/source.git synced 2025-09-14 22:09:16 +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, ... btNil, // nil = pointer, class, procedure, method, ...
btProc, // TPasProcedure btProc, // TPasProcedure
btBuiltInProc, 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 btRange // a..b see SubType
); );
TResolveBaseTypes = set of TResolverBaseType; TResolveBaseTypes = set of TResolverBaseType;
@ -5784,14 +5785,15 @@ begin
else else
Access:=rraReadAndAssign; Access:=rraReadAndAssign;
ResolveExpr(El.left,Access); ResolveExpr(El.left,Access);
ResolveExpr(El.right,rraRead);
{$IFDEF VerbosePasResolver} {$IFDEF VerbosePasResolver}
writeln('TPasResolver.ResolveImplAssign Kind=',El.Kind,' left=',GetObjName(El.left),' right=',GetObjName(el.right)); writeln('TPasResolver.ResolveImplAssign Kind=',El.Kind,' left=',GetObjName(El.left),' right=',GetObjName(el.right));
{$ENDIF} {$ENDIF}
// check LHS can be assigned // check LHS can be assigned
ComputeElement(El.left,LeftResolved,[rcSkipTypeAlias,rcNoImplicitProc,rcSetReferenceFlags]); ComputeElement(El.left,LeftResolved,[rcSkipTypeAlias,rcNoImplicitProc,rcSetReferenceFlags]);
CheckCanBeLHS(LeftResolved,true,El.left); CheckCanBeLHS(LeftResolved,true,El.left);
// compute RHS // compute RHS
ResolveExpr(El.right,rraRead); // ToDo: btArrayLit: if LHS is array then pass ArrType and Dim
Flags:=[rcSkipTypeAlias,rcSetReferenceFlags]; Flags:=[rcSkipTypeAlias,rcSetReferenceFlags];
if IsProcedureType(LeftResolved,true) then if IsProcedureType(LeftResolved,true) then
if (msDelphi in CurrentParser.CurrentModeswitches) then if (msDelphi in CurrentParser.CurrentModeswitches) then
@ -13761,7 +13763,7 @@ begin
Include(RHSFlags,rcNoImplicitProcType); Include(RHSFlags,rcNoImplicitProcType);
if SetReferenceFlags then if SetReferenceFlags then
Include(RHSFlags,rcSetReferenceFlags); Include(RHSFlags,rcSetReferenceFlags);
ComputeElement(Expr,ExprResolved,RHSFlags); ComputeElement(Expr,ExprResolved,RHSFlags); // ToDo: btArrayLit: if ParamResolved is array then pass ArrType and Dim
{$IFDEF VerbosePasResolver} {$IFDEF VerbosePasResolver}
writeln('TPasResolver.CheckParamCompatibility Expr=',GetTreeDbg(Expr,2),' ResolvedExpr=',GetResolverResultDbg(ExprResolved),' RHSFlags=',dbgs(RHSFlags)); 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; i, Count: Integer;
IsLastRange: Boolean; IsLastRange: Boolean;
ArrayValues: TPasExprArray; ArrayValues: TPasExprArray;
Impl: TPasElement;
begin begin
Expr:=Values.ExprEl; Expr:=Values.ExprEl;
if (Expr=nil) and (Values.IdentEl is TPasVariable) then if (Expr=nil) and (Values.IdentEl is TPasVariable) then
@ -14117,10 +14120,28 @@ function TPasResolver.CheckAssignCompatibilityArrayType(const LHS,
end end
else if Values.BaseType=btSet then else if Values.BaseType=btSet then
begin begin
// common mistake: const requires () instead of [] if ErrorEl.Parent is TPasVariable then
if RaiseOnIncompatible then begin
RaiseMsg(20170913181208,nXExpectedButYFound,sXExpectedButYFound, // common mistake: const requires () instead of []
['(','['],ErrorEl); 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; exit;
end end
else else
@ -14177,8 +14198,8 @@ begin
exit; exit;
if IsEmptySet(RHS) then if IsEmptySet(RHS) then
begin begin
if length(LArrType.Ranges)=0 then if (length(LArrType.Ranges)=0) then
exit(cExact); // empty set fits dyn and open array exit(cExact); // empty set fits open and dyn array
end; end;
CheckRange(LArrType,0,RHS,ErrorEl); CheckRange(LArrType,0,RHS,ErrorEl);

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

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