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

pas2js: error on compare static array

Browse Source 
git-svn-id: trunk@45309 -
This commit is contained in:
Mattias Gaertner 2020-05-08 08:46:41 +00:00
parent 4d428d945e
commit 4ff4c2456d
3 changed files with 43 additions and 1 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

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

@ -2216,7 +2216,7 @@ type
ErrorEl: TPasElement; RaiseOnIncompatible: boolean): integer;
function CheckEqualCompatibilityUserType(
const LHS, RHS: TPasResolverResult; ErrorEl: TPasElement;
RaiseOnIncompatible: boolean): integer; // LHS.BaseType=btContext=RHS.BaseType and both rrfReadable
RaiseOnIncompatible: boolean): integer; virtual; // LHS.BaseType=btContext=RHS.BaseType and both rrfReadable
function CheckTypeCast(El: TPasType; Params: TParamsExpr; RaiseOnError: boolean): integer;
function CheckTypeCastRes(const FromResolved, ToResolved: TPasResolverResult;
ErrorEl: TPasElement; RaiseOnError: boolean): integer; virtual;

25
packages/pastojs/src/fppas2js.pp
View File

@ -1449,6 +1449,10 @@ type
procedure AddElementData(Data: TPas2JsElementData); virtual;
function CreateElementData(DataClass: TPas2JsElementDataClass;
El: TPasElement): TPas2JsElementData; virtual;
// checking compatibilility
function CheckEqualCompatibilityUserType(const LHS,
RHS: TPasResolverResult; ErrorEl: TPasElement;
RaiseOnIncompatible: boolean): integer; override;
// utility
procedure RaiseMsg(const Id: TMaxPrecInt; MsgNumber: integer; const Fmt: String;
Args: array of {$IFDEF pas2js}jsvalue{$ELSE}const{$ENDIF}; ErrorPosEl: TPasElement); override;
@ -5979,6 +5983,20 @@ begin
AddElementData(Result);
end;
function TPas2JSResolver.CheckEqualCompatibilityUserType(const LHS,
RHS: TPasResolverResult; ErrorEl: TPasElement; RaiseOnIncompatible: boolean
): integer;
begin
Result:=inherited CheckEqualCompatibilityUserType(LHS,RHS,ErrorEl,RaiseOnIncompatible);
if Result=cIncompatible then exit;
if (LHS.LoTypeEl is TPasArrayType)
and (length(TPasArrayType(LHS.LoTypeEl).Ranges)>0) then
RaiseMsg(20200508103543,nXIsNotSupported,sXIsNotSupported,['compare static array'],ErrorEl);
if (RHS.LoTypeEl is TPasArrayType)
and (length(TPasArrayType(RHS.LoTypeEl).Ranges)>0) then
RaiseMsg(20200508103544,nXIsNotSupported,sXIsNotSupported,['compare static array'],ErrorEl);
end;
procedure TPas2JSResolver.RaiseMsg(const Id: TMaxPrecInt; MsgNumber: integer;
const Fmt: String; Args: array of {$IFDEF pas2js}jsvalue{$ELSE}const{$ENDIF};
ErrorPosEl: TPasElement);
@ -7728,6 +7746,7 @@ var
JSBinClass: TJSBinaryClass;
ResolvedEl: TPasResolverResult;
AInt, BInt: TMaxPrecInt;
LArrType: TPasArrayType;
begin
{$IFDEF VerbosePas2JS}
writeln('TPasToJSConverter.ConvertBinaryExpressionRes OpCode="',OpcodeStrings[El.OpCode],'" Left=',GetResolverResultDbg(LeftResolved),' Right=',GetResolverResultDbg(RightResolved));
@ -8254,6 +8273,7 @@ begin
end
else if LeftTypeEl.ClassType=TPasArrayType then
begin
LArrType:=TPasArrayType(LeftTypeEl);
if RightResolved.BaseType=btNil then
begin
// convert "array = nil" to "rtl.length(array) === 0"
@ -8261,6 +8281,11 @@ begin
Result:=CreateCmpArrayWithNil(El,A,El.OpCode);
A:=nil;
exit;
end
else if length(LArrType.Ranges)>0 then
begin
// LHS is static array
aResolver.RaiseMsg(20200508102656,nXIsNotSupported,sXIsNotSupported,['compare static array'],TPasElement(El));
end;
end;
end;

17
packages/pastojs/tests/tcmodules.pas
View File

@ -424,6 +424,7 @@ type
Procedure TestArray_StaticChar;
Procedure TestArray_StaticMultiDim;
Procedure TestArray_StaticInFunction;
Procedure TestArray_StaticMultiDimEqualNotImplemented;
Procedure TestArrayOfRecord;
Procedure TestArray_StaticRecord;
Procedure TestArrayOfSet;
@ -8884,6 +8885,22 @@ begin
'']));
end;
procedure TTestModule.TestArray_StaticMultiDimEqualNotImplemented;
begin
StartProgram(false);
Add([
'type',
' TArrayInt = array[1..3,1..2] of longint;',
'var',
' a,b: TArrayInt;',
'begin',
' if a=b then ;',
'']);
SetExpectedPasResolverError('compare static array is not supported',
nXIsNotSupported);
ConvertProgram;
end;
procedure TTestModule.TestArrayOfRecord;
begin
StartProgram(false);