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

fcl-passrc: resolver: allow passing a string/char to an array of char

Browse Source 
git-svn-id: trunk@45293 -
This commit is contained in:
Mattias Gaertner 2020-05-06 19:02:27 +00:00
parent 40504a6f9d
commit c66ac2f892
2 changed files with 66 additions and 8 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

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

@ -2,7 +2,7 @@
This file is part of the Free Component Library This file is part of the Free Component Library
Pascal resolver Pascal resolver
Copyright (c) 2019 Mattias Gaertner mattias@freepascal.org Copyright (c) 2020 Mattias Gaertner mattias@freepascal.org
See the file COPYING.FPC, included in this distribution, See the file COPYING.FPC, included in this distribution,
for details about the copyright. for details about the copyright.
@ -25646,9 +25646,19 @@ function TPasResolver.CheckAssignCompatibilityArrayType(const LHS,
procedure CheckRange(ArrType: TPasArrayType; RangeIndex: integer; procedure CheckRange(ArrType: TPasArrayType; RangeIndex: integer;
Values: TPasResolverResult; ErrorEl: TPasElement); Values: TPasResolverResult; ErrorEl: TPasElement);
var
ElTypeResolved: TPasResolverResult;
procedure CheckArrOfCharAssignString;
begin
ComputeElement(ArrType.ElType,ElTypeResolved,[rcType]);
if ElTypeResolved.BaseType in btAllChars then
Result:=cTypeConversion; // ArrOfChar:=aString
end;
var var
Range, Value, Expr: TPasExpr; Range, Value, Expr: TPasExpr;
RangeResolved, ValueResolved, ElTypeResolved: TPasResolverResult; RangeResolved, ValueResolved: TPasResolverResult;
i, ExpectedCount, ValCnt: Integer; i, ExpectedCount, ValCnt: Integer;
IsLastRange, IsConstExpr: Boolean; IsLastRange, IsConstExpr: Boolean;
ArrayValues: TPasExprArray; ArrayValues: TPasExprArray;
@ -25752,19 +25762,18 @@ function TPasResolver.CheckAssignCompatibilityArrayType(const LHS,
ExpectedCount:=-1; ExpectedCount:=-1;
if length(ArrType.Ranges)=0 then if length(ArrType.Ranges)=0 then
begin begin
// dynamic array // dynamic or open array
if (Expr<>nil) then if (Expr<>nil) then
begin begin
if Expr.ClassType=TArrayValues then if Expr.ClassType=TArrayValues then
ExpectedCount:=length(TArrayValues(Expr).Values) ExpectedCount:=length(TArrayValues(Expr).Values)
else if (Expr.ClassType=TParamsExpr) and (TParamsExpr(Expr).Kind=pekSet) then else if (Expr.ClassType=TParamsExpr) and (TParamsExpr(Expr).Kind=pekSet) then
ExpectedCount:=length(TParamsExpr(Expr).Params) ExpectedCount:=length(TParamsExpr(Expr).Params)
else if (Values.BaseType in btAllStringAndChars) and IsVarInit(Expr) then else if (Values.BaseType in btAllStringAndChars) then
begin begin
// const a: dynarray = string // e.g. const a: dynarray = string
ComputeElement(ArrType.ElType,ElTypeResolved,[rcType]); // or e.g. pass a string literal to an open array
if ElTypeResolved.BaseType in btAllChars then CheckArrOfCharAssignString;
Result:=cExact;
exit; exit;
end end
else else
@ -25777,7 +25786,15 @@ function TPasResolver.CheckAssignCompatibilityArrayType(const LHS,
begin begin
// type check // type check
if (Values.BaseType<>btContext) or (Values.LoTypeEl.ClassType<>TPasArrayType) then if (Values.BaseType<>btContext) or (Values.LoTypeEl.ClassType<>TPasArrayType) then
begin
// RHS is not an array
if (Values.BaseType in btAllStringAndChars) then
begin
// e.g. pass a string literal to an open array
CheckArrOfCharAssignString;
end;
exit; exit;
end;
RArrayType:=TPasArrayType(Values.LoTypeEl); RArrayType:=TPasArrayType(Values.LoTypeEl);
if length(RArrayType.Ranges)>0 then if length(RArrayType.Ranges)>0 then
begin begin

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

@ -780,6 +780,7 @@ type
Procedure TestStaticArrayOfChar; Procedure TestStaticArrayOfChar;
Procedure TestStaticArrayOfCharDelphi; Procedure TestStaticArrayOfCharDelphi;
Procedure TestStaticArrayOfRangeElCheckFail; Procedure TestStaticArrayOfRangeElCheckFail;
Procedure TestArrayOfChar_String;
Procedure TestArrayOfArray; Procedure TestArrayOfArray;
Procedure TestArrayOfArray_NameAnonymous; Procedure TestArrayOfArray_NameAnonymous;
Procedure TestFunctionReturningArray; Procedure TestFunctionReturningArray;
@ -814,6 +815,7 @@ type
Procedure TestArray_OpenArrayAsDynArray; Procedure TestArray_OpenArrayAsDynArray;
Procedure TestArray_OpenArrayDelphi; Procedure TestArray_OpenArrayDelphi;
Procedure TestArray_OpenArrayChar; Procedure TestArray_OpenArrayChar;
Procedure TestArray_DynArrayChar;
Procedure TestArray_CopyConcat; Procedure TestArray_CopyConcat;
Procedure TestStaticArray_CopyConcat;// ToDo Procedure TestStaticArray_CopyConcat;// ToDo
Procedure TestArray_CopyMismatchFail; Procedure TestArray_CopyMismatchFail;
@ -14193,6 +14195,25 @@ begin
'range check error while evaluating constants (300 is not between -128 and 127)'); 'range check error while evaluating constants (300 is not between -128 and 127)');
end; end;
procedure TTestResolver.TestArrayOfChar_String;
begin
StartProgram(false);
Add([
'procedure {#a}Run(const s: string); overload;',
'begin end;',
'procedure {#b}Run(const a: array of char); overload;',
'begin end;',
'var',
' s: string;',
' c: char;',
'begin',
' {@a}Run(''foo'');',
' {@a}Run(s);',
' {@a}Run(c);',
'']);
ParseProgram;
end;
procedure TTestResolver.TestArrayOfArray; procedure TTestResolver.TestArrayOfArray;
begin begin
StartProgram(false); StartProgram(false);
@ -14858,6 +14879,26 @@ begin
'var Key: Char;', 'var Key: Char;',
'begin', 'begin',
' if CharInSet(Key, [^V, ^X, ^C]) then ;', ' if CharInSet(Key, [^V, ^X, ^C]) then ;',
' CharInSet(Key,''abc'');',
' CharInSet(Key,Key);',
'']);
ParseProgram;
end;
procedure TTestResolver.TestArray_DynArrayChar;
begin
StartProgram(false);
Add([
'{$mode delphi}',
'type TArrChr = array of char;',
'var',
' Key: Char;',
' s: string;',
' a: TArrChr;',
'begin',
' a:=''Foo'';',
' a:=Key;',
' a:=s;',
'']); '']);
ParseProgram; ParseProgram;
end; end;