pastojs:

- changed records from function to Object
- added $new, $assign, $clone, $eq
- passig records to var argument now passes directly instead of temp setter
- using $assign for aRecord:= copying values, keeping object, needed by pointer of record
- advanced records: methods, class vars, const, property, array property, default property, RTTI

git-svn-id: trunk@40797 -

packages/pastojs/src/pas2jscompiler.pp

@@ -1138,6 +1138,7 @@ begin
     Result:=UseAnalyzer.IsUsed(El)
   else
     Result:=true;
+  if Sender=nil then ;
 end;
 
 function TPas2jsCompilerFile.OnConverterIsTypeInfoUsed(Sender: TObject;
@@ -1150,6 +1151,7 @@ begin
     Result:=UseAnalyzer.IsTypeInfoUsed(El)
   else
     Result:=true;
+  if Sender=nil then ;
 end;
 
 procedure TPas2jsCompilerFile.OnPasResolverLog(Sender: TObject; const Msg: String);
@@ -1160,6 +1162,7 @@ begin
   aResolver:=TPasResolver(Sender);
   DoLogMsgAtEl(aResolver.LastMsgType,aResolver.LastMsg,aResolver.LastMsgNumber,
           aResolver.LastElement);
+  if Sender=nil then ;
 end;
 
 procedure TPas2jsCompilerFile.OnParserLog(Sender: TObject; const Msg: String);
@@ -1172,6 +1175,7 @@ begin
   aScanner:=aParser.Scanner;
   Log.Log(aParser.LastMsgType,aParser.LastMsg,aParser.LastMsgNumber,
           aScanner.CurFilename,aScanner.CurRow,aScanner.CurColumn);
+  if Sender=nil then ;
 end;
 
 procedure TPas2jsCompilerFile.OnScannerLog(Sender: TObject; const Msg: String);
@@ -1182,12 +1186,14 @@ begin
   aScanner:=TPas2jsPasScanner(Sender);
   Log.Log(aScanner.LastMsgType,aScanner.LastMsg,aScanner.LastMsgNumber,
           aScanner.CurFilename,aScanner.CurRow,aScanner.CurColumn);
+  if Sender=nil then ;
 end;
 
 procedure TPas2jsCompilerFile.OnUseAnalyzerMessage(Sender: TObject;
   Msg: TPAMessage);
 begin
   Log.Log(Msg.MsgType,Msg.MsgText,Msg.MsgNumber,Msg.Filename,Msg.Row,Msg.Col);
+  if Sender=nil then ;
 end;
 
 procedure TPas2jsCompilerFile.HandleEParserError(E: EParserError);
@@ -1710,6 +1716,7 @@ begin
     exit(true);
   end;
 
+  if Sender=nil then ;
   Result:=false;
 end;
 
@@ -3801,6 +3808,7 @@ function TPas2jsCompiler.OnMacroCfgDir(Sender: TObject; var Params: string;
   Lvl: integer): boolean;
 begin
   if Lvl=0 then ;
+  if Sender=nil then ;
   Params:=ExtractFilePath(ConfigSupport.CurrentCfgFilename);
   Result:=true;
 end;

packages/pastojs/src/pas2jsfiler.pp

@@ -842,6 +842,7 @@ type
     procedure Set_SetType_EnumType(RefEl: TPasElement; Data: TObject);
     procedure Set_Variant_Members(RefEl: TPasElement; Data: TObject);
     procedure Set_RecordType_VariantEl(RefEl: TPasElement; Data: TObject);
+    procedure Set_RecordScope_DefaultProperty(RefEl: TPasElement; Data: TObject);
     procedure Set_Argument_ArgType(RefEl: TPasElement; Data: TObject);
     procedure Set_ClassScope_NewInstanceFunction(RefEl: TPasElement; Data: TObject);
     procedure Set_ClassScope_DirectAncestor(RefEl: TPasElement; Data: TObject);
@@ -1699,11 +1700,11 @@ var
   El: TPasElement;
 begin
   El:=Scope.Element;
-  if El is TPasClassType then
+  if El is TPasMembersType then
     Result:=El
   else if El is TPasModule then
     Result:=El
-  else if (Scope is TPasProcedureScope) and (Scope.Element.Parent is TPasClassType) then
+  else if (Scope is TPasProcedureScope) and (Scope.Element.Parent is TPasMembersType) then
     Result:=Scope.Element.Parent
   else
     Result:=nil;
@@ -3324,6 +3325,7 @@ end;
 procedure TPCUWriter.WriteRecordTypeScope(Obj: TJSONObject;
   Scope: TPasRecordScope; aContext: TPCUWriterContext);
 begin
+  AddReferenceToObj(Obj,'DefaultProperty',Scope.DefaultProperty);
   WriteIdentifierScope(Obj,Scope,aContext);
 end;
 
@@ -3829,10 +3831,9 @@ begin
   C:=Parent.ClassType;
   if C.InheritsFrom(TPasDeclarations) then
     WriteMemberIndex(TPasDeclarations(Parent).Declarations,Ref.Element,Ref.Obj)
-  else if C=TPasClassType then
+  else if (C=TPasClassType)
-    WriteMemberIndex(TPasClassType(Parent).Members,Ref.Element,Ref.Obj)
+      or (C=TPasRecordType) then
-  else if C=TPasRecordType then
+    WriteMemberIndex(TPasMembersType(Parent).Members,Ref.Element,Ref.Obj)
-    WriteMemberIndex(TPasRecordType(Parent).Members,Ref.Element,Ref.Obj)
   else if C=TPasEnumType then
     WriteMemberIndex(TPasEnumType(Parent).Values,Ref.Element,Ref.Obj)
   else if C.InheritsFrom(TPasModule) then
@@ -4212,6 +4213,17 @@ begin
     RaiseMsg(20180210205031,El,GetObjName(RefEl));
 end;
 
+procedure TPCUReader.Set_RecordScope_DefaultProperty(RefEl: TPasElement;
+  Data: TObject);
+var
+  Scope: TPasRecordScope absolute Data;
+begin
+  if RefEl is TPasProperty then
+    Scope.DefaultProperty:=TPasProperty(RefEl) // no AddRef
+  else
+    RaiseMsg(20190106213412,Scope.Element,GetObjName(RefEl));
+end;
+
 procedure TPCUReader.Set_Argument_ArgType(RefEl: TPasElement; Data: TObject);
 var
   El: TPasArgument absolute Data;
@@ -5230,10 +5242,8 @@ begin
     begin
     if El is TPasDeclarations then
       ReadExternalMembers(El,Arr,TPasDeclarations(El).Declarations)
-    else if El is TPasClassType then
+    else if El is TPasMembersType then
-      ReadExternalMembers(El,Arr,TPasClassType(El).Members)
+      ReadExternalMembers(El,Arr,TPasMembersType(El).Members)
-    else if El is TPasRecordType then
-      ReadExternalMembers(El,Arr,TPasRecordType(El).Members)
     else if El is TPasEnumType then
       ReadExternalMembers(El,Arr,TPasEnumType(El).Values)
     else if El is TPasModule then
@@ -5459,9 +5469,7 @@ begin
       Section.ResStrings.Add(El)
     else if C=TPasConst then
       Section.Consts.Add(El)
-    else if C=TPasClassType then
+    else if (C=TPasClassType) or (C=TPasRecordType) then
-      Section.Classes.Add(El)
-    else if C=TPasRecordType then
       Section.Classes.Add(El)
     else if C.InheritsFrom(TPasType) then
       // not TPasClassType, TPasRecordType !
@@ -6615,6 +6623,7 @@ end;
 procedure TPCUReader.ReadRecordScope(Obj: TJSONObject; Scope: TPasRecordScope;
   aContext: TPCUReaderContext);
 begin
+  ReadElementReference(Obj,Scope,'DefaultProperty',@Set_RecordScope_DefaultProperty);
   ReadIdentifierScope(Obj,Scope,aContext);
 end;
 
@@ -7313,8 +7322,8 @@ begin
   // Scope.OverloadName is already set in ReadProcedure
   ReadElementReference(Obj,Scope,'ImplProc',@Set_ProcedureScope_ImplProc);
   ReadElementReference(Obj,Scope,'Overridden',@Set_ProcedureScope_Overridden);
-  if Proc.Parent is TPasClassType then
+  if Proc.Parent is TPasMembersType then
-    Scope.ClassScope:=Proc.Parent.CustomData as TPas2JSClassScope; // no AddRef
+    Scope.ClassOrRecordScope:=Proc.Parent.CustomData as TPasClassOrRecordScope; // no AddRef
   // ClassScope: TPasClassScope; auto derived
   // Scope.SelfArg only valid for method implementation
 

packages/pastojs/src/pas2jsfscompiler.pp

@@ -27,7 +27,7 @@ uses
   PasUseAnalyzer,
   Pas2jsFileCache, Pas2jsCompiler,
   Pas2JSFS,
-  FPPas2Js, Pas2jsFileUtils;
+  Pas2jsFileUtils;
 
 Type
   TPas2jsFSCompiler = Class(TPas2JSCompiler)
@@ -121,6 +121,7 @@ function TPas2jsFSCompiler.OnMacroEnv(Sender: TObject; var Params: string;
   Lvl: integer): boolean;
 begin
   if Lvl=0 then ;
+  if Sender=nil then ;
   Params:=GetEnvironmentVariablePJ(Params);
   Result:=true;
 end;

packages/pastojs/tests/tcfiler.pas

@@ -143,6 +143,7 @@ type
     procedure TestPC_SetOfAnonymousEnumType;
     procedure TestPC_Record;
     procedure TestPC_Record_InFunction;
+    procedure TestPC_RecordAdv;
     procedure TestPC_JSValue;
     procedure TestPC_Array;
     procedure TestPC_ArrayOfAnonymous;
@@ -705,6 +706,7 @@ end;
 procedure TCustomTestPrecompile.CheckRestoredRecordScope(const Path: string;
   Orig, Rest: TPasRecordScope);
 begin
+  CheckRestoredReference(Path+'.DefaultProperty',Orig.DefaultProperty,Rest.DefaultProperty);
   CheckRestoredIdentifierScope(Path,Orig,Rest);
 end;
 
@@ -808,7 +810,7 @@ begin
     AssertEquals(Path+'.ResultVarName',Orig.ResultVarName,Rest.ResultVarName);
     CheckRestoredReference(Path+'.OverriddenProc',Orig.OverriddenProc,Rest.OverriddenProc);
 
-    CheckRestoredScopeReference(Path+'.ClassScope',Orig.ClassScope,Rest.ClassScope);
+    CheckRestoredScopeReference(Path+'.ClassScope',Orig.ClassOrRecordScope,Rest.ClassOrRecordScope);
     CheckRestoredElement(Path+'.SelfArg',Orig.SelfArg,Rest.SelfArg);
     if Orig.Flags<>Rest.Flags then
       Fail(Path+'.Flags');
@@ -1753,6 +1755,39 @@ begin
   WriteReadUnit;
 end;
 
+procedure TTestPrecompile.TestPC_RecordAdv;
+begin
+  StartUnit(false);
+  Add([
+  '{$ModeSwitch advancedrecords}',
+  'interface',
+  'type',
+  '  TRec = record',
+  '  private',
+  '    FInt: longint;',
+  '    procedure SetInt(Value: longint);',
+  '    function GetItems(Value: word): word;',
+  '    procedure SetItems(Index, Value: word);',
+  '  public',
+  '    property Int: longint read FInt write SetInt default 3;',
+  '    property Items[Index: word]: word read GetItems write SetItems; default;',
+  '  end;',
+  'var',
+  '  r: trec;',
+  'implementation',
+  'procedure TRec.SetInt(Value: longint);',
+  'begin',
+  'end;',
+  'function TRec.GetItems(Value: word): word;',
+  'begin',
+  'end;',
+  'procedure TRec.SetItems(Index, Value: word);',
+  'begin',
+  'end;',
+  '']);
+  WriteReadUnit;
+end;
+
 procedure TTestPrecompile.TestPC_JSValue;
 begin
   StartUnit(false);

packages/pastojs/tests/tcoptimizations.pas

@@ -387,17 +387,17 @@ begin
   ConvertProgram;
   CheckSource('TestWPO_OmitRecordMember',
     LinesToStr([
-    'this.TRec = function (s) {',
+    'rtl.createTRecord($mod, "TRec", function () {',
-    '  if (s) {',
+    '  this.a = 0;',
-    '    this.a = s.a;',
+    '  this.$eq = function (b) {',
-    '  } else {',
-    '    this.a = 0;',
-    '  };',
-    '  this.$equal = function (b) {',
     '    return this.a === b.a;',
     '  };',
-    '};',
+    '  this.$assign = function (s) {',
-    'this.r = new $mod.TRec();',
+    '    this.a = s.a;',
+    '    return this;',
+    '  };',
+    '});',
+    'this.r = $mod.TRec.$new();',
     '']),
     LinesToStr([
     '$mod.r.a = 3;',

utils/pas2js/dist/rtl.js

@@ -71,6 +71,10 @@ var rtl = {
     return ((typeof(o)==="object") || (typeof(o)==='function')) ? o : null;
   },
 
+  isTRecord: function(type){
+    return (rtl.isObject(type) && type.hasOwnProperty('$new') && (typeof(type.$new)==='function'));
+  },
+
   isPasClass: function(type){
     return (rtl.isObject(type) && type.hasOwnProperty('$classname') && rtl.isObject(type.$module));
   },
@@ -141,7 +145,7 @@ var rtl = {
       try{
         doRun();
       } catch(re) {
-        var errMsg = re.hasOwnProperty('$class') ? re.$class.$classname : '';
+        var errMsg = rtl.hasString(re.$classname) ? re.$classname : '';
 	    errMsg +=  ((errMsg) ? ': ' : '') + (re.hasOwnProperty('fMessage') ? re.fMessage : re);
         alert('Uncaught Exception : '+errMsg);
         rtl.exitCode = 216;
@@ -233,23 +237,28 @@ var rtl = {
     }
   },
 
-  initClass: function(c,parent,name,initfn){
+  initStruct: function(c,parent,name){
-    parent[name] = c;
-    c.$class = c; // Note: o.$class === Object.getPrototypeOf(o)
-    c.$classname = name;
     if ((parent.$module) && (parent.$module.$impl===parent)) parent=parent.$module;
     c.$parent = parent;
-    c.$fullname = parent.$name+'.'+name;
     if (rtl.isModule(parent)){
       c.$module = parent;
       c.$name = name;
     } else {
       c.$module = parent.$module;
-      c.$name = parent.name+'.'+name;
+      c.$name = parent.$name+'.'+name;
     };
+    return parent;
+  },
+
+  initClass: function(c,parent,name,initfn){
+    parent[name] = c;
+    c.$class = c; // Note: o.$class === Object.getPrototypeOf(o)
+    c.$classname = name;
+    parent = rtl.initStruct(c,parent,name);
+    c.$fullname = parent.$name+'.'+name;
     // rtti
     if (rtl.debug_rtti) rtl.debug('initClass '+c.$fullname);
-    var t = c.$module.$rtti.$Class(c.$name,{ "class": c, module: parent });
+    var t = c.$module.$rtti.$Class(c.$name,{ "class": c });
     c.$rtti = t;
     if (rtl.isObject(c.$ancestor)) t.ancestor = c.$ancestor.$rtti;
     if (!t.ancestor) t.ancestor = null;
@@ -298,8 +307,7 @@ var rtl = {
     // Create a class using an external ancestor.
     // If newinstancefnname is given, use that function to create the new object.
     // If exist call BeforeDestruction and AfterConstruction.
-    var c = null;
+    var c = Object.create(ancestor);
-    c = Object.create(ancestor);
     c.$create = function(fnname,args){
       if (args == undefined) args = [];
       var o = null;
@@ -342,6 +350,32 @@ var rtl = {
     return null;
   },
 
+  createTRecord: function(parent,name,initfn,full){
+    var t = {};
+    if (parent) parent[name] = t;
+    function hide(prop){
+      Object.defineProperty(t,prop,{enumerable:false});
+    }
+    if (full){
+      rtl.initStruct(t,parent,name);
+      t.$record = t;
+      hide('$record');
+      hide('$name');
+      hide('$parent');
+      hide('$module');
+    }
+    initfn.call(t);
+    if (!t.$new){
+      t.$new = function(){ return Object.create(this); };
+    }
+    t.$clone = function(r){ return this.$new().$assign(r); };
+    hide('$new');
+    hide('$clone');
+    hide('$eq');
+    hide('$assign');
+    return t;
+  },
+
   is: function(instance,type){
     return type.isPrototypeOf(instance) || (instance===type);
   },
@@ -465,7 +499,7 @@ var rtl = {
 
   createTGUID: function(guid){
     var TGuid = (pas.System)?pas.System.TGuid:pas.system.tguid;
-    var g = rtl.strToGUIDR(guid,new TGuid());
+    var g = rtl.strToGUIDR(guid,TGuid.$new());
     return g;
   },
 
@@ -730,10 +764,12 @@ var rtl = {
         if (argNo === p.length-1){
           if (rtl.isArray(defaultvalue)){
             for (var i=oldlen; i<newlen; i++) a[i]=[]; // nested array
-          } else if (rtl.isFunction(defaultvalue)){
-            for (var i=oldlen; i<newlen; i++) a[i]=new defaultvalue(); // e.g. record
           } else if (rtl.isObject(defaultvalue)) {
-            for (var i=oldlen; i<newlen; i++) a[i]={}; // e.g. set
+            if (rtl.isTRecord(defaultvalue)){
+              for (var i=oldlen; i<newlen; i++) a[i]=defaultvalue.$new(); // e.g. record
+            } else {
+              for (var i=oldlen; i<newlen; i++) a[i]={}; // e.g. set
+            }
           } else {
             for (var i=oldlen; i<newlen; i++) a[i]=defaultvalue;
           }
@@ -762,10 +798,10 @@ var rtl = {
     // type: 0 for references, "refset" for calling refSet(), a function for new type()
     // src must not be null
     // This function does not range check.
-    if (rtl.isFunction(type)){
+    if(type === 'refSet') {
-      for (; srcpos<endpos; srcpos++) dst[dstpos++] = new type(src[srcpos]); // clone record
-    } else if(type === 'refSet') {
       for (; srcpos<endpos; srcpos++) dst[dstpos++] = rtl.refSet(src[srcpos]); // ref set
+    } else if (rtl.isTRecord(type)){
+      for (; srcpos<endpos; srcpos++) dst[dstpos++] = type.$clone(src[srcpos]); // clone record
     }  else {
       for (; srcpos<endpos; srcpos++) dst[dstpos++] = src[srcpos]; // reference
     };

utils/pas2js/docs/translation.html

@@ -133,7 +133,7 @@ Put + after a boolean switch option to enable it, - to disable it
     -ic   : Write list of supported JS processors usable by -P<x>
     -io   : Write list of supported optimizations usable by -Oo<x>
     -it   : Write list of supported targets usable by -T<x>
-    -iJ  : Write list of supported JavaScript identifiers -JoRTL-<x>
+    -iJ   : Write list of supported JavaScript identifiers -JoRTL-<x>
   -C<x>   : Code generation options. <x> is a combination of the following letters:
     o     : Overflow checking
     r     : Range checking