mirror of
https://gitlab.com/freepascal.org/fpc/source.git
synced 2025-08-28 20:00:15 +02:00
pastojs: errors on pointer arithmetic
git-svn-id: trunk@38820 -
This commit is contained in:
Mattias Gaertner
parent
ec338c4787
commit
af8348fba4
@ -252,6 +252,7 @@ Works:
|
||||
- property default value
|
||||
- pointer
|
||||
- compare with and assign nil
|
||||
- typecast class, class-of, interface, array
|
||||
- ECMAScript6:
|
||||
- use 0b for binary literals
|
||||
- use 0o for octal literals
|
||||
@ -995,22 +996,19 @@ const
|
||||
msClass,
|
||||
msResult,
|
||||
msRepeatForward,
|
||||
// ToDo: msPointer2Procedure,
|
||||
// ToDo: msAutoDeref,
|
||||
msInitFinal,
|
||||
msOut,
|
||||
msDefaultPara,
|
||||
// ToDo: msDuplicateNames
|
||||
msProperty,
|
||||
// ToDo: msDefaultInline
|
||||
msExcept,
|
||||
// ToDo: msAdvancedRecords
|
||||
msDefaultUnicodestring,
|
||||
msCBlocks
|
||||
];
|
||||
msAllPas2jsModeSwitches = msAllPas2jsModeSwitchesReadOnly+[
|
||||
msDelphi,msObjfpc,
|
||||
msHintDirective,msNestedComment,
|
||||
msAutoDeref,
|
||||
msHintDirective,
|
||||
msNestedComment,
|
||||
msExternalClass,
|
||||
msIgnoreAttributes];
|
||||
|
||||
@ -1040,7 +1038,7 @@ const
|
||||
btString,
|
||||
btUnicodeString,
|
||||
btDouble,
|
||||
btCurrency, // nativeint*10000
|
||||
btCurrency, // nativeint*10000 truncated
|
||||
btBoolean,
|
||||
btByteBool,
|
||||
btWordBool,
|
||||
@ -1064,7 +1062,9 @@ const
|
||||
btAllJSFloats = [btDouble];
|
||||
btAllJSBooleans = [btBoolean];
|
||||
btAllJSInteger = [btByte,btShortInt,btWord,btSmallInt,btLongWord,btLongint,
|
||||
btIntDouble,btUIntDouble,btCurrency];
|
||||
btIntDouble,btUIntDouble,
|
||||
btCurrency // in pas2js currency is more like an integer, instead of float
|
||||
];
|
||||
btAllJSValueSrcTypes = [btNil,btUntyped,btPointer]+btAllJSInteger
|
||||
+btAllJSStringAndChars+btAllJSFloats+btAllJSBooleans;
|
||||
btAllJSValueTypeCastTo = btAllJSInteger
|
||||
@ -1079,7 +1079,8 @@ const
|
||||
proExtClassInstanceNoTypeMembers,
|
||||
proOpenAsDynArrays,
|
||||
proProcTypeWithoutIsNested,
|
||||
proMethodAddrAsPointer
|
||||
proMethodAddrAsPointer,
|
||||
proNoPointerArithmetic
|
||||
];
|
||||
type
|
||||
TPas2JSResolver = class(TPasResolver)
|
||||
@ -1109,6 +1110,7 @@ type
|
||||
procedure ResolveNameExpr(El: TPasExpr; const aName: string;
|
||||
Access: TResolvedRefAccess); override;
|
||||
procedure FinishInterfaceSection(Section: TPasSection); override;
|
||||
procedure FinishTypeSection(El: TPasDeclarations); override;
|
||||
procedure FinishModule(CurModule: TPasModule); override;
|
||||
procedure FinishEnumType(El: TPasEnumType); override;
|
||||
procedure FinishSetType(El: TPasSetType); override;
|
||||
@ -1117,6 +1119,7 @@ type
|
||||
procedure FinishArrayType(El: TPasArrayType); override;
|
||||
procedure FinishAncestors(aClass: TPasClassType); override;
|
||||
procedure FinishVariable(El: TPasVariable); override;
|
||||
procedure FinishArgument(El: TPasArgument); override;
|
||||
procedure FinishProcedureType(El: TPasProcedureType); override;
|
||||
procedure FinishPropertyOfClass(PropEl: TPasProperty); override;
|
||||
procedure CheckConditionExpr(El: TPasExpr;
|
||||
@ -2429,6 +2432,25 @@ begin
|
||||
end;
|
||||
end;
|
||||
|
||||
procedure TPas2JSResolver.FinishTypeSection(El: TPasDeclarations);
|
||||
var
|
||||
i: Integer;
|
||||
Decl: TPasElement;
|
||||
C: TClass;
|
||||
begin
|
||||
inherited FinishTypeSection(El);
|
||||
for i:=0 to El.Declarations.Count-1 do
|
||||
begin
|
||||
Decl:=TPasElement(El.Declarations[i]);
|
||||
C:=Decl.ClassType;
|
||||
if C=TPasPointerType then
|
||||
begin
|
||||
// ToDo: pointer of record
|
||||
RaiseMsg(20180423105726,nNotSupportedX,sNotSupportedX,['pointer of '+TPasPointerType(Decl).DestType.Name],El);
|
||||
end;
|
||||
end;
|
||||
end;
|
||||
|
||||
procedure TPas2JSResolver.FinishModule(CurModule: TPasModule);
|
||||
var
|
||||
ModuleClass: TClass;
|
||||
@ -2786,19 +2808,40 @@ begin
|
||||
AddExternalPath(ExtName,El.ExportName);
|
||||
end;
|
||||
|
||||
if (El.VarType<>nil) and (El.Expr<>nil) then
|
||||
if El.VarType<>nil then
|
||||
begin
|
||||
TypeEl:=ResolveAliasType(El.VarType);
|
||||
if (TypeEl.ClassType=TPasRecordType) then
|
||||
|
||||
if TypeEl.ClassType=TPasPointerType then
|
||||
RaiseMsg(20180423110113,nNotSupportedX,sNotSupportedX,['pointer'],El);
|
||||
|
||||
if El.Expr<>nil then
|
||||
begin
|
||||
if GetAssignGUIDString(TPasRecordType(TypeEl),El.Expr,GUID) then
|
||||
// e.g. IObjectInstance: TGuid = '{D91C9AF4-3C93-420F-A303-BF5BA82BFD23}'
|
||||
else
|
||||
;
|
||||
if (TypeEl.ClassType=TPasRecordType) then
|
||||
begin
|
||||
if GetAssignGUIDString(TPasRecordType(TypeEl),El.Expr,GUID) then
|
||||
// e.g. IObjectInstance: TGuid = '{D91C9AF4-3C93-420F-A303-BF5BA82BFD23}'
|
||||
else
|
||||
;
|
||||
end;
|
||||
end;
|
||||
end;
|
||||
end;
|
||||
|
||||
procedure TPas2JSResolver.FinishArgument(El: TPasArgument);
|
||||
var
|
||||
TypeEl: TPasType;
|
||||
begin
|
||||
inherited FinishArgument(El);
|
||||
if El.ArgType<>nil then
|
||||
begin
|
||||
TypeEl:=ResolveAliasType(El.ArgType);
|
||||
|
||||
if TypeEl.ClassType=TPasPointerType then
|
||||
RaiseMsg(20180423110239,nNotSupportedX,sNotSupportedX,['pointer'],El);
|
||||
end;
|
||||
end;
|
||||
|
||||
procedure TPas2JSResolver.FinishProcedureType(El: TPasProcedureType);
|
||||
var
|
||||
Proc: TPasProcedure;
|
||||
@ -2808,8 +2851,17 @@ var
|
||||
AClass: TPasClassType;
|
||||
ClassScope: TPas2JSClassScope;
|
||||
ptm: TProcTypeModifier;
|
||||
TypeEl: TPasType;
|
||||
begin
|
||||
inherited FinishProcedureType(El);
|
||||
|
||||
if El is TPasFunctionType then
|
||||
begin
|
||||
TypeEl:=ResolveAliasType(TPasFunctionType(El).ResultEl.ResultType);
|
||||
if TypeEl.ClassType=TPasPointerType then
|
||||
RaiseMsg(20180423110824,nNotSupportedX,sNotSupportedX,['pointer'],El);
|
||||
end;
|
||||
|
||||
if El.Parent is TPasProcedure then
|
||||
begin
|
||||
Proc:=TPasProcedure(El.Parent);
|
||||
@ -2964,7 +3016,6 @@ begin
|
||||
if Proc.Parent is TPasSection then
|
||||
AddExternalPath(ExtName,Proc.LibrarySymbolName);
|
||||
|
||||
exit;
|
||||
end;
|
||||
end;
|
||||
end;
|
||||
@ -4848,9 +4899,18 @@ function TPasToJSConverter.ConvertUnaryExpression(El: TUnaryExpr;
|
||||
AContext: TConvertContext): TJSElement;
|
||||
|
||||
procedure NotSupported;
|
||||
var
|
||||
ResolvedEl: TPasResolverResult;
|
||||
begin
|
||||
DoError(20170215134950,nUnaryOpcodeNotSupported,sUnaryOpcodeNotSupported,
|
||||
[OpcodeStrings[El.OpCode]],El);
|
||||
if AContext.Resolver<>nil then
|
||||
begin
|
||||
AContext.Resolver.ComputeElement(El.Operand,ResolvedEl,[],El);
|
||||
DoError(20180423111325,nIllegalQualifierInFrontOf,sIllegalQualifierInFrontOf,
|
||||
[OpcodeStrings[El.OpCode],AContext.Resolver.GetResolverResultDescription(ResolvedEl)],El);
|
||||
end
|
||||
else
|
||||
DoError(20170215134950,nUnaryOpcodeNotSupported,sUnaryOpcodeNotSupported,
|
||||
[OpcodeStrings[El.OpCode]],El);
|
||||
end;
|
||||
|
||||
Var
|
||||
@ -5348,6 +5408,8 @@ begin
|
||||
{$ENDIF}
|
||||
Result:=nil;
|
||||
aResolver:=AContext.Resolver;
|
||||
LeftTypeEl:=aResolver.ResolveAliasType(LeftResolved.TypeEl);
|
||||
RightTypeEl:=aResolver.ResolveAliasType(RightResolved.TypeEl);
|
||||
if LeftResolved.BaseType=btSet then
|
||||
begin
|
||||
// set operators -> rtl.operatorfunction(a,b)
|
||||
@ -5462,11 +5524,25 @@ begin
|
||||
RaiseNotSupported(El,AContext,20180422104215);
|
||||
end;
|
||||
end
|
||||
else if (LeftResolved.BaseType=btPointer)
|
||||
or ((LeftResolved.BaseType=btContext) and (LeftTypeEl.ClassType=TPasPointerType)) then
|
||||
case El.OpCode of
|
||||
eopEqual,eopNotEqual: ;
|
||||
else
|
||||
DoError(20180423114054,nIllegalQualifierAfter,sIllegalQualifierAfter,
|
||||
[OpcodeStrings[El.OpCode],aResolver.GetResolverResultDescription(LeftResolved,true)],El);
|
||||
end
|
||||
else if (RightResolved.BaseType=btPointer)
|
||||
or ((RightResolved.BaseType=btContext) and (RightTypeEl.ClassType=TPasPointerType)) then
|
||||
case El.OpCode of
|
||||
eopEqual,eopNotEqual: ;
|
||||
else
|
||||
DoError(20180423114246,nIllegalQualifierInFrontOf,sIllegalQualifierInFrontOf,
|
||||
[OpcodeStrings[El.OpCode],aResolver.GetResolverResultDescription(RightResolved,true)],El);
|
||||
end
|
||||
else if (El.OpCode=eopIs) then
|
||||
begin
|
||||
// "A is B"
|
||||
LeftTypeEl:=aResolver.ResolveAliasType(LeftResolved.TypeEl);
|
||||
RightTypeEl:=aResolver.ResolveAliasType(RightResolved.TypeEl);
|
||||
Call:=CreateCallExpression(El);
|
||||
Result:=Call;
|
||||
Call.AddArg(A); A:=nil;
|
||||
@ -6454,6 +6530,12 @@ function TPasToJSConverter.ConvertArrayParams(El: TParamsExpr;
|
||||
var
|
||||
ArgContext: TConvertContext;
|
||||
|
||||
procedure RaiseIllegalBrackets(id: int64; const ResolvedEl: TPasResolverResult);
|
||||
begin
|
||||
DoError(id,nIllegalQualifierAfter,sIllegalQualifierAfter,
|
||||
['[',AContext.Resolver.GetResolverResultDescription(ResolvedEl,true)],El);
|
||||
end;
|
||||
|
||||
function GetValueReference: TResolvedReference;
|
||||
var
|
||||
Value: TPasExpr;
|
||||
@ -7118,10 +7200,10 @@ begin
|
||||
// anArray[]
|
||||
ConvertArray(TPasArrayType(TypeEl))
|
||||
else
|
||||
RaiseNotSupported(El,AContext,20170206181220,GetResolverResultDbg(ResolvedEl));
|
||||
RaiseIllegalBrackets(20170206181220,ResolvedEl);
|
||||
end
|
||||
else
|
||||
RaiseNotSupported(El,AContext,20170206180222);
|
||||
RaiseIllegalBrackets(20170206180222,ResolvedEl);
|
||||
end;
|
||||
|
||||
function TPasToJSConverter.ConvertFuncParams(El: TParamsExpr;
|
||||
|
||||
@ -538,8 +538,15 @@ type
|
||||
Procedure TestPointer_Proc;
|
||||
Procedure TestPointer_AssignRecordFail;
|
||||
Procedure TestPointer_AssignStaticArrayFail;
|
||||
Procedure TestPointer_ArrayParamsFail;
|
||||
Procedure TestPointer_TypeCastJSValueToPointer;
|
||||
Procedure TestPointer_NonRecordFail;
|
||||
Procedure TestPointer_AnonymousArgTypeFail;
|
||||
Procedure TestPointer_AnonymousVarTypeFail;
|
||||
Procedure TestPointer_AnonymousResultTypeFail;
|
||||
Procedure TestPointer_AddrOperatorFail;
|
||||
Procedure TestPointer_ArrayParamsFail;
|
||||
Procedure TestPointer_PointerAddFail;
|
||||
Procedure TestPointer_IncPointerFail;
|
||||
|
||||
// jsvalue
|
||||
Procedure TestJSValue_AssignToJSValue;
|
||||
@ -16195,17 +16202,6 @@ begin
|
||||
ConvertProgram;
|
||||
end;
|
||||
|
||||
procedure TTestModule.TestPointer_ArrayParamsFail;
|
||||
begin
|
||||
StartProgram(false);
|
||||
Add('var');
|
||||
Add(' p: Pointer;');
|
||||
Add('begin');
|
||||
Add(' p:=p[1];');
|
||||
SetExpectedPasResolverError('illegal qualifier "[" after "Pointer"',nIllegalQualifierAfter);
|
||||
ConvertProgram;
|
||||
end;
|
||||
|
||||
procedure TTestModule.TestPointer_TypeCastJSValueToPointer;
|
||||
begin
|
||||
StartProgram(false);
|
||||
@ -16233,6 +16229,103 @@ begin
|
||||
'']));
|
||||
end;
|
||||
|
||||
procedure TTestModule.TestPointer_NonRecordFail;
|
||||
begin
|
||||
StartProgram(false);
|
||||
Add([
|
||||
'type',
|
||||
' p = ^longint;',
|
||||
'begin',
|
||||
'']);
|
||||
SetExpectedPasResolverError('Not supported: pointer of Longint',nNotSupportedX);
|
||||
ConvertProgram;
|
||||
end;
|
||||
|
||||
procedure TTestModule.TestPointer_AnonymousArgTypeFail;
|
||||
begin
|
||||
StartProgram(false);
|
||||
Add([
|
||||
'procedure DoIt(p: ^longint); begin end;',
|
||||
'begin',
|
||||
'']);
|
||||
SetExpectedPasResolverError('Not supported: pointer',nNotSupportedX);
|
||||
ConvertProgram;
|
||||
end;
|
||||
|
||||
procedure TTestModule.TestPointer_AnonymousVarTypeFail;
|
||||
begin
|
||||
StartProgram(false);
|
||||
Add([
|
||||
'var p: ^longint;',
|
||||
'begin',
|
||||
'']);
|
||||
SetExpectedPasResolverError('Not supported: pointer',nNotSupportedX);
|
||||
ConvertProgram;
|
||||
end;
|
||||
|
||||
procedure TTestModule.TestPointer_AnonymousResultTypeFail;
|
||||
begin
|
||||
StartProgram(false);
|
||||
Add([
|
||||
'function DoIt: ^longint; begin end;',
|
||||
'begin',
|
||||
'']);
|
||||
SetExpectedPasResolverError('Not supported: pointer',nNotSupportedX);
|
||||
ConvertProgram;
|
||||
end;
|
||||
|
||||
procedure TTestModule.TestPointer_AddrOperatorFail;
|
||||
begin
|
||||
StartProgram(false);
|
||||
Add([
|
||||
'var i: longint;',
|
||||
'begin',
|
||||
' if @i=nil then ;',
|
||||
'']);
|
||||
SetExpectedConverterError('illegal qualifier "@" in front of "i:Longint"',nIllegalQualifierInFrontOf);
|
||||
ConvertProgram;
|
||||
end;
|
||||
|
||||
procedure TTestModule.TestPointer_ArrayParamsFail;
|
||||
begin
|
||||
StartProgram(false);
|
||||
Add([
|
||||
'var',
|
||||
' p: Pointer;',
|
||||
'begin',
|
||||
' p:=p[1];',
|
||||
'']);
|
||||
SetExpectedPasResolverError('illegal qualifier "[" after "Pointer"',nIllegalQualifierAfter);
|
||||
ConvertProgram;
|
||||
end;
|
||||
|
||||
procedure TTestModule.TestPointer_PointerAddFail;
|
||||
begin
|
||||
StartProgram(false);
|
||||
Add([
|
||||
'var',
|
||||
' p: Pointer;',
|
||||
'begin',
|
||||
' p:=p+1;',
|
||||
'']);
|
||||
SetExpectedPasResolverError('Operator is not overloaded: "Pointer" + "Longint"',nOperatorIsNotOverloadedAOpB);
|
||||
ConvertProgram;
|
||||
end;
|
||||
|
||||
procedure TTestModule.TestPointer_IncPointerFail;
|
||||
begin
|
||||
StartProgram(false);
|
||||
Add([
|
||||
'var',
|
||||
' p: Pointer;',
|
||||
'begin',
|
||||
' inc(p,1);',
|
||||
'']);
|
||||
SetExpectedPasResolverError('Incompatible type arg no. 1: Got "Pointer", expected "integer"',
|
||||
nIncompatibleTypeArgNo);
|
||||
ConvertProgram;
|
||||
end;
|
||||
|
||||
procedure TTestModule.TestJSValue_AssignToJSValue;
|
||||
begin
|
||||
StartProgram(false);
|
||||
|
||||
Loading…
Reference in New Issue
Block a user