mirror of
https://gitlab.com/freepascal.org/fpc/source.git
synced 2025-09-14 14:29:14 +02:00
pastojs: treat constref as const, warn for non record/array
git-svn-id: trunk@43689 -
This commit is contained in:
Mattias Gaertner
parent
200c3b9390
commit
c8a3a11a26
@ -484,7 +484,7 @@ const
|
||||
nVirtualMethodNameMustMatchExternal = 4013;
|
||||
nPublishedNameMustMatchExternal = 4014;
|
||||
nInvalidVariableModifier = 4015;
|
||||
// was nExternalObjectConstructorMustBeNamedNew = 4016;
|
||||
nConstRefNotForXAsConst = 4016;
|
||||
nNewInstanceFunctionMustBeVirtual = 4017;
|
||||
nNewInstanceFunctionMustHaveTwoParameters = 4018;
|
||||
nNewInstanceFunctionMustNotHaveOverloadAtX = 4019;
|
||||
@ -517,6 +517,7 @@ resourcestring
|
||||
sInvalidVariableModifier = 'Invalid variable modifier "%s"';
|
||||
sPublishedNameMustMatchExternal = 'Published name must match external';
|
||||
// was sExternalObjectConstructorMustBeNamedNew = 'external object constructor must be named "new"';
|
||||
sConstRefNotForXAsConst = 'ConstRef not yet implemented for %s. Treating as Const';
|
||||
sNewInstanceFunctionMustBeVirtual = 'NewInstance function must be virtual';
|
||||
sNewInstanceFunctionMustHaveTwoParameters = 'NewInstance function must have two parameters';
|
||||
sNewInstanceFunctionMustNotHaveOverloadAtX = 'NewInstance function must not have overload at %s';
|
||||
@ -3939,13 +3940,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
|
||||
@ -3953,6 +3956,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;
|
||||
|
||||
@ -17380,7 +17392,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
|
||||
@ -22346,7 +22358,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;
|
||||
|
||||
@ -339,6 +339,7 @@ type
|
||||
Procedure TestProc_LocalVarAbsolute;
|
||||
Procedure TestProc_LocalVarInit;
|
||||
Procedure TestProc_ReservedWords;
|
||||
Procedure TestProc_ConstRefWord;
|
||||
|
||||
// anonymous functions
|
||||
Procedure TestAnonymousProc_Assign_ObjFPC;
|
||||
@ -434,6 +435,7 @@ type
|
||||
Procedure TestArray_SetLengthProperty;
|
||||
Procedure TestArray_SetLengthMultiDim;
|
||||
Procedure TestArray_OpenArrayOfString;
|
||||
Procedure TestArray_ConstRef;
|
||||
Procedure TestArray_Concat;
|
||||
Procedure TestArray_Copy;
|
||||
Procedure TestArray_InsertDelete;
|
||||
@ -456,6 +458,7 @@ type
|
||||
Procedure TestRecord_WithDo;
|
||||
Procedure TestRecord_Assign;
|
||||
Procedure TestRecord_AsParams;
|
||||
Procedure TestRecord_ConstRef;
|
||||
Procedure TestRecordElement_AsParams;
|
||||
Procedure TestRecordElementFromFuncResult_AsParams;
|
||||
Procedure TestRecordElementFromWith_AsParams;
|
||||
@ -4545,6 +4548,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);
|
||||
@ -9320,6 +9367,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);
|
||||
@ -10388,6 +10475,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