pas2js: doc about dispatch

git-svn-id: trunk@41676 -

packages/pastojs/src/fppas2js.pp

@@ -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;

packages/pastojs/tests/tcmodules.pas

@@ -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;
 

utils/pas2js/docs/translation.html

@@ -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>
@@ -658,26 +659,26 @@ End.
 ["System"],
 function(){
   var $mod = this;
-  this.TMyRecord = function(s) {
-    if (s){
+  rtl.recNewT($mod, "TMyRecord", function() {
+    this.i = 0;
+    this.s = "";
+    this.d = 0.0;
+    this.$eq = function (b) {
+      return (this.i == b.i) &&
+         (this.s == b.i) && (this.d == b.d);
+    };
+    this.$assign = function (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);
+      return this;
     };
   };
-  this.r = new this.TMyRecord();
+  this.r = this.TMyRecord.$new();
   $mod.$init = function() {
     $mod.r.i=123;
-    $mod.r = new $mod.TMyRecord($mod.s);
-    if ($mod.r.$equal($mod.s)) ;
+    $mod.r.$assign($mod.s);
+    if ($mod.r.$eq($mod.s)) ;
   },
 },
 []);
@@ -688,26 +689,26 @@ function(){
 ["System"],
 function(){
   var $mod = this;
-  rtl.recNewT($mod, "TMyRecord", function() {
-    this.i = 0;
-    this.s = "";
-    this.d = 0.0;
-    this.$eq = function (b) {
-      return (this.i == b.i) &&
-         (this.s == b.i) && (this.d == b.d);
-    };
-    this.$assign = function (s) {
+  this.TMyRecord = function(s) {
+    if (s){
       this.i = s.i;
       this.s = s.s;
       this.d = s.d;
-      return this;
+    } 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 = this.TMyRecord.$new();
+  this.r = new this.TMyRecord();
   $mod.$init = function() {
     $mod.r.i=123;
-    $mod.r.$assign($mod.s);
-    if ($mod.r.$eq($mod.s)) ;
+    $mod.r = new $mod.TMyRecord($mod.s);
+    if ($mod.r.$equal($mod.s)) ;
   },
 },
 []);
@@ -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