paweld/pas2js
1
0
Fork 0
mirror of https://gitlab.com/freepascal.org/fpc/pas2js.git synced 2025-09-01 21:20:13 +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); exit(false);
if length(TPasArrayType(TypeEl).Ranges)<>0 then if length(TPasArrayType(TypeEl).Ranges)<>0 then
exit(false); exit(false);
if TPasArrayType(TypeEl).ElType=nil then // Note: Array of Const is an open array of TVarRec
exit(true);// array of const is a dynamic array of TVarRec
if OptionalOpenArray and (proOpenAsDynArrays in Options) then if OptionalOpenArray and (proOpenAsDynArrays in Options) then
Result:=true Result:=true
else else
@ -22229,8 +22228,7 @@ begin
and (TypeEl.ClassType=TPasArrayType) and (TypeEl.ClassType=TPasArrayType)
and (length(TPasArrayType(TypeEl).Ranges)=0) and (length(TPasArrayType(TypeEl).Ranges)=0)
and (TypeEl.Parent<>nil) and (TypeEl.Parent<>nil)
and (TypeEl.Parent.ClassType=TPasArgument) and (TypeEl.Parent.ClassType=TPasArgument);
and (TPasArrayType(TypeEl).ElType<>nil);
end; end;
function TPasResolver.IsDynOrOpenArray(TypeEl: TPasType): boolean; function TPasResolver.IsDynOrOpenArray(TypeEl: TPasType): boolean;

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

@ -807,6 +807,8 @@ type
// array of const // array of const
Procedure TestArrayOfConst; Procedure TestArrayOfConst;
Procedure TestArrayOfConst_PassDynArrayOfIntFail; Procedure TestArrayOfConst_PassDynArrayOfIntFail;
Procedure TestArrayOfConst_AssignNilFail;
Procedure TestArrayOfConst_SetLengthFail;
// static arrays // static arrays
Procedure TestArrayIntRange_OutOfRange; Procedure TestArrayIntRange_OutOfRange;
@ -14375,6 +14377,7 @@ begin
' i: longint;', ' i: longint;',
' v: TVarRec;', ' v: TVarRec;',
' a: TArrOfVarRec;', ' a: TArrOfVarRec;',
' sa: array[1..2] of TVarRec;',
'begin', 'begin',
' DoIt(args);', ' DoIt(args);',
' DoIt(a);', ' DoIt(a);',
@ -14389,8 +14392,7 @@ begin
' end;', ' end;',
' end;', ' end;',
' for v in Args do ;', ' for v in Args do ;',
' args:=nil;', ' args:=sa;',
' SetLength(args,2);',
'end;', 'end;',
'begin']); 'begin']);
ParseProgram; ParseProgram;
@ -14412,6 +14414,35 @@ begin
nIncompatibleTypeArgNo); nIncompatibleTypeArgNo);
end; 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; procedure TTestResolver.TestArrayIntRange_OutOfRange;
begin begin
StartProgram(false); StartProgram(false);