paweld/fpc
1
0
Fork 0
mirror of https://gitlab.com/freepascal.org/fpc/source.git synced 2025-04-24 06:39:36 +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
packages/fcl-passrc
src
pasresolver.pp
tests
tcresolver.pas

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

@ -2,7 +2,7 @@
This file is part of the Free Component Library
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,
for details about the copyright.
@ -25646,9 +25646,19 @@ function TPasResolver.CheckAssignCompatibilityArrayType(const LHS,
procedure CheckRange(ArrType: TPasArrayType; RangeIndex: integer;
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
Range, Value, Expr: TPasExpr;
RangeResolved, ValueResolved, ElTypeResolved: TPasResolverResult;
RangeResolved, ValueResolved: TPasResolverResult;
i, ExpectedCount, ValCnt: Integer;
IsLastRange, IsConstExpr: Boolean;
ArrayValues: TPasExprArray;
@ -25752,19 +25762,18 @@ function TPasResolver.CheckAssignCompatibilityArrayType(const LHS,
ExpectedCount:=-1;
if length(ArrType.Ranges)=0 then
begin
// dynamic array
// dynamic or open array
if (Expr<>nil) then
begin
if Expr.ClassType=TArrayValues then
ExpectedCount:=length(TArrayValues(Expr).Values)
else if (Expr.ClassType=TParamsExpr) and (TParamsExpr(Expr).Kind=pekSet) then
ExpectedCount:=length(TParamsExpr(Expr).Params)
else if (Values.BaseType in btAllStringAndChars) and IsVarInit(Expr) then
else if (Values.BaseType in btAllStringAndChars) then
begin
// const a: dynarray = string
ComputeElement(ArrType.ElType,ElTypeResolved,[rcType]);
if ElTypeResolved.BaseType in btAllChars then
Result:=cExact;
// e.g. const a: dynarray = string
// or e.g. pass a string literal to an open array
CheckArrOfCharAssignString;
exit;
end
else
@ -25777,7 +25786,15 @@ function TPasResolver.CheckAssignCompatibilityArrayType(const LHS,
begin
// type check
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;
end;
RArrayType:=TPasArrayType(Values.LoTypeEl);
if length(RArrayType.Ranges)>0 then
begin

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

@ -780,6 +780,7 @@ type
Procedure TestStaticArrayOfChar;
Procedure TestStaticArrayOfCharDelphi;
Procedure TestStaticArrayOfRangeElCheckFail;
Procedure TestArrayOfChar_String;
Procedure TestArrayOfArray;
Procedure TestArrayOfArray_NameAnonymous;
Procedure TestFunctionReturningArray;
@ -814,6 +815,7 @@ type
Procedure TestArray_OpenArrayAsDynArray;
Procedure TestArray_OpenArrayDelphi;
Procedure TestArray_OpenArrayChar;
Procedure TestArray_DynArrayChar;
Procedure TestArray_CopyConcat;
Procedure TestStaticArray_CopyConcat;// ToDo
Procedure TestArray_CopyMismatchFail;
@ -14193,6 +14195,25 @@ begin
'range check error while evaluating constants (300 is not between -128 and 127)');
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;
begin
StartProgram(false);
@ -14858,6 +14879,26 @@ begin
'var Key: Char;',
'begin',
' 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;
end;