mirror of
https://gitlab.com/freepascal.org/fpc/pas2js.git
synced 2025-04-06 02:27:48 +02:00
pastojs: treat constref as const, warn for non record/array
This commit is contained in:
mattias
parent
24c18cc178
commit
e814995348
@ -520,6 +520,7 @@ const
|
||||
nJSNewNotSupported = 4026;
|
||||
nHelperClassMethodForExtClassMustBeStatic = 4027;
|
||||
nBitWiseOperationIs32Bit = 4028;
|
||||
nConstRefNotForXAsConst = 4031;
|
||||
// resourcestring patterns of messages
|
||||
resourcestring
|
||||
sPasElementNotSupported = 'Pascal element not supported: %s';
|
||||
@ -550,6 +551,7 @@ resourcestring
|
||||
sJSNewNotSupported = 'Pascal class does not support the "new" constructor';
|
||||
sHelperClassMethodForExtClassMustBeStatic = 'Helper class method for external class must be static';
|
||||
sBitWiseOperationIs32Bit = 'Bitwise operation is 32-bit';
|
||||
sConstRefNotForXAsConst = 'ConstRef not yet implemented for %s. Treating as Const';
|
||||
|
||||
const
|
||||
ExtClassBracketAccessor = '[]'; // external name '[]' marks the array param getter/setter
|
||||
@ -3783,13 +3785,15 @@ end;
|
||||
procedure TPas2JSResolver.FinishArgument(El: TPasArgument);
|
||||
var
|
||||
TypeEl, ElTypeEl: TPasType;
|
||||
C: TClass;
|
||||
begin
|
||||
inherited FinishArgument(El);
|
||||
if El.ArgType<>nil then
|
||||
begin
|
||||
TypeEl:=ResolveAliasType(El.ArgType);
|
||||
C:=TypeEl.ClassType;
|
||||
|
||||
if TypeEl.ClassType=TPasPointerType then
|
||||
if C=TPasPointerType then
|
||||
begin
|
||||
ElTypeEl:=ResolveAliasType(TPasPointerType(TypeEl).DestType);
|
||||
if ElTypeEl.ClassType=TPasRecordType then
|
||||
@ -3797,6 +3801,15 @@ begin
|
||||
else
|
||||
RaiseMsg(20180423110239,nNotSupportedX,sNotSupportedX,['pointer'],El);
|
||||
end;
|
||||
|
||||
if El.Access=argConstRef then
|
||||
begin
|
||||
if (C=TPasRecordType) or (C=TPasArrayType) then
|
||||
// argConstRef works same as argConst for records -> ok
|
||||
else
|
||||
LogMsg(20191215133912,mtWarning,nConstRefNotForXAsConst,sConstRefNotForXAsConst,
|
||||
[GetElementTypeName(TypeEl)],El);
|
||||
end;
|
||||
end;
|
||||
end;
|
||||
|
||||
@ -16661,7 +16674,7 @@ begin
|
||||
// add flags
|
||||
case Arg.Access of
|
||||
argDefault: ;
|
||||
argConst: inc(Flags,pfConst);
|
||||
argConst,argConstRef: inc(Flags,pfConst);
|
||||
argVar: inc(Flags,pfVar);
|
||||
argOut: inc(Flags,pfOut);
|
||||
else
|
||||
@ -21203,7 +21216,7 @@ begin
|
||||
exit;
|
||||
end;
|
||||
|
||||
if not (TargetArg.Access in [argDefault,argVar,argOut,argConst]) then
|
||||
if not (TargetArg.Access in [argDefault,argVar,argOut,argConst,argConstRef]) then
|
||||
DoError(20170213220927,nPasElementNotSupported,sPasElementNotSupported,
|
||||
[AccessNames[TargetArg.Access]],El);
|
||||
aResolver:=AContext.Resolver;
|
||||
|
||||
@ -337,6 +337,7 @@ type
|
||||
Procedure TestProc_LocalVarAbsolute;
|
||||
Procedure TestProc_LocalVarInit;
|
||||
Procedure TestProc_ReservedWords;
|
||||
Procedure TestProc_ConstRefWord;
|
||||
|
||||
// anonymous functions
|
||||
Procedure TestAnonymousProc_Assign_ObjFPC;
|
||||
@ -432,6 +433,7 @@ type
|
||||
Procedure TestArray_SetLengthProperty;
|
||||
Procedure TestArray_SetLengthMultiDim;
|
||||
Procedure TestArray_OpenArrayOfString;
|
||||
Procedure TestArray_ConstRef;
|
||||
Procedure TestArray_Concat;
|
||||
Procedure TestArray_Copy;
|
||||
Procedure TestArray_InsertDelete;
|
||||
@ -455,6 +457,7 @@ type
|
||||
Procedure TestRecord_WithDo;
|
||||
Procedure TestRecord_Assign;
|
||||
Procedure TestRecord_AsParams;
|
||||
Procedure TestRecord_ConstRef;
|
||||
Procedure TestRecordElement_AsParams;
|
||||
Procedure TestRecordElementFromFuncResult_AsParams;
|
||||
Procedure TestRecordElementFromWith_AsParams;
|
||||
@ -4441,7 +4444,7 @@ begin
|
||||
' Nan:=&bOolean;',
|
||||
'end;',
|
||||
'begin',
|
||||
' Date(1);']);
|
||||
' Date(1);']);
|
||||
ConvertProgram;
|
||||
CheckSource('TestProc_ReservedWords',
|
||||
LinesToStr([ // statements
|
||||
@ -4458,6 +4461,50 @@ begin
|
||||
]));
|
||||
end;
|
||||
|
||||
procedure TTestModule.TestProc_ConstRefWord;
|
||||
begin
|
||||
StartProgram(false);
|
||||
Add([
|
||||
'procedure Run(constref w: word);',
|
||||
'var l: word;',
|
||||
'begin',
|
||||
' l:=w;',
|
||||
' Run(w);',
|
||||
' Run(l);',
|
||||
'end;',
|
||||
'procedure Fly(a: word; var b: word; out c: word; const d: word; constref e: word);',
|
||||
'begin',
|
||||
' Run(a);',
|
||||
' Run(b);',
|
||||
' Run(c);',
|
||||
' Run(d);',
|
||||
' Run(e);',
|
||||
'end;',
|
||||
'begin',
|
||||
' Run(1);']);
|
||||
ConvertProgram;
|
||||
CheckHint(mtWarning,nConstRefNotForXAsConst,'ConstRef not yet implemented for Word. Treating as Const');
|
||||
CheckSource('TestProc_ConstRefWord',
|
||||
LinesToStr([ // statements
|
||||
'this.Run = function (w) {',
|
||||
' var l = 0;',
|
||||
' l = w;',
|
||||
' $mod.Run(w);',
|
||||
' $mod.Run(l);',
|
||||
'};',
|
||||
'this.Fly = function (a, b, c, d, e) {',
|
||||
' $mod.Run(a);',
|
||||
' $mod.Run(b.get());',
|
||||
' $mod.Run(c.get());',
|
||||
' $mod.Run(d);',
|
||||
' $mod.Run(e);',
|
||||
'};',
|
||||
'']),
|
||||
LinesToStr([
|
||||
'$mod.Run(1);'
|
||||
]));
|
||||
end;
|
||||
|
||||
procedure TTestModule.TestAnonymousProc_Assign_ObjFPC;
|
||||
begin
|
||||
StartProgram(false);
|
||||
@ -9231,6 +9278,46 @@ begin
|
||||
'']));
|
||||
end;
|
||||
|
||||
procedure TTestModule.TestArray_ConstRef;
|
||||
begin
|
||||
StartProgram(false);
|
||||
Add([
|
||||
'type TArr = array of word;',
|
||||
'procedure Run(constref a: TArr);',
|
||||
'begin',
|
||||
'end;',
|
||||
'procedure Fly(a: TArr; var b: TArr; out c: TArr; const d: TArr; constref e: TArr);',
|
||||
'var l: TArr;',
|
||||
'begin',
|
||||
' Run(l);',
|
||||
' Run(a);',
|
||||
' Run(b);',
|
||||
' Run(c);',
|
||||
' Run(d);',
|
||||
' Run(e);',
|
||||
'end;',
|
||||
'begin',
|
||||
'']);
|
||||
ConvertProgram;
|
||||
CheckResolverUnexpectedHints();
|
||||
CheckSource('TestArray_ConstRef',
|
||||
LinesToStr([ // statements
|
||||
'this.Run = function (a) {',
|
||||
'};',
|
||||
'this.Fly = function (a, b, c, d, e) {',
|
||||
' var l = [];',
|
||||
' $mod.Run(l);',
|
||||
' $mod.Run(a);',
|
||||
' $mod.Run(b.get());',
|
||||
' $mod.Run(c.get());',
|
||||
' $mod.Run(d);',
|
||||
' $mod.Run(e);',
|
||||
'};',
|
||||
'']),
|
||||
LinesToStr([
|
||||
'']));
|
||||
end;
|
||||
|
||||
procedure TTestModule.TestArray_Concat;
|
||||
begin
|
||||
StartProgram(false);
|
||||
@ -10326,6 +10413,56 @@ begin
|
||||
'']));
|
||||
end;
|
||||
|
||||
procedure TTestModule.TestRecord_ConstRef;
|
||||
begin
|
||||
StartProgram(false);
|
||||
Add([
|
||||
'type TRec = record i: word; end;',
|
||||
'procedure Run(constref a: TRec);',
|
||||
'begin',
|
||||
'end;',
|
||||
'procedure Fly(a: TRec; var b: TRec; out c: TRec; const d: TRec; constref e: TRec);',
|
||||
'var l: TRec;',
|
||||
'begin',
|
||||
' Run(l);',
|
||||
' Run(a);',
|
||||
' Run(b);',
|
||||
' Run(c);',
|
||||
' Run(d);',
|
||||
' Run(e);',
|
||||
'end;',
|
||||
'begin',
|
||||
'']);
|
||||
ConvertProgram;
|
||||
CheckResolverUnexpectedHints();
|
||||
CheckSource('TestRecord_ConstRef',
|
||||
LinesToStr([ // statements
|
||||
'rtl.recNewT($mod, "TRec", function () {',
|
||||
' this.i = 0;',
|
||||
' this.$eq = function (b) {',
|
||||
' return this.i === b.i;',
|
||||
' };',
|
||||
' this.$assign = function (s) {',
|
||||
' this.i = s.i;',
|
||||
' return this;',
|
||||
' };',
|
||||
'});',
|
||||
'this.Run = function (a) {',
|
||||
'};',
|
||||
'this.Fly = function (a, b, c, d, e) {',
|
||||
' var l = $mod.TRec.$new();',
|
||||
' $mod.Run(l);',
|
||||
' $mod.Run(a);',
|
||||
' $mod.Run(b);',
|
||||
' $mod.Run(c);',
|
||||
' $mod.Run(d);',
|
||||
' $mod.Run(e);',
|
||||
'};',
|
||||
'']),
|
||||
LinesToStr([
|
||||
'']));
|
||||
end;
|
||||
|
||||
procedure TTestModule.TestRecordElement_AsParams;
|
||||
begin
|
||||
StartProgram(false);
|
||||
|
||||
Loading…
Reference in New Issue
Block a user