paweld/pas2js
1
0
Fork 0
mirror of https://gitlab.com/freepascal.org/fpc/pas2js.git synced 2025-08-27 14:11:06 +02:00
Code Issues Packages Projects Releases Wiki Activity

fcl-passrc: fixed array of const

Browse Source
This commit is contained in:
mattias 2019-02-26 08:41:07 +00:00
parent 557d181ec9
commit 30988dba4d
2 changed files with 35 additions and 6 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

6
compiler/packages/fcl-passrc/src/pasresolver.pp
View File

@ -22215,8 +22215,7 @@ begin
exit(false);
if length(TPasArrayType(TypeEl).Ranges)<>0 then
exit(false);
if TPasArrayType(TypeEl).ElType=nil then
exit(true);// array of const is a dynamic array of TVarRec
// Note: Array of Const is an open array of TVarRec
if OptionalOpenArray and (proOpenAsDynArrays in Options) then
Result:=true
else
@ -22229,8 +22228,7 @@ begin
and (TypeEl.ClassType=TPasArrayType)
and (length(TPasArrayType(TypeEl).Ranges)=0)
and (TypeEl.Parent<>nil)
and (TypeEl.Parent.ClassType=TPasArgument)
and (TPasArrayType(TypeEl).ElType<>nil);
and (TypeEl.Parent.ClassType=TPasArgument);
end;
function TPasResolver.IsDynOrOpenArray(TypeEl: TPasType): boolean;

35
compiler/packages/fcl-passrc/tests/tcresolver.pas
View File

@ -807,6 +807,8 @@ type
// array of const
Procedure TestArrayOfConst;
Procedure TestArrayOfConst_PassDynArrayOfIntFail;
Procedure TestArrayOfConst_AssignNilFail;
Procedure TestArrayOfConst_SetLengthFail;
// static arrays
Procedure TestArrayIntRange_OutOfRange;
@ -14375,6 +14377,7 @@ begin
' i: longint;',
' v: TVarRec;',
' a: TArrOfVarRec;',
' sa: array[1..2] of TVarRec;',
'begin',
' DoIt(args);',
' DoIt(a);',
@ -14389,8 +14392,7 @@ begin
' end;',
' end;',
' for v in Args do ;',
' args:=nil;',
' SetLength(args,2);',
' args:=sa;',
'end;',
'begin']);
ParseProgram;
@ -14412,6 +14414,35 @@ begin
nIncompatibleTypeArgNo);
end;
procedure TTestResolver.TestArrayOfConst_AssignNilFail;
begin
StartProgram(true,[supTVarRec]);
Add([
'type',
' TArr = array of word;',
'procedure DoIt(args: array of const);',
'begin',
' args:=nil;',
'end;',
'begin']);
CheckResolverException('Incompatible types: got "Nil" expected "array of const"',nIncompatibleTypesGotExpected);
end;
procedure TTestResolver.TestArrayOfConst_SetLengthFail;
begin
StartProgram(true,[supTVarRec]);
Add([
'type',
' TArr = array of word;',
'procedure DoIt(args: array of const);',
'begin',
' SetLength(args,2);',
'end;',
'begin']);
CheckResolverException('Incompatible type arg no. 1: Got "array of const", expected "string or dynamic array variable"',
nIncompatibleTypeArgNo);
end;
procedure TTestResolver.TestArrayIntRange_OutOfRange;
begin
StartProgram(false);