pas2js: doc about dispatch

git-svn-id: trunk@41676 -
This commit is contained in:
Mattias Gaertner 2019-03-11 14:38:23 +00:00
parent 89c921a11c
commit bc8df85d00
3 changed files with 123 additions and 98 deletions

View File

@ -792,11 +792,11 @@ const
'rc', // rtl.rc
'rcCharAt', // rtl.rcCharAt
'rcSetCharAt', // rtl.rcSetCharAt
'$assign',
'$clone',
'recNewT',
'$eq',
'$new',
'$assign', // pbifnRecordAssign
'$clone', // pbifnRecordClone
'recNewT', // pbifnRecordNew
'$eq', // pbifnRecordEqual
'$new', // pbifnRecordNew
'addField',
'addFields',
'addMethod',
@ -5110,7 +5110,7 @@ begin
else if C=TPasRecordType then
begin
// typecast to recordtype
if FromResolved.BaseType=btNone then
if FromResolved.BaseType=btUntyped then
// recordtype(untyped) -> ok
else if FromResolved.BaseType=btContext then
begin
@ -9516,7 +9516,7 @@ var
Param, Value: TPasExpr;
JSBaseType: TPas2jsBaseType;
C: TClass;
aName: String;
aName, ArgName: String;
aClassTypeEl: TPasClassType;
ParamTypeEl, TypeEl: TPasType;
NeedIntfRef: Boolean;
@ -9666,6 +9666,15 @@ begin
aResolver.ComputeElement(Param,ParamResolved,[]);
ParamTypeEl:=ParamResolved.LoTypeEl;
if (C=TPasRecordType) and (ParamResolved.BaseType=btUntyped)
and (ParamResolved.IdentEl is TPasArgument) then
begin
// RecordType(UntypedArg) -> UntypedArg
ArgName:=TransformArgName(TPasArgument(ParamResolved.IdentEl),AContext);
Result:=CreatePrimitiveDotExpr(ArgName,El);
exit;
end;
Result:=ConvertExpression(Param,AContext);
if C=TPasRangeType then
@ -21594,6 +21603,9 @@ begin
aResolver.ComputeElement(El,ExprResolved,ExprFlags);
if (TargetArg.ArgType=nil) and (ExprResolved.LoTypeEl is TPasRecordType) then
NeedVar:=false; // pass aRecord to UntypedArg -> no reference needed
// consider TargetArg access
if NeedVar then
Result:=CreateProcCallArgRef(El,ExprResolved,TargetArg,AContext)
@ -22077,7 +22089,7 @@ begin
// create SetExpr.$assign(v)
Call:=CreateCallExpression(El);
Call.Expr:=CreateDotNameExpr(El,SetExpr,
TJSString(GetBIName(pbifnRecordAssign)));
TJSString(GetBIName(pbifnRecordAssign)));
Call.AddArg(RHS);
SetExpr:=Call;
end
@ -22232,6 +22244,40 @@ begin
TypeEl:=AContext.Resolver.ResolveAliasType(Arg.ArgType);
IsRecord:=TypeEl is TPasRecordType;
if AContext.Access=caAssign then
begin
AssignContext:=AContext.AccessContext as TAssignContext;
if IsRecord then
begin
// aRecordArg:=right -> "aRecordArg.$assign(right)"
if AssignContext.Call<>nil then
RaiseNotSupported(Arg,AContext,20190105174026);
Result:=CreateSetter(GetBIName(pbifnRecordAssign),AssignContext);
exit;
end
else if (Arg.ArgType=nil)
and (AssignContext.RightResolved.LoTypeEl is TPasRecordType)
and (rrfReadable in AssignContext.RightResolved.Flags) then
begin
// UntypedArg:=aRecordVar -> "UntypedArg.$assign(right)"
// Note: records are passed directly to Untyped parameters
if AssignContext.Call<>nil then
RaiseNotSupported(Arg,AContext,20190311140048);
Result:=CreateSetter(GetBIName(pbifnRecordAssign),AssignContext);
exit;
end;
end
else if IsRecord and (AContext is TParamContext) then
begin
ParamContext:=TParamContext(AContext);
if ParamContext.ResolvedExpr.BaseType=btUntyped then
begin
// pass aRecordVar to UntypedArg -> pass aRecordVar directly, no temp ref object
Result:=CreatePrimitiveDotExpr(ArgName,PosEl);
exit;
end;
end;
if (Arg.Access in [argVar,argOut]) and not IsRecord then
begin
// Arg is a reference object
@ -22266,18 +22312,6 @@ begin
else
RaiseNotSupported(Arg,AContext,20170214120739);
end;
end
else if AContext.Access=caAssign then
begin
AssignContext:=AContext.AccessContext as TAssignContext;
if AssignContext.LeftResolved.LoTypeEl is TPasRecordType then
begin
// aRecordArg:=right -> "aRecordArg.$assign(right)"
if AssignContext.Call<>nil then
RaiseNotSupported(Arg,AContext,20190105174026);
Result:=CreateSetter(GetBIName(pbifnRecordAssign),AssignContext);
exit;
end;
end;
Result:=CreatePrimitiveDotExpr(ArgName,PosEl);
end;

View File

@ -10078,15 +10078,19 @@ begin
' U:=vd;',
' U:=vc;',
' U:=vv;',
' vl:=TRecord(U);',
' vd:=TRecord(U);',
' vv:=TRecord(U);',
' doit(vd,vd,vd,vd);',
' doit(vc,vc,vl,vl);',
' doit(vv,vv,vv,vv);',
' doit(vl,vl,vl,vl);',
//' TRecord(U).i:=3;',
' TRecord(U).i:=3;',
'end;',
'var i: TRecord;',
'begin',
' doit(i,i,i,i);']);
' doit(i,i,i,i);',
'']);
ConvertProgram;
CheckSource('TestRecord_AsParams',
LinesToStr([ // statements
@ -10107,55 +10111,23 @@ begin
' vL.$assign(vC);',
' vV.$assign(vV);',
' vV.i = vV.i;',
' U.set(vL);',
' U.set(vD);',
' U.set(vC);',
' U.set(vV);',
' $mod.DoIt($mod.TRecord.$clone(vD), vD, vD, {',
' get: function () {',
' return vD;',
' },',
' set: function (v) {',
' vD.$assign(v);',
' }',
' });',
' $mod.DoIt($mod.TRecord.$clone(vC), vC, vL, {',
' get: function () {',
' return vL;',
' },',
' set: function (v) {',
' vL.$assign(v);',
' }',
' });',
' $mod.DoIt($mod.TRecord.$clone(vV), vV, vV, {',
' get: function () {',
' return vV;',
' },',
' set: function (v) {',
' vV.$assign(v);',
' }',
' });',
' $mod.DoIt($mod.TRecord.$clone(vL), vL, vL, {',
' get: function () {',
' return vL;',
' },',
' set: function (v) {',
' vL.$assign(v);',
' }',
' });',
' U.$assign(vL);',
' U.$assign(vD);',
' U.$assign(vC);',
' U.$assign(vV);',
' vL.$assign(U);',
' vD.$assign(U);',
' vV.$assign(U);',
' $mod.DoIt($mod.TRecord.$clone(vD), vD, vD, vD);',
' $mod.DoIt($mod.TRecord.$clone(vC), vC, vL, vL);',
' $mod.DoIt($mod.TRecord.$clone(vV), vV, vV, vV);',
' $mod.DoIt($mod.TRecord.$clone(vL), vL, vL, vL);',
' U.i = 3;',
'};',
'this.i = $mod.TRecord.$new();'
]),
LinesToStr([
'$mod.DoIt($mod.TRecord.$clone($mod.i), $mod.i, $mod.i, {',
' p: $mod,',
' get: function () {',
' return this.p.i;',
' },',
' set: function (v) {',
' this.p.i.$assign(v);',
' }',
'});',
'$mod.DoIt($mod.TRecord.$clone($mod.i), $mod.i, $mod.i, $mod.i);',
'']));
end;

View File

@ -65,6 +65,7 @@
<a href="#functiontype">Translating function types</a><br>
<a href="#absolute">Translating var modifier absolute</a><br>
<a href="#assert">Translating assert()</a><br>
<a href="#dispatch">TObject.Dispatch</a><br>
<a href="#calljavascript">Calling JavaScript from Pascal</a><br>
<a href="#asm">The asm block</a><br>
<a href="#assembler">The procedure modifier assembler</a><br>
@ -630,8 +631,8 @@ End.
<tbody>
<tr>
<th>Pascal</th>
<th>JS Pas2js 1.2</th>
<th>JS Pas2js 1.3</th>
<th>JS Pas2js 1.2</th>
</tr>
<tr>
<td>
@ -656,36 +657,6 @@ End.
<td>
<pre>rtl.module("MyModule",
["System"],
function(){
var $mod = this;
this.TMyRecord = function(s) {
if (s){
this.i = s.i;
this.s = s.s;
this.d = s.d;
} else {
this.i = 0;
this.s = "";
this.d = 0.0;
};
this.$equal = function (b) {
return (this.i == b.i) &&
(this.s == b.i) && (this.d == b.d);
};
};
this.r = new this.TMyRecord();
$mod.$init = function() {
$mod.r.i=123;
$mod.r = new $mod.TMyRecord($mod.s);
if ($mod.r.$equal($mod.s)) ;
},
},
[]);
</pre>
</td>
<td>
<pre>rtl.module("MyModule",
["System"],
function(){
var $mod = this;
rtl.recNewT($mod, "TMyRecord", function() {
@ -711,6 +682,36 @@ function(){
},
},
[]);
</pre>
</td>
<td>
<pre>rtl.module("MyModule",
["System"],
function(){
var $mod = this;
this.TMyRecord = function(s) {
if (s){
this.i = s.i;
this.s = s.s;
this.d = s.d;
} else {
this.i = 0;
this.s = "";
this.d = 0.0;
};
this.$equal = function (b) {
return (this.i == b.i) &&
(this.s == b.i) && (this.d == b.d);
};
};
this.r = new this.TMyRecord();
$mod.$init = function() {
$mod.r.i=123;
$mod.r = new $mod.TMyRecord($mod.s);
if ($mod.r.$equal($mod.s)) ;
},
},
[]);
</pre>
</td>
</tr>
@ -756,6 +757,9 @@ function(){
<li><i>Dispose(PointerOfRecord)</i> Sets the variable to null if possible.</li>
</ul>
</li>
<li>Passing a record to an untyped arguments (e.g. ''TObject.Dispatch(var Msg)'')
passes the record JS object directly, not creating a temporary reference object.</li>
<li>Typecasting RecordType(UntypedArgument) returns the argument, i.e. no conversion.</li>
</ul>
</div>
@ -2266,6 +2270,21 @@ End.
</ul>
</div>
<div class="section">
<h2 id="dispatch">TObject.Dispatch</h2>
The procedure modifier '''message''' and the ''TObject.Dispatch'' works
similar to FPC/Delphi, as it expects a record of a specific format and
''Dispatch'' calls the method with that message number or string.<br>
The procedure modifier '''message &lt;integer&gt;''' adds an entry to the
''$msgint'' object, and modifier '''message &lt;string&gt;''' adds an entry
to the ''$msgstr'' object.<br>
The '''TObject.Dispatch''' expects as argument a record with an integer
field ''Msg'' (case sensitive).<br>
The '''TObject.DispatchStr''' expects as argument a record with a string
field ''MsgStr'' (case sensitive).<br>
</div>
<div class="section">
<h2 id="calljavascript">Calling JavaScript from Pascal</h2>
Pas2js allows to write low level functions and/or access a JavaScript library