mirror of
https://gitlab.com/freepascal.org/fpc/source.git
synced 2025-08-29 23:00:13 +02:00
pastojs: pointer of record
git-svn-id: trunk@38823 -
This commit is contained in:
Mattias Gaertner
parent
549420da71
commit
08d2a5ff47
@ -325,6 +325,9 @@ Works:
|
||||
- Currency:=Double -> Currency:=Math.floor(Double*10000)
|
||||
- jsvalue := currency -> jsvalue:=currency/10000
|
||||
- simplify Math.floor(number) to trunc(number)
|
||||
- Pointer of record
|
||||
- p:=@r, p^:=r
|
||||
- p^.x, p.x
|
||||
|
||||
ToDos:
|
||||
- for i in jsvalue do
|
||||
@ -1183,6 +1186,8 @@ type
|
||||
function CreateElementData(DataClass: TPas2JsElementDataClass;
|
||||
El: TPasElement): TPas2JsElementData; virtual;
|
||||
// utility
|
||||
procedure RaiseMsg(const Id: int64; MsgNumber: integer; const Fmt: String;
|
||||
Args: array of const; ErrorPosEl: TPasElement); override;
|
||||
function GetOverloadName(El: TPasElement): string;
|
||||
function GetBaseDescription(const R: TPasResolverResult; AddPath: boolean=
|
||||
false): string; override;
|
||||
@ -2437,6 +2442,7 @@ var
|
||||
i: Integer;
|
||||
Decl: TPasElement;
|
||||
C: TClass;
|
||||
TypeEl: TPasType;
|
||||
begin
|
||||
inherited FinishTypeSection(El);
|
||||
for i:=0 to El.Declarations.Count-1 do
|
||||
@ -2445,8 +2451,11 @@ begin
|
||||
C:=Decl.ClassType;
|
||||
if C=TPasPointerType then
|
||||
begin
|
||||
// ToDo: pointer of record
|
||||
RaiseMsg(20180423105726,nNotSupportedX,sNotSupportedX,['pointer of '+TPasPointerType(Decl).DestType.Name],El);
|
||||
TypeEl:=ResolveAliasType(TPasPointerType(Decl).DestType);
|
||||
if TypeEl.ClassType=TPasRecordType then
|
||||
// ^record
|
||||
else
|
||||
RaiseMsg(20180423105726,nNotSupportedX,sNotSupportedX,['pointer of '+TPasPointerType(Decl).DestType.Name],Decl);
|
||||
end;
|
||||
end;
|
||||
end;
|
||||
@ -2684,7 +2693,7 @@ var
|
||||
AbsExpr: TPasExpr;
|
||||
ResolvedAbsol: TPasResolverResult;
|
||||
AbsIdent: TPasElement;
|
||||
TypeEl: TPasType;
|
||||
TypeEl, ElTypeEl: TPasType;
|
||||
GUID: TGUID;
|
||||
i: Integer;
|
||||
SectionScope: TPas2JSSectionScope;
|
||||
@ -2813,7 +2822,13 @@ begin
|
||||
TypeEl:=ResolveAliasType(El.VarType);
|
||||
|
||||
if TypeEl.ClassType=TPasPointerType then
|
||||
RaiseMsg(20180423110113,nNotSupportedX,sNotSupportedX,['pointer'],El);
|
||||
begin
|
||||
ElTypeEl:=ResolveAliasType(TPasPointerType(TypeEl).DestType);
|
||||
if ElTypeEl.ClassType=TPasRecordType then
|
||||
// ^record
|
||||
else
|
||||
RaiseMsg(20180423110113,nNotSupportedX,sNotSupportedX,['pointer'],El);
|
||||
end;
|
||||
|
||||
if El.Expr<>nil then
|
||||
begin
|
||||
@ -2830,7 +2845,7 @@ end;
|
||||
|
||||
procedure TPas2JSResolver.FinishArgument(El: TPasArgument);
|
||||
var
|
||||
TypeEl: TPasType;
|
||||
TypeEl, ElTypeEl: TPasType;
|
||||
begin
|
||||
inherited FinishArgument(El);
|
||||
if El.ArgType<>nil then
|
||||
@ -2838,7 +2853,13 @@ begin
|
||||
TypeEl:=ResolveAliasType(El.ArgType);
|
||||
|
||||
if TypeEl.ClassType=TPasPointerType then
|
||||
RaiseMsg(20180423110239,nNotSupportedX,sNotSupportedX,['pointer'],El);
|
||||
begin
|
||||
ElTypeEl:=ResolveAliasType(TPasPointerType(TypeEl).DestType);
|
||||
if ElTypeEl.ClassType=TPasRecordType then
|
||||
// ^record
|
||||
else
|
||||
RaiseMsg(20180423110239,nNotSupportedX,sNotSupportedX,['pointer'],El);
|
||||
end;
|
||||
end;
|
||||
end;
|
||||
|
||||
@ -2851,7 +2872,7 @@ var
|
||||
AClass: TPasClassType;
|
||||
ClassScope: TPas2JSClassScope;
|
||||
ptm: TProcTypeModifier;
|
||||
TypeEl: TPasType;
|
||||
TypeEl, ElTypeEl: TPasType;
|
||||
begin
|
||||
inherited FinishProcedureType(El);
|
||||
|
||||
@ -2859,7 +2880,13 @@ begin
|
||||
begin
|
||||
TypeEl:=ResolveAliasType(TPasFunctionType(El).ResultEl.ResultType);
|
||||
if TypeEl.ClassType=TPasPointerType then
|
||||
RaiseMsg(20180423110824,nNotSupportedX,sNotSupportedX,['pointer'],El);
|
||||
begin
|
||||
ElTypeEl:=ResolveAliasType(TPasPointerType(TypeEl).DestType);
|
||||
if ElTypeEl.ClassType=TPasRecordType then
|
||||
// ^record
|
||||
else
|
||||
RaiseMsg(20180423110824,nNotSupportedX,sNotSupportedX,['pointer'],El);
|
||||
end;
|
||||
end;
|
||||
|
||||
if El.Parent is TPasProcedure then
|
||||
@ -4150,6 +4177,15 @@ begin
|
||||
AddElementData(Result);
|
||||
end;
|
||||
|
||||
procedure TPas2JSResolver.RaiseMsg(const Id: int64; MsgNumber: integer;
|
||||
const Fmt: String; Args: array of const; ErrorPosEl: TPasElement);
|
||||
begin
|
||||
{$IFDEF VerbosePas2JS}
|
||||
writeln('TPas2JSResolver.RaiseMsg [',Id,']');
|
||||
{$ENDIF}
|
||||
inherited RaiseMsg(Id, MsgNumber, Fmt, Args, ErrorPosEl);
|
||||
end;
|
||||
|
||||
function TPas2JSResolver.GetOverloadName(El: TPasElement): string;
|
||||
var
|
||||
Data: TObject;
|
||||
@ -4898,29 +4934,42 @@ end;
|
||||
function TPasToJSConverter.ConvertUnaryExpression(El: TUnaryExpr;
|
||||
AContext: TConvertContext): TJSElement;
|
||||
|
||||
procedure NotSupported;
|
||||
procedure NotSupported(Id: int64);
|
||||
var
|
||||
ResolvedEl: TPasResolverResult;
|
||||
begin
|
||||
if AContext.Resolver<>nil then
|
||||
begin
|
||||
AContext.Resolver.ComputeElement(El.Operand,ResolvedEl,[],El);
|
||||
DoError(20180423111325,nIllegalQualifierInFrontOf,sIllegalQualifierInFrontOf,
|
||||
DoError(Id,nIllegalQualifierInFrontOf,sIllegalQualifierInFrontOf,
|
||||
[OpcodeStrings[El.OpCode],AContext.Resolver.GetResolverResultDescription(ResolvedEl)],El);
|
||||
end
|
||||
else
|
||||
DoError(20170215134950,nUnaryOpcodeNotSupported,sUnaryOpcodeNotSupported,
|
||||
DoError(Id,nUnaryOpcodeNotSupported,sUnaryOpcodeNotSupported,
|
||||
[OpcodeStrings[El.OpCode]],El);
|
||||
end;
|
||||
|
||||
function DerefPointer(TypeEl: TPasType): boolean;
|
||||
begin
|
||||
if TypeEl.ClassType=TPasRecordType then
|
||||
begin
|
||||
// PRecordVar^ -> PRecordVar
|
||||
ConvertUnaryExpression:=ConvertElement(El.Operand,AContext);
|
||||
exit(true);
|
||||
end;
|
||||
Result:=false;
|
||||
end;
|
||||
|
||||
Var
|
||||
U : TJSUnaryExpression;
|
||||
E : TJSElement;
|
||||
ResolvedOp, ResolvedEl: TPasResolverResult;
|
||||
BitwiseNot: Boolean;
|
||||
|
||||
aResolver: TPas2JSResolver;
|
||||
TypeEl, SubTypeEl: TPasType;
|
||||
begin
|
||||
if AContext=nil then ;
|
||||
aResolver:=AContext.Resolver;
|
||||
Result:=Nil;
|
||||
U:=nil;
|
||||
Case El.OpCode of
|
||||
@ -4940,9 +4989,9 @@ begin
|
||||
begin
|
||||
E:=ConvertElement(El.Operand,AContext);
|
||||
BitwiseNot:=true;
|
||||
if AContext.Resolver<>nil then
|
||||
if aResolver<>nil then
|
||||
begin
|
||||
AContext.Resolver.ComputeElement(El.Operand,ResolvedOp,[]);
|
||||
aResolver.ComputeElement(El.Operand,ResolvedOp,[]);
|
||||
BitwiseNot:=ResolvedOp.BaseType in btAllJSInteger;
|
||||
end;
|
||||
if BitwiseNot then
|
||||
@ -4953,9 +5002,9 @@ begin
|
||||
end;
|
||||
eopAddress:
|
||||
begin
|
||||
if AContext.Resolver=nil then
|
||||
NotSupported;
|
||||
AContext.Resolver.ComputeElement(El.Operand,ResolvedEl,[rcNoImplicitProc]);
|
||||
if aResolver=nil then
|
||||
NotSupported(20180423162321);
|
||||
aResolver.ComputeElement(El.Operand,ResolvedEl,[rcNoImplicitProc]);
|
||||
{$IFDEF VerbosePas2JS}
|
||||
writeln('TPasToJSConverter.ConvertUnaryExpression ',GetResolverResultDbg(ResolvedEl));
|
||||
{$ENDIF}
|
||||
@ -4966,6 +5015,36 @@ begin
|
||||
Result:=CreateCallback(El.Operand,ResolvedEl,AContext);
|
||||
exit;
|
||||
end;
|
||||
end
|
||||
else if (ResolvedEl.BaseType=btContext) then
|
||||
begin
|
||||
TypeEl:=aResolver.ResolveAliasType(ResolvedEl.TypeEl);
|
||||
if TypeEl.ClassType=TPasRecordType then
|
||||
begin
|
||||
// @RecVar -> RecVar
|
||||
Result:=ConvertElement(El.Operand,AContext);
|
||||
exit;
|
||||
end;
|
||||
end;
|
||||
end;
|
||||
eopDeref:
|
||||
begin
|
||||
if aResolver=nil then
|
||||
NotSupported(20180423162350);
|
||||
aResolver.ComputeElement(El.Operand,ResolvedEl,[rcNoImplicitProc]);
|
||||
if ResolvedEl.BaseType=btPointer then
|
||||
begin
|
||||
TypeEl:=aResolver.ResolveAliasType(ResolvedEl.TypeEl);
|
||||
if DerefPointer(TypeEl) then exit;
|
||||
end
|
||||
else if (ResolvedEl.BaseType=btContext) then
|
||||
begin
|
||||
TypeEl:=aResolver.ResolveAliasType(ResolvedEl.TypeEl);
|
||||
if TypeEl.ClassType=TPasPointerType then
|
||||
begin
|
||||
SubTypeEl:=aResolver.ResolveAliasType(TPasPointerType(TypeEl).DestType);
|
||||
if DerefPointer(SubTypeEl) then exit;
|
||||
end;
|
||||
end;
|
||||
end;
|
||||
eopMemAddress:
|
||||
@ -4976,7 +5055,7 @@ begin
|
||||
end;
|
||||
end;
|
||||
if U=nil then
|
||||
NotSupported;
|
||||
NotSupported(20180423162324);
|
||||
Result:=U;
|
||||
end;
|
||||
|
||||
|
||||
@ -547,6 +547,8 @@ type
|
||||
Procedure TestPointer_ArrayParamsFail;
|
||||
Procedure TestPointer_PointerAddFail;
|
||||
Procedure TestPointer_IncPointerFail;
|
||||
Procedure TestPointer_Record;
|
||||
Procedure TestPointer_RecordArg;
|
||||
|
||||
// jsvalue
|
||||
Procedure TestJSValue_AssignToJSValue;
|
||||
@ -16326,6 +16328,151 @@ begin
|
||||
ConvertProgram;
|
||||
end;
|
||||
|
||||
procedure TTestModule.TestPointer_Record;
|
||||
begin
|
||||
StartProgram(false);
|
||||
Add([
|
||||
'type',
|
||||
' TRec = record x: longint; end;',
|
||||
' PRec = ^TRec;',
|
||||
'var',
|
||||
' r: TRec;',
|
||||
' p: PRec;',
|
||||
'begin',
|
||||
' p:=@r;',
|
||||
' r:=p^;',
|
||||
' r.x:=p^.x;',
|
||||
' p^.x:=r.x;',
|
||||
' if p^.x=3 then ;',
|
||||
' if 4=p^.x then ;',
|
||||
'']);
|
||||
ConvertProgram;
|
||||
CheckSource('TestPointer_Record',
|
||||
LinesToStr([ // statements
|
||||
'this.TRec = function (s) {',
|
||||
' if (s) {',
|
||||
' this.x = s.x;',
|
||||
' } else {',
|
||||
' this.x = 0;',
|
||||
' };',
|
||||
' this.$equal = function (b) {',
|
||||
' return this.x === b.x;',
|
||||
' };',
|
||||
'};',
|
||||
'this.r = new $mod.TRec();',
|
||||
'this.p = null;',
|
||||
'']),
|
||||
LinesToStr([ // $mod.$main
|
||||
'$mod.p = $mod.r;',
|
||||
'$mod.r = new $mod.TRec($mod.p);',
|
||||
'$mod.r.x = $mod.p.x;',
|
||||
'$mod.p.x = $mod.r.x;',
|
||||
'if ($mod.p.x === 3) ;',
|
||||
'if (4 === $mod.p.x) ;',
|
||||
'']));
|
||||
end;
|
||||
|
||||
procedure TTestModule.TestPointer_RecordArg;
|
||||
begin
|
||||
StartProgram(false);
|
||||
Add([
|
||||
'{$modeswitch autoderef}',
|
||||
'type',
|
||||
' TRec = record x: longint; end;',
|
||||
' PRec = ^TRec;',
|
||||
'function DoIt(const a: PRec; var b: PRec; out c: PRec): TRec;',
|
||||
'begin',
|
||||
' a.x:=a.x;',
|
||||
' a^.x:=a^.x;',
|
||||
' with a^ do',
|
||||
' x:=x;',
|
||||
'end;',
|
||||
'function GetIt(p: PRec): PRec;',
|
||||
'begin',
|
||||
' p.x:=p.x;',
|
||||
' p^.x:=p^.x;',
|
||||
' with p^ do',
|
||||
' x:=x;',
|
||||
'end;',
|
||||
'var',
|
||||
' r: TRec;',
|
||||
' p: PRec;',
|
||||
'begin',
|
||||
' p:=GetIt(p);',
|
||||
' p^:=GetIt(@r)^;',
|
||||
' DoIt(p,p,p);',
|
||||
' DoIt(@r,p,p);',
|
||||
'']);
|
||||
ConvertProgram;
|
||||
CheckSource('TestPointer_Record',
|
||||
LinesToStr([ // statements
|
||||
'this.TRec = function (s) {',
|
||||
' if (s) {',
|
||||
' this.x = s.x;',
|
||||
' } else {',
|
||||
' this.x = 0;',
|
||||
' };',
|
||||
' this.$equal = function (b) {',
|
||||
' return this.x === b.x;',
|
||||
' };',
|
||||
'};',
|
||||
'this.DoIt = function (a, b, c) {',
|
||||
' var Result = new $mod.TRec();',
|
||||
' a.x = a.x;',
|
||||
' a.x = a.x;',
|
||||
' a.x = a.x;',
|
||||
' return Result;',
|
||||
'};',
|
||||
'this.GetIt = function (p) {',
|
||||
' var Result = null;',
|
||||
' p.x = p.x;',
|
||||
' p.x = p.x;',
|
||||
' p.x = p.x;',
|
||||
' return Result;',
|
||||
'};',
|
||||
'this.r = new $mod.TRec();',
|
||||
'this.p = null;',
|
||||
'']),
|
||||
LinesToStr([ // $mod.$main
|
||||
'$mod.p = $mod.GetIt($mod.p);',
|
||||
'$mod.p = new $mod.TRec($mod.GetIt($mod.r));',
|
||||
'$mod.DoIt($mod.p, {',
|
||||
' p: $mod,',
|
||||
' get: function () {',
|
||||
' return this.p.p;',
|
||||
' },',
|
||||
' set: function (v) {',
|
||||
' this.p.p = v;',
|
||||
' }',
|
||||
'}, {',
|
||||
' p: $mod,',
|
||||
' get: function () {',
|
||||
' return this.p.p;',
|
||||
' },',
|
||||
' set: function (v) {',
|
||||
' this.p.p = v;',
|
||||
' }',
|
||||
'});',
|
||||
'$mod.DoIt($mod.r, {',
|
||||
' p: $mod,',
|
||||
' get: function () {',
|
||||
' return this.p.p;',
|
||||
' },',
|
||||
' set: function (v) {',
|
||||
' this.p.p = v;',
|
||||
' }',
|
||||
'}, {',
|
||||
' p: $mod,',
|
||||
' get: function () {',
|
||||
' return this.p.p;',
|
||||
' },',
|
||||
' set: function (v) {',
|
||||
' this.p.p = v;',
|
||||
' }',
|
||||
'});',
|
||||
'']));
|
||||
end;
|
||||
|
||||
procedure TTestModule.TestJSValue_AssignToJSValue;
|
||||
begin
|
||||
StartProgram(false);
|
||||
|
||||
Loading…
Reference in New Issue
Block a user