2
0
Эх сурвалжийг харах

# revisions: 40446,40447,40450,40451,40452,40455,40456,40457,40458,40459,40460,40461,40469,40470,40471,40473,40474,40475,40476,40477,40478,40479,40483,40484,40486,40487,40488,40489,40491,40493,40494,40495,40505,40506,40507,40508,40509,40514,40516,40517,40518,40522,40523,40530,40531,40533,40534,40549,40550,40551,40553,40554,40555,40558,40559,40562,40580,40582,40584,40591,40593,40594,40596,40597,40620,40638,40639,40650,40659,40671,40672,40674,40675,40685,40691,40708,40712,40714,40715,40722,40768,40795,40796,40797,40799

git-svn-id: branches/fixes_3_2@41993 -
marco 6 жил өмнө
parent
commit
586398ad41
44 өөрчлөгдсөн 6923 нэмэгдсэн , 2091 устгасан
  1. 7 0
      .gitattributes
  2. 238 52
      packages/fcl-db/tests/testjsondataset.pp
  3. 2 2
      packages/fcl-js/src/jsbase.pp
  4. 2 0
      packages/fcl-js/src/jswriter.pp
  5. 89 66
      packages/fcl-passrc/src/pasresolveeval.pas
  6. 374 145
      packages/fcl-passrc/src/pasresolver.pp
  7. 317 167
      packages/fcl-passrc/src/pastree.pp
  8. 94 66
      packages/fcl-passrc/src/pasuseanalyzer.pas
  9. 311 147
      packages/fcl-passrc/src/pparser.pp
  10. 33 7
      packages/fcl-passrc/src/pscanner.pp
  11. 3 1
      packages/fcl-passrc/tests/tcclasstype.pas
  12. 1031 39
      packages/fcl-passrc/tests/tcresolver.pas
  13. 1 1
      packages/fcl-passrc/tests/tcscanner.pas
  14. 236 38
      packages/fcl-passrc/tests/tctypeparser.pas
  15. 37 0
      packages/fcl-passrc/tests/tcuseanalyzer.pas
  16. 13 1
      packages/pastojs/fpmake.pp
  17. 373 107
      packages/pastojs/src/fppas2js.pp
  18. 5 0
      packages/pastojs/src/pas2js_defines.inc
  19. 325 570
      packages/pastojs/src/pas2jscompiler.pp
  20. 97 0
      packages/pastojs/src/pas2jscompilercfg.pp
  21. 262 0
      packages/pastojs/src/pas2jscompilerpp.pp
  22. 206 340
      packages/pastojs/src/pas2jsfilecache.pp
  23. 28 20
      packages/pastojs/src/pas2jsfiler.pp
  24. 0 88
      packages/pastojs/src/pas2jsfileutils.pp
  25. 453 0
      packages/pastojs/src/pas2jsfs.pp
  26. 166 0
      packages/pastojs/src/pas2jsfscompiler.pp
  27. 8 4
      packages/pastojs/src/pas2jslibcompiler.pp
  28. 64 8
      packages/pastojs/src/pas2jslogger.pp
  29. 103 79
      packages/pastojs/src/pas2jspcucompiler.pp
  30. 430 0
      packages/pastojs/src/pas2jsutils.pp
  31. 1 0
      packages/pastojs/tests/tcconverter.pp
  32. 146 4
      packages/pastojs/tests/tcfiler.pas
  33. 643 73
      packages/pastojs/tests/tcmodules.pas
  34. 9 9
      packages/pastojs/tests/tcoptimizations.pas
  35. 6 6
      packages/pastojs/tests/tcprecompile.pas
  36. 6 5
      packages/pastojs/tests/tcunitsearch.pas
  37. 7 8
      packages/pastojs/tests/testpas2js.lpi
  38. 67 19
      utils/pas2js/dist/rtl.js
  39. 65 8
      utils/pas2js/docs/translation.html
  40. 6 4
      utils/pas2js/nodepas2js.pp
  41. 25 3
      utils/pas2js/pas2js.lpi
  42. 7 4
      utils/pas2js/pas2js.pp
  43. 97 0
      utils/pas2js/pas2jswebcompiler.pp
  44. 530 0
      utils/pas2js/webfilecache.pp

+ 7 - 0
.gitattributes

@@ -6947,16 +6947,21 @@ packages/pastojs/src/fppas2js.pp svneol=native#text/plain
 packages/pastojs/src/fppjssrcmap.pp svneol=native#text/plain
 packages/pastojs/src/fppjssrcmap.pp svneol=native#text/plain
 packages/pastojs/src/pas2js_defines.inc svneol=native#text/plain
 packages/pastojs/src/pas2js_defines.inc svneol=native#text/plain
 packages/pastojs/src/pas2jscompiler.pp svneol=native#text/plain
 packages/pastojs/src/pas2jscompiler.pp svneol=native#text/plain
+packages/pastojs/src/pas2jscompilercfg.pp svneol=native#text/plain
+packages/pastojs/src/pas2jscompilerpp.pp svneol=native#text/plain
 packages/pastojs/src/pas2jsfilecache.pp svneol=native#text/plain
 packages/pastojs/src/pas2jsfilecache.pp svneol=native#text/plain
 packages/pastojs/src/pas2jsfiler.pp svneol=native#text/plain
 packages/pastojs/src/pas2jsfiler.pp svneol=native#text/plain
 packages/pastojs/src/pas2jsfileutils.pp svneol=native#text/plain
 packages/pastojs/src/pas2jsfileutils.pp svneol=native#text/plain
 packages/pastojs/src/pas2jsfileutilsnodejs.inc svneol=native#text/plain
 packages/pastojs/src/pas2jsfileutilsnodejs.inc svneol=native#text/plain
 packages/pastojs/src/pas2jsfileutilsunix.inc svneol=native#text/plain
 packages/pastojs/src/pas2jsfileutilsunix.inc svneol=native#text/plain
 packages/pastojs/src/pas2jsfileutilswin.inc svneol=native#text/plain
 packages/pastojs/src/pas2jsfileutilswin.inc svneol=native#text/plain
+packages/pastojs/src/pas2jsfs.pp svneol=native#text/plain
+packages/pastojs/src/pas2jsfscompiler.pp svneol=native#text/plain
 packages/pastojs/src/pas2jslibcompiler.pp svneol=native#text/plain
 packages/pastojs/src/pas2jslibcompiler.pp svneol=native#text/plain
 packages/pastojs/src/pas2jslogger.pp svneol=native#text/plain
 packages/pastojs/src/pas2jslogger.pp svneol=native#text/plain
 packages/pastojs/src/pas2jspcucompiler.pp svneol=native#text/plain
 packages/pastojs/src/pas2jspcucompiler.pp svneol=native#text/plain
 packages/pastojs/src/pas2jspparser.pp svneol=native#text/plain
 packages/pastojs/src/pas2jspparser.pp svneol=native#text/plain
+packages/pastojs/src/pas2jsutils.pp svneol=native#text/plain
 packages/pastojs/tests/tcconverter.pp svneol=native#text/plain
 packages/pastojs/tests/tcconverter.pp svneol=native#text/plain
 packages/pastojs/tests/tcfiler.pas svneol=native#text/plain
 packages/pastojs/tests/tcfiler.pas svneol=native#text/plain
 packages/pastojs/tests/tcmodules.pas svneol=native#text/plain
 packages/pastojs/tests/tcmodules.pas svneol=native#text/plain
@@ -17346,6 +17351,7 @@ utils/pas2js/pas2js.lpi svneol=native#text/plain
 utils/pas2js/pas2js.pp svneol=native#text/plain
 utils/pas2js/pas2js.pp svneol=native#text/plain
 utils/pas2js/pas2jslib.lpi svneol=native#text/plain
 utils/pas2js/pas2jslib.lpi svneol=native#text/plain
 utils/pas2js/pas2jslib.pp svneol=native#text/plain
 utils/pas2js/pas2jslib.pp svneol=native#text/plain
+utils/pas2js/pas2jswebcompiler.pp svneol=native#text/plain
 utils/pas2js/samples/arraydemo.pp svneol=native#text/plain
 utils/pas2js/samples/arraydemo.pp svneol=native#text/plain
 utils/pas2js/samples/fordemo.pp svneol=native#text/plain
 utils/pas2js/samples/fordemo.pp svneol=native#text/plain
 utils/pas2js/samples/fordowndemo.pp svneol=native#text/plain
 utils/pas2js/samples/fordowndemo.pp svneol=native#text/plain
@@ -17353,6 +17359,7 @@ utils/pas2js/samples/hello.pas svneol=native#text/plain
 utils/pas2js/samples/ifdemo.pp svneol=native#text/plain
 utils/pas2js/samples/ifdemo.pp svneol=native#text/plain
 utils/pas2js/samples/repeatdemo.pp svneol=native#text/plain
 utils/pas2js/samples/repeatdemo.pp svneol=native#text/plain
 utils/pas2js/samples/whiledemo.pp svneol=native#text/plain
 utils/pas2js/samples/whiledemo.pp svneol=native#text/plain
+utils/pas2js/webfilecache.pp svneol=native#text/plain
 utils/pas2js/webidl2pas.lpi svneol=native#text/plain
 utils/pas2js/webidl2pas.lpi svneol=native#text/plain
 utils/pas2js/webidl2pas.pp svneol=native#text/plain
 utils/pas2js/webidl2pas.pp svneol=native#text/plain
 utils/pas2ut/Makefile svneol=native#text/plain
 utils/pas2ut/Makefile svneol=native#text/plain

+ 238 - 52
packages/fcl-db/tests/testjsondataset.pp

@@ -1,80 +1,106 @@
-program testjsondataset;
+program devds;
 
 
 {$DEFINE TESTCALCFIELDS}
 {$DEFINE TESTCALCFIELDS}
+{$DEFINE TESTLOOKUPFIELDS}
 
 
-uses sysutils, db, jsonparser, fpjson,fpjsondataset, extjsdataset;
+uses variants, varutils, sysutils, db, fpjson , fpjsondataset, ExtJSDataset, types;
 
 
 Type
 Type
 
 
   { TApp }
   { TApp }
 
 
   TApp = Class(TObject)
   TApp = Class(TObject)
-    Procedure DumpRecord(DS : TDataset);
-    Procedure DumpRecords(DS : TDataset);
-    Procedure Run;
   private
   private
+    DS : TExtJSJSONObjectDataSet;
+    DC : TExtJSJSONObjectDataSet;
+    Procedure DumpRecord(aDS : TDataset);
+    Procedure DumpRecords(aDS : TDataset);
+    procedure CreateDataset;
     procedure DoCalcFields(DataSet: TDataSet);
     procedure DoCalcFields(DataSet: TDataSet);
+    procedure TestAppend;
+    procedure TestBookMark;
+    procedure TestDataLinkActiveRecord;
+    procedure TestDataLinkEdit;
+    procedure TestEdit;
+    procedure TestInsert;
+    procedure TestLocate;
+    procedure TestLookup;
+    procedure TestNavigation;
+  Public
+    Procedure Run;
   end;
   end;
 
 
-Procedure TApp.DumpRecord(DS : TDataset);
-
-//Var
-//  F : TField;
+Procedure TApp.DumpRecord(aDS : TDataset);
 
 
 begin
 begin
-//  For F in  DS.Fields do
-//    Write(F.Name,' : ',F.IsNull,' ');
-//  WriteLn;
   Writeln(
   Writeln(
   {$IFDEF TESTCALCFIELDS}
   {$IFDEF TESTCALCFIELDS}
-          'Full name: ',DS.FieldByName('fullname').AsString,
+          'Full name: ',aDS.FieldByName('fullname').AsString,
+  {$ENDIF}
+          'First name: ',aDS.FieldByName('firstname').AsString,
+          ', Last name:', aDS.FieldByName('lastname').AsString,
+          ', Children:', aDS.FieldByName('children').AsInteger,
+          ', Birthday:', aDS.FieldByName('birthday').AsString,
+          ', Weight:', aDS.FieldByName('weight').AsFloat,
+          ', Business:', aDS.FieldByName('business').AsBoolean,
+          ', Country:', aDS.FieldByName('Country').AsString
+  {$IFDEF TESTLOOKUPFIELDS}
+          ,', CountryName:', aDS.FieldByName('CountryName').AsString
   {$ENDIF}
   {$ENDIF}
-          'First name: ',DS.FieldByName('firstname').AsString,
-          ', Last name: ', DS.FieldByName('lastname').AsString,
-          ', Children: ', DS.FieldByName('children').AsInteger,
-          ', Birthday: ', DS.FieldByName('birthday').AsString
   );
   );
 end;
 end;
 
 
-Procedure TApp.DumpRecords(DS : TDataset);
+Procedure TApp.DumpRecords(aDS : TDataset);
 
 
 begin
 begin
-  While not DS.EOF do
+  While not aDS.EOF do
     begin
     begin
-    Write(DS.RecNo,': ');
-    DumpRecord(DS);
-    DS.Next;
+    DumpRecord(aDS);
+    aDS.Next;
     end;
     end;
 end;
 end;
 
 
 
 
-Procedure TApp.Run;
+Procedure TApp.CreateDataset;
 
 
-Var
-  DS : TExtJSJSONObjectDataSet;
-  B : TBookmark;
-  t: TDataLink;
-  DSS : TDatasource;
 {$IFDEF TESTCALCFIELDS}
 {$IFDEF TESTCALCFIELDS}
+Var
   F : TField;
   F : TField;
 {$ENDIF}
 {$ENDIF}
 
 
 begin
 begin
-
+  Writeln('Creating dataset');
   DS:=TExtJSJSONObjectDataSet.Create(Nil);
   DS:=TExtJSJSONObjectDataSet.Create(Nil);
-  DS.MetaData:=GetJSON(' { "fields" : [ {"name": "firstname", "maxLen" : 100}, {"name": "lastname","maxLen" : 100}, '+
-                       ' { "name" : "children", "type": "int" }, '+
-                       ' { "name" : "birthday", "type": "date", "dateFormat": "yyyy\"-\"mm\"-\"dd" } ]}') as TJSONObject;
-  DS.Rows:=GetJSON('[{"firstname" : "Michael", "lastname" : "Van Canneyt", "children" : 2, "birthday": "1970-07-07" },'+
-                                  '  {"firstname" : "Mattias", "lastname" : "Gaertner", "children" : 0, "birthday" : "1970-07-08" }, '+
-                                  '  {"firstname" : "Bruno", "lastname" : "Fierens", "children" : 3, "birthday" : "1970-07-09" },'+
-                                  '  {"firstname" : "Detlef", "lastname" : "Overbeek", "children" : 2, "birthday" : "1950-07-08" }'+
-                                  ' ]') as TJSONarray;
+  DS.MetaData:=GetJSON('{ "fields" : [ '+
+                                          ' { "name": "firstname"}, '+
+                                          ' { "name": "lastname"}, '+
+                                          ' { "name" : "children", "type": "int" }, '+
+                                          ' { "name" : "birthday", "type": "date", "dateFormat": "yyyy\"-\"mm\"-\"dd" }, '+
+                                          ' { "name" : "country",  "type": "string", "maxLen" : 2 }, '+
+                                          ' { "name" : "business", "type": "boolean" }, '+
+                                          ' { "name" : "weight",   "type": "float" } '+
+                                       ']}') as TJSONObject;
+  DS.Rows:=GetJSON('[{"firstname" : "Michael", "lastname" : "Van Canneyt", "children" : 2, "birthday": "1970-07-07", "business" : false, "weight": 75.5, "country": "BE" },'+
+                                  '  {"firstname" : "Mattias", "lastname" : "Gaertner", "children" : 0, "birthday" : "1970-07-08", "business" : false, "weight": 76.2, "country": "DE"   }, '+
+                                  '  {"firstname" : "Bruno", "lastname" : "Fierens", "children" : 3, "birthday" : "1970-07-09", "business" : true, "weight": 77.3, "country": "BE"  },'+
+                                  '  {"firstname" : "Detlef", "lastname" : "Overbeek", "children" : 2, "birthday" : "1950-07-08", "business" : true, "weight": 78.8, "country": "NL"  }'+
+                                  ' ]') as TJSONArray;
+  DC:=TExtJSJSONObjectDataSet.Create(Nil);
+  DC.MetaData:=GetJSON('{ "fields" : [ '+
+                                       ' { "name": "code"}, '+
+                                       ' { "name": "name"} '+
+                                       ']} ') as TJSONObject;
+  DC.Rows:=GetJSON('[{"code" : "BE", "name" : "Belgium" }, '+
+                                 '  {"code" : "DE", "name" : "Germany" }, '+
+                                 '  {"code" : "NL", "name" : "Netherlands" }, '+
+                                 '  {"code" : "FR", "name" : "France" }, '+
+                                 '  {"code" : "UK", "name" : "United Kingdom" } '+
+                                 ' ]') as TJSONArray;
 {$IFDEF TESTCALCFIELDS}
 {$IFDEF TESTCALCFIELDS}
   F:=TStringField.Create(DS);
   F:=TStringField.Create(DS);
   F.FieldKind:=fkCalculated;
   F.FieldKind:=fkCalculated;
   F.Size:=200;
   F.Size:=200;
-  F.FieldName:='fullname';
+  F.FieldName:='FullName';
   F.Dataset:=DS;
   F.Dataset:=DS;
   F:=TStringField.Create(DS);
   F:=TStringField.Create(DS);
   F.FieldKind:=fkData;
   F.FieldKind:=fkData;
@@ -90,15 +116,40 @@ begin
   F.FieldKind:=fkData;
   F.FieldKind:=fkData;
   F.FieldName:='children';
   F.FieldName:='children';
   F.Dataset:=DS;
   F.Dataset:=DS;
-  F:=TJSONDateField.Create(DS);
-  TJSONDateField(F).DateFormat:='yyyy"-"mm"-"dd';
+  F:=TDateField.Create(DS);
   F.FieldKind:=fkData;
   F.FieldKind:=fkData;
   F.FieldName:='birthday';
   F.FieldName:='birthday';
-
   F.Dataset:=DS;
   F.Dataset:=DS;
+  F:=TBooleanField.Create(DS);
+  F.FieldKind:=fkData;
+  F.FieldName:='business';
+  F.Dataset:=DS;
+  F:=TFloatField.Create(DS);
+  F.FieldKind:=fkData;
+  F.FieldName:='weight';
+  F.Dataset:=DS;
+  F:=TStringField.Create(DS);
+  F.FieldKind:=fkData;
+  F.Size:=2;
+  F.FieldName:='country';
+  F.Dataset:=DS;
+  {$IFDEF TESTLOOKUPFIELDS}
+  F:=TStringField.Create(DS);
+  F.FieldKind:=fkLookup;
+  F.LookupDataSet:=DC;
+  F.KeyFields:='country';
+  F.LookupKeyFields:='code';
+  F.LookupResultField:='name';
+  F.FieldName:='CountryName';
+  F.Dataset:=DS;
+  {$ENDIF}
   DS.OnCalcFields:=@DoCalcFields;
   DS.OnCalcFields:=@DoCalcFields;
 {$ENDIF}
 {$ENDIF}
-  DS.Open;
+end;
+
+Procedure TApp.TestNavigation;
+
+begin
   Writeln('All records');
   Writeln('All records');
   DumpRecords(DS);
   DumpRecords(DS);
   Writeln('First record (expect Michael.)');
   Writeln('First record (expect Michael.)');
@@ -113,16 +164,17 @@ begin
     DumpRecord(DS);
     DumpRecord(DS);
     DS.Prior;
     DS.Prior;
     end;
     end;
+end;
+
+Procedure TApp.TestAppend;
+
+begin
   DS.Append;
   DS.Append;
   Writeln('Dumping record after APPEND (expect empty)');
   Writeln('Dumping record after APPEND (expect empty)');
-  Writeln('Modified before dump (expect False): ',DS.Modified);
+  Writeln('Modified before  (expect False): ',DS.Modified);
   DumpRecord(DS);
   DumpRecord(DS);
   DS.FieldByName('firstname').AsString:='Florian';
   DS.FieldByName('firstname').AsString:='Florian';
-  Write('Old value of field first name (expect null): ');
-  if DS.FieldByName('firstname').OldValue=Null then
-    Writeln('Null')
-  else
-    Writeln(DS.FieldByName('firstname').OldValue);
+  Writeln('Old value of field first name (expect null): ', DS.FieldByName('firstname').OldValue);
   DS.FieldByName('lastname').AsString:='Klaempfl';
   DS.FieldByName('lastname').AsString:='Klaempfl';
   DS.FieldByName('children').AsInteger:=1;
   DS.FieldByName('children').AsInteger:=1;
   DS.FieldByName('birthday').AsDateTime:=EncodeDate(1980,5,4);
   DS.FieldByName('birthday').AsDateTime:=EncodeDate(1980,5,4);
@@ -135,6 +187,11 @@ begin
   Writeln('Jump to first (expect Michael)');
   Writeln('Jump to first (expect Michael)');
   DS.First;
   DS.First;
   DumpRecord(DS);
   DumpRecord(DS);
+end;
+
+Procedure TApp.TestEdit;
+
+begin
   DS.Edit;
   DS.Edit;
   Writeln('Dumping record after EDIT');
   Writeln('Dumping record after EDIT');
   Writeln('Modified before  (expect False): ',DS.Modified);
   Writeln('Modified before  (expect False): ',DS.Modified);
@@ -167,6 +224,14 @@ begin
   Writeln('Jump to first and dumping all records (expect Dolores first)');
   Writeln('Jump to first and dumping all records (expect Dolores first)');
   DS.First;
   DS.First;
   DumpRecords(DS);
   DumpRecords(DS);
+end;
+
+Procedure TApp.TestBookMark;
+
+var
+  B : TBookmark;
+
+begin
   Writeln('Jump to first  (expect Dolores)');
   Writeln('Jump to first  (expect Dolores)');
   DS.First;
   DS.First;
   DumpRecord(DS);
   DumpRecord(DS);
@@ -181,9 +246,13 @@ begin
   DS.Delete;
   DS.Delete;
   DumpRecord(DS);
   DumpRecord(DS);
   Writeln('Setting Bookmark (expect Detlef)');
   Writeln('Setting Bookmark (expect Detlef)');
-  Writeln('BM value: ',PNativeInt(B)^);
   DS.BookMark:=B;
   DS.BookMark:=B;
   DumpRecord(DS);
   DumpRecord(DS);
+end;
+
+Procedure TApp.TestInsert;
+
+begin
   Writeln('Jump to second (expect Bruno)');
   Writeln('Jump to second (expect Bruno)');
   DS.First;
   DS.First;
   DS.Next;
   DS.Next;
@@ -205,12 +274,22 @@ begin
   Writeln('Jump to first and dumping all records (expect Mattias first, then Felicity)');
   Writeln('Jump to first and dumping all records (expect Mattias first, then Felicity)');
   DS.First;
   DS.First;
   DumpRecords(DS);
   DumpRecords(DS);
+end;
+
+Procedure TApp.TestDataLinkEdit;
+
+var
+  t: TDataLink;
+  DSS : TDatasource;
+
+begin
   Writeln('Jump to first before edit');
   Writeln('Jump to first before edit');
   DS.First;
   DS.First;
-  DSS:=TDatasource.Create(Nil);
-  DSS.DataSet:=DS;
+  DSS:=Nil;
   t:=TDataLink.Create;
   t:=TDataLink.Create;
   try
   try
+    DSS:=TDatasource.Create(Nil);
+    DSS.DataSet:=DS;
     Writeln('Buffercount');
     Writeln('Buffercount');
     t.BufferCount := 10;
     t.BufferCount := 10;
     t.DataSource := DSS;
     t.DataSource := DSS;
@@ -230,9 +309,22 @@ begin
     t.ActiveRecord := 0;
     t.ActiveRecord := 0;
   Finally
   Finally
     t.Free;
     t.Free;
+    dss.free;
   end;
   end;
+end;
+
+Procedure TApp.TestDataLinkActiveRecord;
+
+var
+  t: TDataLink;
+  DSS : TDatasource;
+
+begin
+  DSS:=Nil;
   t:=TDataLink.Create;
   t:=TDataLink.Create;
   try
   try
+    DSS.DataSet:=DS;
+    DSS.DataSet:=DS;
     t.DataSource := DSS;
     t.DataSource := DSS;
     DS.Last;
     DS.Last;
     Writeln('Last record :',DS.RecNo);
     Writeln('Last record :',DS.RecNo);
@@ -247,13 +339,107 @@ begin
     t.ActiveRecord := 0;
     t.ActiveRecord := 0;
   Finally
   Finally
     t.Free;
     t.Free;
+    dss.Free;
   end;
   end;
+end;
+
+Procedure TApp.TestLocate;
+
+Var
+  V : Variant;
 
 
+begin
+  DS.First;
+  Writeln('Locating 3 children (expect true, Bruno): ',DS.Locate('Children',3,[]));
+  DumpRecord(DS);
+  DS.First;
+  v:=VarArrayCreate([0,0],varVariant);
+  V[0]:=3;
+  Writeln('Locating 3 children using array (expect true, Bruno): ',DS.Locate('Children',V,[]));
+  DumpRecord(DS);
+  DS.First;
+  Writeln('Locating 4 children (expect false): ',DS.Locate('Children',4,[]));
+  DS.First;
+  Writeln('Locating first name Detlef (expect true): ',DS.Locate('Firstname','Detlef',[]));
+  DumpRecord(DS);
+  DS.First;
+  Writeln('Locating first name detlef (expect false): ',DS.Locate('Firstname','detlef',[]));
+  DS.First;
+  Writeln('Locating first name detlef (loCaseInsensitive, expect true): ',DS.Locate('Firstname','detlef',[loCaseInsensitive]));
+  DumpRecord(DS);
+  DS.First;
+  Writeln('Locating first name Det (expect false): ',DS.Locate('Firstname','Det',[]));
+  DS.First;
+  Writeln('Locating first name Det (loPartialKey,expect true): ',DS.Locate('Firstname','Det',[loPartialKey]));
+  DumpRecord(DS);
+  DS.First;
+  Writeln('Locating first name det (loPartialKey, expect false): ',DS.Locate('Firstname','det',[loPartialKey]));
+  DS.First;
+  Writeln('Locating first name det (loCaseInsensitive,loPartialKey, expect true): ',DS.Locate('Firstname','det',[loCaseInsensitive,loPartialKey]));
+  DumpRecord(DS);
+  v:=VarArrayCreate([0,1],varVariant);
+  V[0]:=3;
+  V[1]:='Detlef';
+  DS.First;
+  Writeln('Locating first name Detlef & children 3  ( expect false): ',DS.Locate('Children;Firstname',v,[]));
+  V[0]:=2;
+  V[1]:='Detlef';
+  DS.First;
+  Writeln('Locating first name Detlef & children 2 ( expect true): ',DS.Locate('Children;Firstname',v,[]));
+  DS.First;
+  Writeln('Locating birthday  (expect true, Bruno): ',DS.Locate('BirthDay',EncodeDate(1970,07,09),[]));
+  DS.First;
+  Writeln('Locating business  (expect true, Bruno): ',DS.Locate('business',true,[]));
+  DumpRecord(DS);
+  DS.First;
+  Writeln('Deleting first');
+  DS.Delete;
+  Writeln('Locating weight  (expect true, bruno): ',DS.Locate('weight',77.3,[]));
+  DumpRecord(DS);
+
+end;
+
+procedure TApp.TestLookup;
+begin
+  DS.First;
+  Writeln('Locating weight  (expect true, detlef overbeek): ',DS.Lookup('weight',78.8,'fullname'));
+  Writeln('Still on Michael:');
+  DumpRecord(DS);
+  DS.First;
+  Writeln('Locating birthday  (expect true, Bruno): ',DS.Lookup('BirthDay',EncodeDate(1970,07,09),'firstname'));
+  Writeln('Still on Michael:');
+  DumpRecord(DS);
+end;
+
+Procedure TApp.Run;
+
+
+begin
+  try
+    CreateDataset;
+    Writeln('Opening dataset');
+
+    DC.Open;
+    DS.Open;
+//    TestLocate;
+    TestLookup;
+    exit;
+    TestNavigation;
+    TestAppend;
+    TestEdit;
+    TestBookmark;
+    TestInsert;
+    TestDataLinkEdit;
+    TestDataLinkActiveRecord;
+  except
+    On E : Exception do
+      Writeln('!! Caught Exception ',E.ClassName,' : ',E.Message);
+  end;
 end;
 end;
 
 
 procedure TApp.DoCalcFields(DataSet: TDataSet);
 procedure TApp.DoCalcFields(DataSet: TDataSet);
 begin
 begin
-  Writeln('In calcfields callback');
+//  Writeln('In callback');
   Dataset.FieldByName('FullName').AsString:= Dataset.FieldByName('firstName').AsString+' '+Dataset.FieldByName('lastname').AsString;
   Dataset.FieldByName('FullName').AsString:= Dataset.FieldByName('firstName').AsString+' '+Dataset.FieldByName('lastname').AsString;
 end;
 end;
 
 

+ 2 - 2
packages/fcl-js/src/jsbase.pp

@@ -26,8 +26,8 @@ uses
   Classes, SysUtils;
   Classes, SysUtils;
 
 
 const
 const
-  MinSafeIntDouble = -$10000000000000; // -4503599627370496
-  MaxSafeIntDouble =   $fffffffffffff; //  4503599627370495
+  MinSafeIntDouble = -$fffffffffffff-1; // -4503599627370496
+  MaxSafeIntDouble =  $fffffffffffff; //  4503599627370495
 Type
 Type
   TJSType = (jstUNDEFINED,jstNull,jstBoolean,jstNumber,jstString,jstObject,jstReference,jstCompletion);
   TJSType = (jstUNDEFINED,jstNull,jstBoolean,jstNumber,jstString,jstObject,jstReference,jstCompletion);
 
 

+ 2 - 0
packages/fcl-js/src/jswriter.pp

@@ -470,6 +470,7 @@ Var
   S : String;
   S : String;
 
 
 begin
 begin
+  //system.writeln('TJSWriter.Write unicodestring=',U);
   WriteIndent;
   WriteIndent;
   if UseUTF8 then
   if UseUTF8 then
     begin
     begin
@@ -488,6 +489,7 @@ end;
 
 
 procedure TJSWriter.Write(const S: TJSWriterString);
 procedure TJSWriter.Write(const S: TJSWriterString);
 begin
 begin
+  //system.writeln('TJSWriter.Write TJSWriterString=',S);
   {$ifdef FPC_HAS_CPSTRING}
   {$ifdef FPC_HAS_CPSTRING}
   if Not (woUseUTF8 in Options) then
   if Not (woUseUTF8 in Options) then
     Write(UnicodeString(S))
     Write(UnicodeString(S))

+ 89 - 66
packages/fcl-passrc/src/pasresolveeval.pas

@@ -134,10 +134,10 @@ const
   nFoundCallCandidateX = 3057;
   nFoundCallCandidateX = 3057;
   nTextAfterFinalIgnored = 3058;
   nTextAfterFinalIgnored = 3058;
   nNoMemberIsProvidedToAccessProperty = 3059;
   nNoMemberIsProvidedToAccessProperty = 3059;
-  // free 3060
-  // free 3061
-  // free 3062
-  // free 3063
+  nTheUseOfXisNotAllowedInARecord = 3060;
+  nParameterlessConstructorsNotAllowedInRecords = 3061;
+  nMultipleXinTypeYNameZCAandB = 3062;
+  nXCannotHaveParameters = 3063;
   nRangeCheckError = 3064;
   nRangeCheckError = 3064;
   nHighRangeLimitLTLowRangeLimit = 3065;
   nHighRangeLimitLTLowRangeLimit = 3065;
   nRangeCheckEvaluatingConstantsVMinMax = 3066;
   nRangeCheckEvaluatingConstantsVMinMax = 3066;
@@ -154,14 +154,14 @@ const
   nMethodHidesMethodOfBaseType = 3077;
   nMethodHidesMethodOfBaseType = 3077;
   nContextExpectedXButFoundY = 3078;
   nContextExpectedXButFoundY = 3078;
   nContextXInvalidY = 3079;
   nContextXInvalidY = 3079;
-  // free 3080;
+  nIdentifierXIsNotAnInstanceField = 3080;
   nXIsNotSupported = 3081;
   nXIsNotSupported = 3081;
   nOperatorIsNotOverloadedAOpB = 3082;
   nOperatorIsNotOverloadedAOpB = 3082;
   nIllegalQualifierAfter = 3084;
   nIllegalQualifierAfter = 3084;
   nIllegalQualifierInFrontOf = 3085;
   nIllegalQualifierInFrontOf = 3085;
   nIllegalQualifierWithin = 3086;
   nIllegalQualifierWithin = 3086;
   nMethodClassXInOtherUnitY = 3087;
   nMethodClassXInOtherUnitY = 3087;
-  // free 3088
+  nClassMethodsMustBeStaticInRecords = 3088;
   nCannotMixMethodResolutionAndDelegationAtX = 3089;
   nCannotMixMethodResolutionAndDelegationAtX = 3089;
   nImplementsDoesNotSupportArrayProperty = 3101;
   nImplementsDoesNotSupportArrayProperty = 3101;
   nImplementsDoesNotSupportIndex = 3102;
   nImplementsDoesNotSupportIndex = 3102;
@@ -251,6 +251,10 @@ resourcestring
   sFoundCallCandidateX = 'Found call candidate %s';
   sFoundCallCandidateX = 'Found call candidate %s';
   sTextAfterFinalIgnored = 'Text after final ''end.''. ignored by compiler';
   sTextAfterFinalIgnored = 'Text after final ''end.''. ignored by compiler';
   sNoMemberIsProvidedToAccessProperty = 'No member is provided to access property';
   sNoMemberIsProvidedToAccessProperty = 'No member is provided to access property';
+  sTheUseOfXisNotAllowedInARecord = 'The use of "%s" is not allowed in a record';
+  sParameterlessConstructorsNotAllowedInRecords = 'Parameterless constructors are not allowed in records or record/type helpers';
+  sMultipleXinTypeYNameZCAandB = 'Multiple %s in %s %s: %s and %s';
+  sXCannotHaveParameters = '%s cannot have parameters';
   sSymbolXIsNotPortable = 'Symbol "%s" is not portable';
   sSymbolXIsNotPortable = 'Symbol "%s" is not portable';
   sSymbolXIsExperimental = 'Symbol "%s" is experimental';
   sSymbolXIsExperimental = 'Symbol "%s" is experimental';
   sSymbolXIsNotImplemented = 'Symbol "%s" is not implemented';
   sSymbolXIsNotImplemented = 'Symbol "%s" is not implemented';
@@ -273,6 +277,7 @@ resourcestring
   sMethodHidesMethodOfBaseType = 'Method "%s" hides method of base type "%s" at %s';
   sMethodHidesMethodOfBaseType = 'Method "%s" hides method of base type "%s" at %s';
   sContextExpectedXButFoundY = '%s: expected "%s", but found "%s"';
   sContextExpectedXButFoundY = '%s: expected "%s", but found "%s"';
   sContextXInvalidY = '%s: invalid %s';
   sContextXInvalidY = '%s: invalid %s';
+  sIdentifierXIsNotAnInstanceField = 'Identifier "%s" is not an instance field';
   sConstructingClassXWithAbstractMethodY = 'Constructing a class "%s" with abstract method "%s"';
   sConstructingClassXWithAbstractMethodY = 'Constructing a class "%s" with abstract method "%s"';
   sXIsNotSupported = '%s is not supported';
   sXIsNotSupported = '%s is not supported';
   sOperatorIsNotOverloadedAOpB = 'Operator is not overloaded: "%s" %s "%s"';
   sOperatorIsNotOverloadedAOpB = 'Operator is not overloaded: "%s" %s "%s"';
@@ -281,6 +286,7 @@ resourcestring
   sIllegalQualifierWithin = 'illegal qualifier "%s" within "%s"';
   sIllegalQualifierWithin = 'illegal qualifier "%s" within "%s"';
   sMethodClassXInOtherUnitY = 'method class "%s" in other unit "%s"';
   sMethodClassXInOtherUnitY = 'method class "%s" in other unit "%s"';
   sNoMatchingImplForIntfMethodXFound = 'No matching implementation for interface method "%s" found';
   sNoMatchingImplForIntfMethodXFound = 'No matching implementation for interface method "%s" found';
+  sClassMethodsMustBeStaticInRecords = 'Class methods must be static in records';
   sCannotMixMethodResolutionAndDelegationAtX = 'Cannot mix method resolution and delegation at %s';
   sCannotMixMethodResolutionAndDelegationAtX = 'Cannot mix method resolution and delegation at %s';
   sImplementsDoesNotSupportArrayProperty = '"implements" does dot support array property';
   sImplementsDoesNotSupportArrayProperty = '"implements" does dot support array property';
   sImplementsDoesNotSupportIndex = '"implements" does not support "index"';
   sImplementsDoesNotSupportIndex = '"implements" does not support "index"';
@@ -340,8 +346,8 @@ const
   MinSafeIntSingle = -16777216;
   MinSafeIntSingle = -16777216;
   MaxSafeIntSingle =  16777216;
   MaxSafeIntSingle =  16777216;
   MaskUIntSingle = $3fffff;
   MaskUIntSingle = $3fffff;
-  MinSafeIntDouble = -$10000000000000; // -4503599627370496
-  MaxSafeIntDouble =   $fffffffffffff; //  4503599627370495
+  MinSafeIntDouble = -$fffffffffffff-1; // -4503599627370496
+  MaxSafeIntDouble =  $fffffffffffff; //  4503599627370495
   MaskUIntDouble = $fffffffffffff;
   MaskUIntDouble = $fffffffffffff;
 
 
 type
 type
@@ -697,6 +703,8 @@ type
     procedure PredValue(Value: TResEvalValue; ErrorEl: TPasElement); virtual;
     procedure PredValue(Value: TResEvalValue; ErrorEl: TPasElement); virtual;
     procedure SuccValue(Value: TResEvalValue; ErrorEl: TPasElement); virtual;
     procedure SuccValue(Value: TResEvalValue; ErrorEl: TPasElement); virtual;
     function EvalStrFunc(Params: TParamsExpr; Flags: TResEvalFlags): TResEvalValue; virtual;
     function EvalStrFunc(Params: TParamsExpr; Flags: TResEvalFlags): TResEvalValue; virtual;
+    function EvalStringAddExpr(Expr, LeftExpr, RightExpr: TPasExpr;
+      LeftValue, RightValue: TResEvalValue): TResEvalValue; virtual;
     function EnumTypeCast(EnumType: TPasEnumType; Expr: TPasExpr;
     function EnumTypeCast(EnumType: TPasEnumType; Expr: TPasExpr;
       Flags: TResEvalFlags): TResEvalEnum; virtual;
       Flags: TResEvalFlags): TResEvalEnum; virtual;
     {$ifdef FPC_HAS_CPSTRING}
     {$ifdef FPC_HAS_CPSTRING}
@@ -1249,7 +1257,7 @@ begin
           reitLongWord: TResEvalInt(Result).Int:=not longword(TResEvalInt(Result).Int);
           reitLongWord: TResEvalInt(Result).Int:=not longword(TResEvalInt(Result).Int);
           reitLongInt: TResEvalInt(Result).Int:=not longint(TResEvalInt(Result).Int);
           reitLongInt: TResEvalInt(Result).Int:=not longint(TResEvalInt(Result).Int);
           reitUIntDouble: TResEvalInt(Result).Int:=(not TResEvalInt(Result).Int) and $fffffffffffff;
           reitUIntDouble: TResEvalInt(Result).Int:=(not TResEvalInt(Result).Int) and $fffffffffffff;
-          reitIntDouble: TResEvalInt(Result).Int:=(not TResEvalInt(Result).Int) and $1fffffffffffff;
+          reitIntDouble: {$ifdef fpc}TResEvalInt(Result).Int:=(not TResEvalInt(Result).Int) and $1fffffffffffff{$endif};
           else TResEvalInt(Result).Int:=not TResEvalInt(Result).Int;
           else TResEvalInt(Result).Int:=not TResEvalInt(Result).Int;
         end;
         end;
         end;
         end;
@@ -1534,9 +1542,6 @@ var
   UInt: TMaxPrecUInt;
   UInt: TMaxPrecUInt;
   Flo: TMaxPrecFloat;
   Flo: TMaxPrecFloat;
   aCurrency: TMaxPrecCurrency;
   aCurrency: TMaxPrecCurrency;
-  {$ifdef FPC_HAS_CPSTRING}
-  LeftCP, RightCP: TSystemCodePage;
-  {$endif}
   LeftSet, RightSet: TResEvalSet;
   LeftSet, RightSet: TResEvalSet;
   i: Integer;
   i: Integer;
 begin
 begin
@@ -1634,58 +1639,10 @@ begin
       end;
       end;
       end;
       end;
     {$ifdef FPC_HAS_CPSTRING}
     {$ifdef FPC_HAS_CPSTRING}
-    revkString:
-      case RightValue.Kind of
-      revkString:
-        begin
-        LeftCP:=GetCodePage(TResEvalString(LeftValue).S);
-        RightCP:=GetCodePage(TResEvalString(RightValue).S);
-        if (LeftCP=RightCP) then
-          begin
-          Result:=TResEvalString.Create;
-          TResEvalString(Result).S:=TResEvalString(LeftValue).S+TResEvalString(RightValue).S;
-          end
-        else
-          begin
-          Result:=TResEvalUTF16.Create;
-          TResEvalUTF16(Result).S:=GetUnicodeStr(TResEvalString(LeftValue).S,Expr.left)
-                                  +GetUnicodeStr(TResEvalString(RightValue).S,Expr.right);
-          end;
-        end;
-      revkUnicodeString:
-        begin
-        Result:=TResEvalUTF16.Create;
-        TResEvalUTF16(Result).S:=GetUnicodeStr(TResEvalString(LeftValue).S,Expr.left)
-                                +TResEvalUTF16(RightValue).S;
-        end;
-      else
-        {$IFDEF VerbosePasResolver}
-        writeln('TResExprEvaluator.EvalBinaryAddExpr string+? Left=',LeftValue.AsDebugString,' Right=',RightValue.AsDebugString);
-        {$ENDIF}
-        RaiseNotYetImplemented(20170601141834,Expr);
-      end;
+    revkString,
     {$endif}
     {$endif}
     revkUnicodeString:
     revkUnicodeString:
-      case RightValue.Kind of
-      {$ifdef FPC_HAS_CPSTRING}
-      revkString:
-        begin
-        Result:=TResEvalUTF16.Create;
-        TResEvalUTF16(Result).S:=TResEvalUTF16(LeftValue).S
-                                +GetUnicodeStr(TResEvalString(RightValue).S,Expr.right);
-        end;
-      {$endif}
-      revkUnicodeString:
-        begin
-        Result:=TResEvalUTF16.Create;
-        TResEvalUTF16(Result).S:=TResEvalUTF16(LeftValue).S+TResEvalUTF16(RightValue).S;
-        end;
-      else
-        {$IFDEF VerbosePasResolver}
-        writeln('TResExprEvaluator.EvalBinaryAddExpr utf16+? Left=',LeftValue.AsDebugString,' Right=',RightValue.AsDebugString);
-        {$ENDIF}
-        RaiseNotYetImplemented(20170601141811,Expr);
-      end;
+      Result:=EvalStringAddExpr(Expr,Expr.left,Expr.right,LeftValue,RightValue);
     revkSetOfInt:
     revkSetOfInt:
       case RightValue.Kind of
       case RightValue.Kind of
       revkSetOfInt:
       revkSetOfInt:
@@ -4081,9 +4038,9 @@ begin
           begin
           begin
           c:=S[p];
           c:=S[p];
           case c of
           case c of
-          '0'..'9': u:=u*16+ord(c)-ord('0');
-          'a'..'f': u:=u*16+ord(c)-ord('a')+10;
-          'A'..'F': u:=u*16+ord(c)-ord('A')+10;
+          '0'..'9': u:=u*16+longword(ord(c)-ord('0'));
+          'a'..'f': u:=u*16+longword(ord(c)-ord('a'))+10;
+          'A'..'F': u:=u*16+longword(ord(c)-ord('A'))+10;
           else break;
           else break;
           end;
           end;
           if u>$10FFFF then
           if u>$10FFFF then
@@ -4111,7 +4068,7 @@ begin
           begin
           begin
           c:=S[p];
           c:=S[p];
           case c of
           case c of
-          '0'..'9': u:=u*10+ord(c)-ord('0');
+          '0'..'9': u:=u*10+longword(ord(c)-ord('0'));
           else break;
           else break;
           end;
           end;
           if u>$ffff then
           if u>$ffff then
@@ -4792,6 +4749,72 @@ begin
     {$endif}
     {$endif}
 end;
 end;
 
 
+function TResExprEvaluator.EvalStringAddExpr(Expr, LeftExpr,
+  RightExpr: TPasExpr; LeftValue, RightValue: TResEvalValue): TResEvalValue;
+{$ifdef FPC_HAS_CPSTRING}
+var
+  LeftCP, RightCP: TSystemCodePage;
+{$endif}
+begin
+  case LeftValue.Kind of
+  {$ifdef FPC_HAS_CPSTRING}
+  revkString:
+    case RightValue.Kind of
+    revkString:
+      begin
+      LeftCP:=GetCodePage(TResEvalString(LeftValue).S);
+      RightCP:=GetCodePage(TResEvalString(RightValue).S);
+      if (LeftCP=RightCP) then
+        begin
+        Result:=TResEvalString.Create;
+        TResEvalString(Result).S:=TResEvalString(LeftValue).S+TResEvalString(RightValue).S;
+        end
+      else
+        begin
+        Result:=TResEvalUTF16.Create;
+        TResEvalUTF16(Result).S:=GetUnicodeStr(TResEvalString(LeftValue).S,LeftExpr)
+                                +GetUnicodeStr(TResEvalString(RightValue).S,RightExpr);
+        end;
+      end;
+    revkUnicodeString:
+      begin
+      Result:=TResEvalUTF16.Create;
+      TResEvalUTF16(Result).S:=GetUnicodeStr(TResEvalString(LeftValue).S,LeftExpr)
+                              +TResEvalUTF16(RightValue).S;
+      end;
+    else
+      {$IFDEF VerbosePasResolver}
+      writeln('TResExprEvaluator.EvalBinaryAddExpr string+? Left=',LeftValue.AsDebugString,' Right=',RightValue.AsDebugString);
+      {$ENDIF}
+      RaiseNotYetImplemented(20170601141834,Expr);
+    end;
+  {$endif}
+  revkUnicodeString:
+    case RightValue.Kind of
+    {$ifdef FPC_HAS_CPSTRING}
+    revkString:
+      begin
+      Result:=TResEvalUTF16.Create;
+      TResEvalUTF16(Result).S:=TResEvalUTF16(LeftValue).S
+                              +GetUnicodeStr(TResEvalString(RightValue).S,RightExpr);
+      end;
+    {$endif}
+    revkUnicodeString:
+      begin
+      Result:=TResEvalUTF16.Create;
+      TResEvalUTF16(Result).S:=TResEvalUTF16(LeftValue).S+TResEvalUTF16(RightValue).S;
+      end;
+    else
+      {$IFDEF VerbosePasResolver}
+      writeln('TResExprEvaluator.EvalBinaryAddExpr utf16+? Left=',LeftValue.AsDebugString,' Right=',RightValue.AsDebugString);
+      {$ENDIF}
+      RaiseNotYetImplemented(20170601141811,Expr);
+    end;
+  else
+    RaiseNotYetImplemented(20181219233139,Expr);
+  end;
+end;
+
 function TResExprEvaluator.EnumTypeCast(EnumType: TPasEnumType; Expr: TPasExpr;
 function TResExprEvaluator.EnumTypeCast(EnumType: TPasEnumType; Expr: TPasExpr;
   Flags: TResEvalFlags): TResEvalEnum;
   Flags: TResEvalFlags): TResEvalEnum;
 var
 var

Файлын зөрүү хэтэрхий том тул дарагдсан байна
+ 374 - 145
packages/fcl-passrc/src/pasresolver.pp


+ 317 - 167
packages/fcl-passrc/src/pastree.pp

@@ -82,6 +82,8 @@ resourcestring
   SPasTreeClassDestructor = 'class destructor';
   SPasTreeClassDestructor = 'class destructor';
   SPasTreeConstructor = 'constructor';
   SPasTreeConstructor = 'constructor';
   SPasTreeDestructor = 'destructor';
   SPasTreeDestructor = 'destructor';
+  SPasTreeAnonymousProcedure = 'anonymous procedure';
+  SPasTreeAnonymousFunction = 'anonymous function';
   SPasTreeProcedureImpl = 'procedure/function implementation';
   SPasTreeProcedureImpl = 'procedure/function implementation';
   SPasTreeConstructorImpl = 'constructor implementation';
   SPasTreeConstructorImpl = 'constructor implementation';
   SPasTreeDestructorImpl = 'destructor implementation';
   SPasTreeDestructorImpl = 'destructor implementation';
@@ -192,7 +194,7 @@ type
 
 
   TPasExprKind = (pekIdent, pekNumber, pekString, pekSet, pekNil, pekBoolConst,
   TPasExprKind = (pekIdent, pekNumber, pekString, pekSet, pekNil, pekBoolConst,
      pekRange, pekUnary, pekBinary, pekFuncParams, pekArrayParams, pekListOfExp,
      pekRange, pekUnary, pekBinary, pekFuncParams, pekArrayParams, pekListOfExp,
-     pekInherited, pekSelf, pekSpecialize);
+     pekInherited, pekSelf, pekSpecialize, pekProcedure);
 
 
   TExprOpCode = (eopNone,
   TExprOpCode = (eopNone,
                  eopAdd,eopSubtract,eopMultiply,eopDivide, eopDiv,eopMod, eopPower,// arithmetic
                  eopAdd,eopSubtract,eopMultiply,eopDivide, eopDiv,eopMod, eopPower,// arithmetic
@@ -690,14 +692,31 @@ type
     Members: TPasRecordType;
     Members: TPasRecordType;
   end;
   end;
 
 
-  { TPasRecordType }
+  { TPasMembersType - base type for TPasRecordType and TPasClassType }
 
 
-  TPasRecordType = class(TPasType)
+  TPasMembersType = class(TPasType)
   private
   private
     procedure ClearChildReferences(El: TPasElement; arg: pointer);
     procedure ClearChildReferences(El: TPasElement; arg: pointer);
-    procedure GetMembers(S: TStrings);
   protected
   protected
     procedure SetParent(const AValue: TPasElement); override;
     procedure SetParent(const AValue: TPasElement); override;
+  public
+    PackMode: TPackMode;
+    Members: TFPList;
+    GenericTemplateTypes: TFPList; // list of TPasGenericTemplateType
+    Constructor Create(const AName: string; AParent: TPasElement); override;
+    Destructor Destroy; override;
+    Function IsPacked: Boolean;
+    Function IsBitPacked : Boolean;
+    Procedure ForEachCall(const aMethodCall: TOnForEachPasElement;
+      const Arg: Pointer); override;
+    Procedure SetGenericTemplates(AList: TFPList); virtual;
+  end;
+
+  { TPasRecordType }
+
+  TPasRecordType = class(TPasMembersType)
+  private
+    procedure GetMembers(S: TStrings);
   public
   public
     constructor Create(const AName: string; AParent: TPasElement); override;
     constructor Create(const AName: string; AParent: TPasElement); override;
     destructor Destroy; override;
     destructor Destroy; override;
@@ -706,15 +725,9 @@ type
     procedure ForEachCall(const aMethodCall: TOnForEachPasElement;
     procedure ForEachCall(const aMethodCall: TOnForEachPasElement;
       const Arg: Pointer); override;
       const Arg: Pointer); override;
   public
   public
-    PackMode: TPackMode;
-    Members: TFPList;     // list of TPasVariable elements
     VariantEl: TPasElement; // nil or TPasVariable or TPasType
     VariantEl: TPasElement; // nil or TPasVariable or TPasType
     Variants: TFPList;	// list of TPasVariant elements, may be nil!
     Variants: TFPList;	// list of TPasVariant elements, may be nil!
-    GenericTemplateTypes: TFPList; // list of TPasGenericTemplateType
-    Function IsPacked: Boolean;
-    Function IsBitPacked : Boolean;
     Function IsAdvancedRecord : Boolean;
     Function IsAdvancedRecord : Boolean;
-    Procedure SetGenericTemplates(AList : TFPList);
   end;
   end;
 
 
   TPasGenericTemplateType = Class(TPasType)
   TPasGenericTemplateType = Class(TPasType)
@@ -735,9 +748,7 @@ type
 
 
   { TPasClassType }
   { TPasClassType }
 
 
-  TPasClassType = class(TPasType)
-  private
-    procedure ClearChildReferences(El: TPasElement; arg: pointer);
+  TPasClassType = class(TPasMembersType)
   protected
   protected
     procedure SetParent(const AValue: TPasElement); override;
     procedure SetParent(const AValue: TPasElement); override;
   public
   public
@@ -747,7 +758,6 @@ type
     procedure ForEachCall(const aMethodCall: TOnForEachPasElement;
     procedure ForEachCall(const aMethodCall: TOnForEachPasElement;
       const Arg: Pointer); override;
       const Arg: Pointer); override;
   public
   public
-    PackMode: TPackMode;
     ObjKind: TPasObjKind;
     ObjKind: TPasObjKind;
     AncestorType: TPasType;   // TPasClassType or TPasUnresolvedTypeRef or TPasAliasType or TPasTypeAliasType
     AncestorType: TPasType;   // TPasClassType or TPasUnresolvedTypeRef or TPasAliasType or TPasTypeAliasType
                               // Note: AncestorType can be nil even though it has a default ancestor
                               // Note: AncestorType can be nil even though it has a default ancestor
@@ -756,25 +766,20 @@ type
     IsExternal : Boolean;
     IsExternal : Boolean;
     IsShortDefinition: Boolean;//class(anchestor); without end
     IsShortDefinition: Boolean;//class(anchestor); without end
     GUIDExpr : TPasExpr;
     GUIDExpr : TPasExpr;
-    Members: TFPList;     // list of TPasElement
     Modifiers: TStringList;
     Modifiers: TStringList;
     Interfaces : TFPList; // list of TPasType
     Interfaces : TFPList; // list of TPasType
-    GenericTemplateTypes: TFPList; // list of TPasGenericTemplateType
     ExternalNameSpace : String;
     ExternalNameSpace : String;
     ExternalName : String;
     ExternalName : String;
     InterfaceType: TPasClassInterfaceType;
     InterfaceType: TPasClassInterfaceType;
-    Procedure SetGenericTemplates(AList : TFPList);
+    Procedure SetGenericTemplates(AList : TFPList); override;
     Function FindMember(MemberClass : TPTreeElement; Const MemberName : String) : TPasElement;
     Function FindMember(MemberClass : TPTreeElement; Const MemberName : String) : TPasElement;
     Function FindMemberInAncestors(MemberClass : TPTreeElement; Const MemberName : String) : TPasElement;
     Function FindMemberInAncestors(MemberClass : TPTreeElement; Const MemberName : String) : TPasElement;
-    Function IsPacked : Boolean;
     Function InterfaceGUID : string;
     Function InterfaceGUID : string;
     Function IsSealed : Boolean;
     Function IsSealed : Boolean;
     Function IsAbstract : Boolean;
     Function IsAbstract : Boolean;
     Function HasModifier(const aModifier: String): Boolean;
     Function HasModifier(const aModifier: String): Boolean;
   end;
   end;
 
 
-
-
   TArgumentAccess = (argDefault, argConst, argVar, argOut, argConstRef);
   TArgumentAccess = (argDefault, argConst, argVar, argOut, argConstRef);
 
 
   { TPasArgument }
   { TPasArgument }
@@ -972,7 +977,8 @@ type
                ptOperator, ptClassOperator,
                ptOperator, ptClassOperator,
                ptConstructor, ptDestructor,
                ptConstructor, ptDestructor,
                ptClassProcedure, ptClassFunction,
                ptClassProcedure, ptClassFunction,
-               ptClassConstructor, ptClassDestructor);
+               ptClassConstructor, ptClassDestructor,
+               ptAnonymousProcedure, ptAnonymousFunction);
 
 
   { TPasProcedureBase }
   { TPasProcedureBase }
 
 
@@ -1007,6 +1013,8 @@ type
                         
                         
   TProcedureBody = class;
   TProcedureBody = class;
 
 
+  { TPasProcedure - named procedure, not anonymous }
+
   TPasProcedure = class(TPasProcedureBase)
   TPasProcedure = class(TPasProcedureBase)
   Private
   Private
     FModifiers : TProcedureModifiers;
     FModifiers : TProcedureModifiers;
@@ -1023,13 +1031,13 @@ type
     procedure ForEachCall(const aMethodCall: TOnForEachPasElement;
     procedure ForEachCall(const aMethodCall: TOnForEachPasElement;
       const Arg: Pointer); override;
       const Arg: Pointer); override;
   public
   public
-    ProcType : TPasProcedureType;
-    Body : TProcedureBody;
     PublicName, // e.g. public PublicName;
     PublicName, // e.g. public PublicName;
     LibrarySymbolName,
     LibrarySymbolName,
     LibraryExpr : TPasExpr; // e.g. external LibraryExpr name LibrarySymbolName;
     LibraryExpr : TPasExpr; // e.g. external LibraryExpr name LibrarySymbolName;
     DispIDExpr :  TPasExpr;
     DispIDExpr :  TPasExpr;
     AliasName : String;
     AliasName : String;
+    ProcType : TPasProcedureType;
+    Body : TProcedureBody;
     Procedure AddModifier(AModifier : TProcedureModifier);
     Procedure AddModifier(AModifier : TProcedureModifier);
     Function IsVirtual : Boolean;
     Function IsVirtual : Boolean;
     Function IsDynamic : Boolean;
     Function IsDynamic : Boolean;
@@ -1042,6 +1050,7 @@ type
     Function IsReintroduced : Boolean;
     Function IsReintroduced : Boolean;
     Function IsStatic : Boolean;
     Function IsStatic : Boolean;
     Function IsForward: Boolean;
     Function IsForward: Boolean;
+    Function GetProcTypeEnum: TProcType; virtual;
     Property Modifiers : TProcedureModifiers Read FModifiers Write FModifiers;
     Property Modifiers : TProcedureModifiers Read FModifiers Write FModifiers;
     Property CallingConvention : TCallingConvention Read GetCallingConvention Write SetCallingConvention;
     Property CallingConvention : TCallingConvention Read GetCallingConvention Write SetCallingConvention;
     Property MessageName : String Read FMessageName Write FMessageName;
     Property MessageName : String Read FMessageName Write FMessageName;
@@ -1051,14 +1060,16 @@ type
 
 
   TArrayOfPasProcedure = array of TPasProcedure;
   TArrayOfPasProcedure = array of TPasProcedure;
 
 
+  { TPasFunction - named function, not anonymous function}
+
   TPasFunction = class(TPasProcedure)
   TPasFunction = class(TPasProcedure)
   private
   private
     function GetFT: TPasFunctionType; inline;
     function GetFT: TPasFunctionType; inline;
   public
   public
     function ElementTypeName: string; override;
     function ElementTypeName: string; override;
     function TypeName: string; override;
     function TypeName: string; override;
-    function GetDeclaration (full : boolean) : string; override;
     Property FuncType : TPasFunctionType Read GetFT;
     Property FuncType : TPasFunctionType Read GetFT;
+    function GetProcTypeEnum: TProcType; override;
   end;
   end;
 
 
   { TPasOperator }
   { TPasOperator }
@@ -1085,17 +1096,18 @@ type
     Function OldName(WithPath : Boolean) : String;
     Function OldName(WithPath : Boolean) : String;
     function ElementTypeName: string; override;
     function ElementTypeName: string; override;
     function TypeName: string; override;
     function TypeName: string; override;
+    function GetProcTypeEnum: TProcType; override;
     function GetDeclaration (full : boolean) : string; override;
     function GetDeclaration (full : boolean) : string; override;
     Property OperatorType : TOperatorType Read FOperatorType Write FOperatorType;
     Property OperatorType : TOperatorType Read FOperatorType Write FOperatorType;
     // True if the declaration was using a token instead of an identifier
     // True if the declaration was using a token instead of an identifier
     Property TokenBased : Boolean Read FTokenBased Write FTokenBased;
     Property TokenBased : Boolean Read FTokenBased Write FTokenBased;
   end;
   end;
 
 
-Type
   { TPasClassOperator }
   { TPasClassOperator }
 
 
   TPasClassOperator = class(TPasOperator)
   TPasClassOperator = class(TPasOperator)
     function TypeName: string; override;
     function TypeName: string; override;
+    function GetProcTypeEnum: TProcType; override;
   end;
   end;
 
 
 
 
@@ -1105,6 +1117,7 @@ Type
   public
   public
     function ElementTypeName: string; override;
     function ElementTypeName: string; override;
     function TypeName: string; override;
     function TypeName: string; override;
+    function GetProcTypeEnum: TProcType; override;
   end;
   end;
 
 
   { TPasClassConstructor }
   { TPasClassConstructor }
@@ -1113,6 +1126,7 @@ Type
   public
   public
     function ElementTypeName: string; override;
     function ElementTypeName: string; override;
     function TypeName: string; override;
     function TypeName: string; override;
+    function GetProcTypeEnum: TProcType; override;
   end;
   end;
 
 
   { TPasDestructor }
   { TPasDestructor }
@@ -1121,6 +1135,7 @@ Type
   public
   public
     function ElementTypeName: string; override;
     function ElementTypeName: string; override;
     function TypeName: string; override;
     function TypeName: string; override;
+    function GetProcTypeEnum: TProcType; override;
   end;
   end;
 
 
   { TPasClassDestructor }
   { TPasClassDestructor }
@@ -1129,6 +1144,7 @@ Type
   public
   public
     function ElementTypeName: string; override;
     function ElementTypeName: string; override;
     function TypeName: string; override;
     function TypeName: string; override;
+    function GetProcTypeEnum: TProcType; override;
   end;
   end;
 
 
   { TPasClassProcedure }
   { TPasClassProcedure }
@@ -1137,6 +1153,7 @@ Type
   public
   public
     function ElementTypeName: string; override;
     function ElementTypeName: string; override;
     function TypeName: string; override;
     function TypeName: string; override;
+    function GetProcTypeEnum: TProcType; override;
   end;
   end;
 
 
   { TPasClassFunction }
   { TPasClassFunction }
@@ -1145,8 +1162,43 @@ Type
   public
   public
     function ElementTypeName: string; override;
     function ElementTypeName: string; override;
     function TypeName: string; override;
     function TypeName: string; override;
+    function GetProcTypeEnum: TProcType; override;
+  end;
+
+  { TPasAnonymousProcedure - parent is TProcedureExpr }
+
+  TPasAnonymousProcedure = class(TPasProcedure)
+  public
+    function ElementTypeName: string; override;
+    function TypeName: string; override;
+    function GetProcTypeEnum: TProcType; override;
+  end;
+
+  { TPasAnonymousFunction - parent is TProcedureExpr and ProcType is TPasFunctionType}
+
+  TPasAnonymousFunction = class(TPasAnonymousProcedure)
+  private
+    function GetFT: TPasFunctionType; inline;
+  public
+    function ElementTypeName: string; override;
+    function TypeName: string; override;
+    Property FuncType : TPasFunctionType Read GetFT;
+    function GetProcTypeEnum: TProcType; override;
   end;
   end;
 
 
+  { TProcedureExpr }
+
+  TProcedureExpr = class(TPasExpr)
+  public
+    Proc: TPasAnonymousProcedure;
+    constructor Create(AParent: TPasElement); overload;
+    destructor Destroy; override;
+    function GetDeclaration(full: Boolean): string; override;
+    procedure ForEachCall(const aMethodCall: TOnForEachPasElement;
+      const Arg: Pointer); override;
+  end;
+
+
   TPasImplBlock = class;
   TPasImplBlock = class;
 
 
   { TProcedureBody - the var+type+const+begin, without the header, child of TPasProcedure }
   { TProcedureBody - the var+type+const+begin, without the header, child of TPasProcedure }
@@ -1580,7 +1632,8 @@ const
       'ListOfExp',
       'ListOfExp',
       'Inherited',
       'Inherited',
       'Self',
       'Self',
-      'Specialize');
+      'Specialize',
+      'Procedure');
 
 
   OpcodeStrings : Array[TExprOpCode] of string = (
   OpcodeStrings : Array[TExprOpCode] of string = (
         '','+','-','*','/','div','mod','**',
         '','+','-','*','/','div','mod','**',
@@ -1646,6 +1699,26 @@ begin
   El:=nil;
   El:=nil;
 end;
 end;
 
 
+Function IndentStrings(S : TStrings; indent : Integer) : string;
+Var
+  I,CurrLen,CurrPos : Integer;
+begin
+  Result:='';
+  CurrLen:=0;
+  CurrPos:=0;
+  For I:=0 to S.Count-1 do
+    begin
+    CurrLen:=Length(S[i]);
+    If (CurrLen+CurrPos)>72 then
+      begin
+      Result:=Result+LineEnding+StringOfChar(' ',Indent);
+      CurrPos:=Indent;
+      end;
+    Result:=Result+S[i];
+    CurrPos:=CurrPos+CurrLen;
+    end;
+end;
+
 {$IFDEF HasPTDumpStack}
 {$IFDEF HasPTDumpStack}
 procedure PTDumpStack;
 procedure PTDumpStack;
 begin
 begin
@@ -1846,6 +1919,11 @@ begin
   Result:='class operator';
   Result:='class operator';
 end;
 end;
 
 
+function TPasClassOperator.GetProcTypeEnum: TProcType;
+begin
+  Result:=ptClassOperator;
+end;
+
 { TPasImplAsmStatement }
 { TPasImplAsmStatement }
 
 
 constructor TPasImplAsmStatement.Create(const AName: string;
 constructor TPasImplAsmStatement.Create(const AName: string;
@@ -1868,6 +1946,78 @@ begin
   Result:='class '+ inherited TypeName;
   Result:='class '+ inherited TypeName;
 end;
 end;
 
 
+function TPasClassConstructor.GetProcTypeEnum: TProcType;
+begin
+  Result:=ptClassConstructor;
+end;
+
+{ TPasAnonymousProcedure }
+
+function TPasAnonymousProcedure.ElementTypeName: string;
+begin
+  Result:=SPasTreeAnonymousProcedure;
+end;
+
+function TPasAnonymousProcedure.TypeName: string;
+begin
+  Result:='anonymous procedure';
+end;
+
+function TPasAnonymousProcedure.GetProcTypeEnum: TProcType;
+begin
+  Result:=ptAnonymousProcedure;
+end;
+
+{ TPasAnonymousFunction }
+
+function TPasAnonymousFunction.GetFT: TPasFunctionType;
+begin
+  Result:=ProcType as TPasFunctionType;
+end;
+
+function TPasAnonymousFunction.ElementTypeName: string;
+begin
+  Result := SPasTreeAnonymousFunction;
+end;
+
+function TPasAnonymousFunction.TypeName: string;
+begin
+  Result:='anonymous function';
+end;
+
+function TPasAnonymousFunction.GetProcTypeEnum: TProcType;
+begin
+  Result:=ptAnonymousFunction;
+end;
+
+{ TProcedureExpr }
+
+constructor TProcedureExpr.Create(AParent: TPasElement);
+begin
+  inherited Create(AParent,pekProcedure,eopNone);
+end;
+
+destructor TProcedureExpr.Destroy;
+begin
+  ReleaseAndNil(TPasElement(Proc){$IFDEF CheckPasTreeRefCount},'TProcedureExpr.Proc'{$ENDIF});
+  inherited Destroy;
+end;
+
+function TProcedureExpr.GetDeclaration(full: Boolean): string;
+begin
+  if Proc<>nil then
+    Result:=Proc.GetDeclaration(full)
+  else
+    Result:='procedure-expr';
+end;
+
+procedure TProcedureExpr.ForEachCall(const aMethodCall: TOnForEachPasElement;
+  const Arg: Pointer);
+begin
+  inherited ForEachCall(aMethodCall, Arg);
+  ForEachChildCall(aMethodCall,Arg,Proc,false);
+end;
+
 { TPasImplRaise }
 { TPasImplRaise }
 
 
 destructor TPasImplRaise.Destroy;
 destructor TPasImplRaise.Destroy;
@@ -2160,7 +2310,7 @@ begin
   Result:=ProcType as TPasFunctionType;
   Result:=ProcType as TPasFunctionType;
 end;
 end;
 
 
-function TPasFunction.ElementTypeName: string; begin Result := SPasTreeFunction end;
+function TPasFunction.ElementTypeName: string; begin Result := SPasTreeFunction; end;
 function TPasClassProcedure.ElementTypeName: string; begin Result := SPasTreeClassProcedure; end;
 function TPasClassProcedure.ElementTypeName: string; begin Result := SPasTreeClassProcedure; end;
 function TPasClassConstructor.ElementTypeName: string; begin Result := SPasTreeClassConstructor; end;
 function TPasClassConstructor.ElementTypeName: string; begin Result := SPasTreeClassConstructor; end;
 function TPasClassDestructor.ElementTypeName: string; begin Result := SPasTreeClassDestructor; end;
 function TPasClassDestructor.ElementTypeName: string; begin Result := SPasTreeClassDestructor; end;
@@ -2170,6 +2320,11 @@ begin
   Result:='destructor';
   Result:='destructor';
 end;
 end;
 
 
+function TPasClassDestructor.GetProcTypeEnum: TProcType;
+begin
+  Result:=ptClassDestructor;
+end;
+
 function TPasClassFunction.ElementTypeName: string; begin Result := SPasTreeClassFunction; end;
 function TPasClassFunction.ElementTypeName: string; begin Result := SPasTreeClassFunction; end;
 
 
 class function TPasOperator.OperatorTypeToToken(T: TOperatorType): String;
 class function TPasOperator.OperatorTypeToToken(T: TOperatorType): String;
@@ -2799,22 +2954,12 @@ end;
 constructor TPasRecordType.Create(const AName: string; AParent: TPasElement);
 constructor TPasRecordType.Create(const AName: string; AParent: TPasElement);
 begin
 begin
   inherited Create(AName, AParent);
   inherited Create(AName, AParent);
-  Members := TFPList.Create;
-  GenericTemplateTypes:=TFPList.Create;
 end;
 end;
 
 
 destructor TPasRecordType.Destroy;
 destructor TPasRecordType.Destroy;
 var
 var
   i: Integer;
   i: Integer;
 begin
 begin
-  for i := 0 to GenericTemplateTypes.Count - 1 do
-    TPasElement(GenericTemplateTypes[i]).Release{$IFDEF CheckPasTreeRefCount}('TPasRecordType.GenericTemplateTypes'){$ENDIF};
-  FreeAndNil(GenericTemplateTypes);
-
-  for i := 0 to Members.Count - 1 do
-    TPasVariable(Members[i]).Release{$IFDEF CheckPasTreeRefCount}('TPasRecordType.Members'){$ENDIF};
-  FreeAndNil(Members);
-
   ReleaseAndNil(TPasElement(VariantEl){$IFDEF CheckPasTreeRefCount},'TPasRecordType.VariantEl'{$ENDIF});
   ReleaseAndNil(TPasElement(VariantEl){$IFDEF CheckPasTreeRefCount},'TPasRecordType.VariantEl'{$ENDIF});
 
 
   if Assigned(Variants) then
   if Assigned(Variants) then
@@ -2829,19 +2974,12 @@ end;
 
 
 { TPasClassType }
 { TPasClassType }
 
 
-procedure TPasClassType.ClearChildReferences(El: TPasElement; arg: pointer);
-begin
-  El.ClearTypeReferences(Self);
-  if arg=nil then ;
-end;
-
 procedure TPasClassType.SetParent(const AValue: TPasElement);
 procedure TPasClassType.SetParent(const AValue: TPasElement);
 begin
 begin
   if (AValue=nil) and (Parent<>nil) then
   if (AValue=nil) and (Parent<>nil) then
     begin
     begin
     // parent is cleared
     // parent is cleared
-    // -> clear all child references to this class (releasing loops)
-    ForEachCall(@ClearChildReferences,nil);
+    // -> clear all references to this class (releasing loops)
     if AncestorType=Self then
     if AncestorType=Self then
       ReleaseAndNil(TPasElement(AncestorType){$IFDEF CheckPasTreeRefCount},'TPasClassType.AncestorType'{$ENDIF});
       ReleaseAndNil(TPasElement(AncestorType){$IFDEF CheckPasTreeRefCount},'TPasClassType.AncestorType'{$ENDIF});
     if HelperForType=Self then
     if HelperForType=Self then
@@ -2853,27 +2991,15 @@ end;
 constructor TPasClassType.Create(const AName: string; AParent: TPasElement);
 constructor TPasClassType.Create(const AName: string; AParent: TPasElement);
 begin
 begin
   inherited Create(AName, AParent);
   inherited Create(AName, AParent);
-  PackMode:=pmNone;                     // 12/04/04 - Dave - Added
   IsShortDefinition := False;
   IsShortDefinition := False;
-  Members := TFPList.Create;
   Modifiers := TStringList.Create;
   Modifiers := TStringList.Create;
   Interfaces:= TFPList.Create;
   Interfaces:= TFPList.Create;
-  GenericTemplateTypes:=TFPList.Create;
 end;
 end;
 
 
 destructor TPasClassType.Destroy;
 destructor TPasClassType.Destroy;
 var
 var
   i: Integer;
   i: Integer;
-  El: TPasElement;
 begin
 begin
-  for i := 0 to Members.Count - 1 do
-    begin
-    El:=TPasElement(Members[i]);
-    El.Parent:=nil;
-    El.Release{$IFDEF CheckPasTreeRefCount}('TPasClassType.Members'){$ENDIF};
-    end;
-  FreeAndNil(Members);
-
   for i := 0 to Interfaces.Count - 1 do
   for i := 0 to Interfaces.Count - 1 do
     TPasElement(Interfaces[i]).Release{$IFDEF CheckPasTreeRefCount}('TPasClassType.Interfaces'){$ENDIF};
     TPasElement(Interfaces[i]).Release{$IFDEF CheckPasTreeRefCount}('TPasClassType.Interfaces'){$ENDIF};
   FreeAndNil(Interfaces);
   FreeAndNil(Interfaces);
@@ -2881,9 +3007,6 @@ begin
   ReleaseAndNil(TPasElement(HelperForType){$IFDEF CheckPasTreeRefCount},'TPasClassType.HelperForType'{$ENDIF});
   ReleaseAndNil(TPasElement(HelperForType){$IFDEF CheckPasTreeRefCount},'TPasClassType.HelperForType'{$ENDIF});
   ReleaseAndNil(TPasElement(GUIDExpr){$IFDEF CheckPasTreeRefCount},'TPasClassType.GUIDExpr'{$ENDIF});
   ReleaseAndNil(TPasElement(GUIDExpr){$IFDEF CheckPasTreeRefCount},'TPasClassType.GUIDExpr'{$ENDIF});
   FreeAndNil(Modifiers);
   FreeAndNil(Modifiers);
-  for i := 0 to GenericTemplateTypes.Count - 1 do
-    TPasElement(GenericTemplateTypes[i]).Release{$IFDEF CheckPasTreeRefCount}('TPasClassType.GenericTemplateTypes'){$ENDIF};
-  FreeAndNil(GenericTemplateTypes);
   inherited Destroy;
   inherited Destroy;
 end;
 end;
 
 
@@ -2913,26 +3036,12 @@ begin
     ForEachChildCall(aMethodCall,Arg,TPasElement(Interfaces[i]),true);
     ForEachChildCall(aMethodCall,Arg,TPasElement(Interfaces[i]),true);
   ForEachChildCall(aMethodCall,Arg,HelperForType,true);
   ForEachChildCall(aMethodCall,Arg,HelperForType,true);
   ForEachChildCall(aMethodCall,Arg,GUIDExpr,false);
   ForEachChildCall(aMethodCall,Arg,GUIDExpr,false);
-  for i:=0 to Members.Count-1 do
-    ForEachChildCall(aMethodCall,Arg,TPasElement(Members[i]),false);
-  for i:=0 to GenericTemplateTypes.Count-1 do
-    ForEachChildCall(aMethodCall,Arg,TPasElement(GenericTemplateTypes[i]),false);
 end;
 end;
 
 
 procedure TPasClassType.SetGenericTemplates(AList: TFPList);
 procedure TPasClassType.SetGenericTemplates(AList: TFPList);
-
-Var
-  I : Integer;
-
 begin
 begin
   ObjKind:=okGeneric;
   ObjKind:=okGeneric;
-  For I:=0 to AList.Count-1 do
-    begin
-    TPasElement(AList[i]).Parent:=Self;
-    GenericTemplateTypes.Add(AList[i]);
-    end;
-  AList.Clear;
-  ObjKind:=okGeneric;
+  inherited SetGenericTemplates(AList);
 end;
 end;
 
 
 function TPasClassType.FindMember(MemberClass: TPTreeElement; const MemberName: String): TPasElement;
 function TPasClassType.FindMember(MemberClass: TPTreeElement; const MemberName: String): TPasElement;
@@ -3006,12 +3115,6 @@ begin
   Result:=false;
   Result:=false;
 end;
 end;
 
 
-function TPasClassType.IsPacked: Boolean;
-begin
-  Result:=PackMode<>pmNone;
-end;
-
-
 { TPasArgument }
 { TPasArgument }
 
 
 destructor TPasArgument.Destroy;
 destructor TPasArgument.Destroy;
@@ -3232,12 +3335,12 @@ end;
 
 
 destructor TPasProcedure.Destroy;
 destructor TPasProcedure.Destroy;
 begin
 begin
-  ReleaseAndNil(TPasElement(ProcType){$IFDEF CheckPasTreeRefCount},'TPasProcedure.ProcType'{$ENDIF});
-  ReleaseAndNil(TPasElement(Body){$IFDEF CheckPasTreeRefCount},'TPasProcedure.Body'{$ENDIF});
   ReleaseAndNil(TPasElement(PublicName){$IFDEF CheckPasTreeRefCount},'TPasProcedure.PublicName'{$ENDIF});
   ReleaseAndNil(TPasElement(PublicName){$IFDEF CheckPasTreeRefCount},'TPasProcedure.PublicName'{$ENDIF});
   ReleaseAndNil(TPasElement(LibraryExpr){$IFDEF CheckPasTreeRefCount},'TPasProcedure.LibraryExpr'{$ENDIF});
   ReleaseAndNil(TPasElement(LibraryExpr){$IFDEF CheckPasTreeRefCount},'TPasProcedure.LibraryExpr'{$ENDIF});
   ReleaseAndNil(TPasElement(LibrarySymbolName){$IFDEF CheckPasTreeRefCount},'TPasProcedure.LibrarySymbolName'{$ENDIF});
   ReleaseAndNil(TPasElement(LibrarySymbolName){$IFDEF CheckPasTreeRefCount},'TPasProcedure.LibrarySymbolName'{$ENDIF});
   ReleaseAndNil(TPasElement(DispIDExpr){$IFDEF CheckPasTreeRefCount},'TPasProcedure.DispIDExpr'{$ENDIF});
   ReleaseAndNil(TPasElement(DispIDExpr){$IFDEF CheckPasTreeRefCount},'TPasProcedure.DispIDExpr'{$ENDIF});
+  ReleaseAndNil(TPasElement(ProcType){$IFDEF CheckPasTreeRefCount},'TPasProcedure.ProcType'{$ENDIF});
+  ReleaseAndNil(TPasElement(Body){$IFDEF CheckPasTreeRefCount},'TPasProcedure.Body'{$ENDIF});
   inherited Destroy;
   inherited Destroy;
 end;
 end;
 
 
@@ -3767,29 +3870,6 @@ begin
   ForEachChildCall(aMethodCall,Arg,ElType,true);
   ForEachChildCall(aMethodCall,Arg,ElType,true);
 end;
 end;
 
 
-Function IndentStrings(S : TStrings; indent : Integer) : string;
-
-Var
-  I,CurrLen,CurrPos : Integer;
-
-
-begin
-  Result:='';
-  CurrLen:=0;
-  CurrPos:=0;
-  For I:=0 to S.Count-1 do
-    begin
-    CurrLen:=Length(S[i]);
-    If (CurrLen+CurrPos)>72 then
-      begin
-      Result:=Result+LineEnding+StringOfChar(' ',Indent);
-      CurrPos:=Indent;
-      end;
-    Result:=Result+S[i];
-    CurrPos:=CurrPos+CurrLen;
-    end;
-end;
-
 function TPasEnumType.GetDeclaration (full : boolean) : string;
 function TPasEnumType.GetDeclaration (full : boolean) : string;
 
 
 Var
 Var
@@ -3861,12 +3941,95 @@ begin
   ForEachChildCall(aMethodCall,Arg,EnumType,true);
   ForEachChildCall(aMethodCall,Arg,EnumType,true);
 end;
 end;
 
 
-procedure TPasRecordType.ClearChildReferences(El: TPasElement; arg: pointer);
+{ TPasMembersType }
+
+procedure TPasMembersType.ClearChildReferences(El: TPasElement; arg: pointer);
 begin
 begin
   El.ClearTypeReferences(Self);
   El.ClearTypeReferences(Self);
   if arg=nil then ;
   if arg=nil then ;
 end;
 end;
 
 
+procedure TPasMembersType.SetParent(const AValue: TPasElement);
+begin
+  if (AValue=nil) and (Parent<>nil) then
+    begin
+    // parent is cleared
+    // -> clear all child references to this class/record (releasing loops)
+    ForEachCall(@ClearChildReferences,nil);
+    end;
+  inherited SetParent(AValue);
+end;
+
+constructor TPasMembersType.Create(const AName: string; AParent: TPasElement);
+begin
+  inherited Create(AName, AParent);
+  PackMode:=pmNone;
+  Members := TFPList.Create;
+  GenericTemplateTypes:=TFPList.Create;
+end;
+
+destructor TPasMembersType.Destroy;
+var
+  i: Integer;
+  El: TPasElement;
+begin
+  for i := 0 to Members.Count - 1 do
+    begin
+    El:=TPasElement(Members[i]);
+    El.Parent:=nil;
+    El.Release{$IFDEF CheckPasTreeRefCount}('TPasMembersType.Members'){$ENDIF};
+    end;
+  FreeAndNil(Members);
+
+  for i := 0 to GenericTemplateTypes.Count - 1 do
+    begin
+    El:=TPasElement(GenericTemplateTypes[i]);
+    El.Parent:=nil;
+    El.Release{$IFDEF CheckPasTreeRefCount}('TPasMembersType.GenericTemplateTypes'){$ENDIF};
+    end;
+  FreeAndNil(GenericTemplateTypes);
+
+  inherited Destroy;
+end;
+
+function TPasMembersType.IsPacked: Boolean;
+begin
+  Result:=(PackMode <> pmNone);
+end;
+
+function TPasMembersType.IsBitPacked: Boolean;
+begin
+  Result:=(PackMode=pmBitPacked)
+end;
+
+procedure TPasMembersType.ForEachCall(const aMethodCall: TOnForEachPasElement;
+  const Arg: Pointer);
+var
+  i: Integer;
+begin
+  inherited ForEachCall(aMethodCall, Arg);
+  for i:=0 to GenericTemplateTypes.Count-1 do
+    ForEachChildCall(aMethodCall,Arg,TPasElement(GenericTemplateTypes[i]),true);
+  for i:=0 to Members.Count-1 do
+    ForEachChildCall(aMethodCall,Arg,TPasElement(Members[i]),false);
+end;
+
+procedure TPasMembersType.SetGenericTemplates(AList: TFPList);
+var
+  I: Integer;
+  El: TPasElement;
+begin
+  For I:=0 to AList.Count-1 do
+    begin
+    El:=TPasElement(AList[i]);
+    El.Parent:=Self;
+    GenericTemplateTypes.Add(El);
+    end;
+  AList.Clear;
+end;
+
+{ TPasRecordType }
+
 procedure TPasRecordType.GetMembers(S: TStrings);
 procedure TPasRecordType.GetMembers(S: TStrings);
 
 
 Var
 Var
@@ -3923,17 +4086,6 @@ begin
   end;
   end;
 end;
 end;
 
 
-procedure TPasRecordType.SetParent(const AValue: TPasElement);
-begin
-  if (AValue=nil) and (Parent<>nil) then
-    begin
-    // parent is cleared
-    // -> clear all child references to this class (releasing loops)
-    ForEachCall(@ClearChildReferences,nil);
-    end;
-  inherited SetParent(AValue);
-end;
-
 function TPasRecordType.GetDeclaration (full : boolean) : string;
 function TPasRecordType.GetDeclaration (full : boolean) : string;
 
 
 Var
 Var
@@ -3967,54 +4119,30 @@ var
   i: Integer;
   i: Integer;
 begin
 begin
   inherited ForEachCall(aMethodCall, Arg);
   inherited ForEachCall(aMethodCall, Arg);
-  for i:=0 to GenericTemplateTypes.Count-1 do
-    ForEachChildCall(aMethodCall,Arg,TPasElement(GenericTemplateTypes[i]),true);
-  for i:=0 to Members.Count-1 do
-    ForEachChildCall(aMethodCall,Arg,TPasElement(Members[i]),false);
   ForEachChildCall(aMethodCall,Arg,VariantEl,true);
   ForEachChildCall(aMethodCall,Arg,VariantEl,true);
   if Variants<>nil then
   if Variants<>nil then
     for i:=0 to Variants.Count-1 do
     for i:=0 to Variants.Count-1 do
       ForEachChildCall(aMethodCall,Arg,TPasElement(Variants[i]),false);
       ForEachChildCall(aMethodCall,Arg,TPasElement(Variants[i]),false);
 end;
 end;
 
 
-function TPasRecordType.IsPacked: Boolean;
-begin
-  Result:=(PackMode <> pmNone);
-end;
-
-function TPasRecordType.IsBitPacked: Boolean;
-begin
-  Result:=(PackMode=pmBitPacked)
-end;
-
 function TPasRecordType.IsAdvancedRecord: Boolean;
 function TPasRecordType.IsAdvancedRecord: Boolean;
 
 
 Var
 Var
   I : Integer;
   I : Integer;
+  Member: TPasElement;
 
 
 begin
 begin
   Result:=False;
   Result:=False;
   I:=0;
   I:=0;
   While (Not Result) and (I<Members.Count) do
   While (Not Result) and (I<Members.Count) do
     begin
     begin
-    Result:=TPasElement(Members[i]).InheritsFrom(TPasProcedureBase) or
-            TPasElement(Members[i]).InheritsFrom(TPasProperty);
+    Member:=TPasElement(Members[i]);
+    if (Member.Visibility<>visPublic) then exit(true);
+    if (Member.ClassType<>TPasVariable) then exit(true);
     Inc(I);
     Inc(I);
     end;
     end;
 end;
 end;
 
 
-procedure TPasRecordType.SetGenericTemplates(AList: TFPList);
-var
-  I: Integer;
-begin
-  For I:=0 to AList.Count-1 do
-    begin
-    TPasElement(AList[i]).Parent:=Self;
-    GenericTemplateTypes.Add(AList[i]);
-    end;
-  AList.Clear;
-end;
-
 procedure TPasProcedureType.GetArguments(List : TStrings);
 procedure TPasProcedureType.GetArguments(List : TStrings);
 
 
 Var
 Var
@@ -4281,8 +4409,8 @@ procedure TPasProcedure.ForEachCall(const aMethodCall: TOnForEachPasElement;
   const Arg: Pointer);
   const Arg: Pointer);
 begin
 begin
   inherited ForEachCall(aMethodCall, Arg);
   inherited ForEachCall(aMethodCall, Arg);
-  ForEachChildCall(aMethodCall,Arg,PublicName,false);
   ForEachChildCall(aMethodCall,Arg,ProcType,false);
   ForEachChildCall(aMethodCall,Arg,ProcType,false);
+  ForEachChildCall(aMethodCall,Arg,PublicName,false);
   ForEachChildCall(aMethodCall,Arg,LibraryExpr,false);
   ForEachChildCall(aMethodCall,Arg,LibraryExpr,false);
   ForEachChildCall(aMethodCall,Arg,LibrarySymbolName,false);
   ForEachChildCall(aMethodCall,Arg,LibrarySymbolName,false);
   ForEachChildCall(aMethodCall,Arg,Body,false);
   ForEachChildCall(aMethodCall,Arg,Body,false);
@@ -4350,36 +4478,28 @@ begin
   Result:=pmForward in FModifiers;
   Result:=pmForward in FModifiers;
 end;
 end;
 
 
-function TPasProcedure.GetDeclaration(full: Boolean): string;
-
-Var
-  S : TStringList;
+function TPasProcedure.GetProcTypeEnum: TProcType;
 begin
 begin
-  S:=TStringList.Create;
-  try
-    If Full then
-      S.Add(TypeName+' '+Name);
-    ProcType.GetArguments(S);
-    GetModifiers(S);
-    Result:=IndentStrings(S,Length(S[0]));
-  finally
-    S.Free;
-  end;
+  Result:=ptProcedure;
 end;
 end;
 
 
-function TPasFunction.GetDeclaration (full : boolean) : string;
-
+function TPasProcedure.GetDeclaration(full: Boolean): string;
 Var
 Var
   S : TStringList;
   S : TStringList;
-  T : string;
-
+  T: String;
 begin
 begin
   S:=TStringList.Create;
   S:=TStringList.Create;
   try
   try
     If Full then
     If Full then
-      S.Add(TypeName+' '+Name);
+      begin
+      T:=TypeName;
+      if Name<>'' then
+        T:=T+' '+Name;
+      S.Add(T);
+      end;
     ProcType.GetArguments(S);
     ProcType.GetArguments(S);
-    If Assigned((Proctype as TPasFunctionType).ResultEl) then
+    If (ProcType is TPasFunctionType)
+        and Assigned(TPasFunctionType(Proctype).ResultEl) then
       With TPasFunctionType(ProcType).ResultEl.ResultType do
       With TPasFunctionType(ProcType).ResultEl.ResultType do
         begin
         begin
         T:=' : ';
         T:=' : ';
@@ -4401,6 +4521,11 @@ begin
   Result:='function';
   Result:='function';
 end;
 end;
 
 
+function TPasFunction.GetProcTypeEnum: TProcType;
+begin
+  Result:=ptFunction;
+end;
+
 function TPasOperator.GetOperatorDeclaration(Full : Boolean) : string;
 function TPasOperator.GetOperatorDeclaration(Full : Boolean) : string;
 
 
 begin
 begin
@@ -4453,26 +4578,51 @@ begin
   Result:='operator';
   Result:='operator';
 end;
 end;
 
 
+function TPasOperator.GetProcTypeEnum: TProcType;
+begin
+  Result:=ptOperator;
+end;
+
 function TPasClassProcedure.TypeName: string;
 function TPasClassProcedure.TypeName: string;
 begin
 begin
   Result:='class procedure';
   Result:='class procedure';
 end;
 end;
 
 
+function TPasClassProcedure.GetProcTypeEnum: TProcType;
+begin
+  Result:=ptClassProcedure;
+end;
+
 function TPasClassFunction.TypeName: string;
 function TPasClassFunction.TypeName: string;
 begin
 begin
   Result:='class function';
   Result:='class function';
 end;
 end;
 
 
+function TPasClassFunction.GetProcTypeEnum: TProcType;
+begin
+  Result:=ptClassFunction;
+end;
+
 function TPasConstructor.TypeName: string;
 function TPasConstructor.TypeName: string;
 begin
 begin
   Result:='constructor';
   Result:='constructor';
 end;
 end;
 
 
+function TPasConstructor.GetProcTypeEnum: TProcType;
+begin
+  Result:=ptConstructor;
+end;
+
 function TPasDestructor.TypeName: string;
 function TPasDestructor.TypeName: string;
 begin
 begin
   Result:='destructor';
   Result:='destructor';
 end;
 end;
 
 
+function TPasDestructor.GetProcTypeEnum: TProcType;
+begin
+  Result:=ptDestructor;
+end;
+
 function TPasArgument.GetDeclaration (full : boolean) : string;
 function TPasArgument.GetDeclaration (full : boolean) : string;
 begin
 begin
   If Assigned(ArgType) then
   If Assigned(ArgType) then

+ 94 - 66
packages/fcl-passrc/src/pasuseanalyzer.pas

@@ -262,8 +262,7 @@ type
     procedure UseProcedure(Proc: TPasProcedure); virtual;
     procedure UseProcedure(Proc: TPasProcedure); virtual;
     procedure UseProcedureType(ProcType: TPasProcedureType; Mark: boolean); virtual;
     procedure UseProcedureType(ProcType: TPasProcedureType; Mark: boolean); virtual;
     procedure UseType(El: TPasType; Mode: TPAUseMode); virtual;
     procedure UseType(El: TPasType; Mode: TPAUseMode); virtual;
-    procedure UseRecordType(El: TPasRecordType; Mode: TPAUseMode); virtual;
-    procedure UseClassType(El: TPasClassType; Mode: TPAUseMode); virtual;
+    procedure UseClassOrRecType(El: TPasMembersType; Mode: TPAUseMode); virtual;
     procedure UseVariable(El: TPasVariable; Access: TResolvedRefAccess;
     procedure UseVariable(El: TPasVariable; Access: TResolvedRefAccess;
       UseFull: boolean); virtual;
       UseFull: boolean); virtual;
     procedure UseResourcestring(El: TPasResString); virtual;
     procedure UseResourcestring(El: TPasResString); virtual;
@@ -390,9 +389,7 @@ begin
   aModule:=El.GetModule;
   aModule:=El.GetModule;
   if aModule=El then exit;
   if aModule=El then exit;
   if aModule=nil then
   if aModule=nil then
-    Result:='NilModule.'+Result
-  else
-    Result:=aModule.Name+'.'+Result;
+    Result:='NilModule.'+Result;
 end;
 end;
 
 
 function dbgs(a: TPAIdentifierAccess): string;
 function dbgs(a: TPAIdentifierAccess): string;
@@ -1180,7 +1177,7 @@ begin
   UseInitFinal(aModule.FinalizationSection);
   UseInitFinal(aModule.FinalizationSection);
   ModScope:=aModule.CustomData as TPasModuleScope;
   ModScope:=aModule.CustomData as TPasModuleScope;
   if ModScope.RangeErrorClass<>nil then
   if ModScope.RangeErrorClass<>nil then
-    UseClassType(ModScope.RangeErrorClass,paumElement);
+    UseClassOrRecType(ModScope.RangeErrorClass,paumElement);
   if ModScope.RangeErrorConstructor<>nil then
   if ModScope.RangeErrorConstructor<>nil then
     UseProcedure(ModScope.RangeErrorConstructor);
     UseProcedure(ModScope.RangeErrorConstructor);
 
 
@@ -1481,6 +1478,25 @@ begin
         begin
         begin
         BuiltInProc:=TResElDataBuiltInProc(Decl.CustomData);
         BuiltInProc:=TResElDataBuiltInProc(Decl.CustomData);
         case BuiltInProc.BuiltIn of
         case BuiltInProc.BuiltIn of
+        bfExit:
+          begin
+          if El.Parent is TParamsExpr then
+            begin
+            Params:=(El.Parent as TParamsExpr).Params;
+            if length(Params)=1 then
+              begin
+              SubEl:=El.Parent;
+              while (SubEl<>nil) and not (SubEl is TPasProcedure) do
+                SubEl:=SubEl.Parent;
+              if (SubEl is TPasProcedure)
+                  and (TPasProcedure(SubEl).ProcType is TPasFunctionType) then
+                begin
+                SubEl:=TPasFunctionType(TPasProcedure(SubEl).ProcType).ResultEl;
+                UseElement(SubEl,rraAssign,false);
+                end;
+              end;
+            end;
+          end;
         bfTypeInfo:
         bfTypeInfo:
           begin
           begin
           Params:=(El.Parent as TParamsExpr).Params;
           Params:=(El.Parent as TParamsExpr).Params;
@@ -1492,9 +1508,10 @@ begin
           {$ENDIF}
           {$ENDIF}
           if ParamResolved.IdentEl=nil then
           if ParamResolved.IdentEl=nil then
             RaiseNotSupported(20180628155107,Params[0]);
             RaiseNotSupported(20180628155107,Params[0]);
-          if ParamResolved.IdentEl is TPasFunction then
+          if (ParamResolved.IdentEl is TPasProcedure)
+              and (TPasProcedure(ParamResolved.IdentEl).ProcType is TPasFunctionType) then
             begin
             begin
-            SubEl:=TPasFunction(ParamResolved.IdentEl).FuncType.ResultEl.ResultType;
+            SubEl:=TPasFunctionType(TPasProcedure(ParamResolved.IdentEl).ProcType).ResultEl.ResultType;
             MarkImplScopeRef(El,SubEl,psraTypeInfo);
             MarkImplScopeRef(El,SubEl,psraTypeInfo);
             UseTypeInfo(SubEl);
             UseTypeInfo(SubEl);
             end
             end
@@ -1554,6 +1571,8 @@ begin
     end
     end
   else if C=TInheritedExpr then
   else if C=TInheritedExpr then
     UseInheritedExpr(TInheritedExpr(El))
     UseInheritedExpr(TInheritedExpr(El))
+  else if C=TProcedureExpr then
+    UseProcedure(TProcedureExpr(El).Proc)
   else
   else
     RaiseNotSupported(20170307085444,El);
     RaiseNotSupported(20170307085444,El);
 end;
 end;
@@ -1795,10 +1814,8 @@ begin
     {$IFDEF VerbosePasAnalyzer}
     {$IFDEF VerbosePasAnalyzer}
     writeln('TPasAnalyzer.UseType searching exports in ',GetElModName(El),' ...');
     writeln('TPasAnalyzer.UseType searching exports in ',GetElModName(El),' ...');
     {$ENDIF}
     {$ENDIF}
-    if C=TPasRecordType then
-      UseRecordType(TPasRecordType(El),Mode)
-    else if C=TPasClassType then
-      UseClassType(TPasClassType(El),Mode);
+    if (C=TPasRecordType) or (C=TPasClassType) then
+      UseClassOrRecType(TPasMembersType(El),Mode);
     end
     end
   else
   else
     begin
     begin
@@ -1828,10 +1845,8 @@ begin
         UseExpr(TPasArrayType(El).Ranges[i]);
         UseExpr(TPasArrayType(El).Ranges[i]);
       UseElType(El,TPasArrayType(El).ElType,Mode);
       UseElType(El,TPasArrayType(El).ElType,Mode);
       end
       end
-    else if C=TPasRecordType then
-      UseRecordType(TPasRecordType(El),Mode)
-    else if C=TPasClassType then
-      UseClassType(TPasClassType(El),Mode)
+    else if (C=TPasRecordType) or (C=TPasClassType) then
+      UseClassOrRecType(TPasMembersType(El),Mode)
     else if C=TPasEnumType then
     else if C=TPasEnumType then
       begin
       begin
       if not MarkElementAsUsed(El) then exit;
       if not MarkElementAsUsed(El) then exit;
@@ -1863,22 +1878,7 @@ begin
     end;
     end;
 end;
 end;
 
 
-procedure TPasAnalyzer.UseRecordType(El: TPasRecordType; Mode: TPAUseMode);
-// called by UseType
-var
-  i: Integer;
-begin
-  if Mode=paumAllExports then exit;
-  MarkElementAsUsed(El);
-  if not ElementVisited(El,Mode) then
-    begin
-    if (Mode=paumAllPasUsable) or Resolver.IsTGUID(El) then
-      for i:=0 to El.Members.Count-1 do
-        UseVariable(TObject(El.Members[i]) as TPasVariable,rraNone,true);
-    end;
-end;
-
-procedure TPasAnalyzer.UseClassType(El: TPasClassType; Mode: TPAUseMode);
+procedure TPasAnalyzer.UseClassOrRecType(El: TPasMembersType; Mode: TPAUseMode);
 // called by UseType
 // called by UseType
 
 
   procedure UseDelegations;
   procedure UseDelegations;
@@ -1916,7 +1916,7 @@ procedure TPasAnalyzer.UseClassType(El: TPasClassType; Mode: TPAUseMode);
         Map:=TPasClassIntfMap(o);
         Map:=TPasClassIntfMap(o);
         repeat
         repeat
           if Map.Intf<>nil then
           if Map.Intf<>nil then
-            UseClassType(TPasClassType(Map.Intf),paumElement);
+            UseClassOrRecType(TPasClassType(Map.Intf),paumElement);
           if Map.Procs<>nil then
           if Map.Procs<>nil then
             for j:=0 to Map.Procs.Count-1 do
             for j:=0 to Map.Procs.Count-1 do
               UseProcedure(TPasProcedure(Map.Procs[j]));
               UseProcedure(TPasProcedure(Map.Procs[j]));
@@ -1940,6 +1940,7 @@ var
   o: TObject;
   o: TObject;
   Map: TPasClassIntfMap;
   Map: TPasClassIntfMap;
   ImplProc, IntfProc: TPasProcedure;
   ImplProc, IntfProc: TPasProcedure;
+  aClass: TPasClassType;
 begin
 begin
   FirstTime:=true;
   FirstTime:=true;
   case Mode of
   case Mode of
@@ -1962,35 +1963,54 @@ begin
   {$IFDEF VerbosePasAnalyzer}
   {$IFDEF VerbosePasAnalyzer}
   writeln('TPasAnalyzer.UseClassType ',GetElModName(El),' ',Mode,' First=',FirstTime);
   writeln('TPasAnalyzer.UseClassType ',GetElModName(El),' ',Mode,' First=',FirstTime);
   {$ENDIF}
   {$ENDIF}
-  if El.IsForward then
+  aClass:=nil;
+  ClassScope:=nil;
+  IsCOMInterfaceRoot:=false;
+
+  if El is TPasClassType then
     begin
     begin
-    Ref:=El.CustomData as TResolvedReference;
-    UseClassType(Ref.Declaration as TPasClassType,Mode);
-    exit;
-    end;
+    aClass:=TPasClassType(El);
+    if aClass.IsForward then
+      begin
+      Ref:=aClass.CustomData as TResolvedReference;
+      UseClassOrRecType(Ref.Declaration as TPasClassType,Mode);
+      exit;
+      end;
 
 
-  ClassScope:=El.CustomData as TPasClassScope;
-  if ClassScope=nil then
-    exit; // ClassScope can be nil if msIgnoreInterfaces
+    ClassScope:=aClass.CustomData as TPasClassScope;
+    if ClassScope=nil then
+      exit; // ClassScope can be nil if msIgnoreInterfaces
 
 
-  IsCOMInterfaceRoot:=false;
-  if FirstTime then
-    begin
-    UseElType(El,ClassScope.DirectAncestor,paumElement);
-    UseElType(El,El.HelperForType,paumElement);
-    UseExpr(El.GUIDExpr);
-    // El.Interfaces: using a class does not use automatically the interfaces
-    if El.ObjKind=okInterface then
+    if FirstTime then
       begin
       begin
-      UseDelegations;
-      if (El.InterfaceType=citCom) and (El.AncestorType=nil) then
-        IsCOMInterfaceRoot:=true;
+      UseElType(El,ClassScope.DirectAncestor,paumElement);
+      UseElType(El,aClass.HelperForType,paumElement);
+      UseExpr(aClass.GUIDExpr);
+      // aClass.Interfaces: using a class does not use automatically the interfaces
+      if aClass.ObjKind=okInterface then
+        begin
+        UseDelegations;
+        if (aClass.InterfaceType=citCom) and (aClass.AncestorType=nil) then
+          IsCOMInterfaceRoot:=true;
+        end;
+      if (aClass.ObjKind=okClass) and (ScopeModule<>nil)
+          and (ClassScope.Interfaces<>nil) then
+        // when checking a single unit, mark all method+properties implementing the interfaces
+        MarkAllInterfaceImplementations(ClassScope);
       end;
       end;
-    if (El.ObjKind=okClass) and (ScopeModule<>nil)
-        and (ClassScope.Interfaces<>nil) then
-      // when checking a single unit, mark all method+properties implementing the interfaces
-      MarkAllInterfaceImplementations(ClassScope);
-    end;
+    end
+  else if El is TPasRecordType then
+    begin
+    if (Mode<>paumAllPasUsable) and Resolver.IsTGUID(TPasRecordType(El)) then
+      for i:=0 to El.Members.Count-1 do
+        begin
+        Member:=TPasElement(El.Members[i]);
+        if Member is TPasVariable then
+          UseVariable(TPasVariable(Member),rraNone,true);
+        end;
+    end
+  else
+    RaiseNotSupported(20181229103139,El);
 
 
   // members
   // members
   AllPublished:=(Mode<>paumAllExports);
   AllPublished:=(Mode<>paumAllExports);
@@ -2054,11 +2074,11 @@ begin
       UseTypeInfo(Member);
       UseTypeInfo(Member);
       end
       end
     else
     else
-      ; // else: class is in unit interface, mark all non private members
+      ; // else: class/record is in unit interface, mark all non private members
     UseElement(Member,rraNone,true);
     UseElement(Member,rraNone,true);
     end;
     end;
 
 
-  if FirstTime then
+  if FirstTime and (ClassScope<>nil) then
     begin
     begin
     // method resolution
     // method resolution
     List:=ClassScope.Interfaces;
     List:=ClassScope.Interfaces;
@@ -2070,7 +2090,7 @@ begin
           begin
           begin
           // interface delegation
           // interface delegation
           // Note: This class is used. When the intftype is used, this delegation is used.
           // Note: This class is used. When the intftype is used, this delegation is used.
-          AddOverride(TPasType(El.Interfaces[i]),TPasProperty(o));
+          AddOverride(TPasType(aClass.Interfaces[i]),TPasProperty(o));
           end
           end
         else if o is TPasClassIntfMap then
         else if o is TPasClassIntfMap then
           begin
           begin
@@ -2091,7 +2111,7 @@ begin
             end;
             end;
           end
           end
         else
         else
-          RaiseNotSupported(20180328224632,El,GetObjName(o));
+          RaiseNotSupported(20180328224632,aClass,GetObjName(o));
         end;
         end;
     end;
     end;
 end;
 end;
@@ -2335,6 +2355,7 @@ var
   UsedModule, aModule: TPasModule;
   UsedModule, aModule: TPasModule;
   UsesClause: TPasUsesClause;
   UsesClause: TPasUsesClause;
   Use: TPasUsesUnit;
   Use: TPasUsesUnit;
+  PosEl: TPasElement;
 begin
 begin
   {$IFDEF VerbosePasAnalyzer}
   {$IFDEF VerbosePasAnalyzer}
   writeln('TPasAnalyzer.EmitSectionHints ',GetElModName(Section));
   writeln('TPasAnalyzer.EmitSectionHints ',GetElModName(Section));
@@ -2350,8 +2371,12 @@ begin
       UsedModule:=TPasModule(Use.Module);
       UsedModule:=TPasModule(Use.Module);
       if CompareText(UsedModule.Name,'system')=0 then continue;
       if CompareText(UsedModule.Name,'system')=0 then continue;
       if not PAElementExists(UsedModule) then
       if not PAElementExists(UsedModule) then
+        begin
+        PosEl:=Use.Expr;
+        if PosEl=nil then PosEl:=Use;
         EmitMessage(20170311191725,mtHint,nPAUnitNotUsed,sPAUnitNotUsed,
         EmitMessage(20170311191725,mtHint,nPAUnitNotUsed,sPAUnitNotUsed,
-          [UsedModule.Name,aModule.Name],Use.Expr);
+          [UsedModule.Name,aModule.Name],PosEl);
+        end;
       end;
       end;
     end;
     end;
 
 
@@ -2488,6 +2513,7 @@ var
   ProcScope: TPasProcedureScope;
   ProcScope: TPasProcedureScope;
   PosEl: TPasElement;
   PosEl: TPasElement;
   DeclProc, ImplProc: TPasProcedure;
   DeclProc, ImplProc: TPasProcedure;
+  FuncType: TPasFunctionType;
 begin
 begin
   {$IFDEF VerbosePasAnalyzer}
   {$IFDEF VerbosePasAnalyzer}
   writeln('TPasAnalyzer.EmitProcedureHints ',GetElModName(El));
   writeln('TPasAnalyzer.EmitProcedureHints ',GetElModName(El));
@@ -2553,12 +2579,14 @@ begin
         end;
         end;
       end;
       end;
     // check result
     // check result
-    if (El is TPasFunction) then
+    if (El.ProcType is TPasFunctionType) then
       begin
       begin
-      PosEl:=TPasFunction(El).FuncType.ResultEl;
-      if (ProcScope.ImplProc<>nil) and (TPasFunction(ProcScope.ImplProc).FuncType.ResultEl<>nil) then
+      FuncType:=TPasFunctionType(TPasProcedure(El).ProcType);
+      PosEl:=FuncType.ResultEl;
+      if (ProcScope.ImplProc<>nil)
+          and (TPasFunction(ProcScope.ImplProc).FuncType.ResultEl<>nil) then
         PosEl:=TPasFunction(ProcScope.ImplProc).FuncType.ResultEl;
         PosEl:=TPasFunction(ProcScope.ImplProc).FuncType.ResultEl;
-      Usage:=FindElement(TPasFunction(El).FuncType.ResultEl);
+      Usage:=FindElement(FuncType.ResultEl);
       if (Usage=nil) or (Usage.Access in [paiaNone,paiaRead]) then
       if (Usage=nil) or (Usage.Access in [paiaNone,paiaRead]) then
         // result was never used
         // result was never used
         EmitMessage(20170313214038,mtHint,nPAFunctionResultDoesNotSeemToBeSet,
         EmitMessage(20170313214038,mtHint,nPAFunctionResultDoesNotSeemToBeSet,

Файлын зөрүү хэтэрхий том тул дарагдсан байна
+ 311 - 147
packages/fcl-passrc/src/pparser.pp


+ 33 - 7
packages/fcl-passrc/src/pscanner.pp

@@ -486,6 +486,7 @@ type
     FIncludePaths: TStringList;
     FIncludePaths: TStringList;
     FStrictFileCase : Boolean;
     FStrictFileCase : Boolean;
   Protected
   Protected
+    function FindIncludeFileName(const aFilename: string): String; virtual; abstract;
     procedure SetBaseDirectory(AValue: string); virtual;
     procedure SetBaseDirectory(AValue: string); virtual;
     procedure SetStrictFileCase(AValue: Boolean); virtual;
     procedure SetStrictFileCase(AValue: Boolean); virtual;
     Property IncludePaths: TStringList Read FIncludePaths;
     Property IncludePaths: TStringList Read FIncludePaths;
@@ -509,7 +510,7 @@ type
     FUseStreams: Boolean;
     FUseStreams: Boolean;
     {$endif}
     {$endif}
   Protected
   Protected
-    Function FindIncludeFileName(const AName: string): String; virtual;
+    Function FindIncludeFileName(const AName: string): String; override;
     Function CreateFileReader(Const AFileName : String) : TLineReader; virtual;
     Function CreateFileReader(Const AFileName : String) : TLineReader; virtual;
   Public
   Public
     function FindSourceFile(const AName: string): TLineReader; override;
     function FindSourceFile(const AName: string): TLineReader; override;
@@ -530,6 +531,8 @@ type
     function FindStream(const AName: string; ScanIncludes: Boolean): TStream;
     function FindStream(const AName: string; ScanIncludes: Boolean): TStream;
     function FindStreamReader(const AName: string; ScanIncludes: Boolean): TLineReader;
     function FindStreamReader(const AName: string; ScanIncludes: Boolean): TLineReader;
     procedure SetOwnsStreams(AValue: Boolean);
     procedure SetOwnsStreams(AValue: Boolean);
+  Protected
+    function FindIncludeFileName(const aFilename: string): String; override;
   Public
   Public
     constructor Create; override;
     constructor Create; override;
     destructor Destroy; override;
     destructor Destroy; override;
@@ -746,6 +749,7 @@ type
     procedure SetReadOnlyModeSwitches(const AValue: TModeSwitches);
     procedure SetReadOnlyModeSwitches(const AValue: TModeSwitches);
     procedure SetReadOnlyValueSwitches(const AValue: TValueSwitches);
     procedure SetReadOnlyValueSwitches(const AValue: TValueSwitches);
   protected
   protected
+    function ReadIdentifier(const AParam: string): string;
     function FetchLine: boolean;
     function FetchLine: boolean;
     procedure AddFile(aFilename: string); virtual;
     procedure AddFile(aFilename: string); virtual;
     function GetMacroName(const Param: String): String;
     function GetMacroName(const Param: String): String;
@@ -2539,6 +2543,12 @@ begin
   FOwnsStreams:=AValue;
   FOwnsStreams:=AValue;
 end;
 end;
 
 
+function TStreamResolver.FindIncludeFileName(const aFilename: string): String;
+begin
+  raise EFileNotFoundError.Create('TStreamResolver.FindIncludeFileName not supported '+aFilename);
+  Result:='';
+end;
+
 constructor TStreamResolver.Create;
 constructor TStreamResolver.Create;
 begin
 begin
   Inherited;
   Inherited;
@@ -3448,13 +3458,16 @@ begin
 end;
 end;
 
 
 procedure TPascalScanner.HandleIFDEF(const AParam: String);
 procedure TPascalScanner.HandleIFDEF(const AParam: String);
+var
+  aName: String;
 begin
 begin
   PushSkipMode;
   PushSkipMode;
   if PPIsSkipping then
   if PPIsSkipping then
     PPSkipMode := ppSkipAll
     PPSkipMode := ppSkipAll
   else
   else
     begin
     begin
-    if IsDefined(AParam) then
+    aName:=ReadIdentifier(AParam);
+    if IsDefined(aName) then
       PPSkipMode := ppSkipElseBranch
       PPSkipMode := ppSkipElseBranch
     else
     else
       begin
       begin
@@ -3463,20 +3476,23 @@ begin
       end;
       end;
     If LogEvent(sleConditionals) then
     If LogEvent(sleConditionals) then
       if PPSkipMode=ppSkipElseBranch then
       if PPSkipMode=ppSkipElseBranch then
-        DoLog(mtInfo,nLogIFDefAccepted,sLogIFDefAccepted,[AParam])
+        DoLog(mtInfo,nLogIFDefAccepted,sLogIFDefAccepted,[aName])
       else
       else
-        DoLog(mtInfo,nLogIFDefRejected,sLogIFDefRejected,[AParam]);
+        DoLog(mtInfo,nLogIFDefRejected,sLogIFDefRejected,[aName]);
     end;
     end;
 end;
 end;
 
 
 procedure TPascalScanner.HandleIFNDEF(const AParam: String);
 procedure TPascalScanner.HandleIFNDEF(const AParam: String);
+var
+  aName: String;
 begin
 begin
   PushSkipMode;
   PushSkipMode;
   if PPIsSkipping then
   if PPIsSkipping then
     PPSkipMode := ppSkipAll
     PPSkipMode := ppSkipAll
   else
   else
     begin
     begin
-    if IsDefined(AParam) then
+    aName:=ReadIdentifier(AParam);
+    if IsDefined(aName) then
       begin
       begin
       PPSkipMode := ppSkipIfBranch;
       PPSkipMode := ppSkipIfBranch;
       PPIsSkipping := true;
       PPIsSkipping := true;
@@ -3485,9 +3501,9 @@ begin
       PPSkipMode := ppSkipElseBranch;
       PPSkipMode := ppSkipElseBranch;
     If LogEvent(sleConditionals) then
     If LogEvent(sleConditionals) then
       if PPSkipMode=ppSkipElseBranch then
       if PPSkipMode=ppSkipElseBranch then
-        DoLog(mtInfo,nLogIFNDefAccepted,sLogIFNDefAccepted,[AParam])
+        DoLog(mtInfo,nLogIFNDefAccepted,sLogIFNDefAccepted,[aName])
       else
       else
-        DoLog(mtInfo,nLogIFNDefRejected,sLogIFNDefRejected,[AParam]);
+        DoLog(mtInfo,nLogIFNDefRejected,sLogIFNDefRejected,[aName]);
     end;
     end;
 end;
 end;
 
 
@@ -4673,6 +4689,16 @@ begin
   FReadOnlyValueSwitches:=AValue;
   FReadOnlyValueSwitches:=AValue;
 end;
 end;
 
 
+function TPascalScanner.ReadIdentifier(const AParam: string): string;
+var
+  p, l: Integer;
+begin
+  p:=1;
+  l:=length(AParam);
+  while (p<=l) and (AParam[p] in IdentChars) do inc(p);
+  Result:=LeftStr(AParam,p-1);
+end;
+
 function TPascalScanner.FetchLine: boolean;
 function TPascalScanner.FetchLine: boolean;
 begin
 begin
   if CurSourceFile.IsEOF then
   if CurSourceFile.IsEOF then

+ 3 - 1
packages/fcl-passrc/tests/tcclasstype.pas

@@ -253,6 +253,8 @@ procedure TTestClassType.StartClass(AncestorName: String; InterfaceList: String)
 Var
 Var
   S : String;
   S : String;
 begin
 begin
+  if FStarted then
+    Fail('TTestClassType.StartClass already started');
   FStarted:=True;
   FStarted:=True;
   S:='TMyClass = Class';
   S:='TMyClass = Class';
   if (AncestorName<>'') then
   if (AncestorName<>'') then
@@ -426,7 +428,7 @@ end;
 procedure TTestClassType.SetUp;
 procedure TTestClassType.SetUp;
 begin
 begin
   inherited SetUp;
   inherited SetUp;
-  FDecl:=TstringList.Create;
+  FDecl:=TStringList.Create;
   FClass:=Nil;
   FClass:=Nil;
   FParent:='';
   FParent:='';
   FStarted:=False;
   FStarted:=False;

Файлын зөрүү хэтэрхий том тул дарагдсан байна
+ 1031 - 39
packages/fcl-passrc/tests/tcresolver.pas


+ 1 - 1
packages/fcl-passrc/tests/tcscanner.pas

@@ -1404,7 +1404,7 @@ procedure TTestScanner.TestDefine2;
 
 
 begin
 begin
   FSCanner.Defines.Add('ALWAYS');
   FSCanner.Defines.Add('ALWAYS');
-  TestTokens([tkComment,tkWhitespace,tkOf,tkWhitespace,tkcomment],'{$IFDEF ALWAYS} of {$ENDIF}');
+  TestTokens([tkComment,tkWhitespace,tkOf,tkWhitespace,tkcomment],'{$IFDEF ALWAYS comment} of {$ENDIF}');
 end;
 end;
 
 
 procedure TTestScanner.TestDefine21;
 procedure TTestScanner.TestDefine21;

+ 236 - 38
packages/fcl-passrc/tests/tctypeparser.pas

@@ -171,19 +171,33 @@ type
 
 
   { TTestRecordTypeParser }
   { TTestRecordTypeParser }
 
 
-  TTestRecordTypeParser= Class(TBaseTestTypeParser)
+  TTestRecordTypeParser = Class(TBaseTestTypeParser)
   private
   private
+    FDecl : TStrings;
+    FAdvanced,
+    FEnded,
+    FStarted: boolean;
+    FRecord: TPasRecordType;
+    FMember1: TPasElement;
     function GetC(AIndex: Integer): TPasConst;
     function GetC(AIndex: Integer): TPasConst;
     Function GetField(AIndex : Integer; R : TPasRecordType) : TPasVariable;
     Function GetField(AIndex : Integer; R : TPasRecordType) : TPasVariable;
     Function GetField(AIndex : Integer; R : TPasVariant) : TPasVariable;
     Function GetField(AIndex : Integer; R : TPasVariant) : TPasVariable;
     function GetF(AIndex: Integer): TPasVariable;
     function GetF(AIndex: Integer): TPasVariable;
-    function GetR: TPasRecordType;
+    function GetM(AIndex : Integer): TPasElement;
     Function GetVariant(AIndex : Integer; R : TPasRecordType) : TPasVariant;
     Function GetVariant(AIndex : Integer; R : TPasRecordType) : TPasVariant;
     function GetV(AIndex: Integer): TPasVariant;
     function GetV(AIndex: Integer): TPasVariant;
   Protected
   Protected
+    procedure SetUp; override;
+    procedure TearDown; override;
+    Procedure StartRecord(Advanced: boolean = false);
+    Procedure EndRecord(AEnd : String = 'end');
+    Procedure AddMember(S : String);
+    Procedure ParseRecord;
+    Procedure ParseRecordFail(Msg: string; MsgNumber: integer);
+    Procedure DoParseRecord;
     Procedure TestFields(Const Fields : Array of string; AHint : String; HaveVariant : Boolean = False);
     Procedure TestFields(Const Fields : Array of string; AHint : String; HaveVariant : Boolean = False);
     procedure AssertVariantSelector(AName, AType: string);
     procedure AssertVariantSelector(AName, AType: string);
-    procedure AssertConst1(Hints: TPasMemberHints);
+    procedure AssertConst1(Hints: TPasMemberHints; Index: integer = 1);
     procedure AssertField1(Hints: TPasMemberHints);
     procedure AssertField1(Hints: TPasMemberHints);
     procedure AssertField2(Hints: TPasMemberHints);
     procedure AssertField2(Hints: TPasMemberHints);
     procedure AssertMethod2(Hints: TPasMemberHints; isClass : Boolean = False);
     procedure AssertMethod2(Hints: TPasMemberHints; isClass : Boolean = False);
@@ -216,12 +230,15 @@ type
     procedure DoTestVariantNestedVariantFirstDeprecated(Const AHint : string);
     procedure DoTestVariantNestedVariantFirstDeprecated(Const AHint : string);
     procedure DoTestVariantNestedVariantSecondDeprecated(const AHint: string);
     procedure DoTestVariantNestedVariantSecondDeprecated(const AHint: string);
     procedure DoTestVariantNestedVariantBothDeprecated(const AHint: string);
     procedure DoTestVariantNestedVariantBothDeprecated(const AHint: string);
-    Property TheRecord : TPasRecordType Read GetR;
+    Property TheRecord : TPasRecordType Read FRecord;
+    Property Advanced: boolean read FAdvanced;
     Property Const1 : TPasConst Index 0 Read GetC;
     Property Const1 : TPasConst Index 0 Read GetC;
     Property Field1 : TPasVariable Index 0 Read GetF;
     Property Field1 : TPasVariable Index 0 Read GetF;
     Property Field2 : TPasVariable Index 1 Read GetF;
     Property Field2 : TPasVariable Index 1 Read GetF;
     Property Variant1 : TPasVariant Index 0 Read GetV;
     Property Variant1 : TPasVariant Index 0 Read GetV;
     Property Variant2 : TPasVariant Index 1 Read GetV;
     Property Variant2 : TPasVariant Index 1 Read GetV;
+    Property Members[AIndex : Integer] : TPasElement Read GetM;
+    Property Member1 : TPasElement Read FMember1;
   Published
   Published
     Procedure TestEmpty;
     Procedure TestEmpty;
     Procedure TestEmptyComment;
     Procedure TestEmptyComment;
@@ -240,7 +257,6 @@ type
     Procedure TestOnePlatformField;
     Procedure TestOnePlatformField;
     Procedure TestOnePlatformFieldDeprecated;
     Procedure TestOnePlatformFieldDeprecated;
     Procedure TestOnePlatformFieldPlatform;
     Procedure TestOnePlatformFieldPlatform;
-    Procedure TestOneConstOneField;
     Procedure TestOneGenericField;
     Procedure TestOneGenericField;
     Procedure TestTwoFields;
     Procedure TestTwoFields;
     procedure TestTwoFieldProtected;
     procedure TestTwoFieldProtected;
@@ -333,6 +349,17 @@ type
     Procedure TestVariantNestedVariantBothDeprecatedDeprecated;
     Procedure TestVariantNestedVariantBothDeprecatedDeprecated;
     Procedure TestVariantNestedVariantBothDeprecatedPlatform;
     Procedure TestVariantNestedVariantBothDeprecatedPlatform;
     Procedure TestOperatorField;
     Procedure TestOperatorField;
+    Procedure TestPropertyFail;
+    Procedure TestAdvRec_TwoConst;
+    Procedure TestAdvRec_Property;
+    Procedure TestAdvRec_PropertyImplementsFail;
+    Procedure TestAdvRec_PropertyNoTypeFail;
+    Procedure TestAdvRec_ForwardFail;
+    Procedure TestAdvRec_PublishedFail;
+    Procedure TestAdvRec_ProcVirtualFail;
+    Procedure TestAdvRec_ProcOverrideFail;
+    Procedure TestAdvRec_ProcMessageFail;
+    Procedure TestAdvRec_DestructorFail;
   end;
   end;
 
 
   { TTestProcedureTypeParser }
   { TTestProcedureTypeParser }
@@ -1148,7 +1175,7 @@ end;
 
 
 function TTestRecordTypeParser.GetC(AIndex: Integer): TPasConst;
 function TTestRecordTypeParser.GetC(AIndex: Integer): TPasConst;
 begin
 begin
-  Result:=TObject(GetR.Members[AIndex]) as TPasConst;
+  Result:=TObject(TheRecord.Members[AIndex]) as TPasConst;
 end;
 end;
 
 
 function TTestRecordTypeParser.GetField(AIndex: Integer; R: TPasRecordType
 function TTestRecordTypeParser.GetField(AIndex: Integer; R: TPasRecordType
@@ -1174,12 +1201,18 @@ end;
 
 
 function TTestRecordTypeParser.GetF(AIndex: Integer): TPasVariable;
 function TTestRecordTypeParser.GetF(AIndex: Integer): TPasVariable;
 begin
 begin
-  Result:=GetField(AIndex,GetR);
+  Result:=GetField(AIndex,TheRecord);
 end;
 end;
 
 
-function TTestRecordTypeParser.GetR: TPasRecordType;
+function TTestRecordTypeParser.GetM(AIndex : Integer): TPasElement;
 begin
 begin
-  Result:=TheType as TPasRecordType;
+  AssertNotNull('Have Record',TheRecord);
+  if (AIndex>=TheRecord.Members.Count) then
+    Fail('No member '+IntToStr(AIndex));
+  AssertNotNull('Have member'+IntToStr(AIndex),TheRecord.Members[AIndex]);
+  If Not (TObject(TheRecord.Members[AIndex]) is TPasElement) then
+    Fail('Member '+IntTostr(AIndex)+' is not a TPasElement');
+  Result:=TPasElement(TheRecord.Members[AIndex])
 end;
 end;
 
 
 function TTestRecordTypeParser.GetVariant(AIndex: Integer; R: TPasRecordType
 function TTestRecordTypeParser.GetVariant(AIndex: Integer; R: TPasRecordType
@@ -1194,7 +1227,95 @@ end;
 
 
 function TTestRecordTypeParser.GetV(AIndex: Integer): TPasVariant;
 function TTestRecordTypeParser.GetV(AIndex: Integer): TPasVariant;
 begin
 begin
-  Result:=GetVariant(AIndex,GetR);
+  Result:=GetVariant(AIndex,TheRecord);
+end;
+
+procedure TTestRecordTypeParser.SetUp;
+begin
+  inherited SetUp;
+  FDecl:=TStringList.Create;
+  FStarted:=false;
+  FEnded:=false;
+end;
+
+procedure TTestRecordTypeParser.TearDown;
+begin
+  FreeAndNil(FDecl);
+  inherited TearDown;
+end;
+
+procedure TTestRecordTypeParser.StartRecord(Advanced: boolean);
+var
+  S: String;
+begin
+  if FStarted then
+    Fail('TTestRecordTypeParser.StartRecord already started');
+  FStarted:=True;
+  S:='TMyRecord = record';
+  if Advanced then
+    S:='{$modeswitch advancedrecords}'+sLineBreak+S;
+  FDecl.Add(S);
+end;
+
+procedure TTestRecordTypeParser.EndRecord(AEnd: String);
+begin
+  if FEnded then exit;
+  if not FStarted then
+    StartRecord;
+  FEnded:=True;
+  if (AEnd<>'') then
+    FDecl.Add('  '+AEnd);
+end;
+
+procedure TTestRecordTypeParser.AddMember(S: String);
+begin
+  if Not FStarted then
+    StartRecord;
+  FDecl.Add('    '+S);
+end;
+
+procedure TTestRecordTypeParser.ParseRecord;
+begin
+  DoParseRecord;
+end;
+
+procedure TTestRecordTypeParser.ParseRecordFail(Msg: string; MsgNumber: integer
+  );
+var
+  ok: Boolean;
+begin
+  ok:=false;
+  try
+    ParseRecord;
+  except
+    on E: EParserError do
+      begin
+      AssertEquals('Expected {'+Msg+'} '+IntToStr(MsgNumber)+', but got msg {'+Parser.LastMsg+'} '+IntToStr(Parser.LastMsgNumber),MsgNumber,Parser.LastMsgNumber);
+      AssertEquals('Expected {'+Msg+'}, but got msg {'+Parser.LastMsg+'}',Msg,Parser.LastMsg);
+      ok:=true;
+      end;
+  end;
+  AssertEquals('Missing parser error {'+Msg+'} ('+IntToStr(MsgNumber)+')',true,ok);
+end;
+
+procedure TTestRecordTypeParser.DoParseRecord;
+begin
+  EndRecord;
+  Add('Type');
+  if AddComment then
+    begin
+    Add('// A comment');
+    Engine.NeedComments:=True;
+    end;
+  Add('  '+TrimRight(FDecl.Text)+';');
+  ParseDeclarations;
+  AssertEquals('One record type definition',1,Declarations.Types.Count);
+  AssertEquals('First declaration is type definition.',TPasRecordType,TObject(Declarations.Types[0]).ClassType);
+  FRecord:=TObject(Declarations.Types[0]) as TPasRecordType;
+  TheType:=FRecord; // needed by AssertComment
+  Definition:=TheType; // needed by CheckHint
+  if TheRecord.Members.Count>0 then
+    FMember1:=TObject(TheRecord.Members[0]) as TPasElement;
 end;
 end;
 
 
 procedure TTestRecordTypeParser.TestFields(const Fields: array of string;
 procedure TTestRecordTypeParser.TestFields(const Fields: array of string;
@@ -1205,17 +1326,14 @@ Var
   I : integer;
   I : integer;
 
 
 begin
 begin
-  S:='';
+  StartRecord;
   For I:=Low(Fields) to High(Fields) do
   For I:=Low(Fields) to High(Fields) do
-    begin
-    if (S<>'') then
-      S:=S+sLineBreak;
-    S:=S+'    '+Fields[i];
-    end;
-  if (S<>'') then
-    S:=S+sLineBreak;
-  S:='record'+sLineBreak+s+'  end';
-  ParseType(S,TPasRecordType,AHint);
+    AddMember(Fields[i]);
+  S:='end';
+  if AHint<>'' then
+    S:=S+' '+AHint;
+  EndRecord(S);
+  ParseRecord;
   if HaveVariant then
   if HaveVariant then
     begin
     begin
     AssertNotNull('Have variants',TheRecord.Variants);
     AssertNotNull('Have variants',TheRecord.Variants);
@@ -1228,6 +1346,8 @@ begin
     end;
     end;
   if AddComment then
   if AddComment then
     AssertComment;
     AssertComment;
+  if (AHint<>'') then
+    CheckHint(TPasMemberHint(GetEnumValue(TypeInfo(TPasMemberHint),'h'+AHint)));
 end;
 end;
 
 
 procedure TTestRecordTypeParser.AssertVariantSelector(AName,AType : string);
 procedure TTestRecordTypeParser.AssertVariantSelector(AName,AType : string);
@@ -1250,15 +1370,15 @@ begin
     end;
     end;
 end;
 end;
 
 
-procedure TTestRecordTypeParser.AssertConst1(Hints: TPasMemberHints);
+procedure TTestRecordTypeParser.AssertConst1(Hints: TPasMemberHints;
+  Index: integer);
 begin
 begin
   if Hints=[] then ;
   if Hints=[] then ;
-  AssertEquals('Member 1 type',TPasConst,TObject(TheRecord.Members[0]).ClassType);
-  AssertEquals('Const 1 name','x',Const1.Name);
-  AssertNotNull('Have 1 const expr',Const1.Expr);
+  AssertEquals('Member '+IntToStr(Index+1)+' type',TPasConst,TObject(TheRecord.Members[Index]).ClassType);
+  AssertEquals('Const '+IntToStr(Index+1)+' name','x',Const1.Name);
+  AssertNotNull('Have '+IntToStr(Index+1)+' const expr',Const1.Expr);
 end;
 end;
 
 
-
 procedure TTestRecordTypeParser.DoTestEmpty(const AHint: String);
 procedure TTestRecordTypeParser.DoTestEmpty(const AHint: String);
 begin
 begin
   TestFields([],AHint);
   TestFields([],AHint);
@@ -1271,7 +1391,6 @@ begin
   AssertVariant1(Hints,['0']);
   AssertVariant1(Hints,['0']);
 end;
 end;
 
 
-
 procedure TTestRecordTypeParser.AssertVariant1(Hints: TPasMemberHints;
 procedure TTestRecordTypeParser.AssertVariant1(Hints: TPasMemberHints;
   VariantLabels: array of string);
   VariantLabels: array of string);
 
 
@@ -1787,15 +1906,6 @@ begin
   AssertOneIntegerField([hplatform]);
   AssertOneIntegerField([hplatform]);
 end;
 end;
 
 
-procedure TTestRecordTypeParser.TestOneConstOneField;
-begin
-  Scanner.Options:=[po_Delphi];
-  TestFields(['public','Const x =123;','y : integer'],'',False);
-  AssertConst1([]);
-  AssertEquals('Correct visibility',visPublic,TPasConst(TheRecord.Members[0]).Visibility);
-  AssertField2([]);
-end;
-
 procedure TTestRecordTypeParser.TestOneGenericField;
 procedure TTestRecordTypeParser.TestOneGenericField;
 begin
 begin
   TestFields(['Generic : Integer;'],'',False);
   TestFields(['Generic : Integer;'],'',False);
@@ -2043,6 +2153,7 @@ Var
   P : TPasFunction;
   P : TPasFunction;
 
 
 begin
 begin
+  Scanner.CurrentModeSwitches:=Scanner.CurrentModeSwitches+[msAdvancedRecords];
   TestFields(['x : integer;','class operator assign(a : ta; b : Cardinal) : boolean;','function dosomething3 : Integer;'],'',False);
   TestFields(['x : integer;','class operator assign(a : ta; b : Cardinal) : boolean;','function dosomething3 : Integer;'],'',False);
   AssertEquals('Member count',3,TheRecord.Members.Count);
   AssertEquals('Member count',3,TheRecord.Members.Count);
   AssertField1([]);
   AssertField1([]);
@@ -2057,6 +2168,7 @@ end;
 
 
 procedure TTestRecordTypeParser.TestFieldAndClassVar;
 procedure TTestRecordTypeParser.TestFieldAndClassVar;
 begin
 begin
+  Scanner.CurrentModeSwitches:=Scanner.CurrentModeSwitches+[msAdvancedRecords];
   TestFields(['x : integer;','class var y : integer;'],'',False);
   TestFields(['x : integer;','class var y : integer;'],'',False);
   AssertField1([]);
   AssertField1([]);
   AssertTrue('Second field is class var',vmClass in Field2.VarModifiers);
   AssertTrue('Second field is class var',vmClass in Field2.VarModifiers);
@@ -2064,6 +2176,7 @@ end;
 
 
 procedure TTestRecordTypeParser.TestFieldAndVar;
 procedure TTestRecordTypeParser.TestFieldAndVar;
 begin
 begin
+  Scanner.CurrentModeSwitches:=Scanner.CurrentModeSwitches+[msAdvancedRecords];
   TestFields(['x : integer;','var y : integer;'],'',False);
   TestFields(['x : integer;','var y : integer;'],'',False);
   AssertField1([]);
   AssertField1([]);
   AssertTrue('Second field is regular var',not (vmClass in Field2.VarModifiers));
   AssertTrue('Second field is regular var',not (vmClass in Field2.VarModifiers));
@@ -2408,6 +2521,91 @@ begin
   AssertEquals('Field 1 name','operator',Field1.Name);
   AssertEquals('Field 1 name','operator',Field1.Name);
 end;
 end;
 
 
+procedure TTestRecordTypeParser.TestPropertyFail;
+begin
+  AddMember('Property Something');
+  ParseRecordFail(SErrRecordPropertiesNotAllowed,nErrRecordPropertiesNotAllowed);
+end;
+
+procedure TTestRecordTypeParser.TestAdvRec_TwoConst;
+var
+  aConst: TPasConst;
+begin
+  Scanner.Options:=[po_Delphi];
+  TestFields(['public','Const x =123;','y : integer = 456'],'',False);
+  AssertEquals('Two Const',2,TheRecord.Members.Count);
+  AssertConst1([]);
+  AssertEquals('Correct visibility',visPublic,TPasConst(TheRecord.Members[0]).Visibility);
+  AssertEquals('Member 2 type',TPasConst,TObject(TheRecord.Members[1]).ClassType);
+  aConst:=TPasConst(TheRecord.Members[1]);
+  AssertEquals('Const 2 name','y',aConst.Name);
+  AssertNotNull('Have 2 const expr',aConst.Expr);
+end;
+
+procedure TTestRecordTypeParser.TestAdvRec_Property;
+begin
+  StartRecord(true);
+  AddMember('Property Something: word');
+  ParseRecord;
+end;
+
+procedure TTestRecordTypeParser.TestAdvRec_PropertyImplementsFail;
+begin
+  StartRecord(true);
+  AddMember('Property Something: word implements ISome;');
+  ParseRecordFail('Expected ";"',nParserExpectTokenError);
+end;
+
+procedure TTestRecordTypeParser.TestAdvRec_PropertyNoTypeFail;
+begin
+  StartRecord(true);
+  AddMember('Property Something;');
+  ParseRecordFail('Expected ":"',nParserExpectTokenError);
+end;
+
+procedure TTestRecordTypeParser.TestAdvRec_ForwardFail;
+begin
+  StartRecord(true);
+  FDecl.Add(';TMyRecord = record');
+  ParseRecordFail('Syntax error in type',nParserTypeSyntaxError);
+end;
+
+procedure TTestRecordTypeParser.TestAdvRec_PublishedFail;
+begin
+  StartRecord(true);
+  AddMember('published');
+  AddMember('A: word;');
+  ParseRecordFail(SParserInvalidRecordVisibility,nParserInvalidRecordVisibility);
+end;
+
+procedure TTestRecordTypeParser.TestAdvRec_ProcVirtualFail;
+begin
+  StartRecord(true);
+  AddMember('procedure DoIt; virtual;');
+  ParseRecordFail(SParserExpectedCommaColon,nParserExpectedCommaColon);
+end;
+
+procedure TTestRecordTypeParser.TestAdvRec_ProcOverrideFail;
+begin
+  StartRecord(true);
+  AddMember('procedure DoIt; override;');
+  ParseRecordFail(SParserExpectedCommaColon,nParserExpectedCommaColon);
+end;
+
+procedure TTestRecordTypeParser.TestAdvRec_ProcMessageFail;
+begin
+  StartRecord(true);
+  AddMember('procedure DoIt; message 2;');
+  ParseRecordFail(SParserExpectedCommaColon,nParserExpectedCommaColon);
+end;
+
+procedure TTestRecordTypeParser.TestAdvRec_DestructorFail;
+begin
+  StartRecord(true);
+  AddMember('destructor Free;');
+  ParseRecordFail(SParserNoConstructorAllowed,nParserNoConstructorAllowed);
+end;
+
 { TBaseTestTypeParser }
 { TBaseTestTypeParser }
 
 
 Function TBaseTestTypeParser.ParseType(ASource: String; ATypeClass: TClass;
 Function TBaseTestTypeParser.ParseType(ASource: String; ATypeClass: TClass;
@@ -2434,9 +2632,9 @@ begin
     AssertEquals('One type definition',1,Declarations.Classes.Count)
     AssertEquals('One type definition',1,Declarations.Classes.Count)
   else
   else
     AssertEquals('One type definition',1,Declarations.Types.Count);
     AssertEquals('One type definition',1,Declarations.Types.Count);
-  If (AtypeClass<>Nil) then
+  If ATypeClass<>Nil then
     begin
     begin
-    if ATypeClass.InHeritsFrom(TPasClassType) then
+    if ATypeClass.InheritsFrom(TPasClassType) then
       Result:=TPasType(Declarations.Classes[0])
       Result:=TPasType(Declarations.Classes[0])
     else
     else
       Result:=TPasType(Declarations.Types[0]);
       Result:=TPasType(Declarations.Types[0]);
@@ -2446,7 +2644,7 @@ begin
   FType:=Result;
   FType:=Result;
   Definition:=Result;
   Definition:=Result;
   if (Hint<>'') then
   if (Hint<>'') then
-    CheckHint(TPasMemberHint(Getenumvalue(typeinfo(TPasMemberHint),'h'+Hint)));
+    CheckHint(TPasMemberHint(GetEnumValue(TypeInfo(TPasMemberHint),'h'+Hint)));
 end;
 end;
 
 
 Procedure TBaseTestTypeParser.AssertParseTypeError(ASource: String);
 Procedure TBaseTestTypeParser.AssertParseTypeError(ASource: String);

+ 37 - 0
packages/fcl-passrc/tests/tcuseanalyzer.pas

@@ -72,6 +72,7 @@ type
     procedure TestM_NestedFuncResult;
     procedure TestM_NestedFuncResult;
     procedure TestM_Enums;
     procedure TestM_Enums;
     procedure TestM_ProcedureType;
     procedure TestM_ProcedureType;
+    procedure TestM_AnonymousProc;
     procedure TestM_Params;
     procedure TestM_Params;
     procedure TestM_Class;
     procedure TestM_Class;
     procedure TestM_ClassForward;
     procedure TestM_ClassForward;
@@ -127,6 +128,7 @@ type
     procedure TestM_Hint_FunctionResultRecord;
     procedure TestM_Hint_FunctionResultRecord;
     procedure TestM_Hint_FunctionResultPassRecordElement;
     procedure TestM_Hint_FunctionResultPassRecordElement;
     procedure TestM_Hint_FunctionResultAssembler;
     procedure TestM_Hint_FunctionResultAssembler;
+    procedure TestM_Hint_FunctionResultExit;
     procedure TestM_Hint_AbsoluteVar;
     procedure TestM_Hint_AbsoluteVar;
 
 
     // whole program optimization
     // whole program optimization
@@ -999,6 +1001,27 @@ begin
   AnalyzeProgram;
   AnalyzeProgram;
 end;
 end;
 
 
+procedure TTestUseAnalyzer.TestM_AnonymousProc;
+begin
+  StartProgram(false);
+  Add([
+  'type',
+  '  {#TProc_used}TProc = reference to procedure;',
+  'procedure {#DoIt_used}DoIt;',
+  'var',
+  '  {#p_used}p: TProc;',
+  '  {#i_used}i: longint;',
+  'begin',
+  '  p:=procedure',
+  '    begin',
+  '      i:=3;',
+  '    end;',
+  'end;',
+  'begin',
+  '  DoIt;']);
+  AnalyzeProgram;
+end;
+
 procedure TTestUseAnalyzer.TestM_Params;
 procedure TTestUseAnalyzer.TestM_Params;
 begin
 begin
   StartProgram(false);
   StartProgram(false);
@@ -2136,6 +2159,20 @@ begin
   CheckUseAnalyzerUnexpectedHints;
   CheckUseAnalyzerUnexpectedHints;
 end;
 end;
 
 
+procedure TTestUseAnalyzer.TestM_Hint_FunctionResultExit;
+begin
+  StartProgram(false);
+  Add([
+  'function GetIt: longint;',
+  'begin',
+  '  exit(3);',
+  'end;',
+  'begin',
+  '  GetIt;']);
+  AnalyzeProgram;
+  CheckUseAnalyzerUnexpectedHints;
+end;
+
 procedure TTestUseAnalyzer.TestM_Hint_AbsoluteVar;
 procedure TTestUseAnalyzer.TestM_Hint_AbsoluteVar;
 begin
 begin
   StartProgram(false);
   StartProgram(false);

+ 13 - 1
packages/pastojs/fpmake.pp

@@ -44,7 +44,11 @@ begin
     T:=P.Targets.AddUnit('fppas2js.pp');
     T:=P.Targets.AddUnit('fppas2js.pp');
       T.ResourceStrings:=true;
       T.ResourceStrings:=true;
     T:=P.Targets.AddUnit('fppjssrcmap.pp');
     T:=P.Targets.AddUnit('fppjssrcmap.pp');
+    T:=P.Targets.AddUnit('pas2jsfs.pp');
+    T:=P.Targets.AddUnit('pas2jsutils.pp');
     T:=P.Targets.AddUnit('pas2jsfilecache.pp');
     T:=P.Targets.AddUnit('pas2jsfilecache.pp');
+      T.Dependencies.AddUnit('pas2jsfs');
+      T.Dependencies.AddUnit('pas2jsutils');
     T:=P.Targets.AddUnit('pas2jsfileutils.pp');
     T:=P.Targets.AddUnit('pas2jsfileutils.pp');
       T.Dependencies.AddInclude('pas2js_defines.inc');
       T.Dependencies.AddInclude('pas2js_defines.inc');
       T.Dependencies.AddInclude('pas2jsfileutilsunix.inc',AllUnixOSes);
       T.Dependencies.AddInclude('pas2jsfileutilsunix.inc',AllUnixOSes);
@@ -52,10 +56,18 @@ begin
     T:=P.Targets.AddUnit('pas2jslogger.pp');
     T:=P.Targets.AddUnit('pas2jslogger.pp');
     T:=P.Targets.AddUnit('pas2jspparser.pp');
     T:=P.Targets.AddUnit('pas2jspparser.pp');
     T:=P.Targets.AddUnit('pas2jscompiler.pp');
     T:=P.Targets.AddUnit('pas2jscompiler.pp');
+    T:=P.Targets.AddUnit('pas2jsfscompiler.pp');
+      T.Dependencies.AddUnit('pas2jscompiler');
     T:=P.Targets.AddUnit('pas2jspcucompiler.pp');
     T:=P.Targets.AddUnit('pas2jspcucompiler.pp');
+      T.Dependencies.AddUnit('pas2jsfscompiler');
+    T:=P.Targets.AddUnit('pas2jscompilercfg.pp');
       T.Dependencies.AddUnit('pas2jscompiler');
       T.Dependencies.AddUnit('pas2jscompiler');
-    T:=P.Targets.AddUnit('pas2jslibcompiler.pp');
+    T:=P.Targets.AddUnit('pas2jscompilerpp.pp');
       T.Dependencies.AddUnit('pas2jscompiler');
       T.Dependencies.AddUnit('pas2jscompiler');
+    T:=P.Targets.AddUnit('pas2jslibcompiler.pp');
+      T.Dependencies.AddUnit('pas2jspcucompiler');
+      T.Dependencies.AddUnit('pas2jscompilercfg');
+      T.Dependencies.AddUnit('pas2jscompilerpp');
 {$ifndef ALLPACKAGES}
 {$ifndef ALLPACKAGES}
     Run;
     Run;
     end;
     end;

Файлын зөрүү хэтэрхий том тул дарагдсан байна
+ 373 - 107
packages/pastojs/src/fppas2js.pp


+ 5 - 0
packages/pastojs/src/pas2js_defines.inc

@@ -19,6 +19,11 @@
   {$DEFINE UTF8_RTL}
   {$DEFINE UTF8_RTL}
   {$DEFINE HasStdErr}
   {$DEFINE HasStdErr}
   {$DEFINE HasPas2jsFiler}
   {$DEFINE HasPas2jsFiler}
+  {$DEFINE HASFILESYSTEM}
+{$ENDIF}
+
+{$IFDEF NODEJS}
+{$DEFINE HASFILESYSTEM}
 {$ENDIF}
 {$ENDIF}
 
 
 
 

Файлын зөрүү хэтэрхий том тул дарагдсан байна
+ 325 - 570
packages/pastojs/src/pas2jscompiler.pp


+ 97 - 0
packages/pastojs/src/pas2jscompilercfg.pp

@@ -0,0 +1,97 @@
+{
+    This file is part of the Free Component Library (FCL)
+    Copyright (c) 2018  Michael Van Canneyt
+
+    Pascal to Javascript converter class.
+
+    See the file COPYING.FPC, included in this distribution,
+    for details about the copyright.
+
+    This program is distributed in the hope that it will be useful,
+    but WITHOUT ANY WARRANTY; without even the implied warranty of
+    MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.
+
+ **********************************************************************
+
+  Abstract:
+    Config file handling for compiler, depends on filesystem.
+}
+unit Pas2JSCompilerCfg;
+
+{$mode objfpc}{$H+}
+
+interface
+
+uses
+  {$IFDEF NodeJS}
+  NodeJSFS,
+  {$ENDIF}
+  Classes, SysUtils, Pas2jsFileUtils, Pas2JSFS, Pas2jsCompiler;
+
+Type
+  TPas2JSFileConfigSupport = Class(TPas2JSConfigSupport)
+    function FindDefaultConfig: String; override;
+    function GetReader(aFileName: string): TSourceLineReader; override;
+  end;
+
+implementation
+
+function TPas2JSFileConfigSupport.GetReader(aFileName: string): TSourceLineReader;
+
+Var
+  CacheFile: TPas2jsFile;
+
+begin
+  CacheFile:=Compiler.FS.LoadFile(aFilename);
+  Result:=CacheFile.CreateLineReader(true);
+end;
+
+Function TPas2JSFileConfigSupport.FindDefaultConfig : String;
+
+  function TryConfig(aFilename: string): boolean;
+  begin
+    Result:=false;
+    if aFilename='' then exit;
+    aFilename:=ExpandFileName(aFilename);
+    if Compiler.ShowDebug or Compiler.ShowTriedUsedFiles then
+      Compiler.Log.LogMsgIgnoreFilter(nConfigFileSearch,[aFilename]);
+    if not Compiler.FS.FileExists(aFilename) then exit;
+    FindDefaultConfig:=aFilename;
+    Result:=true;
+  end;
+
+var
+  aFilename: String;
+
+begin
+  Result:='';
+  // first try HOME directory
+  aFilename:=ChompPathDelim(GetEnvironmentVariablePJ('HOME'));
+  if aFilename<>'' then
+    begin
+    aFilename:=aFilename+PathDelim{$IFDEF UNIX}+'.'{$ENDIF}+DefaultConfigFile;
+    if TryConfig(aFileName) then
+      exit;
+    end;
+
+  // then try compiler directory
+  if (Compiler.CompilerExe<>'') then
+  begin
+    aFilename:=ExtractFilePath(Compiler.CompilerExe);
+    if aFilename<>'' then
+    begin
+      aFilename:=IncludeTrailingPathDelimiter(aFilename)+DefaultConfigFile;
+      if TryConfig(aFilename) then
+        exit;
+    end;
+  end;
+
+  // finally try global directory
+  {$IFDEF Unix}
+  if TryConfig('/etc/'+DefaultConfigFile) then
+    exit;
+  {$ENDIF}
+end;
+
+end.
+

+ 262 - 0
packages/pastojs/src/pas2jscompilerpp.pp

@@ -0,0 +1,262 @@
+{
+    This file is part of the Free Component Library (FCL)
+    Copyright (c) 2018  Michael Van Canneyt
+
+    Pascal to Javascript converter class.
+
+    See the file COPYING.FPC, included in this distribution,
+    for details about the copyright.
+
+    This program is distributed in the hope that it will be useful,
+    but WITHOUT ANY WARRANTY; without even the implied warranty of
+    MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.
+
+ **********************************************************************
+
+  Abstract:
+    Pas2JS compiler Postprocessor support. Can depend on filesystem.
+}
+unit Pas2JSCompilerPP;
+
+{$mode objfpc}{$H+}
+
+interface
+
+uses
+  Classes, SysUtils, pas2jscompiler, jswriter, FPPJSSrcMap, contnrs;
+
+Type
+
+  { TPas2JSFSPostProcessorSupport }
+
+  TPas2JSFSPostProcessorSupport = Class(TPas2JSPostProcessorSupport)
+  Private
+    FPostProcs: TObjectList;
+    function CmdListAsStr(CmdList: TStrings): string;
+  Public
+    Constructor Create(aCompiler: TPas2JSCompiler); override;
+    Destructor Destroy; override;
+    Procedure Clear; override;
+    Procedure WriteUsedTools; override;
+    Procedure AddPostProcessor(const Cmd: String); override;
+    Procedure CallPostProcessors(const JSFileName: String; aWriter: TPas2JSMapper); override;
+    function Execute(const JSFilename: String; Cmd: TStringList; JS: TJSWriterString): TJSWriterString;
+  end;
+
+implementation
+
+uses process, pas2jslogger, pas2jsutils, pas2jsfileutils;
+
+function TPas2JSFSPostProcessorSupport.CmdListAsStr(CmdList: TStrings): string;
+var
+  i: Integer;
+begin
+  Result:='';
+  for i:=0 to CmdList.Count-1 do
+  begin
+    if Result<>'' then Result+=' ';
+    Result+=QuoteStr(CmdList[i]);
+  end;
+end;
+
+constructor TPas2JSFSPostProcessorSupport.Create(aCompiler: TPas2JSCompiler);
+begin
+  inherited Create(aCompiler);
+  FPostProcs:=TObjectList.Create; // Owns objects
+end;
+
+destructor TPas2JSFSPostProcessorSupport.Destroy;
+begin
+  FreeAndNil(FPostProcs);
+  inherited Destroy;
+end;
+
+procedure TPas2JSFSPostProcessorSupport.Clear;
+begin
+  FPostProcs.Clear;
+end;
+
+procedure TPas2JSFSPostProcessorSupport.WriteUsedTools;
+
+Var
+  I : integer;
+  PostProc : TStringList;
+
+begin
+  // post processors
+  for i:=0 to FPostProcs.Count-1 do
+  begin
+    PostProc:=TStringList(FPostProcs[i]);
+    Compiler.Log.LogMsgIgnoreFilter(nPostProcessorInfoX,[CmdListAsStr(PostProc)]);
+  end;
+end;
+
+procedure TPas2JSFSPostProcessorSupport.AddPostProcessor(const Cmd: String);
+
+Var
+  PostProc : TStringList;
+  S : String;
+
+begin
+  PostProc:=TStringList.Create;
+  FPostProcs.Add(PostProc);
+  SplitCmdLineParams(Cmd,PostProc);
+  if PostProc.Count<1 then
+    Compiler.ParamFatal('-Jpcmd executable missing');
+  // check executable
+  S:=Compiler.FS.ExpandExecutable(PostProc[0]);
+  if (S='') then
+    Compiler.ParamFatal('-Jpcmd executable "'+S+'" not found');
+  PostProc[0]:=S;
+end;
+
+procedure TPas2JSFSPostProcessorSupport.CallPostProcessors(const JSFileName: String; aWriter: TPas2JSMapper);
+
+var
+  i: Integer;
+  JS, OrigJS: TJSWriterString;
+
+begin
+  if FPostProcs.Count=0 then exit;
+  OrigJS:=aWriter.AsString;
+  JS:=OrigJS;
+  for i:=0 to FPostProcs.Count-1 do
+    JS:=Execute(JSFilename,TStringList(FPostProcs[i]),JS);
+  if JS<>OrigJS then
+  begin
+    aWriter.AsString:=JS;
+    if aWriter.SrcMap<>nil then
+      aWriter.SrcMap.Clear;
+  end;
+
+end;
+
+function TPas2JSFSPostProcessorSupport.Execute(const JSFilename: String; Cmd: TStringList; JS: TJSWriterString): TJSWriterString;
+
+const
+  BufSize = 65536;
+var
+  Exe: String;
+  TheProcess: TProcess;
+  WrittenBytes, ReadBytes: LongInt;
+  Buf, s, ErrBuf: string;
+  OutputChunks: TStringList;
+  CurExitCode, i, InPos: Integer;
+begin
+  Result:='';
+  Buf:='';
+  Exe:=Cmd[0];
+  if Compiler.ShowDebug or Compiler.ShowUsedTools then
+    Compiler.Log.LogMsgIgnoreFilter(nPostProcessorRunX,[QuoteStr(JSFilename)+' | '+CmdListAsStr(Cmd)]);
+  if Compiler.FS.DirectoryExists(Exe) then
+    raise EFOpenError.Create('post processor "'+Exe+'" is a directory');
+  if not FileIsExecutable(Exe) then
+    raise EFOpenError.Create('post processor "'+Exe+'" is a not executable');
+  try
+    TheProcess := TProcess.Create(nil);
+    OutputChunks:=TStringList.Create;
+    try
+      TheProcess.Executable := Exe;
+      for i:=1 to Cmd.Count-1 do
+        TheProcess.Parameters.Add(Cmd[i]);
+      TheProcess.Options:= [poUsePipes];
+      TheProcess.ShowWindow := swoHide;
+      //TheProcess.CurrentDirectory:=WorkingDirectory;
+      TheProcess.Execute;
+      ErrBuf:='';
+      SetLength(Buf,BufSize);
+      InPos:=1;
+      repeat
+        // read stderr and log immediately as warnings
+        repeat
+          if TheProcess.Stderr.NumBytesAvailable=0 then break;
+          ReadBytes:=TheProcess.Stderr.Read(Buf[1],BufSize);
+          if ReadBytes=0 then break;
+          ErrBuf+=LeftStr(Buf,ReadBytes);
+          repeat
+            i:=1;
+            while (i<=length(ErrBuf)) and (i<128) and not (ErrBuf[i] in [#10,#13]) do
+              inc(i);
+            if i>length(ErrBuf) then break;
+            Compiler.Log.LogMsg(nPostProcessorWarnX,[LeftStr(ErrBuf,i)]);
+            if (i<=length(ErrBuf)) and (ErrBuf[i] in [#10,#13]) then
+            begin
+              // skip linebreak
+              if (i<length(ErrBuf)) and (ErrBuf[i+1] in [#10,#13])
+                  and (ErrBuf[i]<>ErrBuf[i+1]) then
+                inc(i,2)
+              else
+                inc(i);
+            end;
+            Delete(ErrBuf,1,i-1);
+          until false;
+        until false;
+        // write to stdin
+        if InPos<length(JS) then
+        begin
+          i:=length(JS)-InPos+1;
+          if i>BufSize then i:=BufSize;
+          WrittenBytes:=TheProcess.Input.Write(JS[InPos],i);
+          inc(InPos,WrittenBytes);
+          if InPos>length(JS) then
+            TheProcess.CloseInput;
+        end else
+          WrittenBytes:=0;
+        // read stdout
+        if TheProcess.Output.NumBytesAvailable=0 then
+          ReadBytes:=0
+        else
+          ReadBytes:=TheProcess.Output.Read(Buf[1],BufSize);
+        if ReadBytes>0 then
+          OutputChunks.Add(LeftStr(Buf,ReadBytes));
+
+        if (WrittenBytes=0) and (ReadBytes=0) then
+        begin
+          if not TheProcess.Running then break;
+          Sleep(10); // give tool some time
+        end;
+      until false;
+      TheProcess.WaitOnExit;
+      CurExitCode:=TheProcess.ExitCode;
+
+      // concatenate output chunks
+      ReadBytes:=0;
+      for i:=0 to OutputChunks.Count-1 do
+        inc(ReadBytes,length(OutputChunks[i]));
+      SetLength(Result,ReadBytes);
+      ReadBytes:=0;
+      for i:=0 to OutputChunks.Count-1 do
+      begin
+        s:=OutputChunks[i];
+        if s='' then continue;
+        System.Move(s[1],Result[ReadBytes+1],length(s));
+        inc(ReadBytes,length(s));
+      end;
+    finally
+      OutputChunks.Free;
+      TheProcess.Free;
+    end;
+  except
+    on E: Exception do begin
+      if Compiler.ShowDebug then
+        Compiler.Log.LogExceptionBackTrace(E);
+      Compiler.Log.LogPlain('Error: '+E.Message);
+      Compiler.Log.LogMsg(nPostProcessorFailX,[CmdListAsStr(Cmd)]);
+      Compiler.Terminate(ExitCodeToolError);
+    end
+    {$IFDEF Pas2js}
+    else HandleJSException('[20181118170506] TPas2jsCompiler.CallPostProcessor Cmd: '+CmdListAsStr(Cmd),JSExceptValue,true);
+    {$ENDIF}
+  end;
+  if CurExitCode<>0 then
+  begin
+    Compiler.Log.LogMsg(nPostProcessorFailX,[CmdListAsStr(Cmd)]);
+    Compiler.Terminate(ExitCodeToolError);
+  end;
+  if Compiler.ShowDebug or Compiler.ShowUsedTools then
+    Compiler.Log.LogMsgIgnoreFilter(nPostProcessorFinished,[]);
+end;
+
+
+end.
+

+ 206 - 340
packages/pastojs/src/pas2jsfilecache.pp

@@ -32,20 +32,12 @@ uses
   {$ENDIF}
   {$ENDIF}
   Classes, SysUtils,
   Classes, SysUtils,
   fpjson,
   fpjson,
-  PScanner, PasUseAnalyzer, PasResolver, Pas2jsLogger, Pas2jsFileUtils;
-
-const // Messages
-  nIncludeSearch = 201; sIncludeSearch = 'Include file search: %s';
-  nUnitSearch = 202; sUnitSearch = 'Unitsearch: %s';
-  nSearchingFileFound = 203; sSearchingFileFound = 'Searching file: %s... found';
-  nSearchingFileNotFound = 204; sSearchingFileNotFound = 'Searching file: %s... not found';
-  nDuplicateFileFound = 205; sDuplicateFileFound = 'Duplicate file found: "%s" and "%s"';
-  nCustomJSFileNotFound = 206; sCustomJSFileNotFound = 'custom JS file not found: "%s"';
-  nUsingPath = 104; sUsingPath = 'Using %s: "%s"';
-  nFolderNotFound = 105; sFolderNotFound = '%s not found: %s';
+  PScanner, PasResolver, PasUseAnalyzer,
+  Pas2jsLogger, Pas2jsFileUtils, Pas2JSFS;
+
 
 
 type
 type
-  EPas2jsFileCache = class(Exception);
+  EPas2jsFileCache = class(EPas2JSFS);
 
 
 type
 type
   TPas2jsFileAgeTime = longint;
   TPas2jsFileAgeTime = longint;
@@ -87,7 +79,7 @@ type
     function Count: integer;
     function Count: integer;
     procedure Clear;
     procedure Clear;
     property ChangeStamp: TChangeStamp read FChangeStamp write FChangeStamp;// set on Update to Pool.ChangeStamp
     property ChangeStamp: TChangeStamp read FChangeStamp write FChangeStamp;// set on Update to Pool.ChangeStamp
-    function NeedsUpdate: boolean; inline;
+    function NeedsUpdate: boolean;
     procedure Update;
     procedure Update;
     procedure Reference;
     procedure Reference;
     procedure Release;
     procedure Release;
@@ -159,93 +151,58 @@ type
     property OnReadDirectory: TReadDirectoryEvent read FOnReadDirectory write FOnReadDirectory;
     property OnReadDirectory: TReadDirectoryEvent read FOnReadDirectory write FOnReadDirectory;
   end;
   end;
 
 
-type
-  TP2jsFileCacheOption = (
-    caoShowFullFilenames,
-    caoShowTriedUsedFiles,
-    caoSearchLikeFPC,
-    caoStrictFileCase
-    );
-  TP2jsFileCacheOptions = set of TP2jsFileCacheOption;
-
-const
-  DefaultPas2jsFileCacheOptions = [];
-
-  p2jsfcoCaption: array[TP2jsFileCacheOption] of string = (
-    // only used by experts, no need for resourcestrings
-    'Show full filenames',
-    'Show tried/used files',
-    'Search files like FPC',
-    'Strict file case'
-    );
-  // 'Combine all JavaScript into main file',
-
-  EncodingBinary = 'Binary';
 type
 type
   TPas2jsFilesCache = class;
   TPas2jsFilesCache = class;
   TPas2jsCachedFile = class;
   TPas2jsCachedFile = class;
 
 
   { TPas2jsFileResolver }
   { TPas2jsFileResolver }
 
 
-  TPas2jsFileResolver = class(TFileResolver)
+  TPas2jsFileResolver = class(TPas2JSFSResolver)
   private
   private
-    FCache: TPas2jsFilesCache;
+    function GetCache: TPas2jsFilesCache;
   public
   public
     constructor Create(aCache: TPas2jsFilesCache); reintroduce;
     constructor Create(aCache: TPas2jsFilesCache); reintroduce;
     // Redirect all calls to cache.
     // Redirect all calls to cache.
-    function FindIncludeFileName(const aFilename: string): String; override;
-    function FindIncludeFile(const aFilename: string): TLineReader; override;
-    function FindSourceFile(const aFilename: string): TLineReader; override;
-    property Cache: TPas2jsFilesCache read FCache;
+    property Cache: TPas2jsFilesCache read GetCache;
   end;
   end;
 
 
   { TPas2jsFileLineReader }
   { TPas2jsFileLineReader }
 
 
-  TPas2jsFileLineReader = class(TLineReader)
+  TPas2jsFileLineReader = class(TSourceLineReader)
   private
   private
     FCachedFile: TPas2jsCachedFile;
     FCachedFile: TPas2jsCachedFile;
-    FIsEOF: boolean;
-    FLineNumber: integer;
-    FSource: string;
-    FSrcPos: integer;
+  Protected
+    Procedure IncLineNumber; override;
+    property CachedFile: TPas2jsCachedFile read FCachedFile;
   public
   public
     constructor Create(const AFilename: string); override;
     constructor Create(const AFilename: string); override;
     constructor Create(aFile: TPas2jsCachedFile); reintroduce;
     constructor Create(aFile: TPas2jsCachedFile); reintroduce;
-    function IsEOF: Boolean; override;
-    function ReadLine: string; override;
-    property LineNumber: integer read FLineNumber;
-    property CachedFile: TPas2jsCachedFile read FCachedFile;
-    property Source: string read FSource;
-    property SrcPos: integer read FSrcPos;
   end;
   end;
 
 
   { TPas2jsCachedFile }
   { TPas2jsCachedFile }
 
 
-  TPas2jsCachedFile = class
+  TPas2jsCachedFile = class(TPas2JSFile)
   private
   private
-    FCache: TPas2jsFilesCache;
     FChangeStamp: TChangeStamp;
     FChangeStamp: TChangeStamp;
     FFileEncoding: string;
     FFileEncoding: string;
-    FFilename: string;
     FLastErrorMsg: string;
     FLastErrorMsg: string;
     FLoaded: boolean;
     FLoaded: boolean;
     FLoadedFileAge: longint;
     FLoadedFileAge: longint;
-    FSource: string;
     FCacheStamp: TChangeStamp; // Cache.ResetStamp when file was loaded
     FCacheStamp: TChangeStamp; // Cache.ResetStamp when file was loaded
+    function GetCache: TPas2jsFilesCache;
     function GetIsBinary: boolean; inline;
     function GetIsBinary: boolean; inline;
-  public
-    constructor Create(aCache: TPas2jsFilesCache; const aFilename: string); reintroduce;
-    function Load(RaiseOnError: boolean; Binary: boolean = false): boolean;
-    function CreateLineReader(RaiseOnError: boolean): TPas2jsFileLineReader;
+  Protected
     property IsBinary: boolean read GetIsBinary;
     property IsBinary: boolean read GetIsBinary;
     property FileEncoding: string read FFileEncoding;
     property FileEncoding: string read FFileEncoding;
-    property Filename: string read FFilename;
-    property Source: string read FSource; // UTF-8 without BOM or Binary
-    property Cache: TPas2jsFilesCache read FCache;
+    property Cache: TPas2jsFilesCache read GetCache;
     property ChangeStamp: TChangeStamp read FChangeStamp;// changed when Source changed
     property ChangeStamp: TChangeStamp read FChangeStamp;// changed when Source changed
     property Loaded: boolean read FLoaded; // Source valid, but may contain an old version
     property Loaded: boolean read FLoaded; // Source valid, but may contain an old version
     property LastErrorMsg: string read FLastErrorMsg;
     property LastErrorMsg: string read FLastErrorMsg;
     property LoadedFileAge: longint read FLoadedFileAge;// only valid if Loaded=true
     property LoadedFileAge: longint read FLoadedFileAge;// only valid if Loaded=true
+  public
+    constructor Create(aCache: TPas2jsFilesCache; const aFilename: string); reintroduce;
+    function Load(RaiseOnError: boolean; Binary: boolean = false): boolean; override;
+    function CreateLineReader(RaiseOnError: boolean): TSourceLineReader; override;
   end;
   end;
 
 
   TPas2jsReadFileEvent = function(aFilename: string; var aSource: string): boolean of object;
   TPas2jsReadFileEvent = function(aFilename: string; var aSource: string): boolean of object;
@@ -258,10 +215,9 @@ type
 
 
   { TPas2jsFilesCache }
   { TPas2jsFilesCache }
 
 
-  TPas2jsFilesCache = class
+  TPas2jsFilesCache = class (TPas2JSFS)
   private
   private
     FBaseDirectory: string;
     FBaseDirectory: string;
-    FDefaultOutputPath: string;
     FDirectoryCache: TPas2jsCachedDirectories;
     FDirectoryCache: TPas2jsCachedDirectories;
     FFiles: TPasAnalyzerKeySet; // set of TPas2jsCachedFile, key is Filename
     FFiles: TPasAnalyzerKeySet; // set of TPas2jsCachedFile, key is Filename
     FForeignUnitPaths: TStringList;
     FForeignUnitPaths: TStringList;
@@ -269,94 +225,78 @@ type
     FIncludePaths: TStringList;
     FIncludePaths: TStringList;
     FIncludePathsFromCmdLine: integer;
     FIncludePathsFromCmdLine: integer;
     FLog: TPas2jsLogger;
     FLog: TPas2jsLogger;
-    FNamespaces: TStringList;
-    FNamespacesFromCmdLine: integer;
     FOnReadFile: TPas2jsReadFileEvent;
     FOnReadFile: TPas2jsReadFileEvent;
     FOnWriteFile: TPas2jsWriteFileEvent;
     FOnWriteFile: TPas2jsWriteFileEvent;
-    FOptions: TP2jsFileCacheOptions;
-    FReadLineCounter: SizeInt;
     FResetStamp: TChangeStamp;
     FResetStamp: TChangeStamp;
-    FUnitOutputPath: string;
     FUnitPaths: TStringList;
     FUnitPaths: TStringList;
     FUnitPathsFromCmdLine: integer;
     FUnitPathsFromCmdLine: integer;
+    FPCUPaths: TStringList;
     function FileExistsILogged(var Filename: string): integer;
     function FileExistsILogged(var Filename: string): integer;
     function FileExistsLogged(const Filename: string): boolean;
     function FileExistsLogged(const Filename: string): boolean;
-    function FindSourceFileName(const aFilename: string): String;
-    function GetSearchLikeFPC: boolean;
-    function GetShowFullFilenames: boolean;
-    function GetShowTriedUsedFiles: boolean;
-    function GetStrictFileCase: Boolean;
+    function GetOnReadDirectory: TReadDirectoryEvent;
     procedure RegisterMessages;
     procedure RegisterMessages;
     procedure SetBaseDirectory(AValue: string);
     procedure SetBaseDirectory(AValue: string);
     function AddSearchPaths(const Paths: string; Kind: TPas2jsSearchPathKind;
     function AddSearchPaths(const Paths: string; Kind: TPas2jsSearchPathKind;
       FromCmdLine: boolean; var List: TStringList; var CmdLineCount: integer): string;
       FromCmdLine: boolean; var List: TStringList; var CmdLineCount: integer): string;
-    procedure SetDefaultOutputPath(AValue: string);
-    procedure SetOptions(AValue: TP2jsFileCacheOptions);
-    procedure SetSearchLikeFPC(const AValue: boolean);
-    procedure SetShowFullFilenames(const AValue: boolean);
-    procedure SetShowTriedUsedFiles(const AValue: boolean);
-    procedure SetStrictFileCase(AValue: Boolean);
-    procedure SetUnitOutputPath(AValue: string);
-    procedure SetOption(Flag: TP2jsFileCacheOption; Enable: boolean);
+    procedure SetOnReadDirectory(AValue: TReadDirectoryEvent);
   protected
   protected
+    function FindSourceFileName(const aFilename: string): String; override;
     function GetHasPCUSupport: Boolean; virtual;
     function GetHasPCUSupport: Boolean; virtual;
     function ReadFile(Filename: string; var Source: string): boolean; virtual;
     function ReadFile(Filename: string; var Source: string): boolean; virtual;
     procedure FindMatchingFiles(Mask: string; MaxCount: integer; Files: TStrings);// find files, matching * and ?
     procedure FindMatchingFiles(Mask: string; MaxCount: integer; Files: TStrings);// find files, matching * and ?
   public
   public
-    constructor Create(aLog: TPas2jsLogger);
+    constructor Create(aLog: TPas2jsLogger); overload;
     destructor Destroy; override;
     destructor Destroy; override;
-    procedure Reset; virtual;
-    procedure WriteFoldersAndSearchPaths; virtual;
+    procedure Reset; override;
+    procedure WriteFoldersAndSearchPaths; override;
+    procedure GetPCUDirs(aList: TStrings; const aBaseDir: String); override;
+    function PCUExists(var aFileName: string): Boolean; override;
+    Function SameFileName(Const File1,File2 : String) : Boolean;  override;
+    Function File1IsNewer(const File1, File2: String): Boolean; override;
     function SearchLowUpCase(var Filename: string): boolean;
     function SearchLowUpCase(var Filename: string): boolean;
-    function FindCustomJSFileName(const aFilename: string): String;
-    function FindUnitJSFileName(const aUnitFilename: string): String;
-    function FindUnitFileName(const aUnitname, InFilename: string; out IsForeign: boolean): String; virtual;
-    function FindIncludeFileName(const aFilename: string): String; virtual;
+    function FindCustomJSFileName(const aFilename: string): String; override;
+    function FindUnitJSFileName(const aUnitFilename: string): String; override;
+    function FindUnitFileName(const aUnitname, InFilename: string; out IsForeign: boolean): String; override;
+    function FindIncludeFileName(const aFilename: string): String; override;
     function AddIncludePaths(const Paths: string; FromCmdLine: boolean; out ErrorMsg: string): boolean;
     function AddIncludePaths(const Paths: string; FromCmdLine: boolean; out ErrorMsg: string): boolean;
-    function AddNamespaces(const Paths: string; FromCmdLine: boolean; out ErrorMsg: string): boolean;
     function AddUnitPaths(const Paths: string; FromCmdLine: boolean; out ErrorMsg: string): boolean;
     function AddUnitPaths(const Paths: string; FromCmdLine: boolean; out ErrorMsg: string): boolean;
     function AddSrcUnitPaths(const Paths: string; FromCmdLine: boolean; out ErrorMsg: string): boolean;
     function AddSrcUnitPaths(const Paths: string; FromCmdLine: boolean; out ErrorMsg: string): boolean;
-    function CreateResolver: TPas2jsFileResolver;
-    function FormatPath(const aPath: string): string;
-    Function DirectoryExists(Filename: string): boolean; virtual;
-    function FileExists(Filename: string): boolean; virtual;
+    function CreateResolver: TPas2jsFSResolver; override;
+    function FormatPath(const aPath: string): string; override;
+    Function DirectoryExists(Const Filename: string): boolean; override;
+    function FileExists(const Filename: string): boolean; override;
     function FileExistsI(var Filename: string): integer; // returns number of found files
     function FileExistsI(var Filename: string): integer; // returns number of found files
     function FileAge(const Filename: string): TPas2jsFileAgeTime; virtual;
     function FileAge(const Filename: string): TPas2jsFileAgeTime; virtual;
     function FindFile(Filename: string): TPas2jsCachedFile;
     function FindFile(Filename: string): TPas2jsCachedFile;
-    function LoadFile(Filename: string; Binary: boolean = false): TPas2jsCachedFile;
+    function LoadFile(Filename: string; Binary: boolean = false): TPas2jsFile; override;
     function NormalizeFilename(const Filename: string; RaiseOnError: boolean): string;
     function NormalizeFilename(const Filename: string; RaiseOnError: boolean): string;
     procedure GetListing(const aDirectory: string; var Files: TStrings;
     procedure GetListing(const aDirectory: string; var Files: TStrings;
                          FullPaths: boolean = true);
                          FullPaths: boolean = true);
     procedure RaiseDuplicateFile(aFilename: string);
     procedure RaiseDuplicateFile(aFilename: string);
-    procedure SaveToFile(ms: TFPJSStream; Filename: string);
-    function ExpandDirectory(const Filename, BaseDir: string): string;
-    function ExpandExecutable(const Filename, BaseDir: string): string;
+    procedure SaveToFile(ms: TFPJSStream; Filename: string); override;
+    function ExpandDirectory(const Filename: string): string; override;
+    function ExpandFileName(const Filename: string): string; override;
+    function ExpandExecutable(const Filename: string): string; override;
+    function HandleOptionPaths(C: Char; aValue: String; FromCmdLine: Boolean): String; override;
+    Function AddForeignUnitPath(const aValue: String; FromCmdLine: Boolean): String; override;
+    function TryCreateRelativePath(const Filename, BaseDirectory: String; UsePointDirectory: boolean; out RelPath: String): Boolean; override;
+  Protected
+    property DirectoryCache: TPas2jsCachedDirectories read FDirectoryCache;
   public
   public
     property BaseDirectory: string read FBaseDirectory write SetBaseDirectory; // includes trailing pathdelim
     property BaseDirectory: string read FBaseDirectory write SetBaseDirectory; // includes trailing pathdelim
-    property MainOutputPath: string read FDefaultOutputPath write SetDefaultOutputPath; // includes trailing pathdelim
-    property DirectoryCache: TPas2jsCachedDirectories read FDirectoryCache;
     property ForeignUnitPaths: TStringList read FForeignUnitPaths;
     property ForeignUnitPaths: TStringList read FForeignUnitPaths;
     property ForeignUnitPathsFromCmdLine: integer read FForeignUnitPathsFromCmdLine;
     property ForeignUnitPathsFromCmdLine: integer read FForeignUnitPathsFromCmdLine;
     property IncludePaths: TStringList read FIncludePaths;
     property IncludePaths: TStringList read FIncludePaths;
     property IncludePathsFromCmdLine: integer read FIncludePathsFromCmdLine;
     property IncludePathsFromCmdLine: integer read FIncludePathsFromCmdLine;
     property Log: TPas2jsLogger read FLog;
     property Log: TPas2jsLogger read FLog;
-    property Namespaces: TStringList read FNamespaces;
-    property NamespacesFromCmdLine: integer read FNamespacesFromCmdLine;
-    property Options: TP2jsFileCacheOptions read FOptions write SetOptions default DefaultPas2jsFileCacheOptions;
-    property ReadLineCounter: SizeInt read FReadLineCounter write FReadLineCounter;
     property ResetStamp: TChangeStamp read FResetStamp;
     property ResetStamp: TChangeStamp read FResetStamp;
-    property SearchLikeFPC: boolean read GetSearchLikeFPC write SetSearchLikeFPC;
-    property ShowFullPaths: boolean read GetShowFullFilenames write SetShowFullFilenames;
-    property ShowTriedUsedFiles: boolean read GetShowTriedUsedFiles write SetShowTriedUsedFiles;
-    property UnitOutputPath: string read FUnitOutputPath write SetUnitOutputPath; // includes trailing pathdelim
     property UnitPaths: TStringList read FUnitPaths;
     property UnitPaths: TStringList read FUnitPaths;
     property UnitPathsFromCmdLine: integer read FUnitPathsFromCmdLine;
     property UnitPathsFromCmdLine: integer read FUnitPathsFromCmdLine;
+    property OnReadDirectory: TReadDirectoryEvent read GetOnReadDirectory write SetOnReadDirectory;
     property OnReadFile: TPas2jsReadFileEvent read FOnReadFile write FOnReadFile;
     property OnReadFile: TPas2jsReadFileEvent read FOnReadFile write FOnReadFile;
     property OnWriteFile: TPas2jsWriteFileEvent read FOnWriteFile write FOnWriteFile;
     property OnWriteFile: TPas2jsWriteFileEvent read FOnWriteFile write FOnWriteFile;
-    Property StrictFileCase : Boolean Read GetStrictFileCase Write SetStrictFileCase;
   end;
   end;
 
 
-
 {$IFDEF Pas2js}
 {$IFDEF Pas2js}
 function PtrStrToStr(StrAsPtr: Pointer): string;
 function PtrStrToStr(StrAsPtr: Pointer): string;
 function PtrFilenameToKeyName(FilenameAsPtr: Pointer): string;
 function PtrFilenameToKeyName(FilenameAsPtr: Pointer): string;
@@ -409,6 +349,7 @@ var
 begin
 begin
   Result:=FilenameToKey(Dir.Path);
   Result:=FilenameToKey(Dir.Path);
 end;
 end;
+
 {$ELSE}
 {$ELSE}
 function CompareFilenameWithCachedFile(Filename, CachedFile: Pointer): integer;
 function CompareFilenameWithCachedFile(Filename, CachedFile: Pointer): integer;
 var
 var
@@ -439,6 +380,7 @@ var
 begin
 begin
   Result:=CompareFilenames(AnsiString(Path),Directory.Path);
   Result:=CompareFilenames(AnsiString(Path),Directory.Path);
 end;
 end;
+
 {$ENDIF}
 {$ENDIF}
 
 
 function ComparePas2jsDirectoryEntries(Entry1, Entry2: {$IFDEF Pas2js}jsvalue{$ELSE}Pointer{$ENDIF}): integer;
 function ComparePas2jsDirectoryEntries(Entry1, Entry2: {$IFDEF Pas2js}jsvalue{$ELSE}Pointer{$ENDIF}): integer;
@@ -614,6 +556,7 @@ begin
   FPath:=IncludeTrailingPathDelimiter(aPath);
   FPath:=IncludeTrailingPathDelimiter(aPath);
   FEntries:=TFPList.Create;
   FEntries:=TFPList.Create;
   FPool:=aPool;
   FPool:=aPool;
+  FChangeStamp:=InvalidChangeStamp;
 end;
 end;
 
 
 destructor TPas2jsCachedDirectory.Destroy;
 destructor TPas2jsCachedDirectory.Destroy;
@@ -1105,6 +1048,13 @@ end;
 
 
 { TPas2jsFileLineReader }
 { TPas2jsFileLineReader }
 
 
+procedure TPas2jsFileLineReader.IncLineNumber;
+begin
+  if (CachedFile<>nil) and (CachedFile.Cache<>nil) then
+    CachedFile.Cache.IncReadLineCounter;
+  inherited IncLineNumber;
+end;
+
 constructor TPas2jsFileLineReader.Create(const AFilename: string);
 constructor TPas2jsFileLineReader.Create(const AFilename: string);
 begin
 begin
   raise Exception.Create('TPas2jsFileLineReader.Create [20180126090825] no cache "'+AFilename+'"');
   raise Exception.Create('TPas2jsFileLineReader.Create [20180126090825] no cache "'+AFilename+'"');
@@ -1112,60 +1062,10 @@ end;
 
 
 constructor TPas2jsFileLineReader.Create(aFile: TPas2jsCachedFile);
 constructor TPas2jsFileLineReader.Create(aFile: TPas2jsCachedFile);
 begin
 begin
-  inherited Create(aFile.Filename);
+  inherited Create(aFile.Filename,aFile.Source);
   FCachedFile:=aFile;
   FCachedFile:=aFile;
-  FSource:=aFile.Source;
-  FSrcPos:=1;
-  FIsEOF:=FSource='';
-end;
-
-function TPas2jsFileLineReader.IsEOF: Boolean;
-begin
-  Result:=FIsEOF;
 end;
 end;
 
 
-function TPas2jsFileLineReader.ReadLine: string;
-var
-  S: string;
-  p, SrcLen: integer;
-
-  procedure GetLine;
-  var
-    l: SizeInt;
-  begin
-    l:=p-FSrcPos;
-    Result:=copy(S,FSrcPos,l);
-    FSrcPos:=p;
-    inc(FLineNumber);
-    if (CachedFile<>nil) and (CachedFile.Cache<>nil) then
-      inc(CachedFile.Cache.FReadLineCounter);
-    //writeln('GetLine "',Result,'"');
-  end;
-
-begin
-  if FIsEOF then exit('');
-  S:=Source;
-  SrcLen:=length(S);
-  p:=FSrcPos;
-  while p<=SrcLen do
-    case S[p] of
-    #10,#13:
-      begin
-        GetLine;
-        inc(p);
-        if (p<=SrcLen) and (S[p] in [#10,#13]) and (S[p]<>S[p-1]) then
-          inc(p);
-        if p>SrcLen then
-          FIsEOF:=true;
-        FSrcPos:=p;
-        exit;
-      end;
-    else
-      inc(p);
-    end;
-  FIsEOF:=true;
-  GetLine;
-end;
 
 
 { TPas2jsCachedFile }
 { TPas2jsCachedFile }
 
 
@@ -1175,13 +1075,17 @@ begin
   Result:=FFileEncoding=EncodingBinary;
   Result:=FFileEncoding=EncodingBinary;
 end;
 end;
 
 
+function TPas2jsCachedFile.GetCache: TPas2jsFilesCache;
+begin
+  Result:=TPas2jsFilesCache(FS);
+end;
+
 constructor TPas2jsCachedFile.Create(aCache: TPas2jsFilesCache;
 constructor TPas2jsCachedFile.Create(aCache: TPas2jsFilesCache;
   const aFilename: string);
   const aFilename: string);
 begin
 begin
+  inHerited Create(aCache,aFileName);
   FChangeStamp:=InvalidChangeStamp;
   FChangeStamp:=InvalidChangeStamp;
-  FCache:=aCache;
   FCacheStamp:=Cache.ResetStamp;
   FCacheStamp:=Cache.ResetStamp;
-  FFilename:=aFilename;
 end;
 end;
 
 
 function TPas2jsCachedFile.Load(RaiseOnError: boolean; Binary: boolean
 function TPas2jsCachedFile.Load(RaiseOnError: boolean; Binary: boolean
@@ -1254,14 +1158,14 @@ begin
   {$ENDIF}
   {$ENDIF}
   if Binary then
   if Binary then
   begin
   begin
-    FSource:=NewSource;
+    SetSource(NewSource);
     FFileEncoding:=EncodingBinary;
     FFileEncoding:=EncodingBinary;
   end else
   end else
   begin
   begin
     {$IFDEF FPC_HAS_CPSTRING}
     {$IFDEF FPC_HAS_CPSTRING}
-    FSource:=ConvertTextToUTF8(NewSource,FFileEncoding);
+    SetSource(ConvertTextToUTF8(NewSource,FFileEncoding));
     {$ELSE}
     {$ELSE}
-    FSource:=NewSource;
+    SetSource(NewSource);
     {$ENDIF}
     {$ENDIF}
   end;
   end;
   FLoaded:=true;
   FLoaded:=true;
@@ -1273,7 +1177,7 @@ begin
 end;
 end;
 
 
 function TPas2jsCachedFile.CreateLineReader(RaiseOnError: boolean
 function TPas2jsCachedFile.CreateLineReader(RaiseOnError: boolean
-  ): TPas2jsFileLineReader;
+  ): TSourceLineReader;
 begin
 begin
   if not Load(RaiseOnError) then
   if not Load(RaiseOnError) then
     exit(nil);
     exit(nil);
@@ -1282,44 +1186,16 @@ end;
 
 
 { TPas2jsFileResolver }
 { TPas2jsFileResolver }
 
 
-constructor TPas2jsFileResolver.Create(aCache: TPas2jsFilesCache);
-begin
-  inherited Create;
-  FCache:=aCache;
-end;
-
-function TPas2jsFileResolver.FindIncludeFile(const aFilename: string): TLineReader;
-var
-  Filename: String;
-begin
-  Result:=nil;
-  Filename:=Cache.FindIncludeFileName(aFilename);
-  if Filename='' then exit;
-  try
-    Result:=FindSourceFile(Filename);
-  except
-    // error is shown in the scanner, which has the context information
-  end;
-end;
-
-function TPas2jsFileResolver.FindIncludeFileName(const aFilename: string): String;
-
+function TPas2jsFileResolver.GetCache: TPas2jsFilesCache;
 begin
 begin
-  Result:=Cache.FindIncludeFileName(aFilename);
+  Result:=TPas2jsFilesCache(FS);
 end;
 end;
 
 
-
-function TPas2jsFileResolver.FindSourceFile(const aFilename: string): TLineReader;
-
-var
-  CurFilename: String;
-
+constructor TPas2jsFileResolver.Create(aCache: TPas2jsFilesCache);
 begin
 begin
-  CurFilename:=Cache.FindSourceFileName(aFileName);
-  Result:=Cache.LoadFile(CurFilename).CreateLineReader(false);
+  inherited Create(aCache);
 end;
 end;
 
 
-
 { TPas2jsFilesCache }
 { TPas2jsFilesCache }
 
 
 procedure TPas2jsFilesCache.RegisterMessages;
 procedure TPas2jsFilesCache.RegisterMessages;
@@ -1337,28 +1213,6 @@ begin
   Result:=False;
   Result:=False;
 end;
 end;
 
 
-function TPas2jsFilesCache.GetStrictFileCase : Boolean;
-
-begin
-  Result:=caoStrictFileCase in FOptions;
-end;
-
-function TPas2jsFilesCache.GetSearchLikeFPC: boolean;
-begin
-  Result:=caoSearchLikeFPC in FOptions;
-end;
-
-function TPas2jsFilesCache.GetShowFullFilenames: boolean;
-begin
-  Result:=caoShowFullFilenames in FOptions;
-end;
-
-function TPas2jsFilesCache.GetShowTriedUsedFiles: boolean;
-begin
-  Result:=caoShowTriedUsedFiles in FOptions;
-end;
-
-
 procedure TPas2jsFilesCache.SetBaseDirectory(AValue: string);
 procedure TPas2jsFilesCache.SetBaseDirectory(AValue: string);
 begin
 begin
   AValue:=Pas2jsFileUtils.ExpandDirectory(AValue);
   AValue:=Pas2jsFileUtils.ExpandDirectory(AValue);
@@ -1456,7 +1310,7 @@ begin
       if aPath='' then continue;
       if aPath='' then continue;
       if Kind=spkPath then
       if Kind=spkPath then
       begin
       begin
-        aPath:=ExpandDirectory(aPath,BaseDirectory);
+        aPath:=ExpandDirectory(aPath);
         if aPath='' then continue;
         if aPath='' then continue;
       end;
       end;
       aPaths.Clear;
       aPaths.Clear;
@@ -1474,55 +1328,9 @@ begin
   end;
   end;
 end;
 end;
 
 
-procedure TPas2jsFilesCache.SetDefaultOutputPath(AValue: string);
-begin
-  AValue:=ExpandDirectory(AValue,BaseDirectory);
-  if FDefaultOutputPath=AValue then Exit;
-  FDefaultOutputPath:=AValue;
-end;
-
-
-procedure TPas2jsFilesCache.SetOptions(AValue: TP2jsFileCacheOptions);
-begin
-  if FOptions=AValue then Exit;
-  FOptions:=AValue;
-end;
-
-procedure TPas2jsFilesCache.SetSearchLikeFPC(const AValue: boolean);
-begin
-  SetOption(caoSearchLikeFPC,AValue);
-end;
-
-procedure TPas2jsFilesCache.SetShowFullFilenames(const AValue: boolean);
+procedure TPas2jsFilesCache.SetOnReadDirectory(AValue: TReadDirectoryEvent);
 begin
 begin
-  SetOption(caoShowFullFilenames,AValue);
-end;
-
-procedure TPas2jsFilesCache.SetShowTriedUsedFiles(const AValue: boolean);
-begin
-  SetOption(caoShowTriedUsedFiles,AValue);
-end;
-
-procedure TPas2jsFilesCache.SetStrictFileCase(AValue: Boolean);
-begin
-  SetOption(caoStrictFileCase,aValue)
-end;
-
-
-procedure TPas2jsFilesCache.SetUnitOutputPath(AValue: string);
-begin
-  AValue:=ExpandDirectory(AValue,BaseDirectory);
-  if FUnitOutputPath=AValue then Exit;
-  FUnitOutputPath:=AValue;
-end;
-
-procedure TPas2jsFilesCache.SetOption(Flag: TP2jsFileCacheOption; Enable: boolean
-  );
-begin
-  if Enable then
-    Include(FOptions,Flag)
-  else
-    Exclude(FOptions,Flag);
+  DirectoryCache.OnReadDirectory:=AValue;
 end;
 end;
 
 
 function TPas2jsFilesCache.ReadFile(Filename: string; var Source: string
 function TPas2jsFilesCache.ReadFile(Filename: string; var Source: string
@@ -1629,10 +1437,8 @@ begin
   inherited Create;
   inherited Create;
   FResetStamp:=InvalidChangeStamp;
   FResetStamp:=InvalidChangeStamp;
   FLog:=aLog;
   FLog:=aLog;
-  FOptions:=DefaultPas2jsFileCacheOptions;
   FIncludePaths:=TStringList.Create;
   FIncludePaths:=TStringList.Create;
   FForeignUnitPaths:=TStringList.Create;
   FForeignUnitPaths:=TStringList.Create;
-  FNamespaces:=TStringList.Create;
   FUnitPaths:=TStringList.Create;
   FUnitPaths:=TStringList.Create;
   FFiles:=TPasAnalyzerKeySet.Create(
   FFiles:=TPasAnalyzerKeySet.Create(
     {$IFDEF Pas2js}
     {$IFDEF Pas2js}
@@ -1652,28 +1458,25 @@ begin
   FreeAndNil(FFiles);
   FreeAndNil(FFiles);
   FreeAndNil(FIncludePaths);
   FreeAndNil(FIncludePaths);
   FreeAndNil(FForeignUnitPaths);
   FreeAndNil(FForeignUnitPaths);
-  FreeAndNil(FNamespaces);
   FreeAndNil(FUnitPaths);
   FreeAndNil(FUnitPaths);
+  FreeAndNil(FPCUPaths);
   inherited Destroy;
   inherited Destroy;
 end;
 end;
 
 
 procedure TPas2jsFilesCache.Reset;
 procedure TPas2jsFilesCache.Reset;
 begin
 begin
+  Inherited;
   IncreaseChangeStamp(FResetStamp);
   IncreaseChangeStamp(FResetStamp);
   FDirectoryCache.Invalidate;
   FDirectoryCache.Invalidate;
   // FFiles: keep data, files are checked against LoadedFileAge
   // FFiles: keep data, files are checked against LoadedFileAge
-  FOptions:=DefaultPas2jsFileCacheOptions;
   FBaseDirectory:='';
   FBaseDirectory:='';
-  FUnitOutputPath:='';
-  FReadLineCounter:=0;
   FForeignUnitPaths.Clear;
   FForeignUnitPaths.Clear;
   FForeignUnitPathsFromCmdLine:=0;
   FForeignUnitPathsFromCmdLine:=0;
   FUnitPaths.Clear;
   FUnitPaths.Clear;
   FUnitPathsFromCmdLine:=0;
   FUnitPathsFromCmdLine:=0;
   FIncludePaths.Clear;
   FIncludePaths.Clear;
   FIncludePathsFromCmdLine:=0;
   FIncludePathsFromCmdLine:=0;
-  FNamespaces.Clear;
-  FNamespacesFromCmdLine:=0;
+  FreeAndNil(FPCUPaths);
   // FOnReadFile: TPas2jsReadFileEvent; keep
   // FOnReadFile: TPas2jsReadFileEvent; keep
   // FOnWriteFile: TPas2jsWriteFileEvent; keep
   // FOnWriteFile: TPas2jsWriteFileEvent; keep
 end;
 end;
@@ -1695,25 +1498,47 @@ begin
     WriteFolder('foreign unit path',ForeignUnitPaths[i]);
     WriteFolder('foreign unit path',ForeignUnitPaths[i]);
   for i:=0 to UnitPaths.Count-1 do
   for i:=0 to UnitPaths.Count-1 do
     WriteFolder('unit path',UnitPaths[i]);
     WriteFolder('unit path',UnitPaths[i]);
-  for i:=0 to Namespaces.Count-1 do
-    Log.LogMsgIgnoreFilter(nUsingPath,['unit scope',Namespaces[i]]);
   for i:=0 to IncludePaths.Count-1 do
   for i:=0 to IncludePaths.Count-1 do
     WriteFolder('include path',IncludePaths[i]);
     WriteFolder('include path',IncludePaths[i]);
   WriteFolder('unit output path',UnitOutputPath);
   WriteFolder('unit output path',UnitOutputPath);
   WriteFolder('main output path',MainOutputPath);
   WriteFolder('main output path',MainOutputPath);
 end;
 end;
 
 
-function TPas2jsFilesCache.AddIncludePaths(const Paths: string;
-  FromCmdLine: boolean; out ErrorMsg: string): boolean;
+procedure TPas2jsFilesCache.GetPCUDirs(aList: TStrings; const aBaseDir: String);
+var
+  i: Integer;
 begin
 begin
-  ErrorMsg:=AddSearchPaths(Paths,spkPath,FromCmdLine,FIncludePaths,FIncludePathsFromCmdLine);
-  Result:=ErrorMsg='';
+  if FPCUPaths=nil then
+    begin
+    FPCUPaths:=TStringList.Create;
+    inherited GetPCUDirs(FPCUPaths, aBaseDir);
+    FPCUPaths.AddStrings(UnitPaths);
+    for i:=0 to FPCUPaths.Count-1 do
+      FPCUPaths[i]:=IncludeTrailingPathDelimiter(FPCUPaths[i]);
+    DeleteDuplicateFiles(FPCUPaths);
+    end;
+  aList.Assign(FPCUPaths);
+end;
+
+function TPas2jsFilesCache.PCUExists(var aFileName: string): Boolean;
+begin
+  Result:=SearchLowUpCase(aFileName);
 end;
 end;
 
 
-function TPas2jsFilesCache.AddNamespaces(const Paths: string;
+function TPas2jsFilesCache.SameFileName(const File1, File2: String): Boolean;
+begin
+  Result:=Pas2jsFileUtils.CompareFilenames(File1,File2)=0;
+end;
+
+function TPas2jsFilesCache.File1IsNewer(const File1, File2: String): Boolean;
+begin
+  Result:=FileAge(File1)>FileAge(File2);
+end;
+
+function TPas2jsFilesCache.AddIncludePaths(const Paths: string;
   FromCmdLine: boolean; out ErrorMsg: string): boolean;
   FromCmdLine: boolean; out ErrorMsg: string): boolean;
 begin
 begin
-  ErrorMsg:=AddSearchPaths(Paths,spkIdentifier,FromCmdLine,FNamespaces,FNamespacesFromCmdLine);
+  ErrorMsg:=AddSearchPaths(Paths,spkPath,FromCmdLine,FIncludePaths,FIncludePathsFromCmdLine);
   Result:=ErrorMsg='';
   Result:=ErrorMsg='';
 end;
 end;
 
 
@@ -1731,7 +1556,8 @@ begin
   Result:=ErrorMsg='';
   Result:=ErrorMsg='';
 end;
 end;
 
 
-function TPas2jsFilesCache.CreateResolver: TPas2jsFileResolver;
+function TPas2jsFilesCache.CreateResolver: TPas2jsFSResolver;
+
 begin
 begin
   Result := TPas2jsFileResolver.Create(Self);
   Result := TPas2jsFileResolver.Create(Self);
   {$IFDEF HasStreams}
   {$IFDEF HasStreams}
@@ -1759,12 +1585,12 @@ end;
 
 
 
 
 
 
-function TPas2jsFilesCache.DirectoryExists(Filename: string): boolean;
+function TPas2jsFilesCache.DirectoryExists(const Filename: string): boolean;
 begin
 begin
   Result:=DirectoryCache.DirectoryExists(FileName);
   Result:=DirectoryCache.DirectoryExists(FileName);
 end;
 end;
 
 
-function TPas2jsFilesCache.FileExists(Filename: string): boolean;
+function TPas2jsFilesCache.FileExists(const Filename: string): boolean;
 begin
 begin
   Result:=DirectoryCache.FileExists(FileName);
   Result:=DirectoryCache.FileExists(FileName);
 end;
 end;
@@ -1786,7 +1612,7 @@ begin
 end;
 end;
 
 
 function TPas2jsFilesCache.LoadFile(Filename: string; Binary: boolean
 function TPas2jsFilesCache.LoadFile(Filename: string; Binary: boolean
-  ): TPas2jsCachedFile;
+  ): TPas2jsFile;
 begin
 begin
   Result:=FindFile(FileName);
   Result:=FindFile(FileName);
   if Result=nil then
   if Result=nil then
@@ -1811,7 +1637,6 @@ begin
       raise EFileNotFoundError.Create('invalid file name "'+Filename+'"');
       raise EFileNotFoundError.Create('invalid file name "'+Filename+'"');
 end;
 end;
 
 
-
 procedure TPas2jsFilesCache.GetListing(const aDirectory: string;
 procedure TPas2jsFilesCache.GetListing(const aDirectory: string;
   var Files: TStrings; FullPaths: boolean);
   var Files: TStrings; FullPaths: boolean);
 begin
 begin
@@ -1899,20 +1724,20 @@ begin
   end;
   end;
 end;
 end;
 
 
-function TPas2jsFilesCache.ExpandDirectory(const Filename, BaseDir: string
-  ): string;
+function TPas2jsFilesCache.ExpandDirectory(const Filename: string): string;
 begin
 begin
   if Filename='' then exit('');
   if Filename='' then exit('');
-  if BaseDir<>'' then
-    Result:=ExpandFileNamePJ(Filename,BaseDir)
-  else
-    Result:=ExpandFileNamePJ(Filename,BaseDirectory);
+  Result:=ExpandFileNamePJ(Filename,BaseDirectory);
   if Result='' then exit;
   if Result='' then exit;
   Result:=IncludeTrailingPathDelimiter(Result);
   Result:=IncludeTrailingPathDelimiter(Result);
 end;
 end;
 
 
-function TPas2jsFilesCache.ExpandExecutable(const Filename, BaseDir: string
-  ): string;
+function TPas2jsFilesCache.ExpandFileName(const Filename: string): string;
+begin
+  Result:=ExpandFileNamePJ(Filename,BaseDirectory);
+end;
+
+function TPas2jsFilesCache.ExpandExecutable(const Filename: string): string;
 
 
   function TryFile(CurFilename: string): boolean;
   function TryFile(CurFilename: string): boolean;
   begin
   begin
@@ -1933,10 +1758,7 @@ begin
     // no file path -> search
     // no file path -> search
     {$IFDEF Windows}
     {$IFDEF Windows}
     // search in BaseDir
     // search in BaseDir
-    if BaseDir<>'' then
-    begin
-      if TryFile(IncludeTrailingPathDelimiter(BaseDir)+Filename) then exit;
-    end else if BaseDirectory<>'' then
+    if BaseDirectory<>'' then
     begin
     begin
       if TryFile(IncludeTrailingPathDelimiter(BaseDirectory)+Filename) then exit;
       if TryFile(IncludeTrailingPathDelimiter(BaseDirectory)+Filename) then exit;
     end;
     end;
@@ -1955,10 +1777,38 @@ begin
       if CurPath='' then continue;
       if CurPath='' then continue;
       if TryFile(IncludeTrailingPathDelimiter(CurPath)+Filename) then exit;
       if TryFile(IncludeTrailingPathDelimiter(CurPath)+Filename) then exit;
     end;
     end;
-  end else if BaseDir<>'' then
-    Result:=ExpandFileNamePJ(Filename,BaseDir)
+  end else
+    Result:=ExpandFileName(Filename);
+end;
+
+function TPas2jsFilesCache.HandleOptionPaths(C: Char; aValue: String; FromCmdLine: Boolean): String;
+
+Var
+  ErrorMsg : String;
+
+begin
+  Result:='';
+  case C of
+    'E': MainOutputPath:=aValue;
+    'i': if not AddIncludePaths(aValue,FromCmdLine,ErrorMsg) then
+           Result:='invalid include path (-Fi) "'+ErrorMsg+'"';
+    'u': if not AddUnitPaths(aValue,FromCmdLine,ErrorMsg) then
+           Result:='invalid unit path (-Fu) "'+ErrorMsg+'"';
+    'U': UnitOutputPath:=aValue;
   else
   else
-    Result:=ExpandFileNamePJ(Filename,BaseDirectory);
+    Result:=inherited HandleOptionPaths(C, aValue, FromCmdLine);
+  end;
+end;
+
+function TPas2jsFilesCache.AddForeignUnitPath(const aValue: String; FromCmdLine: Boolean): String;
+begin
+  AddSrcUnitPaths(aValue,FromCmdLine,Result);
+end;
+
+function TPas2jsFilesCache.TryCreateRelativePath(const Filename, BaseDirectory: String; UsePointDirectory: boolean; out
+  RelPath: String): Boolean;
+begin
+  Result:=Pas2jsFileUtils.TryCreateRelativePath(Filename, BaseDirectory, UsePointDirectory, RelPath);
 end;
 end;
 
 
 function TPas2jsFilesCache.FindIncludeFileName(const aFilename: string): String;
 function TPas2jsFilesCache.FindIncludeFileName(const aFilename: string): String;
@@ -2039,11 +1889,15 @@ end;
 
 
 
 
 function TPas2jsFilesCache.FindUnitFileName(const aUnitname, InFilename: string; out IsForeign: boolean): String;
 function TPas2jsFilesCache.FindUnitFileName(const aUnitname, InFilename: string; out IsForeign: boolean): String;
+var
+  SearchedDirs: TStringList;
 
 
   function SearchInDir(Dir: string; var Filename: string): boolean;
   function SearchInDir(Dir: string; var Filename: string): boolean;
   // search in Dir for pp, pas, p times given case, lower case, upper case
   // search in Dir for pp, pas, p times given case, lower case, upper case
   begin
   begin
     Dir:=IncludeTrailingPathDelimiter(Dir);
     Dir:=IncludeTrailingPathDelimiter(Dir);
+    if IndexOfFile(SearchedDirs,Dir)>=0 then exit(false);
+    SearchedDirs.Add(Dir);
     Filename:=Dir+aUnitname+'.pp';
     Filename:=Dir+aUnitname+'.pp';
     if SearchLowUpCase(Filename) then exit(true);
     if SearchLowUpCase(Filename) then exit(true);
     Filename:=Dir+aUnitname+'.pas';
     Filename:=Dir+aUnitname+'.pas';
@@ -2059,38 +1913,42 @@ var
 begin
 begin
   Result:='';
   Result:='';
   IsForeign:=false;
   IsForeign:=false;
-
-  if InFilename<>'' then
-  begin
-    aFilename:=SetDirSeparators(InFilename);
-    Result:=ResolveDots(aFilename);
-    if FilenameIsAbsolute(Result) then
-    begin
-      if SearchLowUpCase(Result) then exit;
-    end else
+  SearchedDirs:=TStringList.Create;
+  try
+    if InFilename<>'' then
     begin
     begin
-      Result:=ResolveDots(BaseDirectory+Result);
-      if SearchLowUpCase(Result) then exit;
+      aFilename:=SetDirSeparators(InFilename);
+      Result:=ResolveDots(aFilename);
+      if FilenameIsAbsolute(Result) then
+      begin
+        if SearchLowUpCase(Result) then exit;
+      end else
+      begin
+        Result:=ResolveDots(BaseDirectory+Result);
+        if SearchLowUpCase(Result) then exit;
+      end;
+      exit('');
     end;
     end;
-    exit('');
-  end;
 
 
-  // first search in foreign unit paths
-  IsForeign:=true;
-  for i:=0 to ForeignUnitPaths.Count-1 do
-    if SearchInDir(ForeignUnitPaths[i],Result) then
-    begin
-      IsForeign:=true;
-      exit;
-    end;
+    // first search in foreign unit paths
+    IsForeign:=true;
+    for i:=0 to ForeignUnitPaths.Count-1 do
+      if SearchInDir(ForeignUnitPaths[i],Result) then
+      begin
+        IsForeign:=true;
+        exit;
+      end;
 
 
-  // then in BaseDirectory
-  IsForeign:=false;
-  if SearchInDir(BaseDirectory,Result) then exit;
+    // then in BaseDirectory
+    IsForeign:=false;
+    if SearchInDir(BaseDirectory,Result) then exit;
 
 
-  // finally search in unit paths
-  for i:=0 to UnitPaths.Count-1 do
-    if SearchInDir(UnitPaths[i],Result) then exit;
+    // finally search in unit paths
+    for i:=0 to UnitPaths.Count-1 do
+      if SearchInDir(UnitPaths[i],Result) then exit;
+  finally
+    SearchedDirs.Free;
+  end;
 
 
   Result:='';
   Result:='';
 end;
 end;
@@ -2112,12 +1970,15 @@ end;
 
 
 function TPas2jsFilesCache.FindCustomJSFileName(const aFilename: string): String;
 function TPas2jsFilesCache.FindCustomJSFileName(const aFilename: string): String;
 
 
+Var
+  FN : String;
+
   function SearchInDir(Dir: string): boolean;
   function SearchInDir(Dir: string): boolean;
   var
   var
     CurFilename: String;
     CurFilename: String;
   begin
   begin
     Dir:=IncludeTrailingPathDelimiter(Dir);
     Dir:=IncludeTrailingPathDelimiter(Dir);
-    CurFilename:=Dir+aFilename;
+    CurFilename:=Dir+FN;
     Result:=FileExistsLogged(CurFilename);
     Result:=FileExistsLogged(CurFilename);
     if Result then
     if Result then
       FindCustomJSFileName:=CurFilename;
       FindCustomJSFileName:=CurFilename;
@@ -2127,18 +1988,18 @@ var
   i: Integer;
   i: Integer;
 begin
 begin
   Result:='';
   Result:='';
-
-  if FilenameIsAbsolute(aFilename) then
+  FN:=ResolveDots(aFileName);
+  if FilenameIsAbsolute(FN) then
     begin
     begin
-    Result:=aFilename;
+    Result:=FN;
     if not FileExistsLogged(Result) then
     if not FileExistsLogged(Result) then
       Result:='';
       Result:='';
     exit;
     exit;
     end;
     end;
 
 
-  if ExtractFilePath(aFilename)<>'' then
+  if ExtractFilePath(FN)<>'' then
     begin
     begin
-    Result:=ExpandFileNamePJ(aFilename,BaseDirectory);
+    Result:=ExpandFileNamePJ(FN,BaseDirectory);
     if not FileExistsLogged(Result) then
     if not FileExistsLogged(Result) then
       Result:='';
       Result:='';
     exit;
     exit;
@@ -2169,6 +2030,11 @@ begin
       Log.LogMsgIgnoreFilter(nSearchingFileNotFound,[FormatPath(Filename)]);
       Log.LogMsgIgnoreFilter(nSearchingFileNotFound,[FormatPath(Filename)]);
 end;
 end;
 
 
+function TPas2jsFilesCache.GetOnReadDirectory: TReadDirectoryEvent;
+begin
+  Result:=DirectoryCache.OnReadDirectory;
+end;
+
 function TPas2jsFilesCache.FileExistsILogged(var Filename: string): integer;
 function TPas2jsFilesCache.FileExistsILogged(var Filename: string): integer;
 begin
 begin
   Result:=DirectoryCache.FileExistsI(Filename);
   Result:=DirectoryCache.FileExistsI(Filename);

+ 28 - 20
packages/pastojs/src/pas2jsfiler.pp

@@ -295,7 +295,8 @@ const
     'List',
     'List',
     'Inherited',
     'Inherited',
     'Self',
     'Self',
-    'Specialize');
+    'Specialize',
+    'Procedure');
 
 
   PCUExprOpCodeNames: array[TExprOpCode] of string = (
   PCUExprOpCodeNames: array[TExprOpCode] of string = (
     'None',
     'None',
@@ -842,6 +843,7 @@ type
     procedure Set_SetType_EnumType(RefEl: TPasElement; Data: TObject);
     procedure Set_SetType_EnumType(RefEl: TPasElement; Data: TObject);
     procedure Set_Variant_Members(RefEl: TPasElement; Data: TObject);
     procedure Set_Variant_Members(RefEl: TPasElement; Data: TObject);
     procedure Set_RecordType_VariantEl(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_Argument_ArgType(RefEl: TPasElement; Data: TObject);
     procedure Set_ClassScope_NewInstanceFunction(RefEl: TPasElement; Data: TObject);
     procedure Set_ClassScope_NewInstanceFunction(RefEl: TPasElement; Data: TObject);
     procedure Set_ClassScope_DirectAncestor(RefEl: TPasElement; Data: TObject);
     procedure Set_ClassScope_DirectAncestor(RefEl: TPasElement; Data: TObject);
@@ -1699,11 +1701,11 @@ var
   El: TPasElement;
   El: TPasElement;
 begin
 begin
   El:=Scope.Element;
   El:=Scope.Element;
-  if El is TPasClassType then
+  if El is TPasMembersType then
     Result:=El
     Result:=El
   else if El is TPasModule then
   else if El is TPasModule then
     Result:=El
     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
     Result:=Scope.Element.Parent
   else
   else
     Result:=nil;
     Result:=nil;
@@ -2130,7 +2132,7 @@ begin
   WriteModeSwitches(Obj,'FinalModeSwitches',Scanner.CurrentModeSwitches,InitialFlags.Modeswitches);
   WriteModeSwitches(Obj,'FinalModeSwitches',Scanner.CurrentModeSwitches,InitialFlags.Modeswitches);
   WriteBoolSwitches(Obj,'FinalBoolSwitches',Scanner.CurrentBoolSwitches,InitialFlags.BoolSwitches);
   WriteBoolSwitches(Obj,'FinalBoolSwitches',Scanner.CurrentBoolSwitches,InitialFlags.BoolSwitches);
   if InitialFlags.ConverterOptions<>Converter.Options then
   if InitialFlags.ConverterOptions<>Converter.Options then
-    RaiseMsg(20180314185555);
+    RaiseMsg(20180314185555,'InitialFlags='+dbgs(InitialFlags.ConverterOptions)+' Converter='+dbgs(Converter.Options));
   // ToDo: write final flags: used defines, used macros
   // ToDo: write final flags: used defines, used macros
 end;
 end;
 
 
@@ -3324,6 +3326,7 @@ end;
 procedure TPCUWriter.WriteRecordTypeScope(Obj: TJSONObject;
 procedure TPCUWriter.WriteRecordTypeScope(Obj: TJSONObject;
   Scope: TPasRecordScope; aContext: TPCUWriterContext);
   Scope: TPasRecordScope; aContext: TPCUWriterContext);
 begin
 begin
+  AddReferenceToObj(Obj,'DefaultProperty',Scope.DefaultProperty);
   WriteIdentifierScope(Obj,Scope,aContext);
   WriteIdentifierScope(Obj,Scope,aContext);
 end;
 end;
 
 
@@ -3829,10 +3832,9 @@ begin
   C:=Parent.ClassType;
   C:=Parent.ClassType;
   if C.InheritsFrom(TPasDeclarations) then
   if C.InheritsFrom(TPasDeclarations) then
     WriteMemberIndex(TPasDeclarations(Parent).Declarations,Ref.Element,Ref.Obj)
     WriteMemberIndex(TPasDeclarations(Parent).Declarations,Ref.Element,Ref.Obj)
-  else if C=TPasClassType then
-    WriteMemberIndex(TPasClassType(Parent).Members,Ref.Element,Ref.Obj)
-  else if C=TPasRecordType then
-    WriteMemberIndex(TPasRecordType(Parent).Members,Ref.Element,Ref.Obj)
+  else if (C=TPasClassType)
+      or (C=TPasRecordType) then
+    WriteMemberIndex(TPasMembersType(Parent).Members,Ref.Element,Ref.Obj)
   else if C=TPasEnumType then
   else if C=TPasEnumType then
     WriteMemberIndex(TPasEnumType(Parent).Values,Ref.Element,Ref.Obj)
     WriteMemberIndex(TPasEnumType(Parent).Values,Ref.Element,Ref.Obj)
   else if C.InheritsFrom(TPasModule) then
   else if C.InheritsFrom(TPasModule) then
@@ -4212,6 +4214,17 @@ begin
     RaiseMsg(20180210205031,El,GetObjName(RefEl));
     RaiseMsg(20180210205031,El,GetObjName(RefEl));
 end;
 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);
 procedure TPCUReader.Set_Argument_ArgType(RefEl: TPasElement; Data: TObject);
 var
 var
   El: TPasArgument absolute Data;
   El: TPasArgument absolute Data;
@@ -5230,10 +5243,8 @@ begin
     begin
     begin
     if El is TPasDeclarations then
     if El is TPasDeclarations then
       ReadExternalMembers(El,Arr,TPasDeclarations(El).Declarations)
       ReadExternalMembers(El,Arr,TPasDeclarations(El).Declarations)
-    else if El is TPasClassType then
-      ReadExternalMembers(El,Arr,TPasClassType(El).Members)
-    else if El is TPasRecordType then
-      ReadExternalMembers(El,Arr,TPasRecordType(El).Members)
+    else if El is TPasMembersType then
+      ReadExternalMembers(El,Arr,TPasMembersType(El).Members)
     else if El is TPasEnumType then
     else if El is TPasEnumType then
       ReadExternalMembers(El,Arr,TPasEnumType(El).Values)
       ReadExternalMembers(El,Arr,TPasEnumType(El).Values)
     else if El is TPasModule then
     else if El is TPasModule then
@@ -5459,9 +5470,7 @@ begin
       Section.ResStrings.Add(El)
       Section.ResStrings.Add(El)
     else if C=TPasConst then
     else if C=TPasConst then
       Section.Consts.Add(El)
       Section.Consts.Add(El)
-    else if C=TPasClassType then
-      Section.Classes.Add(El)
-    else if C=TPasRecordType then
+    else if (C=TPasClassType) or (C=TPasRecordType) then
       Section.Classes.Add(El)
       Section.Classes.Add(El)
     else if C.InheritsFrom(TPasType) then
     else if C.InheritsFrom(TPasType) then
       // not TPasClassType, TPasRecordType !
       // not TPasClassType, TPasRecordType !
@@ -6615,6 +6624,7 @@ end;
 procedure TPCUReader.ReadRecordScope(Obj: TJSONObject; Scope: TPasRecordScope;
 procedure TPCUReader.ReadRecordScope(Obj: TJSONObject; Scope: TPasRecordScope;
   aContext: TPCUReaderContext);
   aContext: TPCUReaderContext);
 begin
 begin
+  ReadElementReference(Obj,Scope,'DefaultProperty',@Set_RecordScope_DefaultProperty);
   ReadIdentifierScope(Obj,Scope,aContext);
   ReadIdentifierScope(Obj,Scope,aContext);
 end;
 end;
 
 
@@ -7313,8 +7323,8 @@ begin
   // Scope.OverloadName is already set in ReadProcedure
   // Scope.OverloadName is already set in ReadProcedure
   ReadElementReference(Obj,Scope,'ImplProc',@Set_ProcedureScope_ImplProc);
   ReadElementReference(Obj,Scope,'ImplProc',@Set_ProcedureScope_ImplProc);
   ReadElementReference(Obj,Scope,'Overridden',@Set_ProcedureScope_Overridden);
   ReadElementReference(Obj,Scope,'Overridden',@Set_ProcedureScope_Overridden);
-  if Proc.Parent is TPasClassType then
-    Scope.ClassScope:=Proc.Parent.CustomData as TPas2JSClassScope; // no AddRef
+  if Proc.Parent is TPasMembersType then
+    Scope.ClassOrRecordScope:=Proc.Parent.CustomData as TPasClassOrRecordScope; // no AddRef
   // ClassScope: TPasClassScope; auto derived
   // ClassScope: TPasClassScope; auto derived
   // Scope.SelfArg only valid for method implementation
   // Scope.SelfArg only valid for method implementation
 
 
@@ -7853,9 +7863,7 @@ end;
 
 
 initialization
 initialization
   PrecompileFormats:=TPas2JSPrecompileFormats.Create;
   PrecompileFormats:=TPas2JSPrecompileFormats.Create;
-  {$IFDEF EnablePas2jsPrecompiled}
-  PrecompileFormats.Add('pcu','all used units must be pcu too',TPCUReader,TPCUWriter);
-  {$ENDIF}
+  PrecompileFormats.Add('pcu','all used pcu must match exactly',TPCUReader,TPCUWriter);
 finalization
 finalization
   PrecompileFormats.Free;
   PrecompileFormats.Free;
   PrecompileFormats:=nil;
   PrecompileFormats:=nil;

+ 0 - 88
packages/pastojs/src/pas2jsfileutils.pp

@@ -66,8 +66,6 @@ function GetEnvironmentVariablePJ(const EnvVar: string): String;
 
 
 function GetNextDelimitedItem(const List: string; Delimiter: char;
 function GetNextDelimitedItem(const List: string; Delimiter: char;
                               var Position: integer): string;
                               var Position: integer): string;
-procedure SplitCmdLineParams(const Params: string; ParamList: TStrings;
-                             ReadBackslash: boolean = false);
 
 
 type TChangeStamp = SizeInt;
 type TChangeStamp = SizeInt;
 const InvalidChangeStamp = low(TChangeStamp);
 const InvalidChangeStamp = low(TChangeStamp);
@@ -732,92 +730,6 @@ begin
   if Position<=length(List) then inc(Position); // skip Delimiter
   if Position<=length(List) then inc(Position); // skip Delimiter
 end;
 end;
 
 
-procedure SplitCmdLineParams(const Params: string; ParamList: TStrings;
-                             ReadBackslash: boolean = false);
-// split spaces, quotes are parsed as single parameter
-// if ReadBackslash=true then \" is replaced to " and not treated as quote
-// #0 is always end
-type
-  TMode = (mNormal,mApostrophe,mQuote);
-var
-  p: Integer;
-  Mode: TMode;
-  Param: String;
-begin
-  p:=1;
-  while p<=length(Params) do
-  begin
-    // skip whitespace
-    while (p<=length(Params)) and (Params[p] in [' ',#9,#10,#13]) do inc(p);
-    if (p>length(Params)) or (Params[p]=#0) then
-      break;
-    // read param
-    Param:='';
-    Mode:=mNormal;
-    while p<=length(Params) do
-    begin
-      case Params[p] of
-      #0:
-        break;
-      '\':
-        begin
-          inc(p);
-          if ReadBackslash then
-            begin
-            // treat next character as normal character
-            if (p>length(Params)) or (Params[p]=#0) then
-              break;
-            if ord(Params[p])<128 then
-            begin
-              Param+=Params[p];
-              inc(p);
-            end else begin
-              // next character is already a normal character
-            end;
-          end else begin
-            // treat backslash as normal character
-            Param+='\';
-          end;
-        end;
-      '''':
-        begin
-          inc(p);
-          case Mode of
-          mNormal:
-            Mode:=mApostrophe;
-          mApostrophe:
-            Mode:=mNormal;
-          mQuote:
-            Param+='''';
-          end;
-        end;
-      '"':
-        begin
-          inc(p);
-          case Mode of
-          mNormal:
-            Mode:=mQuote;
-          mApostrophe:
-            Param+='"';
-          mQuote:
-            Mode:=mNormal;
-          end;
-        end;
-      ' ',#9,#10,#13:
-        begin
-          if Mode=mNormal then break;
-          Param+=Params[p];
-          inc(p);
-        end;
-      else
-        Param+=Params[p];
-        inc(p);
-      end;
-    end;
-    //writeln('SplitCmdLineParams Param=#'+Param+'#');
-    ParamList.Add(Param);
-  end;
-end;
 
 
 procedure IncreaseChangeStamp(var Stamp: TChangeStamp);
 procedure IncreaseChangeStamp(var Stamp: TChangeStamp);
 begin
 begin

+ 453 - 0
packages/pastojs/src/pas2jsfs.pp

@@ -0,0 +1,453 @@
+{
+    This file is part of the Free Component Library (FCL)
+    Copyright (c) 2018  Michael Van Canneyt
+
+    Pascal to Javascript converter class.
+
+    See the file COPYING.FPC, included in this distribution,
+    for details about the copyright.
+
+    This program is distributed in the hope that it will be useful,
+    but WITHOUT ANY WARRANTY; without even the implied warranty of
+    MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.
+
+ **********************************************************************
+
+  Abstract:
+    FileSystem abstraction layer for compiler.
+    Has only abstract classes with no actual implementation, so it does not actually
+    interacts with the filesystem.
+    See Pas2JSFileCache for an actual implementation.
+}
+unit Pas2JSFS;
+
+{$mode objfpc}{$H+}
+{$I pas2js_defines.inc}
+
+interface
+
+uses
+  // No filesystem-dependent units here !
+  Classes, SysUtils, PScanner, fpjson;
+
+const // Messages
+  nIncludeSearch = 201; sIncludeSearch = 'Include file search: %s';
+  nUnitSearch = 202; sUnitSearch = 'Unitsearch: %s';
+  nSearchingFileFound = 203; sSearchingFileFound = 'Searching file: %s... found';
+  nSearchingFileNotFound = 204; sSearchingFileNotFound = 'Searching file: %s... not found';
+  nDuplicateFileFound = 205; sDuplicateFileFound = 'Duplicate file found: "%s" and "%s"';
+  nCustomJSFileNotFound = 206; sCustomJSFileNotFound = 'custom JS file not found: "%s"';
+  nUsingPath = 104; sUsingPath = 'Using %s: "%s"';
+  nFolderNotFound = 105; sFolderNotFound = '%s not found: %s';
+
+Type
+  // Forward definitions
+  EPas2jsFS = Class(Exception);
+  TPas2jsFile = class;
+  TSourceLineReader = class;
+  TPas2jsFSResolver = class;
+  TPas2JSFS = Class;
+
+  { TSourceLineReader }
+
+  TSourceLineReader = class(TLineReader)
+  private
+    FIsEOF: boolean;
+    FLineNumber: integer;
+    FSource: string;
+    FSrcPos: integer;
+  Protected
+    Procedure IncLineNumber; virtual;
+    property Source: string read FSource;
+    property SrcPos: integer read FSrcPos;
+  public
+    Constructor Create(Const aFileName, aSource: String); overload;
+    function IsEOF: Boolean; override;
+    function ReadLine: string; override;
+    property LineNumber: integer read FLineNumber;
+  end;
+
+  TP2jsFSOption = (
+    caoShowFullFilenames,
+    caoShowTriedUsedFiles,
+    caoSearchLikeFPC,
+    caoStrictFileCase
+    );
+  TP2jsFSOptions = set of TP2jsFSOption;
+  TKeyCompareType = (kcFilename,kcUnitName);
+
+  { TPas2JSFS }
+
+  TPas2JSFS = Class
+  Private
+    FOptions: TP2jsFSOptions;
+    FReadLineCounter: SizeInt;
+    FDefaultOutputPath: string;
+    FUnitOutputPath: string;
+    procedure SetOptionFromIndex(AIndex: Integer; AValue: boolean);
+    procedure SetDefaultOutputPath(AValue: string);
+    procedure SetUnitOutputPath(AValue: string);
+  Protected
+    // Not to be overridden
+    procedure SetOption(Flag: TP2jsFSOption; Enable: boolean);
+    Function OptionIsSet(Index: Integer):  Boolean;
+  Protected
+    // Protected Abstract. Must be overridden
+    function FindSourceFileName(const aFilename: string): String; virtual; abstract;
+  Public
+    // Public Abstract. Must be overridden
+    function FindIncludeFileName(const aFilename: string): String; virtual; abstract;
+    function LoadFile(Filename: string; Binary: boolean = false): TPas2jsFile; virtual; abstract;
+    Function FileExists(Const aFileName: String): Boolean; virtual; abstract;
+    function FindUnitJSFileName(const aUnitFilename: string): String; virtual; abstract;
+    function FindCustomJSFileName(const aFilename: string): String; virtual; abstract;
+    function FindUnitFileName(const aUnitname, InFilename: string; out IsForeign: boolean): String; virtual; abstract;
+    procedure SaveToFile(ms: TFPJSStream; Filename: string); virtual; abstract;
+    function PCUExists(var aFileName: string): Boolean; virtual;
+    procedure GetPCUDirs(aList: TStrings; const aBaseDir: String); virtual;
+  Public
+    // Public, may be overridden
+    Function SameFileName(Const File1,File2: String): Boolean; virtual;
+    Function File1IsNewer(Const File1,File2: String): Boolean; virtual;
+    function ExpandDirectory(const Filename: string): string; virtual;
+    function ExpandFileName(const Filename: string): string; virtual;
+    function ExpandExecutable(const Filename: string): string; virtual;
+    Function FormatPath(Const aFileName: string): String; virtual;
+    Function DirectoryExists(Const aDirectory: string): boolean; virtual;
+    function TryCreateRelativePath(const Filename, BaseDirectory: String; UsePointDirectory: boolean; out RelPath: String): Boolean; virtual;
+    procedure DeleteDuplicateFiles(List: TStrings); virtual;
+    function IndexOfFile(FileList: TStrings; aFilename: string; Start: integer = 0): integer; virtual;// -1 if not found
+    Procedure WriteFoldersAndSearchPaths; virtual;
+    function CreateResolver: TPas2jsFSResolver; virtual;
+    // On success, return '', On error, return error message.
+    Function AddForeignUnitPath(Const aValue: String; FromCmdLine: Boolean): String; virtual;
+    Function HandleOptionPaths(C: Char; aValue: String; FromCmdLine: Boolean): String; virtual;
+  Public
+    Constructor Create; virtual;
+    Procedure Reset; virtual;
+    Procedure IncReadLineCounter;
+    property ReadLineCounter: SizeInt read FReadLineCounter write FReadLineCounter;
+    property Options: TP2jsFSOptions read FOptions write FOptions;
+    property ShowFullPaths: boolean Index 0 Read OptionIsSet Write SetOptionFromIndex;
+    property ShowTriedUsedFiles: boolean Index 1 read OptionIsSet Write SetOptionFromIndex;
+    property SearchLikeFPC: boolean index 2 read OptionIsSet Write SetOptionFromIndex;
+    Property StrictFileCase: Boolean Index 3 Read OptionIsSet Write SetOptionFromIndex;
+    property MainOutputPath: string read FDefaultOutputPath write SetDefaultOutputPath; // includes trailing pathdelim
+    property UnitOutputPath: string read FUnitOutputPath write SetUnitOutputPath; // includes trailing pathdelim
+  end;
+
+  { TPas2jsFile }
+
+  TPas2jsFile = class
+  private
+    FFilename: string;
+    FFS: TPas2JSFS;
+    FSource: string;
+  Protected
+    Procedure SetSource(aSource: String);
+  public
+    constructor Create(aFS: TPas2jsFS; const aFilename: string);
+    function CreateLineReader(RaiseOnError: boolean): TSourceLineReader; virtual; abstract;
+    function Load(RaiseOnError: boolean; Binary: boolean): boolean; virtual; abstract;
+    property Source: string read FSource; // UTF-8 without BOM or Binary
+    Property FS: TPas2JSFS Read FFS;
+    property Filename: string read FFilename;
+  end;
+
+  { TPas2jsFSResolver }
+
+  TPas2jsFSResolver = class({$IFDEF HASFILESYSTEM}TFileResolver{$ELSE}TBaseFileResolver{$ENDIF})
+  private
+    FFS: TPas2jsFS;
+  public
+    constructor Create(aFS: TPas2jsFS); reintroduce;
+    // Redirect all calls to FS.
+    function FindIncludeFileName(const aFilename: string): String; override;
+    function FindIncludeFile(const aFilename: string): TLineReader; override;
+    function FindSourceFile(const aFilename: string): TLineReader; override;
+    property FS: TPas2jsFS read FFS;
+  end;
+
+
+Const
+  p2jsfcoCaption: array[TP2jsFSOption] of string = (
+      // only used by experts, no need for resourcestrings
+      'Show full filenames',
+      'Show tried/used files',
+      'Search files like FPC',
+      'Strict file case'
+      );
+    // 'Combine all JavaScript into main file',
+    EncodingBinary = 'Binary';
+
+  DefaultPas2jsFSOptions = [];
+
+implementation
+
+// No filesystem-dependent units here !
+
+{ TPas2JSFS }
+
+procedure TPas2JSFS.SetOptionFromIndex(AIndex: Integer; AValue: boolean);
+begin
+  SetOption(TP2jsFSOption(aIndex),aValue);
+end;
+
+procedure TPas2JSFS.SetOption(Flag: TP2jsFSOption; Enable: boolean);
+begin
+  if Enable then
+    Include(FOptions,Flag)
+  else
+    Exclude(FOptions,Flag);
+end;
+
+function TPas2JSFS.OptionIsSet(Index: Integer): Boolean;
+begin
+  Result:=TP2jsFSOption(Index) in FOptions;
+end;
+
+function TPas2JSFS.PCUExists(var aFileName: string): Boolean;
+begin
+  Result:=Self.FileExists(aFileName);
+end;
+
+procedure TPas2JSFS.GetPCUDirs(aList: TStrings; const aBaseDir: String);
+begin
+  if UnitOutputPath<>'' then
+    aList.Add(UnitOutputPath);
+  aList.Add(aBaseDir);
+end;
+
+function TPas2JSFS.SameFileName(const File1, File2: String): Boolean;
+begin
+  Result:=CompareText(File1,File2)=0;
+end;
+
+function TPas2JSFS.File1IsNewer(const File1, File2: String): Boolean;
+begin
+  Result:=False;
+  if File1=File2 then ;
+end;
+
+function TPas2JSFS.ExpandDirectory(const Filename: string): string;
+begin
+  Result:=FileName;
+end;
+
+function TPas2JSFS.ExpandFileName(const Filename: string): string;
+begin
+  Result:=FileName;
+end;
+
+function TPas2JSFS.ExpandExecutable(const Filename: string): string;
+begin
+  Result:=FileName
+end;
+
+function TPas2JSFS.FormatPath(const aFileName: string): String;
+begin
+  Result:=aFileName;
+end;
+
+function TPas2JSFS.DirectoryExists(const aDirectory: string): boolean;
+begin
+  Result:=aDirectory='';
+end;
+
+function TPas2JSFS.TryCreateRelativePath(const Filename, BaseDirectory: String; UsePointDirectory: boolean; out RelPath: String
+  ): Boolean;
+begin
+  Result:=True;
+  RelPath:=FileName;
+  if (BaseDirectory='') or UsePointDirectory then ;
+end;
+
+procedure TPas2JSFS.DeleteDuplicateFiles(List: TStrings);
+var
+  i, j: Integer;
+begin
+  for i:=0 to List.Count-2 do
+    for j:=List.Count-1 downto i+1 do
+      if SameFileName(List[i],List[j]) then
+        List.Delete(j);
+end;
+
+function TPas2JSFS.IndexOfFile(FileList: TStrings; aFilename: string;
+  Start: integer): integer;
+var
+  i: Integer;
+begin
+  if FileList<>nil then
+    for i:=Start to FileList.Count-1 do
+      if SameFileName(FileList[i],aFilename) then exit(i);
+  Result:=-1;
+end;
+
+procedure TPas2JSFS.WriteFoldersAndSearchPaths;
+begin
+  // Do nothing
+end;
+
+function TPas2JSFS.CreateResolver: TPas2jsFSResolver;
+begin
+  Result:=TPas2jsFSResolver.Create(Self);
+end;
+
+function TPas2JSFS.AddForeignUnitPath(const aValue: String; FromCmdLine: Boolean): String;
+begin
+  Result:='';
+  if (aValue='') or FromCmdLine then ;
+end;
+
+function TPas2JSFS.HandleOptionPaths(C: Char; aValue: String; FromCmdLine: Boolean): String;
+begin
+  Result:='Invalid parameter: -F'+C+aValue;
+  if FromCmdLine then ;
+end;
+
+constructor TPas2JSFS.Create;
+begin
+  FOptions:=DefaultPas2jsFSOptions;
+end;
+
+procedure TPas2JSFS.Reset;
+begin
+  FReadLineCounter:=0;
+  FUnitOutputPath:='';
+  FDefaultOutputPath:='';
+end;
+
+procedure TPas2JSFS.IncReadLineCounter;
+begin
+  Inc(FReadLineCounter);
+end;
+
+procedure TPas2JSFS.SetDefaultOutputPath(AValue: string);
+begin
+  AValue:=ExpandDirectory(AValue);
+  if FDefaultOutputPath=AValue then Exit;
+  FDefaultOutputPath:=AValue;
+end;
+
+procedure TPas2JSFS.SetUnitOutputPath(AValue: string);
+
+begin
+  AValue:=ExpandDirectory(AValue);
+  if FUnitOutputPath=AValue then Exit;
+  FUnitOutputPath:=AValue;
+end;
+
+
+{ TPas2jsFile }
+
+procedure TPas2jsFile.SetSource(aSource: String);
+begin
+  FSource:=ASource;
+end;
+
+constructor TPas2jsFile.Create(aFS: TPas2jsFS; const aFilename: string);
+begin
+  FFS:=aFS;
+  FFileName:=aFileName;
+end;
+
+procedure TSourceLineReader.IncLineNumber;
+begin
+  inc(FLineNumber);
+end;
+
+Constructor TSourceLineReader.Create(Const aFileName, aSource: String);
+begin
+  Inherited Create(aFileName);
+  FSource:=aSource;
+  FSrcPos:=1;
+  FIsEOF:=FSource='';
+end;
+
+function TSourceLineReader.IsEOF: Boolean;
+begin
+  Result:=FIsEOF;
+end;
+
+function TSourceLineReader.ReadLine: string;
+var
+  S: string;
+  p, SrcLen: integer;
+
+  procedure GetLine;
+  var
+    l: SizeInt;
+  begin
+    l:=p-FSrcPos;
+    Result:=copy(S,FSrcPos,l);
+    FSrcPos:=p;
+    IncLineNumber;
+    //writeln('GetLine "',Result,'"');
+  end;
+
+begin
+  if FIsEOF then exit('');
+  S:=Source;
+  SrcLen:=length(S);
+  p:=FSrcPos;
+  while p<=SrcLen do
+    case S[p] of
+    #10,#13:
+      begin
+        GetLine;
+        inc(p);
+        if (p<=SrcLen) and (S[p] in [#10,#13]) and (S[p]<>S[p-1]) then
+          inc(p);
+        if p>SrcLen then
+          FIsEOF:=true;
+        FSrcPos:=p;
+        exit;
+      end;
+    else
+      inc(p);
+    end;
+  FIsEOF:=true;
+  GetLine;
+end;
+
+
+function TPas2jsFSResolver.FindIncludeFile(const aFilename: string): TLineReader;
+var
+  Filename: String;
+begin
+  Result:=nil;
+  Filename:=FS.FindIncludeFileName(aFilename);
+  if Filename='' then exit;
+  try
+    Result:=FindSourceFile(Filename);
+  except
+    // error is shown in the scanner, which has the context information
+  end;
+end;
+
+constructor TPas2jsFSResolver.Create(aFS: TPas2jsFS);
+begin
+  FFS:=aFS;
+end;
+
+function TPas2jsFSResolver.FindIncludeFileName(const aFilename: string): String;
+
+begin
+  Result:=FS.FindIncludeFileName(aFilename);
+end;
+
+
+function TPas2jsFSResolver.FindSourceFile(const aFilename: string): TLineReader;
+
+var
+  CurFilename: String;
+
+begin
+  CurFilename:=FS.FindSourceFileName(aFileName);
+  Result:=FS.LoadFile(CurFilename).CreateLineReader(false);
+end;
+
+
+
+end.
+

+ 166 - 0
packages/pastojs/src/pas2jsfscompiler.pp

@@ -0,0 +1,166 @@
+{
+    This file is part of the Free Component Library (FCL)
+    Copyright (c) 2018  Michael Van Canneyt
+
+    Pascal to Javascript converter class.
+
+    See the file COPYING.FPC, included in this distribution,
+    for details about the copyright.
+
+    This program is distributed in the hope that it will be useful,
+    but WITHOUT ANY WARRANTY; without even the implied warranty of
+    MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.
+
+ **********************************************************************
+
+  Abstract:
+    FileSystem aware compiler descendent. No support for PCU.
+}
+unit Pas2JSFSCompiler;
+
+{$mode objfpc}{$H+}
+
+interface
+
+uses
+  Classes, SysUtils,
+  PasUseAnalyzer,
+  Pas2jsFileCache, Pas2jsCompiler,
+  Pas2JSFS,
+  Pas2jsFileUtils;
+
+Type
+  TPas2jsFSCompiler = Class(TPas2JSCompiler)
+  private
+    function GetFileCache: TPas2jsFilesCache;
+    function OnMacroEnv(Sender: TObject; var Params: string; Lvl: integer): boolean;
+  Public
+    Procedure SetWorkingDir(const aDir: String); override;
+    function CreateSetOfCompilerFiles(keyType: TKeyCompareType): TPasAnalyzerKeySet; override;
+    Function CreateFS : TPas2JSFS; override;
+    Procedure InitParamMacros; override;
+    Property FileCache : TPas2jsFilesCache Read GetFileCache;
+  end;
+
+implementation
+
+{$IFDEF PAS2JS}
+function Pas2jsCompilerFile_FilenameToKeyName(Item: Pointer): String;
+var
+  aFile: TPas2jsCompilerFile absolute Item;
+begin
+  Result:=FilenameToKey(aFile.PasFilename);
+end;
+
+function PtrUnitnameToKeyName(Item: Pointer): String;
+var
+  aUnitName: string absolute Item;
+begin
+  Result:=LowerCase(aUnitName);
+end;
+
+function Pas2jsCompilerFile_UnitnameToKeyName(Item: Pointer): String;
+var
+  aFile: TPas2jsCompilerFile absolute Item;
+begin
+  Result:=LowerCase(aFile.PasUnitName);
+end;
+{$ELSE}
+function CompareCompilerFiles_UnitFilename(Item1, Item2: Pointer): integer;
+var
+  File1: TPas2JSCompilerFile absolute Item1;
+  File2: TPas2JSCompilerFile absolute Item2;
+begin
+  Result:=CompareFilenames(File1.UnitFilename,File2.UnitFilename);
+end;
+
+function CompareFileAndCompilerFile_UnitFilename(Filename, Item: Pointer): integer;
+var
+  aFile: TPas2JSCompilerFile absolute Item;
+  aFilename: String;
+begin
+  aFilename:=AnsiString(Filename);
+  Result:=CompareFilenames(aFilename,aFile.UnitFilename);
+end;
+
+function CompareCompilerFilesPasUnitname(Item1, Item2: Pointer): integer;
+var
+  File1: TPas2JSCompilerFile absolute Item1;
+  File2: TPas2JSCompilerFile absolute Item2;
+begin
+  Result:=CompareText(File1.PasUnitName,File2.PasUnitName);
+end;
+
+function CompareUnitnameAndCompilerFile_PasUnitName(TheUnitname, Item: Pointer): integer;
+var
+  aFile: TPas2JSCompilerFile absolute Item;
+  anUnitname: String;
+begin
+  anUnitname:=AnsiString(TheUnitname);
+  Result:=CompareText(anUnitname,aFile.PasUnitName);
+end;
+{$ENDIF}
+
+function TPas2jsFSCompiler.CreateFS: TPas2JSFS;
+
+Var
+  C :  TPas2jsFilesCache;
+
+begin
+  C:=TPas2jsFilesCache.Create(Log);
+  C.BaseDirectory:=GetCurrentDirPJ;
+  Result:=C;
+end;
+
+function TPas2jsFSCompiler.GetFileCache: TPas2jsFilesCache;
+begin
+  Result:=FS as TPas2jsFilesCache;
+end;
+
+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;
+
+procedure TPas2jsFSCompiler.SetWorkingDir(const aDir: String);
+begin
+  inherited SetWorkingDir(aDir);
+  FileCache.BaseDirectory:=aDir;
+end;
+
+function TPas2jsFSCompiler.CreateSetOfCompilerFiles(keyType: TKeyCompareType): TPasAnalyzerKeySet;
+begin
+  Case keyType of
+    kcFileName:
+      Result:=TPasAnalyzerKeySet.Create(
+          {$IFDEF Pas2js}
+          @Pas2jsCompilerFile_FilenameToKeyName,@PtrFilenameToKeyName
+          {$ELSE}
+          @CompareCompilerFiles_UnitFilename,@CompareFileAndCompilerFile_UnitFilename
+          {$ENDIF});
+    kcUnitName:
+      Result:=TPasAnalyzerKeySet.Create(
+        {$IFDEF Pas2js}
+        @Pas2jsCompilerFile_UnitnameToKeyName,@PtrUnitnameToKeyName
+        {$ELSE}
+        @CompareCompilerFilesPasUnitname,@CompareUnitnameAndCompilerFile_PasUnitName
+        {$ENDIF});
+  else
+    Raise EPas2jsFileCache.CreateFmt('Internal Unknown key type: %d',[Ord(KeyType)]);
+  end;
+end;
+
+procedure TPas2jsFSCompiler.InitParamMacros;
+begin
+  inherited InitParamMacros;
+  ParamMacros.AddFunction('Env','environment variable, e.g. $Env(HOME)',@OnMacroEnv,true);
+end;
+
+
+
+end.
+

+ 8 - 4
packages/pastojs/src/pas2jslibcompiler.pp

@@ -2,7 +2,7 @@
     This file is part of the Free Component Library (FCL)
     This file is part of the Free Component Library (FCL)
     Copyright (c) 2018  Michael Van Canneyt
     Copyright (c) 2018  Michael Van Canneyt
 
 
-    Pascal to Javascript converter class.
+    Pascal to Javascript converter class. Library version
 
 
     See the file COPYING.FPC, included in this distribution,
     See the file COPYING.FPC, included in this distribution,
     for details about the copyright.
     for details about the copyright.
@@ -21,7 +21,9 @@ unit pas2jslibcompiler;
 interface
 interface
 
 
 uses
 uses
-  SysUtils, Classes, FPPJsSrcMap, Pas2jsFileCache, Pas2jsCompiler;
+  SysUtils, Classes,
+  FPPJsSrcMap, Pas2jsFileCache, Pas2JSCompiler, Pas2jsPCUCompiler,
+  Pas2JSCompilerCfg, Pas2JSCompilerPP;
 
 
 { ---------------------------------------------------------------------
 { ---------------------------------------------------------------------
   Compiler descendant, usable in library
   Compiler descendant, usable in library
@@ -44,7 +46,7 @@ Type
 
 
   { TLibraryPas2JSCompiler }
   { TLibraryPas2JSCompiler }
 
 
-  TLibraryPas2JSCompiler = Class(TPas2JSCompiler)
+  TLibraryPas2JSCompiler = Class(TPas2JSPCUCompiler)
   private
   private
     FLastError: String;
     FLastError: String;
     FLastErrorClass: String;
     FLastErrorClass: String;
@@ -181,7 +183,9 @@ begin
   Log.OnLog:=@DoLibraryLog;
   Log.OnLog:=@DoLibraryLog;
   FileCache.OnReadFile:=@ReadFile;
   FileCache.OnReadFile:=@ReadFile;
   FReadBufferLen:=DefaultReadBufferSize;
   FReadBufferLen:=DefaultReadBufferSize;
-  FileCache.DirectoryCache.OnReadDirectory:=@ReadDirectory;
+  FileCache.OnReadDirectory:=@ReadDirectory;
+  ConfigSupport:=TPas2JSFileConfigSupport.Create(Self);
+  PostProcessorSupport:=TPas2JSFSPostProcessorSupport.Create(Self);
 end;
 end;
 
 
 procedure TLibraryPas2JSCompiler.DoLibraryLog(Sender: TObject; const Msg: String);
 procedure TLibraryPas2JSCompiler.DoLibraryLog(Sender: TObject; const Msg: String);

+ 64 - 8
packages/pastojs/src/pas2jslogger.pp

@@ -28,10 +28,16 @@ interface
 
 
 uses
 uses
   {$IFDEF Pas2JS}
   {$IFDEF Pas2JS}
-  JS, NodeJSFS,
+  JS,
+  {$IFDEF NodeJS}
+  NodeJSFS,
+  {$ENDIF}
   {$ENDIF}
   {$ENDIF}
-  Classes, SysUtils, PasTree, PScanner, jstree, jsbase, jswriter, fpjson,
-  Pas2jsFileUtils;
+  pas2jsutils,
+  {$IFDEF HASFILESYSTEM}
+  pas2jsfileutils,
+  {$ENDIF}
+  Classes, SysUtils, PasTree, PScanner, jstree, jsbase, jswriter, fpjson;
 
 
 const
 const
   ExitCodeErrorInternal = 1; // internal error
   ExitCodeErrorInternal = 1; // internal error
@@ -95,6 +101,16 @@ type
 
 
   TPas2jsLogEvent = Procedure (Sender : TObject; Const Msg : String) Of Object;
   TPas2jsLogEvent = Procedure (Sender : TObject; Const Msg : String) Of Object;
 
 
+
+  { TConsoleFileWriter }
+
+  TConsoleFileWriter = Class(TTextWriter)
+  Public
+    Constructor Create(aFileName : String); reintroduce;
+    Function DoWrite(Const S : TJSWriterString) : Integer; override;
+    Procedure Flush;
+  end;
+
   { TPas2jsLogger }
   { TPas2jsLogger }
 
 
   TPas2jsLogger = class
   TPas2jsLogger = class
@@ -111,7 +127,7 @@ type
     FMsg: TFPList; // list of TPas2jsMessage
     FMsg: TFPList; // list of TPas2jsMessage
     FOnFormatPath: TPScannerFormatPathEvent;
     FOnFormatPath: TPScannerFormatPathEvent;
     FOnLog: TPas2jsLogEvent;
     FOnLog: TPas2jsLogEvent;
-    FOutputFile: TFileWriter;
+    FOutputFile: TTextWriter; // TFileWriter;
     FOutputFilename: string;
     FOutputFilename: string;
     FShowMsgNumbers: boolean;
     FShowMsgNumbers: boolean;
     FShowMsgTypes: TMessageTypes;
     FShowMsgTypes: TMessageTypes;
@@ -129,6 +145,9 @@ type
     procedure SetSorted(AValue: boolean);
     procedure SetSorted(AValue: boolean);
     procedure DoLogRaw(const Msg: string; SkipEncoding : Boolean);
     procedure DoLogRaw(const Msg: string; SkipEncoding : Boolean);
     function Concatenate(Args: array of {$IFDEF Pas2JS}jsvalue{$ELSE}const{$ENDIF}): string;
     function Concatenate(Args: array of {$IFDEF Pas2JS}jsvalue{$ELSE}const{$ENDIF}): string;
+  Protected
+    // so it can be overridden
+    function CreateTextWriter(const aFileName: string): TTextWriter; virtual;
   public
   public
     constructor Create;
     constructor Create;
     destructor Destroy; override;
     destructor Destroy; override;
@@ -484,6 +503,29 @@ begin
   end;
   end;
 end;
 end;
 
 
+{ TConsoleFileWriter }
+
+constructor TConsoleFileWriter.Create(aFileName: String);
+begin
+  Inherited Create;
+  Write('Opening console log: '+aFileName);
+end;
+
+Function TConsoleFileWriter.DoWrite(Const S : TJSWriterString) : Integer;
+
+begin
+  Result:=Length(S);
+  {AllowWriteln}
+  Writeln(S);
+  {AllowWriteln-}
+end;
+
+procedure TConsoleFileWriter.FLush;
+
+begin
+end;
+
+
 {$IFDEF Pas2JS}
 {$IFDEF Pas2JS}
 { TPas2jsFileStream }
 { TPas2jsFileStream }
 
 
@@ -1017,14 +1059,26 @@ begin
   end;
   end;
 end;
 end;
 
 
+Function TPas2jsLogger.CreateTextWriter(const aFileName : string) : TTextWriter;
+
+begin
+{$IFDEF HASFILESYSTEM}
+  Result:=TFileWriter.Create(aFilename);
+{$ELSE}
+  Result:=TConsoleFileWriter.Create(aFileName);
+{$ENDIF}
+end;
+
 procedure TPas2jsLogger.OpenOutputFile;
 procedure TPas2jsLogger.OpenOutputFile;
 begin
 begin
+{$IFDEF HASFILESYSTEM}
   if FOutputFile<>nil then exit;
   if FOutputFile<>nil then exit;
   if OutputFilename='' then
   if OutputFilename='' then
     raise Exception.Create('Log has empty OutputFilename');
     raise Exception.Create('Log has empty OutputFilename');
   if DirectoryExists(OutputFilename) then
   if DirectoryExists(OutputFilename) then
     raise Exception.Create('Log is directory: "'+OutputFilename+'"');
     raise Exception.Create('Log is directory: "'+OutputFilename+'"');
-  FOutputFile:=TFileWriter.Create(OutputFilename);
+{$ENDIF}
+  FOutputFile:=CreateTextWriter(OutputFileName);
   {$IFDEF FPC_HAS_CPSTRING}
   {$IFDEF FPC_HAS_CPSTRING}
   if (Encoding='') or (Encoding='utf8') then
   if (Encoding='') or (Encoding='utf8') then
     FOutputFile.Write(UTF8BOM);
     FOutputFile.Write(UTF8BOM);
@@ -1033,14 +1087,16 @@ end;
 
 
 procedure TPas2jsLogger.Flush;
 procedure TPas2jsLogger.Flush;
 begin
 begin
-  if FOutputFile<>nil then
-    FOutputFile.Flush;
+{$IFDEF HASFILESYSTEM}
+  if Assigned(FOutputFile) and (FoutputFile is TFileWriter) then
+    TFileWriter(FOutputFile).Flush;
+{$ENDIF}
 end;
 end;
 
 
 procedure TPas2jsLogger.CloseOutputFile;
 procedure TPas2jsLogger.CloseOutputFile;
 begin
 begin
   if FOutputFile=nil then exit;
   if FOutputFile=nil then exit;
-  FOutputFile.Flush;
+  Flush;
   FreeAndNil(FOutputFile);
   FreeAndNil(FOutputFile);
 end;
 end;
 
 

+ 103 - 79
packages/pastojs/src/pas2jspcucompiler.pp

@@ -1,4 +1,22 @@
-unit pas2jspcucompiler;
+{
+    This file is part of the Free Component Library (FCL)
+    Copyright (c) 2018  Michael Van Canneyt
+
+    Pascal to Javascript converter class.
+
+    See the file COPYING.FPC, included in this distribution,
+    for details about the copyright.
+
+    This program is distributed in the hope that it will be useful,
+    but WITHOUT ANY WARRANTY; without even the implied warranty of
+    MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.
+
+ **********************************************************************
+
+  Abstract:
+    FileSystem aware compiler descendent with support for PCU files.
+}
+unit Pas2JSPCUCompiler;
 
 
 {$mode objfpc}{$H+}
 {$mode objfpc}{$H+}
 
 
@@ -11,17 +29,20 @@ unit pas2jspcucompiler;
 interface
 interface
 
 
 uses
 uses
-  Classes, SysUtils, pastree, pas2jscompiler, Pas2JsFiler;
+  SysUtils, Classes,
+  jstree,
+  PasTree, PScanner, PasResolveEval,
+  FPPas2Js,
+  Pas2jsCompiler, Pas2JSFS, Pas2JSFSCompiler, Pas2JsFiler,
+  Pas2jsLogger, Pas2jsFileUtils;
 
 
 Type
 Type
+
   { TFilerPCUSupport }
   { TFilerPCUSupport }
 
 
   TFilerPCUSupport = Class(TPCUSupport)
   TFilerPCUSupport = Class(TPCUSupport)
   Private
   Private
-    // This is the format that will be written.
-    FPCUFormat : TPas2JSPrecompileFormat;
-    // This is the format that will be read.
-    FFoundFormat : TPas2JSPrecompileFormat;
+    FPCUFormat: TPas2JSPrecompileFormat;
     FPrecompileInitialFlags: TPCUInitialFlags;
     FPrecompileInitialFlags: TPCUInitialFlags;
     FPCUReader: TPCUCustomReader;
     FPCUReader: TPCUCustomReader;
     FPCUReaderStream: TStream;
     FPCUReaderStream: TStream;
@@ -30,41 +51,42 @@ Type
     function OnWriterIsElementUsed(Sender: TObject; El: TPasElement): boolean;
     function OnWriterIsElementUsed(Sender: TObject; El: TPasElement): boolean;
     procedure OnFilerGetSrc(Sender: TObject; aFilename: string; out p: PChar; out Count: integer);
     procedure OnFilerGetSrc(Sender: TObject; aFilename: string; out p: PChar; out Count: integer);
   Public
   Public
-    constructor create(aCompilerFile: TPas2JSCompilerFile; aFormat: TPas2JSPrecompileFormat);
-    Destructor destroy; override;
-    Function Compiler : TPas2JSCompiler;
-    Function HandleException(E: exception) : Boolean; override;
-    function FindPCU(const UseUnitName: string): string;override;
+    constructor Create(aCompilerFile: TPas2JSCompilerFile; aFormat: TPas2JSPrecompileFormat); reintroduce;
+    destructor Destroy; override;
+    function Compiler: TPas2JSCompiler;
+    function HandleException(E: Exception): Boolean; override;
+    function FindPCU(const UseUnitName: string): string; override;
     function FindPCU(const UseUnitName: string; out aFormat: TPas2JSPrecompileFormat): string;
     function FindPCU(const UseUnitName: string; out aFormat: TPas2JSPrecompileFormat): string;
-    Function HasReader : Boolean; override;
-    Function ReadContinue: Boolean; override;
-    Function ReadCanContinue : Boolean; override;
-    Procedure SetInitialCompileFlags; override;
-    Procedure WritePCU; override;
+    function HasReader: Boolean; override;
+    function ReadContinue: Boolean; override;
+    function ReadCanContinue: Boolean; override;
+    procedure SetInitialCompileFlags; override;
+    procedure WritePCU; override;
     procedure CreatePCUReader; override;
     procedure CreatePCUReader; override;
-    Procedure ReadUnit; override;
+    procedure ReadUnit; override;
     property PrecompileInitialFlags: TPCUInitialFlags read FPrecompileInitialFlags;
     property PrecompileInitialFlags: TPCUInitialFlags read FPrecompileInitialFlags;
   end;
   end;
 
 
-  { TPas2jsPCUCompiler }
-
   { TPas2jsPCUCompilerFile }
   { TPas2jsPCUCompilerFile }
 
 
   TPas2jsPCUCompilerFile = Class(TPas2jsCompilerFile)
   TPas2jsPCUCompilerFile = Class(TPas2jsCompilerFile)
-    Function CreatePCUSupport: TPCUSupport; override;
+    function CreatePCUSupport: TPCUSupport; override;
   end;
   end;
 
 
-  TPas2jsPCUCompiler = Class(TPas2JSCompiler)
-    FPrecompileFormat : TPas2JSPrecompileFormat;
+  { TPas2jsPCUCompiler }
+
+  TPas2jsPCUCompiler = Class(TPas2JSFSCompiler)
+  Private
+    FPrecompileFormat: TPas2JSPrecompileFormat;
   Protected
   Protected
     procedure WritePrecompiledFormats; override;
     procedure WritePrecompiledFormats; override;
-    function CreateCompilerFile(const UnitFileName: String): TPas2jsCompilerFile; override;
-    Procedure HandleOptionPCUFormat(Value : string) ; override;
+    function CreateCompilerFile(const PasFileName, PCUFilename: String): TPas2jsCompilerFile; override;
+    procedure HandleOptionPCUFormat(Value: string) ; override;
   end;
   end;
 
 
 implementation
 implementation
 
 
-uses fppas2js, pscanner, pas2jslogger, pas2jsfilecache, pasresolveeval, jstree, pas2jsfileutils;
+{$IFDEF HASPAS2JSFILER}
 
 
 { ---------------------------------------------------------------------
 { ---------------------------------------------------------------------
   TFilerPCUSupport
   TFilerPCUSupport
@@ -72,19 +94,21 @@ uses fppas2js, pscanner, pas2jslogger, pas2jsfilecache, pasresolveeval, jstree,
 
 
 { TFilerPCUSupport }
 { TFilerPCUSupport }
 
 
-constructor TFilerPCUSupport.create(aCompilerFile: TPas2JSCompilerFile; aFormat: TPas2JSPrecompileFormat);
+constructor TFilerPCUSupport.Create(aCompilerFile: TPas2JSCompilerFile; aFormat: TPas2JSPrecompileFormat);
 begin
 begin
   Inherited Create(aCompilerFile);
   Inherited Create(aCompilerFile);
   FPCUFormat:=AFormat;
   FPCUFormat:=AFormat;
+  if FPCUFormat=nil then
+    RaiseInternalError(20181207143653,aCompilerFile.UnitFilename);
   FPrecompileInitialFlags:=TPCUInitialFlags.Create;
   FPrecompileInitialFlags:=TPCUInitialFlags.Create;
 end;
 end;
 
 
-destructor TFilerPCUSupport.destroy;
+destructor TFilerPCUSupport.Destroy;
 begin
 begin
   FreeAndNil(FPrecompileInitialFlags);
   FreeAndNil(FPrecompileInitialFlags);
   FreeAndNil(FPCUReader);
   FreeAndNil(FPCUReader);
   FreeAndNil(FPCUReaderStream);
   FreeAndNil(FPCUReaderStream);
-  inherited destroy;
+  inherited Destroy;
 end;
 end;
 
 
 function TFilerPCUSupport.Compiler: TPas2JSCompiler;
 function TFilerPCUSupport.Compiler: TPas2JSCompiler;
@@ -92,7 +116,7 @@ begin
   Result:=MyFile.Compiler;
   Result:=MyFile.Compiler;
 end;
 end;
 
 
-Function TFilerPCUSupport.HandleException(E: Exception) : Boolean;
+function TFilerPCUSupport.HandleException(E: Exception): Boolean;
 
 
 begin
 begin
   Result:=False;
   Result:=False;
@@ -100,11 +124,9 @@ begin
     begin
     begin
     Result:=True;
     Result:=True;
     if EPas2JsReadError(E).Owner is TPCUCustomReader then
     if EPas2JsReadError(E).Owner is TPCUCustomReader then
-      begin
-        MyFile.Log.Log(mtError,E.Message,0,MyFile.PCUFilename);
-      end else begin
-        MyFile.Log.Log(mtError,E.Message);
-      end;
+      MyFile.Log.Log(mtError,E.Message,0,MyFile.PCUFilename)
+    else
+      MyFile.Log.Log(mtError,E.Message);
     Compiler.Terminate(ExitCodePCUError);
     Compiler.Terminate(ExitCodePCUError);
     end
     end
   else if (E is EPas2JsWriteError) then
   else if (E is EPas2JsWriteError) then
@@ -117,8 +139,12 @@ end;
 
 
 function TFilerPCUSupport.FindPCU(const UseUnitName: string): string;
 function TFilerPCUSupport.FindPCU(const UseUnitName: string): string;
 
 
+var
+  aPCUFormat: TPas2JSPrecompileFormat;
 begin
 begin
-  Result:=FindPCU(UseUnitName,FFoundFormat);
+  Result:=FindPCU(UseUnitName,aPCUFormat);
+  if (Result<>'') and (FPCUFormat<>aPCUFormat) then
+    RaiseInternalError(20181207143826,UseUnitName);
 end;
 end;
 
 
 function TFilerPCUSupport.HasReader: Boolean;
 function TFilerPCUSupport.HasReader: Boolean;
@@ -148,21 +174,21 @@ end;
 
 
 procedure TFilerPCUSupport.CreatePCUReader;
 procedure TFilerPCUSupport.CreatePCUReader;
 var
 var
-  aFile: TPas2jsCachedFile;
+  aFile: TPas2jsFile;
   s: String;
   s: String;
 begin
 begin
   if MyFile.PCUFilename='' then
   if MyFile.PCUFilename='' then
     RaiseInternalError(20180312144742,MyFile.PCUFilename);
     RaiseInternalError(20180312144742,MyFile.PCUFilename);
   if FPCUReader<>nil then
   if FPCUReader<>nil then
     RaiseInternalError(20180312142938,GetObjName(FPCUReader));
     RaiseInternalError(20180312142938,GetObjName(FPCUReader));
-  if FFoundFormat=nil then
+  if FPCUFormat=nil then
     RaiseInternalError(20180312142954,'');
     RaiseInternalError(20180312142954,'');
-  FPCUReader:=FFoundFormat.ReaderClass.Create;
+  FPCUReader:=FPCUFormat.ReaderClass.Create;
   FPCUReader.SourceFilename:=ExtractFileName(MyFile.PCUFilename);
   FPCUReader.SourceFilename:=ExtractFileName(MyFile.PCUFilename);
 
 
   if MyFile.ShowDebug then
   if MyFile.ShowDebug then
     MyFile.Log.LogMsg(nParsingFile,[QuoteStr(MyFile.PCUFilename)]);
     MyFile.Log.LogMsg(nParsingFile,[QuoteStr(MyFile.PCUFilename)]);
-  aFile:=Compiler.FileCache.LoadFile(MyFile.PCUFilename,true);
+  aFile:=Compiler.FS.LoadFile(MyFile.PCUFilename,true);
   if aFile=nil then
   if aFile=nil then
     RaiseInternalError(20180312145941,MyFile.PCUFilename);
     RaiseInternalError(20180312145941,MyFile.PCUFilename);
   FPCUReaderStream:=TMemoryStream.Create;
   FPCUReaderStream:=TMemoryStream.Create;
@@ -184,7 +210,8 @@ begin
   SetReaderState(prsCanContinue);
   SetReaderState(prsCanContinue);
 end;
 end;
 
 
-function TFilerPCUSupport.FindPCU(const UseUnitName: string; out  aFormat: TPas2JSPrecompileFormat): string;
+function TFilerPCUSupport.FindPCU(const UseUnitName: string;
+  out aFormat: TPas2JSPrecompileFormat): string;
 
 
   function SearchInDir(DirPath: string): boolean;
   function SearchInDir(DirPath: string): boolean;
   var
   var
@@ -199,7 +226,7 @@ function TFilerPCUSupport.FindPCU(const UseUnitName: string; out  aFormat: TPas2
       CurFormat:=PrecompileFormats[i];
       CurFormat:=PrecompileFormats[i];
       if not CurFormat.Enabled then continue;
       if not CurFormat.Enabled then continue;
       Filename:=DirPath+UseUnitName+'.'+CurFormat.Ext;
       Filename:=DirPath+UseUnitName+'.'+CurFormat.Ext;
-      if Compiler.FileCache.SearchLowUpCase(Filename) then
+      if Compiler.FS.PCUExists(Filename) then
       begin
       begin
         FindPCU:=Filename;
         FindPCU:=Filename;
         aFormat:=CurFormat;
         aFormat:=CurFormat;
@@ -210,23 +237,20 @@ function TFilerPCUSupport.FindPCU(const UseUnitName: string; out  aFormat: TPas2
   end;
   end;
 
 
 var
 var
-  Cache: TPas2jsFilesCache;
+  L: TstringList;
   i: Integer;
   i: Integer;
+
 begin
 begin
   Result:='';
   Result:='';
   aFormat:=nil;
   aFormat:=nil;
-  Cache:=Compiler.FileCache;
-
-  // search in output directory
-  if Cache.UnitOutputPath<>'' then
-    if SearchInDir(Cache.UnitOutputPath) then exit;
-
-  // then in BaseDirectory
-  if SearchInDir(MyFile.FileResolver.BaseDirectory) then exit;
-
-  // finally search in unit paths
-  for i:=0 to Cache.UnitPaths.Count-1 do
-    if SearchInDir(Cache.UnitPaths[i]) then exit;
+  L:=TStringList.Create;
+  try
+    Compiler.FS.GetPCUDirs(L,MyFile.FileResolver.BaseDirectory);
+    for i:=0 to L.Count-1 do
+      if SearchInDir(L[i]) then exit;
+  finally
+    L.Free;
+  end;
 end;
 end;
 
 
 function TFilerPCUSupport.OnWriterIsElementUsed(Sender: TObject;
 function TFilerPCUSupport.OnWriterIsElementUsed(Sender: TObject;
@@ -246,7 +270,7 @@ var
   ms: TMemoryStream;
   ms: TMemoryStream;
   DestDir: String;
   DestDir: String;
   JS: TJSElement;
   JS: TJSElement;
-  FN : String;
+  FN: String;
 
 
 begin
 begin
   if FPCUFormat=Nil then
   if FPCUFormat=Nil then
@@ -269,8 +293,8 @@ begin
 
 
   // Determine output filename
   // Determine output filename
   FN:=ExtractFilenameOnly(MyFile.PasFilename)+'.'+FPCUFormat.Ext;
   FN:=ExtractFilenameOnly(MyFile.PasFilename)+'.'+FPCUFormat.Ext;
-  if Compiler.FileCache.UnitOutputPath<>'' then
-    FN:=Compiler.FileCache.UnitOutputPath+FN
+  if Compiler.FS.UnitOutputPath<>'' then
+    FN:=Compiler.FS.UnitOutputPath+FN
   else
   else
     FN:=ExtractFilePath(MyFile.PasFilename)+FN;
     FN:=ExtractFilePath(MyFile.PasFilename)+FN;
   // Set as our filename
   // Set as our filename
@@ -294,38 +318,40 @@ begin
     MyFile.Converter.OnIsTypeInfoUsed:=@OnPCUConverterIsTypeInfoUsed;
     MyFile.Converter.OnIsTypeInfoUsed:=@OnPCUConverterIsTypeInfoUsed;
     JS:=MyFile.Converter.ConvertPasElement(MyFile.PasModule,MyFile.PascalResolver);
     JS:=MyFile.Converter.ConvertPasElement(MyFile.PasModule,MyFile.PascalResolver);
     MyFile.Converter.Options:=MyFile.Converter.Options-[coStoreImplJS];
     MyFile.Converter.Options:=MyFile.Converter.Options-[coStoreImplJS];
+    MyFile.PCUSupport.SetInitialCompileFlags;
     {$IFDEF REALLYVERBOSE}
     {$IFDEF REALLYVERBOSE}
     writeln('TPas2jsCompilerFile.WritePCU create pcu ... ',MyFile.PCUFilename);
     writeln('TPas2jsCompilerFile.WritePCU create pcu ... ',MyFile.PCUFilename);
     {$ENDIF}
     {$ENDIF}
-    Writer.WritePCU(MyFile.PascalResolver,MyFile.Converter,PrecompileInitialFlags,ms,AllowCompressed);
+    Writer.WritePCU(MyFile.PascalResolver,MyFile.Converter,
+                    PrecompileInitialFlags,ms,AllowCompressed);
     {$IFDEF REALLYVERBOSE}
     {$IFDEF REALLYVERBOSE}
     writeln('TPas2jsCompilerFile.WritePCU precompiled ',MyFile.PCUFilename);
     writeln('TPas2jsCompilerFile.WritePCU precompiled ',MyFile.PCUFilename);
     {$ENDIF}
     {$ENDIF}
 
 
-    MyFile.Log.LogMsg(nWritingFile,[QuoteStr(Compiler.FileCache.FormatPath(MyFile.PCUFilename))],'',0,0,
+    MyFile.Log.LogMsg(nWritingFile,[QuoteStr(Compiler.FS.FormatPath(MyFile.PCUFilename))],'',0,0,
                not (coShowLineNumbers in Compiler.Options));
                not (coShowLineNumbers in Compiler.Options));
 
 
     // check output directory
     // check output directory
     DestDir:=ChompPathDelim(ExtractFilePath(MyFile.PCUFilename));
     DestDir:=ChompPathDelim(ExtractFilePath(MyFile.PCUFilename));
-    if (DestDir<>'') and not Compiler.FileCache.DirectoryExists(DestDir) then
+    if (DestDir<>'') and not Compiler.FS.DirectoryExists(DestDir) then
     begin
     begin
       {$IFDEF REALLYVERBOSE}
       {$IFDEF REALLYVERBOSE}
       writeln('TPas2jsCompilerFile.WritePCU output dir not found "',DestDir,'"');
       writeln('TPas2jsCompilerFile.WritePCU output dir not found "',DestDir,'"');
       {$ENDIF}
       {$ENDIF}
-      MyFile.Log.LogMsg(nOutputDirectoryNotFound,[QuoteStr(Compiler.FileCache.FormatPath(DestDir))]);
+      MyFile.Log.LogMsg(nOutputDirectoryNotFound,[QuoteStr(Compiler.FS.FormatPath(DestDir))]);
       Compiler.Terminate(ExitCodeFileNotFound);
       Compiler.Terminate(ExitCodeFileNotFound);
     end;
     end;
-    if Compiler.FileCache.DirectoryExists(MyFile.PCUFilename) then
+    if Compiler.FS.DirectoryExists(MyFile.PCUFilename) then
     begin
     begin
       {$IFDEF REALLYVERBOSE}
       {$IFDEF REALLYVERBOSE}
       writeln('TPas2jsCompilerFile.WritePCU file is folder "',DestDir,'"');
       writeln('TPas2jsCompilerFile.WritePCU file is folder "',DestDir,'"');
       {$ENDIF}
       {$ENDIF}
-      MyFile.Log.LogMsg(nFileIsFolder,[QuoteStr(Compiler.FileCache.FormatPath(MyFile.PCUFilename))]);
+      MyFile.Log.LogMsg(nFileIsFolder,[QuoteStr(Compiler.FS.FormatPath(MyFile.PCUFilename))]);
       Compiler.Terminate(ExitCodeWriteError);
       Compiler.Terminate(ExitCodeWriteError);
     end;
     end;
 
 
     ms.Position:=0;
     ms.Position:=0;
-    Compiler.FileCache.SaveToFile(ms,MyFile.PCUFilename);
+    Compiler.FS.SaveToFile(ms,MyFile.PCUFilename);
     {$IFDEF REALLYVERBOSE}
     {$IFDEF REALLYVERBOSE}
     writeln('TPas2jsCompilerFile.WritePCU written ',MyFile.PCUFilename);
     writeln('TPas2jsCompilerFile.WritePCU written ',MyFile.PCUFilename);
     {$ENDIF}
     {$ENDIF}
@@ -339,11 +365,11 @@ end;
 procedure TFilerPCUSupport.OnFilerGetSrc(Sender: TObject; aFilename: string;
 procedure TFilerPCUSupport.OnFilerGetSrc(Sender: TObject; aFilename: string;
   out p: PChar; out Count: integer);
   out p: PChar; out Count: integer);
 var
 var
-  SrcFile: TPas2jsCachedFile;
+  SrcFile: TPas2jsFile;
 begin
 begin
   if Sender=nil then
   if Sender=nil then
     RaiseInternalError(20180311135558,aFilename);
     RaiseInternalError(20180311135558,aFilename);
-  SrcFile:=MyFile.Compiler.FileCache.LoadFile(aFilename);
+  SrcFile:=MyFile.Compiler.FS.LoadFile(aFilename);
   if SrcFile=nil then
   if SrcFile=nil then
     RaiseInternalError(20180311135329,aFilename);
     RaiseInternalError(20180311135329,aFilename);
   p:=PChar(SrcFile.Source);
   p:=PChar(SrcFile.Source);
@@ -371,31 +397,29 @@ end;
 { TPas2jsPCUCompiler }
 { TPas2jsPCUCompiler }
 
 
 procedure TPas2jsPCUCompiler.WritePrecompiledFormats;
 procedure TPas2jsPCUCompiler.WritePrecompiledFormats;
-
 Var
 Var
-  I : Integer;
-
+  I: Integer;
 begin
 begin
   if PrecompileFormats.Count>0 then
   if PrecompileFormats.Count>0 then
   begin
   begin
-    writeHelpLine('   -JU<x> : Create precompiled units in format x.');
+    writeHelpLine('   -JU<x>: Create precompiled units in format x.');
     for i:=0 to PrecompileFormats.Count-1 do
     for i:=0 to PrecompileFormats.Count-1 do
       with PrecompileFormats[i] do
       with PrecompileFormats[i] do
-        writeHelpLine('     -JU'+Ext+' : '+Description);
-    writeHelpLine('     -JU- : Disable prior -JU<x> option. Do not create precompiled units.');
+        writeHelpLine('     -JU'+Ext+': '+Description);
+    writeHelpLine('     -JU-: Disable prior -JU<x> option. Do not create precompiled units.');
   end;
   end;
 end;
 end;
 
 
-function TPas2jsPCUCompiler.CreateCompilerFile(const UnitFileName: String): TPas2jsCompilerFile;
+function TPas2jsPCUCompiler.CreateCompilerFile(const PasFileName,
+  PCUFilename: String): TPas2jsCompilerFile;
 begin
 begin
-  Result:=TPas2JSPCUCompilerFile.Create(Self,UnitFileName);
+  Result:=TPas2JSPCUCompilerFile.Create(Self,PasFileName,PCUFilename);
 end;
 end;
 
 
 procedure TPas2jsPCUCompiler.HandleOptionPCUFormat(Value: string);
 procedure TPas2jsPCUCompiler.HandleOptionPCUFormat(Value: string);
-
 Var
 Var
-  Found : Boolean;
-  I : integer;
+  Found: Boolean;
+  I: integer;
   PF: TPas2JSPrecompileFormat;
   PF: TPas2JSPrecompileFormat;
 begin
 begin
   Found:=false;
   Found:=false;
@@ -403,7 +427,7 @@ begin
   begin
   begin
     PF:=PrecompileFormats[i];
     PF:=PrecompileFormats[i];
     if not SameText(Value,PF.Ext) then continue;
     if not SameText(Value,PF.Ext) then continue;
-      FPrecompileFormat:=PrecompileFormats[i];
+    FPrecompileFormat:=PrecompileFormats[i];
     Found:=true;
     Found:=true;
   end;
   end;
   if not Found then
   if not Found then
@@ -425,7 +449,7 @@ begin
   else
   else
     Result:=Nil;
     Result:=Nil;
 end;
 end;
-
+{$ENDIF}
 
 
 end.
 end.
 
 

+ 430 - 0
packages/pastojs/src/pas2jsutils.pp

@@ -0,0 +1,430 @@
+unit pas2jsutils;
+{
+    This file is part of the Free Component Library (FCL)
+    Copyright (c) 2018  Mattias Gaertner  [email protected]
+
+    Pascal to Javascript converter class.
+
+    See the file COPYING.FPC, included in this distribution,
+    for details about the copyright.
+
+    This program is distributed in the hope that it will be useful,
+    but WITHOUT ANY WARRANTY; without even the implied warranty of
+    MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.
+
+ **********************************************************************
+
+  Abstract:
+    Utility routines that do not need a filesystem or OS functionality.
+    Filesystem-specific things should go to pas2jsfileutils instead.
+}
+{$mode objfpc}{$H+}
+
+interface
+
+uses
+  Classes, SysUtils;
+
+function ChompPathDelim(const Path: string): string;
+function GetNextDelimitedItem(const List: string; Delimiter: char;
+                              var Position: integer): string;
+type
+   TChangeStamp = SizeInt;
+
+const
+  InvalidChangeStamp = low(TChangeStamp);
+
+Function IncreaseChangeStamp(Stamp: TChangeStamp) : TChangeStamp;
+const
+  EncodingUTF8 = 'UTF-8';
+  EncodingSystem = 'System';
+
+function NormalizeEncoding(const Encoding: string): string;
+function IsASCII(const s: string): boolean; inline;
+{$IFDEF FPC_HAS_CPSTRING}
+const
+  UTF8BOM = #$EF#$BB#$BF;
+function UTF8CharacterStrictLength(P: PChar): integer;
+
+function UTF8ToUTF16(const s: string): UnicodeString;
+function UTF16ToUTF8(const s: UnicodeString): string;
+
+{$ENDIF FPC_HAS_CPSTRING}
+
+function IsNonUTF8System: boolean;// true if system encoding is not UTF-8
+{$IFDEF Windows}
+// AConsole - If false, it is the general system encoding,
+//            if true, it is the console encoding
+function GetWindowsEncoding(AConsole: Boolean = False): string;
+{$ENDIF}
+{$IF defined(Unix) and not defined(Darwin)}
+function GetUnixEncoding: string;
+{$ENDIF}
+
+Function NonUTF8System: boolean;
+function GetDefaultTextEncoding: string;
+
+procedure SplitCmdLineParams(const Params: string; ParamList: TStrings;
+                             ReadBackslash: boolean = false);
+
+implementation
+
+{$IFDEF Windows}
+uses Windows;
+{$ENDIF}
+
+Var
+  {$IFDEF Unix}
+  {$IFNDEF Darwin}
+  Lang: string = '';
+  {$ENDIF}
+  {$ENDIF}
+  EncodingValid: boolean = false;
+  DefaultTextEncoding: string = EncodingSystem;
+  gNonUTF8System : Boolean = {$IFDEF FPC_HAS_CPSTRING}false{$ELSE}true{$ENDIF};
+
+Function NonUTF8System: boolean;
+
+begin
+  Result:=gNonUTF8System;
+end;
+
+function GetNextDelimitedItem(const List: string; Delimiter: char;
+  var Position: integer): string;
+var
+  StartPos: Integer;
+begin
+  StartPos:=Position;
+  while (Position<=length(List)) and (List[Position]<>Delimiter) do
+    inc(Position);
+  Result:=copy(List,StartPos,Position-StartPos);
+  if Position<=length(List) then inc(Position); // skip Delimiter
+end;
+
+function IncreaseChangeStamp(Stamp: TChangeStamp): TChangeStamp;
+begin
+  if Stamp<High(TChangeStamp) then
+    Result:=Stamp+1
+  else
+    Result:=InvalidChangeStamp+1;
+end;
+
+function ChompPathDelim(const Path: string): string;
+var
+  Len, MinLen: Integer;
+begin
+  Result:=Path;
+  if Path = '' then
+    exit;
+  Len:=length(Result);
+  if (Result[1] in AllowDirectorySeparators) then
+  begin
+    MinLen := 1;
+    {$IFDEF HasUNCPaths}
+    if (Len >= 2) and (Result[2] in AllowDirectorySeparators) then
+      MinLen := 2; // keep UNC '\\', chomp 'a\' to 'a'
+    {$ENDIF}
+    {$IFDEF Pas2js}
+    if (Len >= 2) and (Result[2]=Result[1]) and (PathDelim='\') then
+      MinLen := 2; // keep UNC '\\', chomp 'a\' to 'a'
+    {$ENDIF}
+  end
+  else begin
+    MinLen := 0;
+    {$IFdef MSWindows}
+    if (Len >= 3) and (Result[1] in ['a'..'z', 'A'..'Z'])  and
+       (Result[2] = ':') and (Result[3] in AllowDirectorySeparators)
+    then
+      MinLen := 3;
+    {$ENDIF}
+    {$IFdef Pas2js}
+    if (PathDelim='\')
+        and (Len >= 3) and (Result[1] in ['a'..'z', 'A'..'Z'])
+        and (Result[2] = ':') and (Result[3] in AllowDirectorySeparators)
+    then
+      MinLen := 3;
+    {$ENDIF}
+  end;
+
+  while (Len > MinLen) and (Result[Len] in AllowDirectorySeparators) do dec(Len);
+  if Len<length(Result) then
+    SetLength(Result,Len);
+end;
+
+function NormalizeEncoding(const Encoding: string): string;
+var
+  i: Integer;
+begin
+  Result:=LowerCase(Encoding);
+  for i:=length(Result) downto 1 do
+    if Result[i]='-' then Delete(Result,i,1);
+end;
+
+{$IFDEF WINDOWS}
+function GetWindowsEncoding(AConsole: Boolean = False): string;
+var
+  cp : UINT;
+{$IFDEF WinCE}
+// CP_UTF8 is missing in the windows unit of the Windows CE RTL
+const
+  CP_UTF8 = 65001;
+{$ENDIF}
+begin
+  if AConsole then cp := GetOEMCP
+  else cp := GetACP;
+
+  case cp of
+    CP_UTF8: Result := EncodingUTF8;
+  else
+    Result:='cp'+IntToStr(cp);
+  end;
+end;
+{$ENDIF}
+
+function IsASCII(const s: string): boolean; inline;
+{$IFDEF Pas2js}
+var
+  i: Integer;
+begin
+  for i:=1 to length(s) do
+    if s[i]>#127 then exit(false);
+  Result:=true;
+end;
+{$ELSE}
+var
+  p: PChar;
+begin
+  if s='' then exit(true);
+  p:=PChar(s);
+  repeat
+    case p^ of
+    #0: if p-PChar(s)=length(s) then exit(true);
+    #128..#255: exit(false);
+    end;
+    inc(p);
+  until false;
+end;
+{$ENDIF}
+
+{$IFDEF FPC_HAS_CPSTRING}
+function UTF8CharacterStrictLength(P: PChar): integer;
+begin
+  if p=nil then exit(0);
+  if ord(p^)<%10000000 then
+  begin
+    // regular single byte character
+    exit(1);
+  end
+  else if ord(p^)<%11000000 then
+  begin
+    // invalid single byte character
+    exit(0);
+  end
+  else if ((ord(p^) and %11100000) = %11000000) then
+  begin
+    // should be 2 byte character
+    if (ord(p[1]) and %11000000) = %10000000 then
+      exit(2)
+    else
+      exit(0);
+  end
+  else if ((ord(p^) and %11110000) = %11100000) then
+  begin
+    // should be 3 byte character
+    if ((ord(p[1]) and %11000000) = %10000000)
+    and ((ord(p[2]) and %11000000) = %10000000) then
+      exit(3)
+    else
+      exit(0);
+  end
+  else if ((ord(p^) and %11111000) = %11110000) then
+  begin
+    // should be 4 byte character
+    if ((ord(p[1]) and %11000000) = %10000000)
+    and ((ord(p[2]) and %11000000) = %10000000)
+    and ((ord(p[3]) and %11000000) = %10000000) then
+      exit(4)
+    else
+      exit(0);
+  end else
+    exit(0);
+end;
+
+function UTF8ToUTF16(const s: string): UnicodeString;
+begin
+  Result:=UTF8Decode(s);
+end;
+
+function UTF16ToUTF8(const s: UnicodeString): string;
+begin
+  if s='' then exit('');
+  Result:=UTF8Encode(s);
+  // prevent UTF8 codepage appear in the strings - we don't need codepage
+  // conversion magic
+  SetCodePage(RawByteString(Result), CP_ACP, False);
+end;
+{$ENDIF}
+
+function IsNonUTF8System: boolean;
+begin
+  Result:=NonUTF8System;
+end;
+
+{$IFDEF UNIX}
+{$IFNDEF Darwin}
+function GetUnixEncoding: string;
+var
+  i: integer;
+begin
+  Result:=EncodingSystem;
+  i:=pos('.',Lang);
+  if (i>0) and (i<=length(Lang)) then
+    Result:=copy(Lang,i+1,length(Lang)-i);
+end;
+{$ENDIF}
+{$ENDIF}
+
+function GetDefaultTextEncoding: string;
+
+
+begin
+  if EncodingValid then
+  begin
+    Result:=DefaultTextEncoding;
+    exit;
+  end;
+
+  {$IFDEF Pas2js}
+  Result:=EncodingUTF8;
+  {$ELSE}
+    {$IFDEF Windows}
+    Result:=GetWindowsEncoding;
+    {$ELSE}
+      {$IFDEF Darwin}
+      Result:=EncodingUTF8;
+      {$ELSE}
+      // unix
+      Lang := GetEnvironmentVariable('LC_ALL');
+      if Lang='' then
+      begin
+        Lang := GetEnvironmentVariable('LC_MESSAGES');
+        if Lang='' then
+          Lang := GetEnvironmentVariable('LANG');
+      end;
+      Result:=GetUnixEncoding;
+      {$ENDIF}
+    {$ENDIF}
+  {$ENDIF}
+  Result:=NormalizeEncoding(Result);
+
+  DefaultTextEncoding:=Result;
+  EncodingValid:=true;
+end;
+
+procedure InternalInit;
+begin
+  {$IFDEF FPC_HAS_CPSTRING}
+  SetMultiByteConversionCodePage(CP_UTF8);
+  // SetMultiByteFileSystemCodePage(CP_UTF8); not needed, this is the default under Windows
+  SetMultiByteRTLFileSystemCodePage(CP_UTF8);
+
+  GetDefaultTextEncoding;
+  {$IFDEF Windows}
+  gNonUTF8System:=true;
+  {$ELSE}
+  gNonUTF8System:=SysUtils.CompareText(DefaultTextEncoding,'UTF8')<>0;
+  {$ENDIF}
+  {$ENDIF}
+end;
+procedure SplitCmdLineParams(const Params: string; ParamList: TStrings;
+                             ReadBackslash: boolean = false);
+// split spaces, quotes are parsed as single parameter
+// if ReadBackslash=true then \" is replaced to " and not treated as quote
+// #0 is always end
+type
+  TMode = (mNormal,mApostrophe,mQuote);
+var
+  p: Integer;
+  Mode: TMode;
+  Param: String;
+begin
+  p:=1;
+  while p<=length(Params) do
+  begin
+    // skip whitespace
+    while (p<=length(Params)) and (Params[p] in [' ',#9,#10,#13]) do inc(p);
+    if (p>length(Params)) or (Params[p]=#0) then
+      break;
+    // read param
+    Param:='';
+    Mode:=mNormal;
+    while p<=length(Params) do
+    begin
+      case Params[p] of
+      #0:
+        break;
+      '\':
+        begin
+          inc(p);
+          if ReadBackslash then
+            begin
+            // treat next character as normal character
+            if (p>length(Params)) or (Params[p]=#0) then
+              break;
+            if ord(Params[p])<128 then
+            begin
+              Param+=Params[p];
+              inc(p);
+            end else begin
+              // next character is already a normal character
+            end;
+          end else begin
+            // treat backslash as normal character
+            Param+='\';
+          end;
+        end;
+      '''':
+        begin
+          inc(p);
+          case Mode of
+          mNormal:
+            Mode:=mApostrophe;
+          mApostrophe:
+            Mode:=mNormal;
+          mQuote:
+            Param+='''';
+          end;
+        end;
+      '"':
+        begin
+          inc(p);
+          case Mode of
+          mNormal:
+            Mode:=mQuote;
+          mApostrophe:
+            Param+='"';
+          mQuote:
+            Mode:=mNormal;
+          end;
+        end;
+      ' ',#9,#10,#13:
+        begin
+          if Mode=mNormal then break;
+          Param+=Params[p];
+          inc(p);
+        end;
+      else
+        Param+=Params[p];
+        inc(p);
+      end;
+    end;
+    //writeln('SplitCmdLineParams Param=#'+Param+'#');
+    ParamList.Add(Param);
+  end;
+end;
+
+
+initialization
+  InternalInit;
+end.
+

+ 1 - 0
packages/pastojs/tests/tcconverter.pp

@@ -1259,6 +1259,7 @@ end;
 procedure TTestConverter.SetUp;
 procedure TTestConverter.SetUp;
 begin
 begin
   FConverter:=TPasToJSConverter.Create;
   FConverter:=TPasToJSConverter.Create;
+  FConverter.Globals:=TPasToJSConverterGlobals.Create(FConverter);
 end;
 end;
 
 
 procedure TTestConverter.TearDown;
 procedure TTestConverter.TearDown;

+ 146 - 4
packages/pastojs/tests/tcfiler.pas

@@ -24,7 +24,7 @@ interface
 
 
 uses
 uses
   Classes, SysUtils, fpcunit, testregistry,
   Classes, SysUtils, fpcunit, testregistry,
-  PasTree, PScanner, PasResolver, PasResolveEval, PParser, PasUseAnalyzer,
+  PasTree, PScanner, PParser, PasResolveEval, PasResolver, PasUseAnalyzer,
   FPPas2Js, Pas2JsFiler,
   FPPas2Js, Pas2JsFiler,
   tcmodules, jstree;
   tcmodules, jstree;
 
 
@@ -90,6 +90,7 @@ type
     procedure CheckRestoredPrimitiveExpr(const Path: string; Orig, Rest: TPrimitiveExpr); virtual;
     procedure CheckRestoredPrimitiveExpr(const Path: string; Orig, Rest: TPrimitiveExpr); virtual;
     procedure CheckRestoredBoolConstExpr(const Path: string; Orig, Rest: TBoolConstExpr); virtual;
     procedure CheckRestoredBoolConstExpr(const Path: string; Orig, Rest: TBoolConstExpr); virtual;
     procedure CheckRestoredParamsExpr(const Path: string; Orig, Rest: TParamsExpr); virtual;
     procedure CheckRestoredParamsExpr(const Path: string; Orig, Rest: TParamsExpr); virtual;
+    procedure CheckRestoredProcedureExpr(const Path: string; Orig, Rest: TProcedureExpr); virtual;
     procedure CheckRestoredRecordValues(const Path: string; Orig, Rest: TRecordValues); virtual;
     procedure CheckRestoredRecordValues(const Path: string; Orig, Rest: TRecordValues); virtual;
     procedure CheckRestoredPasExprArray(const Path: string; Orig, Rest: TPasExprArray); virtual;
     procedure CheckRestoredPasExprArray(const Path: string; Orig, Rest: TPasExprArray); virtual;
     procedure CheckRestoredArrayValues(const Path: string; Orig, Rest: TArrayValues); virtual;
     procedure CheckRestoredArrayValues(const Path: string; Orig, Rest: TArrayValues); virtual;
@@ -138,17 +139,22 @@ type
     procedure TestPC_Var;
     procedure TestPC_Var;
     procedure TestPC_Enum;
     procedure TestPC_Enum;
     procedure TestPC_Set;
     procedure TestPC_Set;
+    procedure TestPC_Set_InFunction;
     procedure TestPC_SetOfAnonymousEnumType;
     procedure TestPC_SetOfAnonymousEnumType;
     procedure TestPC_Record;
     procedure TestPC_Record;
+    procedure TestPC_Record_InFunction;
+    procedure TestPC_RecordAdv;
     procedure TestPC_JSValue;
     procedure TestPC_JSValue;
     procedure TestPC_Array;
     procedure TestPC_Array;
     procedure TestPC_ArrayOfAnonymous;
     procedure TestPC_ArrayOfAnonymous;
+    procedure TestPC_Array_InFunction;
     procedure TestPC_Proc;
     procedure TestPC_Proc;
     procedure TestPC_Proc_Nested;
     procedure TestPC_Proc_Nested;
     procedure TestPC_Proc_LocalConst;
     procedure TestPC_Proc_LocalConst;
     procedure TestPC_Proc_UTF8;
     procedure TestPC_Proc_UTF8;
     procedure TestPC_Proc_Arg;
     procedure TestPC_Proc_Arg;
     procedure TestPC_ProcType;
     procedure TestPC_ProcType;
+    procedure TestPC_Proc_Anonymous;
     procedure TestPC_Class;
     procedure TestPC_Class;
     procedure TestPC_ClassForward;
     procedure TestPC_ClassForward;
     procedure TestPC_ClassConstructor;
     procedure TestPC_ClassConstructor;
@@ -444,8 +450,8 @@ begin
   FInitialFlags.ModeSwitches:=Scanner.CurrentModeSwitches;
   FInitialFlags.ModeSwitches:=Scanner.CurrentModeSwitches;
   FInitialFlags.BoolSwitches:=Scanner.CurrentBoolSwitches;
   FInitialFlags.BoolSwitches:=Scanner.CurrentBoolSwitches;
   FInitialFlags.ConverterOptions:=Converter.Options;
   FInitialFlags.ConverterOptions:=Converter.Options;
-  FInitialFlags.TargetPlatform:=Converter.TargetPlatform;
-  FInitialFlags.TargetProcessor:=Converter.TargetProcessor;
+  FInitialFlags.TargetPlatform:=Converter.Globals.TargetPlatform;
+  FInitialFlags.TargetProcessor:=Converter.Globals.TargetProcessor;
   // ToDo: defines
   // ToDo: defines
 end;
 end;
 
 
@@ -700,6 +706,7 @@ end;
 procedure TCustomTestPrecompile.CheckRestoredRecordScope(const Path: string;
 procedure TCustomTestPrecompile.CheckRestoredRecordScope(const Path: string;
   Orig, Rest: TPasRecordScope);
   Orig, Rest: TPasRecordScope);
 begin
 begin
+  CheckRestoredReference(Path+'.DefaultProperty',Orig.DefaultProperty,Rest.DefaultProperty);
   CheckRestoredIdentifierScope(Path,Orig,Rest);
   CheckRestoredIdentifierScope(Path,Orig,Rest);
 end;
 end;
 
 
@@ -803,7 +810,7 @@ begin
     AssertEquals(Path+'.ResultVarName',Orig.ResultVarName,Rest.ResultVarName);
     AssertEquals(Path+'.ResultVarName',Orig.ResultVarName,Rest.ResultVarName);
     CheckRestoredReference(Path+'.OverriddenProc',Orig.OverriddenProc,Rest.OverriddenProc);
     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);
     CheckRestoredElement(Path+'.SelfArg',Orig.SelfArg,Rest.SelfArg);
     if Orig.Flags<>Rest.Flags then
     if Orig.Flags<>Rest.Flags then
       Fail(Path+'.Flags');
       Fail(Path+'.Flags');
@@ -1078,6 +1085,8 @@ begin
     CheckRestoredPasExpr(Path,TPasExpr(Orig),TPasExpr(Rest))
     CheckRestoredPasExpr(Path,TPasExpr(Orig),TPasExpr(Rest))
   else if C=TParamsExpr then
   else if C=TParamsExpr then
     CheckRestoredParamsExpr(Path,TParamsExpr(Orig),TParamsExpr(Rest))
     CheckRestoredParamsExpr(Path,TParamsExpr(Orig),TParamsExpr(Rest))
+  else if C=TProcedureExpr then
+    CheckRestoredProcedureExpr(Path,TProcedureExpr(Orig),TProcedureExpr(Rest))
   else if C=TRecordValues then
   else if C=TRecordValues then
     CheckRestoredRecordValues(Path,TRecordValues(Orig),TRecordValues(Rest))
     CheckRestoredRecordValues(Path,TRecordValues(Orig),TRecordValues(Rest))
   else if C=TArrayValues then
   else if C=TArrayValues then
@@ -1259,6 +1268,13 @@ begin
   CheckRestoredPasExpr(Path,Orig,Rest);
   CheckRestoredPasExpr(Path,Orig,Rest);
 end;
 end;
 
 
+procedure TCustomTestPrecompile.CheckRestoredProcedureExpr(const Path: string;
+  Orig, Rest: TProcedureExpr);
+begin
+  CheckRestoredProcedure(Path+'$Ano',Orig.Proc,Rest.Proc);
+  CheckRestoredPasExpr(Path,Orig,Rest);
+end;
+
 procedure TCustomTestPrecompile.CheckRestoredRecordValues(const Path: string;
 procedure TCustomTestPrecompile.CheckRestoredRecordValues(const Path: string;
   Orig, Rest: TRecordValues);
   Orig, Rest: TRecordValues);
 var
 var
@@ -1662,6 +1678,32 @@ begin
   WriteReadUnit;
   WriteReadUnit;
 end;
 end;
 
 
+procedure TTestPrecompile.TestPC_Set_InFunction;
+begin
+  StartUnit(false);
+  Add([
+  'interface',
+  'procedure DoIt;',
+  'implementation',
+  'procedure DoIt;',
+  'type',
+  '  TEnum = (red,green,blue);',
+  '  TEnumRg = green..blue;',
+  '  TEnumAlias = TEnum;', // alias
+  '  TSetOfEnum = set of TEnum;',
+  '  TSetOfEnumRg = set of TEnumRg;',
+  '  TSetOfDir = set of (west,east);',
+  'var',
+  '  Empty: TSetOfEnum = [];', // empty set lit
+  '  All: TSetOfEnum = [low(TEnum)..pred(high(TEnum)),high(TEnum)];', // full set lit, range in set
+  '  Dirs: TSetOfDir;',
+  'begin',
+  '  Dirs:=[east];',
+  'end;',
+  '']);
+  WriteReadUnit;
+end;
+
 procedure TTestPrecompile.TestPC_SetOfAnonymousEnumType;
 procedure TTestPrecompile.TestPC_SetOfAnonymousEnumType;
 begin
 begin
   StartUnit(false);
   StartUnit(false);
@@ -1691,6 +1733,61 @@ begin
   WriteReadUnit;
   WriteReadUnit;
 end;
 end;
 
 
+procedure TTestPrecompile.TestPC_Record_InFunction;
+begin
+  StartUnit(false);
+  Add([
+  'interface',
+  'procedure DoIt;',
+  'implementation',
+  'procedure DoIt;',
+  'type',
+  '  TRec = record',
+  '    i: longint;',
+  '    s: string;',
+  '  end;',
+  '  P = ^TRec;',
+  '  TArrOfRec = array of TRec;',
+  'var',
+  '  r: TRec;',
+  'begin',
+  'end;']);
+  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;
 procedure TTestPrecompile.TestPC_JSValue;
 begin
 begin
   StartUnit(false);
   StartUnit(false);
@@ -1729,6 +1826,25 @@ begin
   WriteReadUnit;
   WriteReadUnit;
 end;
 end;
 
 
+procedure TTestPrecompile.TestPC_Array_InFunction;
+begin
+  StartUnit(false);
+  Add([
+  'interface',
+  'procedure DoIt;',
+  'implementation',
+  'procedure DoIt;',
+  'type',
+  '  TArr = array[1..2] of word;',
+  'var',
+  '  arr: TArr;',
+  'begin',
+  '  arr[2]:=arr[1];',
+  'end;',
+  '']);
+  WriteReadUnit;
+end;
+
 procedure TTestPrecompile.TestPC_Proc;
 procedure TTestPrecompile.TestPC_Proc;
 begin
 begin
   StartUnit(false);
   StartUnit(false);
@@ -1866,6 +1982,32 @@ begin
   WriteReadUnit;
   WriteReadUnit;
 end;
 end;
 
 
+procedure TTestPrecompile.TestPC_Proc_Anonymous;
+begin
+  StartUnit(false);
+  Add([
+  'interface',
+  'type',
+  '  TFunc = reference to function(w: word): word;',
+  '  function GetIt(f: TFunc): longint;',
+  'implementation',
+  'var k: byte;',
+  'function GetIt(f: TFunc): longint;',
+  'begin',
+  '  f:=function(w: word): word',
+  '    var j: byte;',
+  '      function GetMul(a,b: longint): longint; ',
+  '      begin',
+  '        Result:=a*b;',
+  '      end;',
+  '    begin',
+  '      Result:=j*GetMul(1,2)*k;',
+  '    end;',
+  'end;',
+  '']);
+  WriteReadUnit;
+end;
+
 procedure TTestPrecompile.TestPC_Class;
 procedure TTestPrecompile.TestPC_Class;
 begin
 begin
   StartUnit(false);
   StartUnit(false);

Файлын зөрүү хэтэрхий том тул дарагдсан байна
+ 643 - 73
packages/pastojs/tests/tcmodules.pas


+ 9 - 9
packages/pastojs/tests/tcoptimizations.pas

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

+ 6 - 6
packages/pastojs/tests/tcprecompile.pas

@@ -17,7 +17,7 @@
     ./testpas2js --suite=TTestCLI_Precompile
     ./testpas2js --suite=TTestCLI_Precompile
     ./testpas2js --suite=TTestModule.TestEmptyUnit
     ./testpas2js --suite=TTestModule.TestEmptyUnit
 }
 }
-unit tcprecompile;
+unit TCPrecompile;
 
 
 {$mode objfpc}{$H+}
 {$mode objfpc}{$H+}
 
 
@@ -26,7 +26,7 @@ interface
 uses
 uses
   Classes, SysUtils,
   Classes, SysUtils,
   fpcunit, testregistry, Pas2jsFileUtils, Pas2JsFiler, Pas2jsCompiler,
   fpcunit, testregistry, Pas2jsFileUtils, Pas2JsFiler, Pas2jsCompiler,
-  tcunitsearch, tcmodules;
+  TCUnitSearch, TCModules;
 
 
 type
 type
 
 
@@ -115,6 +115,8 @@ begin
     JSFile:=FindFile(JSFilename);
     JSFile:=FindFile(JSFilename);
     OrigSrc:=JSFile.Source;
     OrigSrc:=JSFile.Source;
     // compile, using .pcu files
     // compile, using .pcu files
+    //for i:=0 to FileCount-1 do
+    //  writeln('TCustomTestCLI_Precompile.CheckPrecompile ',i,' ',Files[i].Filename);
     {$IFDEF VerbosePCUFiler}
     {$IFDEF VerbosePCUFiler}
     writeln('TTestCLI_Precompile.CheckPrecompile compile using pcu files==================');
     writeln('TTestCLI_Precompile.CheckPrecompile compile using pcu files==================');
     {$ENDIF}
     {$ENDIF}
@@ -285,7 +287,7 @@ begin
    'end;']);
    'end;']);
   AddUnit('src/unit2.pp',
   AddUnit('src/unit2.pp',
   ['uses unit1;',
   ['uses unit1;',
-  'procedure Do2(j: integer);'],
+   'procedure Do2(j: integer);'],
   ['procedure Do2(j: integer);',
   ['procedure Do2(j: integer);',
    'begin',
    'begin',
    '  unit1.i:=j;',
    '  unit1.i:=j;',
@@ -550,7 +552,7 @@ begin
   ExpectedSrc:=LinesToStr([
   ExpectedSrc:=LinesToStr([
     UTF8BOM+'rtl.module("system",[],function () {',
     UTF8BOM+'rtl.module("system",[],function () {',
     '  "use strict";',
     '  "use strict";',
-    '  rtl.checkVersion(10101);',
+    '  rtl.checkVersion(10301);',
     '  var $mod = this;',
     '  var $mod = this;',
     '});']);
     '});']);
   if not CheckSrcDiff(ExpectedSrc,aFile.Source,s) then
   if not CheckSrcDiff(ExpectedSrc,aFile.Source,s) then
@@ -558,8 +560,6 @@ begin
 end;
 end;
 
 
 Initialization
 Initialization
-  {$IFDEF EnablePas2jsPrecompiled}
   RegisterTests([TTestCLI_Precompile]);
   RegisterTests([TTestCLI_Precompile]);
-  {$ENDIF}
 end.
 end.
 
 

+ 6 - 5
packages/pastojs/tests/tcunitsearch.pas

@@ -18,7 +18,7 @@
     ./testpas2js --suite=TestUS_Program
     ./testpas2js --suite=TestUS_Program
     ./testpas2js --suite=TestUS_UsesEmptyFileFail
     ./testpas2js --suite=TestUS_UsesEmptyFileFail
 }
 }
-unit tcunitsearch;
+unit TCUnitSearch;
 
 
 {$mode objfpc}{$H+}
 {$mode objfpc}{$H+}
 
 
@@ -29,14 +29,14 @@ uses
   fpcunit, testregistry,
   fpcunit, testregistry,
   PScanner, PasTree,
   PScanner, PasTree,
   {$IFDEF CheckPasTreeRefCount}PasResolveEval,{$ENDIF}
   {$IFDEF CheckPasTreeRefCount}PasResolveEval,{$ENDIF}
-  Pas2jsFileUtils, Pas2jsCompiler, Pas2jsFileCache, Pas2jsLogger,
+  Pas2jsFileUtils, Pas2jsCompiler, Pas2JSPCUCompiler, Pas2jsFileCache, Pas2jsLogger,
   tcmodules;
   tcmodules;
 
 
 type
 type
 
 
   { TTestCompiler }
   { TTestCompiler }
 
 
-  TTestCompiler = class(TPas2jsCompiler)
+  TTestCompiler = class(TPas2jsPCUCompiler)
   private
   private
     FExitCode: longint;
     FExitCode: longint;
   protected
   protected
@@ -209,7 +209,7 @@ procedure TCustomTestCLI.SetWorkDir(const AValue: string);
 var
 var
   NewValue: String;
   NewValue: String;
 begin
 begin
-  NewValue:=IncludeTrailingPathDelimiter(ResolveDots(AValue));
+  NewValue:=IncludeTrailingPathDelimiter(ExpandFileNamePJ(ResolveDots(AValue)));
   if FWorkDir=NewValue then Exit;
   if FWorkDir=NewValue then Exit;
   FWorkDir:=NewValue;
   FWorkDir:=NewValue;
 end;
 end;
@@ -228,8 +228,9 @@ begin
   CompilerExe:='/usr/bin/pas2js';
   CompilerExe:='/usr/bin/pas2js';
   {$ENDIF}
   {$ENDIF}
   FCompiler:=TTestCompiler.Create;
   FCompiler:=TTestCompiler.Create;
+  //FCompiler.ConfigSupport:=TPas2JSFileConfigSupport.Create(FCompiler);
   Compiler.Log.OnLog:=@DoLog;
   Compiler.Log.OnLog:=@DoLog;
-  Compiler.FileCache.DirectoryCache.OnReadDirectory:=@OnReadDirectory;
+  Compiler.FileCache.OnReadDirectory:=@OnReadDirectory;
   Compiler.FileCache.OnReadFile:=@OnReadFile;
   Compiler.FileCache.OnReadFile:=@OnReadFile;
   Compiler.FileCache.OnWriteFile:=@OnWriteFile;
   Compiler.FileCache.OnWriteFile:=@OnWriteFile;
 end;
 end;

+ 7 - 8
packages/pastojs/tests/testpas2js.lpi

@@ -19,16 +19,9 @@
       <Version Value="2"/>
       <Version Value="2"/>
     </PublishOptions>
     </PublishOptions>
     <RunParams>
     <RunParams>
-      <local>
-        <CommandLineParams Value="--suite=TTestCLI_UnitSearch"/>
-      </local>
       <FormatVersion Value="2"/>
       <FormatVersion Value="2"/>
       <Modes Count="1">
       <Modes Count="1">
-        <Mode0 Name="default">
-          <local>
-            <CommandLineParams Value="--suite=TTestCLI_UnitSearch"/>
-          </local>
-        </Mode0>
+        <Mode0 Name="default"/>
       </Modes>
       </Modes>
     </RunParams>
     </RunParams>
     <RequiredPackages Count="2">
     <RequiredPackages Count="2">
@@ -56,6 +49,7 @@
       <Unit3>
       <Unit3>
         <Filename Value="tcmodules.pas"/>
         <Filename Value="tcmodules.pas"/>
         <IsPartOfProject Value="True"/>
         <IsPartOfProject Value="True"/>
+        <UnitName Value="TCModules"/>
       </Unit3>
       </Unit3>
       <Unit4>
       <Unit4>
         <Filename Value="tcoptimizations.pas"/>
         <Filename Value="tcoptimizations.pas"/>
@@ -82,10 +76,12 @@
       <Unit9>
       <Unit9>
         <Filename Value="tcunitsearch.pas"/>
         <Filename Value="tcunitsearch.pas"/>
         <IsPartOfProject Value="True"/>
         <IsPartOfProject Value="True"/>
+        <UnitName Value="TCUnitSearch"/>
       </Unit9>
       </Unit9>
       <Unit10>
       <Unit10>
         <Filename Value="tcprecompile.pas"/>
         <Filename Value="tcprecompile.pas"/>
         <IsPartOfProject Value="True"/>
         <IsPartOfProject Value="True"/>
+        <UnitName Value="TCPrecompile"/>
       </Unit10>
       </Unit10>
     </Units>
     </Units>
   </ProjectOptions>
   </ProjectOptions>
@@ -110,6 +106,9 @@
     </CodeGeneration>
     </CodeGeneration>
     <Other>
     <Other>
       <CustomOptions Value="-dVerbosePas2JS"/>
       <CustomOptions Value="-dVerbosePas2JS"/>
+      <OtherDefines Count="1">
+        <Define0 Value="VerbosePas2JS"/>
+      </OtherDefines>
     </Other>
     </Other>
   </CompilerOptions>
   </CompilerOptions>
   <Debugging>
   <Debugging>

+ 67 - 19
utils/pas2js/dist/rtl.js

@@ -2,7 +2,7 @@
 
 
 var rtl = {
 var rtl = {
 
 
-  version: 10101,
+  version: 10301,
 
 
   quiet: false,
   quiet: false,
   debug_load_units: false,
   debug_load_units: false,
@@ -71,6 +71,10 @@ var rtl = {
     return ((typeof(o)==="object") || (typeof(o)==='function')) ? o : null;
     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){
   isPasClass: function(type){
     return (rtl.isObject(type) && type.hasOwnProperty('$classname') && rtl.isObject(type.$module));
     return (rtl.isObject(type) && type.hasOwnProperty('$classname') && rtl.isObject(type.$module));
   },
   },
@@ -141,7 +145,7 @@ var rtl = {
       try{
       try{
         doRun();
         doRun();
       } catch(re) {
       } 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);
 	    errMsg +=  ((errMsg) ? ': ' : '') + (re.hasOwnProperty('fMessage') ? re.fMessage : re);
         alert('Uncaught Exception : '+errMsg);
         alert('Uncaught Exception : '+errMsg);
         rtl.exitCode = 216;
         rtl.exitCode = 216;
@@ -233,23 +237,28 @@ var rtl = {
     }
     }
   },
   },
 
 
-  initClass: function(c,parent,name,initfn){
-    parent[name] = c;
-    c.$class = c; // Note: o.$class === Object.getPrototypeOf(o)
-    c.$classname = name;
+  initStruct: function(c,parent,name){
     if ((parent.$module) && (parent.$module.$impl===parent)) parent=parent.$module;
     if ((parent.$module) && (parent.$module.$impl===parent)) parent=parent.$module;
     c.$parent = parent;
     c.$parent = parent;
-    c.$fullname = parent.$name+'.'+name;
     if (rtl.isModule(parent)){
     if (rtl.isModule(parent)){
       c.$module = parent;
       c.$module = parent;
       c.$name = name;
       c.$name = name;
     } else {
     } else {
       c.$module = parent.$module;
       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
     // rtti
     if (rtl.debug_rtti) rtl.debug('initClass '+c.$fullname);
     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;
     c.$rtti = t;
     if (rtl.isObject(c.$ancestor)) t.ancestor = c.$ancestor.$rtti;
     if (rtl.isObject(c.$ancestor)) t.ancestor = c.$ancestor.$rtti;
     if (!t.ancestor) t.ancestor = null;
     if (!t.ancestor) t.ancestor = null;
@@ -298,8 +307,7 @@ var rtl = {
     // Create a class using an external ancestor.
     // Create a class using an external ancestor.
     // If newinstancefnname is given, use that function to create the new object.
     // If newinstancefnname is given, use that function to create the new object.
     // If exist call BeforeDestruction and AfterConstruction.
     // If exist call BeforeDestruction and AfterConstruction.
-    var c = null;
-    c = Object.create(ancestor);
+    var c = Object.create(ancestor);
     c.$create = function(fnname,args){
     c.$create = function(fnname,args){
       if (args == undefined) args = [];
       if (args == undefined) args = [];
       var o = null;
       var o = null;
@@ -342,6 +350,32 @@ var rtl = {
     return null;
     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){
   is: function(instance,type){
     return type.isPrototypeOf(instance) || (instance===type);
     return type.isPrototypeOf(instance) || (instance===type);
   },
   },
@@ -465,7 +499,7 @@ var rtl = {
 
 
   createTGUID: function(guid){
   createTGUID: function(guid){
     var TGuid = (pas.System)?pas.System.TGuid:pas.system.tguid;
     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;
     return g;
   },
   },
 
 
@@ -730,10 +764,12 @@ var rtl = {
         if (argNo === p.length-1){
         if (argNo === p.length-1){
           if (rtl.isArray(defaultvalue)){
           if (rtl.isArray(defaultvalue)){
             for (var i=oldlen; i<newlen; i++) a[i]=[]; // nested array
             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)) {
           } 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 {
           } else {
             for (var i=oldlen; i<newlen; i++) a[i]=defaultvalue;
             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()
     // type: 0 for references, "refset" for calling refSet(), a function for new type()
     // src must not be null
     // src must not be null
     // This function does not range check.
     // This function does not range check.
-    if (rtl.isFunction(type)){
-      for (; srcpos<endpos; srcpos++) dst[dstpos++] = new type(src[srcpos]); // clone record
-    } else if(type === 'refSet') {
+    if(type === 'refSet') {
       for (; srcpos<endpos; srcpos++) dst[dstpos++] = rtl.refSet(src[srcpos]); // ref set
       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 {
     }  else {
       for (; srcpos<endpos; srcpos++) dst[dstpos++] = src[srcpos]; // reference
       for (; srcpos<endpos; srcpos++) dst[dstpos++] = src[srcpos]; // reference
     };
     };
@@ -950,7 +986,7 @@ var rtl = {
     };
     };
   },
   },
 
 
-  floatToStr : function(d,w,p){
+  floatToStr: function(d,w,p){
     // input 1-3 arguments: double, width, precision
     // input 1-3 arguments: double, width, precision
     if (arguments.length>2){
     if (arguments.length>2){
       return rtl.spaceLeft(d.toFixed(p),w);
       return rtl.spaceLeft(d.toFixed(p),w);
@@ -975,6 +1011,18 @@ var rtl = {
     }
     }
   },
   },
 
 
+  valEnum: function(s, enumType, setCodeFn){
+    s = s.toLowerCase();
+    for (var key in enumType){
+      if((typeof(key)==='string') && (key.toLowerCase()===s)){
+        setCodeFn(0);
+        return enumType[key];
+      }
+    }
+    setCodeFn(1);
+    return 0;
+  },
+
   initRTTI: function(){
   initRTTI: function(){
     if (rtl.debug_rtti) rtl.debug('initRTTI');
     if (rtl.debug_rtti) rtl.debug('initRTTI');
 
 

+ 65 - 8
utils/pas2js/docs/translation.html

@@ -133,6 +133,7 @@ Put + after a boolean switch option to enable it, - to disable it
     -ic   : Write list of supported JS processors usable by -P&lt;x&gt;
     -ic   : Write list of supported JS processors usable by -P&lt;x&gt;
     -io   : Write list of supported optimizations usable by -Oo&lt;x&gt;
     -io   : Write list of supported optimizations usable by -Oo&lt;x&gt;
     -it   : Write list of supported targets usable by -T&lt;x&gt;
     -it   : Write list of supported targets usable by -T&lt;x&gt;
+    -iJ   : Write list of supported JavaScript identifiers -JoRTL-&lt;x&gt;
   -C&lt;x&gt;   : Code generation options. &lt;x&gt; is a combination of the following letters:
   -C&lt;x&gt;   : Code generation options. &lt;x&gt; is a combination of the following letters:
     o     : Overflow checking
     o     : Overflow checking
     r     : Range checking
     r     : Range checking
@@ -164,6 +165,11 @@ Put + after a boolean switch option to enable it, - to disable it
    -Jo&lt;x&gt; : Enable or disable extra option. The x is case insensitive:
    -Jo&lt;x&gt; : Enable or disable extra option. The x is case insensitive:
      -JoSearchLikeFPC : search source files like FPC, default: search case insensitive.
      -JoSearchLikeFPC : search source files like FPC, default: search case insensitive.
      -JoUseStrict : add "use strict" to modules, default.
      -JoUseStrict : add "use strict" to modules, default.
+     -JoCheckVersion-: do not add rtl version check, default. (since 1.1)
+     -JoCheckVersion=main: insert rtl version check into main. (since 1.1)
+     -JoCheckVersion=system: insert rtl version check into system unit init. (since 1.1)
+     -JoCheckVersion=unit: insert rtl version check into every unit init. (since 1.1)
+     -JoRTL-&lt;x&gt;=&lt;y&gt;: set RTL identifier x to value y. See -iJ. (since 1.1)
    -Jpcmd&lt;command&gt; : Run postprocessor. For each generated js execute
    -Jpcmd&lt;command&gt; : Run postprocessor. For each generated js execute
                   command passing the js as stdin and read the new js from stdout.
                   command passing the js as stdin and read the new js from stdout.
                   This option can be added multiple times to call several
                   This option can be added multiple times to call several
@@ -622,7 +628,8 @@ End.
       <tbody>
       <tbody>
         <tr>
         <tr>
           <th>Pascal</th>
           <th>Pascal</th>
-          <th>JavaScript</th>
+          <th>JS Pas2js 1.2</th>
+          <th>JS Pas2js 1.3</th>
         </tr>
         </tr>
         <tr>
         <tr>
           <td>
           <td>
@@ -671,6 +678,35 @@ function(){
   },
   },
 },
 },
 []);
 []);
+</pre>
+          </td>
+          <td>
+<pre>rtl.module("MyModule",
+["System"],
+function(){
+  var $mod = this;
+  rtl.createTRecord($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;
+      return this;
+    };
+  };
+  this.r = this.TMyRecord.$new();
+  $mod.$init = function() {
+    $mod.r.i=123;
+    $mod.r.$assign($mod.s);
+    if ($mod.r.$eq($mod.s)) ;
+  },
+},
+[]);
 </pre>
 </pre>
           </td>
           </td>
         </tr>
         </tr>
@@ -680,9 +716,20 @@ function(){
       <li>The record variable creates a JavaScript object.</li>
       <li>The record variable creates a JavaScript object.</li>
       <li>Variant records are not supported.</li>
       <li>Variant records are not supported.</li>
       <li>Supported: Assign, pass as argument, equal, not equal,
       <li>Supported: Assign, pass as argument, equal, not equal,
-      array of record, pointer of record, const, default().</li>
-      <li>Not yet implemented: advanced records, operators.</li>
-      <li>When assigning a record it is cloned. This is compatible with Delphi and FPC.</li>
+      array of record, pointer of record, const, default(), RTTI.</li>
+      <li>Advanced record (since pas2js 1.3):
+        <ul>
+          <li>visibility private, strict private, public, default is public</li>
+          <li>methods, class methods (must be static like in Delphi/FPC)</li>
+          <li>class vars</li>
+          <li>const fields</li>
+          <li>property, class property, array property, default property</li>
+        </ul>
+      </li>
+      <li>Not yet implemented: constructors, operators.</li>
+      <li>Until Pas2js 1.2 when assigning a record it is cloned, creating a new
+        JS object. Since Pas2js 1.3 only values are copied,
+        keeping the object, so pointer of record is compatible.</li>
       <li>Since record types are JS objects it is possible to typecast a record type
       <li>Since record types are JS objects it is possible to typecast a record type
       to the JS Object, e.g. TJSObject(TPoint)</li>
       to the JS Object, e.g. TJSObject(TPoint)</li>
       <li>A pointer of record is simply a reference.
       <li>A pointer of record is simply a reference.
@@ -2031,8 +2078,9 @@ rtl = {
 
 
     <div class="section">
     <div class="section">
     <h2 id="anonymousfunctions">Translating anonymous functions</h2>
     <h2 id="anonymousfunctions">Translating anonymous functions</h2>
-    Anonymous functions are not yet supported by pas2js. The next best thing are
-    local procedures. For example:
+    Anonymous functions are supported since pas2js 1.1.<br>
+    Note that in pas2js local procedures are closures as well. See below.<br>
+    For pas2js 1.0 the next best thing are local procedures. For example:
     <table class="sample">
     <table class="sample">
       <tbody>
       <tbody>
         <tr>
         <tr>
@@ -2803,12 +2851,20 @@ End.
     <li>{$I %param%}:
     <li>{$I %param%}:
       <ul>
       <ul>
         <li>%date%: current date as string literal, '[yyyy/mm/dd]'</li>
         <li>%date%: current date as string literal, '[yyyy/mm/dd]'</li>
-        <li>%time%: current time as string literal, 'hh:mm:ss'</li>
-        <li>%line%: current source line number as string literal, e.g. '123'</li>
+        <li>%time%: current time as string literal, 'hh:mm:ss'. Note that the
+          inclusion of %date% and %time% will not cause the compiler to
+          recompile the unit every time it is used:
+          the date and time will be the date and time when the unit was last compiled.</li>
+        <li>%file%: current source filename as string literal, e.g. <i>'unit1.pas'</i></li>
+        <li>%line%: current source line number as string literal, e.g. <i>'123'</i></li>
+        <li>%linenum%: current source line number as integer, e.g. <i>123</i></li>
         <li>%currentroutine%: name of current routine as string literal</li>
         <li>%currentroutine%: name of current routine as string literal</li>
         <li>%pas2jstarget%, %pas2jstargetos%, %fpctarget%, %fpctargetos%: target os as string literal, e.g. 'Browser'</li>
         <li>%pas2jstarget%, %pas2jstargetos%, %fpctarget%, %fpctargetos%: target os as string literal, e.g. 'Browser'</li>
         <li>%pas2jstargetcpu%, %fpctargetcpu%: target cpu as string literal, e.g. 'ECMAScript5'</li>
         <li>%pas2jstargetcpu%, %fpctargetcpu%: target cpu as string literal, e.g. 'ECMAScript5'</li>
         <li>%pas2jsversion%, %fpcversion%: compiler version as strnig literal, e.g. '1.0.2'</li>
         <li>%pas2jsversion%, %fpcversion%: compiler version as strnig literal, e.g. '1.0.2'</li>
+        <li>If param is none of the above it will use the environment variable.
+        Keep in mind that depending on the platform the name may be case sensitive.
+        If there is no such variable an empty string <i>''</i> is inserted.</li>
       </ul>
       </ul>
     </li>
     </li>
     <li>{$Warnings on|off}</li>
     <li>{$Warnings on|off}</li>
@@ -2925,6 +2981,7 @@ End.
     <li>Intrinsic procedure WriteStr(out s: string; params...)</li>
     <li>Intrinsic procedure WriteStr(out s: string; params...)</li>
     <li><i>Debugger;</i> converts to <i>debugger;</i>. If a debugger is running
     <li><i>Debugger;</i> converts to <i>debugger;</i>. If a debugger is running
       it will break on this line just like a break point.</li>
       it will break on this line just like a break point.</li>
+    <li><i>concat(string1,string2,...)</i> since 1.3</li>
     </ul>
     </ul>
     </div>
     </div>
 
 

+ 6 - 4
utils/pas2js/nodepas2js.pp

@@ -6,7 +6,8 @@ program nodepas2js;
 uses
 uses
   JS, NodeJSApp,
   JS, NodeJSApp,
   Classes, SysUtils,
   Classes, SysUtils,
-  Pas2jsFileUtils, Pas2jsLogger, Pas2jsCompiler;
+  Pas2jsFileUtils, Pas2jsLogger,
+  Pas2jsCompiler, Pas2JSFSCompiler, Pas2JSCompilerCfg;
 
 
 type
 type
 
 
@@ -14,13 +15,13 @@ type
 
 
   TPas2jsCLI = class(TNodeJSApplication)
   TPas2jsCLI = class(TNodeJSApplication)
   private
   private
-    FCompiler: TPas2jsCompiler;
+    FCompiler: TPas2jsFSCompiler;
   protected
   protected
     procedure DoRun; override;
     procedure DoRun; override;
   public
   public
     constructor Create(TheOwner: TComponent); override;
     constructor Create(TheOwner: TComponent); override;
     destructor Destroy; override;
     destructor Destroy; override;
-    property Compiler: TPas2jsCompiler read FCompiler;
+    property Compiler: TPas2jsFsCompiler read FCompiler;
   end;
   end;
 
 
 procedure TPas2jsCLI.DoRun;
 procedure TPas2jsCLI.DoRun;
@@ -65,7 +66,8 @@ constructor TPas2jsCLI.Create(TheOwner: TComponent);
 begin
 begin
   inherited Create(TheOwner);
   inherited Create(TheOwner);
   StopOnException:=True;
   StopOnException:=True;
-  FCompiler:=TPas2jsCompiler.Create;
+  FCompiler:=TPas2jsFSCompiler.Create;
+  FCompiler.ConfigSupport:=TPas2JSFileConfigSupport.Create(FCompiler);
 end;
 end;
 
 
 destructor TPas2jsCLI.Destroy;
 destructor TPas2jsCLI.Destroy;

+ 25 - 3
utils/pas2js/pas2js.lpi

@@ -23,15 +23,37 @@
     <RunParams>
     <RunParams>
       <FormatVersion Value="2"/>
       <FormatVersion Value="2"/>
       <Modes Count="1">
       <Modes Count="1">
-        <Mode0 Name="default">
-        </Mode0>
+        <Mode0 Name="default"/>
       </Modes>
       </Modes>
     </RunParams>
     </RunParams>
-    <Units Count="1">
+    <Units Count="6">
       <Unit0>
       <Unit0>
         <Filename Value="pas2js.pp"/>
         <Filename Value="pas2js.pp"/>
         <IsPartOfProject Value="True"/>
         <IsPartOfProject Value="True"/>
       </Unit0>
       </Unit0>
+      <Unit1>
+        <Filename Value="../../packages/pastojs/src/pas2jspcucompiler.pp"/>
+        <IsPartOfProject Value="True"/>
+        <UnitName Value="Pas2JSPCUCompiler"/>
+      </Unit1>
+      <Unit2>
+        <Filename Value="../../packages/pastojs/src/pas2jscompilercfg.pp"/>
+        <IsPartOfProject Value="True"/>
+      </Unit2>
+      <Unit3>
+        <Filename Value="../../packages/pastojs/src/pas2jsfs.pp"/>
+        <IsPartOfProject Value="True"/>
+        <UnitName Value="Pas2JSFS"/>
+      </Unit3>
+      <Unit4>
+        <Filename Value="../../packages/pastojs/src/pas2jscompilerpp.pp"/>
+        <IsPartOfProject Value="True"/>
+      </Unit4>
+      <Unit5>
+        <Filename Value="../../packages/pastojs/src/pas2jsfscompiler.pp"/>
+        <IsPartOfProject Value="True"/>
+        <UnitName Value="Pas2JSFSCompiler"/>
+      </Unit5>
     </Units>
     </Units>
   </ProjectOptions>
   </ProjectOptions>
   <CompilerOptions>
   <CompilerOptions>

+ 7 - 4
utils/pas2js/pas2js.pp

@@ -12,7 +12,8 @@ uses
   cthreads, cwstring,
   cthreads, cwstring,
   {$ENDIF}
   {$ENDIF}
   Classes, SysUtils, CustApp,
   Classes, SysUtils, CustApp,
-  Pas2jsFileUtils, Pas2jsLogger, Pas2jsCompiler;
+  Pas2jsFileUtils, Pas2jsLogger, Pas2jsCompiler,
+  Pas2JSFSCompiler, Pas2JSCompilerPP, Pas2JSCompilerCfg;
 
 
 Type
 Type
 
 
@@ -20,14 +21,14 @@ Type
 
 
   TPas2jsCLI = class(TCustomApplication)
   TPas2jsCLI = class(TCustomApplication)
   private
   private
-    FCompiler: TPas2jsCompiler;
+    FCompiler: TPas2JSFSCompiler;
     FWriteOutputToStdErr: Boolean;
     FWriteOutputToStdErr: Boolean;
   protected
   protected
     procedure DoRun; override;
     procedure DoRun; override;
   public
   public
     constructor Create(TheOwner: TComponent); override;
     constructor Create(TheOwner: TComponent); override;
     destructor Destroy; override;
     destructor Destroy; override;
-    property Compiler: TPas2jsCompiler read FCompiler;
+    property Compiler: TPas2JSFSCompiler read FCompiler;
     property WriteOutputToStdErr: Boolean read FWriteOutputToStdErr write FWriteOutputToStdErr;
     property WriteOutputToStdErr: Boolean read FWriteOutputToStdErr write FWriteOutputToStdErr;
   end;
   end;
 
 
@@ -66,7 +67,9 @@ constructor TPas2jsCLI.Create(TheOwner: TComponent);
 begin
 begin
   inherited Create(TheOwner);
   inherited Create(TheOwner);
   StopOnException:=True;
   StopOnException:=True;
-  FCompiler:=TPas2jsCompiler.Create;
+  FCompiler:=TPas2JSFSCompiler.Create;
+  FCompiler.ConfigSupport:=TPas2JSFileConfigSupport.Create(FCompiler);
+  FCompiler.PostProcessorSupport:=TPas2JSFSPostProcessorSupport.Create(FCompiler);
 end;
 end;
 
 
 destructor TPas2jsCLI.Destroy;
 destructor TPas2jsCLI.Destroy;

+ 97 - 0
utils/pas2js/pas2jswebcompiler.pp

@@ -0,0 +1,97 @@
+unit pas2jswebcompiler;
+
+{$mode objfpc}
+
+interface
+
+uses
+  Classes, SysUtils, pas2jsfs, pasuseanalyzer, pas2jscompiler, FPPJsSrcMap, webfilecache;
+
+Type
+
+  { TPas2JSWebcompiler }
+
+  TPas2JSWebcompiler = Class(TPas2JSCompiler)
+  private
+    function GetWebFS: TPas2JSWebFS;
+  Protected
+    function DoWriteJSFile(const DestFilename: String; aWriter: TPas2JSMapper): Boolean; override;
+    function CreateSetOfCompilerFiles(keyType: TKeyCompareType): TPasAnalyzerKeySet; override;
+    function CreateFS : TPas2JSFS; override;
+  Public
+    Property WebFS : TPas2JSWebFS read GetWebFS;
+  end;
+
+implementation
+
+uses js;
+
+function Pas2jsCompilerFile_FilenameToKeyName(Item: Pointer): String;
+var
+  aFile: TPas2jsCompilerFile absolute Item;
+begin
+  Result:=LowerCase(aFile.PasFilename);
+end;
+
+function PtrUnitnameToKeyName(Item: Pointer): String;
+var
+  aUnitName: string absolute Item;
+begin
+  Result:=LowerCase(aUnitName);
+end;
+
+function Pas2jsCompilerFile_UnitnameToKeyName(Item: Pointer): String;
+var
+  aFile: TPas2jsCompilerFile absolute Item;
+begin
+  Result:=LowerCase(aFile.PasUnitName);
+end;
+
+function PtrFilenameToKeyName(FilenameAsPtr: Pointer): string;
+var
+  Filename: String absolute FilenameAsPtr;
+begin
+  Result:=LowerCase(Filename);
+end;
+
+
+{ TPas2JSWebcompiler }
+
+function TPas2JSWebcompiler.GetWebFS: TPas2JSWebFS;
+begin
+  Result:=TPas2JSWebFS(FS)
+end;
+
+function TPas2JSWebcompiler.DoWriteJSFile(const DestFilename: String; aWriter: TPas2JSMapper): Boolean;
+
+Var
+  S : String;
+  T : String;
+
+begin
+//  Writeln('aWriter',AWriter.BufferLength,', array size ',Length(AWriter.Buffer));
+  S:=TJSArray(AWriter.Buffer).Join('');
+//  Writeln('TPas2JSWebcompiler.DoWriteJSFile(',DestFileName,') (',Length(S),' chars): ',S);
+  WebFS.SetFileContent(DestFileName,S);
+  Result:=True;
+end;
+
+function TPas2JSWebcompiler.CreateSetOfCompilerFiles(keyType: TKeyCompareType): TPasAnalyzerKeySet;
+begin
+  Case keyType of
+    kcFileName:
+      Result:=TPasAnalyzerKeySet.Create(@Pas2jsCompilerFile_FilenameToKeyName,@PtrFilenameToKeyName);
+    kcUnitName:
+      Result:=TPasAnalyzerKeySet.Create(@Pas2jsCompilerFile_UnitnameToKeyName,@PtrUnitnameToKeyName);
+  else
+    Raise EPas2jsFS.CreateFmt('Internal Unknown key type: %d',[Ord(KeyType)]);
+  end;
+end;
+
+function TPas2JSWebcompiler.CreateFS: TPas2JSFS;
+begin
+  Result:=TPas2JSWebFS.Create;
+end;
+
+end.
+

+ 530 - 0
utils/pas2js/webfilecache.pp

@@ -0,0 +1,530 @@
+unit webfilecache;
+
+{$mode objfpc}
+
+// Enable this to write lots of debugging info to the browser console.
+{ $DEFINE VERBOSEWEBCACHE}
+
+interface
+
+uses
+  Classes, SysUtils, JS, Web, fpjson, pas2jsfs, pscanner, contnrs;
+
+type
+  TPas2jsWebFS = Class;
+
+  { TWebFileContent }
+
+  TWebFileContent = Class(TObject)
+  private
+    FContents: string;
+    FFileName: String;
+    FModified: Boolean;
+    procedure SetContents(AValue: string);
+  Public
+    Constructor Create(const aFileName,aContents : String);
+    Property FileName : String Read FFileName Write FFileName;
+    Property Contents : string Read FContents Write SetContents;
+    Property Modified : Boolean Read FModified;
+  end;
+  { TWebFilesCache }
+
+  TWebFilesCache = Class(TObject)
+  Private
+    FFiles : TFPObjectHashTable;
+    Function FindFile(aFileName : String) : TWebFileContent;
+  Public
+    Constructor Create;
+    Destructor Destroy; override;
+    Function HasFile(aFileName : String) : Boolean;
+    Function GetFileContent(Const aFileName : String) : String;
+    function SetFileContent(const aFileName, aContent: String): Boolean;
+  end;
+
+  { TPas2jsWebFile }
+
+  TPas2jsWebFile = Class(TPas2jsFile)
+  public
+    function CreateLineReader(RaiseOnError: boolean): TSourceLineReader; override;
+    function Load(RaiseOnError: boolean; Binary: boolean): boolean; override;
+  end;
+
+  { TWebSourceLineReader }
+
+  TWebSourceLineReader = Class(TSourceLineReader)
+  private
+    FFS: TPas2jsFS;
+  Protected
+    Property FS : TPas2jsFS Read FFS;
+    Procedure IncLineNumber; override;
+  end;
+
+  // aFileName is the original filename, not normalized one
+  TLoadFileEvent = Reference to Procedure(Sender : TObject; aFileName : String; aError : string);
+
+  { TLoadFileRequest }
+
+  TLoadFileRequest = Class(TObject)
+    FFS : TPas2jsWebFS;
+    FFileName : string;
+    FXML : TJSXMLHttpRequest;
+    FOnLoaded : TLoadFileEvent;
+  private
+    procedure DoChange;
+  Public
+    constructor Create(aFS: TPas2jsWebFS; const aFileName : string; aOnLoaded: TLoadFileEvent);
+    Procedure DoLoad(const aURL : String);
+  end;
+
+
+  { TPas2jsWebFS }
+
+  TPas2jsWebFS = Class(TPas2jsFS)
+  Private
+    FCache : TWebFilesCache;
+    FLoadBaseURL: String;
+    FOnLoadedFile: TLoadFileEvent;
+  protected
+    // Only for names, no paths
+    Class Function NormalizeFileName(Const aFileName : String) : String;
+    function FindSourceFileName(const aFilename: string): String; override;
+  public
+    Constructor Create; override;
+    // Overrides
+    function CreateResolver: TPas2jsFSResolver; override;
+    function FileExists(const aFileName: String): Boolean; override;
+    function FindCustomJSFileName(const aFilename: string): String; override;
+    function FindIncludeFileName(const aFilename: string): String; override;
+    function FindUnitFileName(const aUnitname, InFilename: string; out IsForeign: boolean): String; override;
+    function FindUnitJSFileName(const aUnitFilename: string): String; override;
+    function LoadFile(Filename: string; Binary: boolean=false): TPas2jsFile; override;
+    procedure SaveToFile(ms: TFPJSStream; Filename: string); override;
+    Function SetFileContent(Const aFileName,aContents : String) : Boolean;
+    Function GetFileContent(Const aFileName : String) : String;
+    // Returns false if the file was already loaded. OnLoaded is called in either case.
+    Function LoadFile(aFileName : String; OnLoaded : TLoadFileEvent = Nil) : Boolean;
+    // Returns number of load requests. OnLoaded is called for each file in the list
+    Function LoadFiles(aList : TStrings;OnLoaded : TLoadFileEvent = Nil) : Integer;
+    Function LoadFiles(aList : array of String;OnLoaded : TLoadFileEvent = Nil) : integer;
+    Property OnLoadedFile : TLoadFileEvent Read FOnLoadedFile Write FOnLoadedFile;
+    Property LoadBaseURL : String Read FLoadBaseURL Write FLoadBaseURL;
+  end;
+
+  { TPas2jsFileResolver }
+
+  { TPas2jsWebResolver }
+
+  TPas2jsWebResolver = class(TPas2jsFSResolver)
+  private
+    function GetWebFS: TPas2jsWebFS;
+  public
+    Property WebFS : TPas2jsWebFS Read GetWebFS;
+  end;
+
+implementation
+
+{ TWebSourceLineReader }
+
+procedure TWebSourceLineReader.IncLineNumber;
+begin
+  if (FFS<>nil) then
+    FFS.IncReadLineCounter;
+  inherited IncLineNumber;
+end;
+
+{ TLoadFileRequest }
+
+procedure TLoadFileRequest.DoChange;
+
+Var
+  Err : String;
+begin
+  Case FXML.readyState of
+    TJSXMLHttpRequest.UNSENT : ;
+    TJSXMLHttpRequest.OPENED : ;
+    TJSXMLHttpRequest.HEADERS_RECEIVED : ;
+    TJSXMLHttpRequest.LOADING : ;
+    TJSXMLHttpRequest.DONE :
+      begin
+      if (FXML.Status div 100)=2 then
+        begin
+        Err:='';
+        // FS will normalize filename
+        FFS.SetFileContent(FFileName,FXML.responsetext)
+        end
+      else
+        Err:='Error loading file: '+FXML.StatusText;
+      If Assigned(FOnLoaded) then
+        FOnLoaded(FFS,FFileName,Err);
+      if Assigned(FFS.OnLoadedFile) then
+        FFS.OnLoadedFile(FFS,FFileName,Err);
+      Free;
+      end;
+  end
+end;
+
+constructor TLoadFileRequest.Create(aFS: TPas2jsWebFS; const aFileName : string; aOnLoaded: TLoadFileEvent);
+begin
+  FFS:=aFS;
+  FOnLoaded:=aOnLoaded;
+  FFileName:=aFileName;
+end;
+
+Procedure TLoadFileRequest.DoLoad(const aURL: String);
+begin
+  FXML:=TJSXMLHttpRequest.new;
+  FXML.onreadystatechange:=@DoChange;
+  // Maybe one day allow do this sync, so the compiler can load files on demand.
+  FXML.Open('GET',aURL);
+  FXML.Send;
+end;
+
+{ TPas2jsWebFile }
+
+function TPas2jsWebFile.CreateLineReader(RaiseOnError: boolean): TSourceLineReader;
+begin
+  {$IFDEF VERBOSEWEBCACHE}
+  Writeln(ClassName,': Creating line reader for ',FileName);
+  {$ENDIF}
+  if Load(RaiseOnError,False) then
+    begin
+    Result:=TWebSourceLineReader.Create(FileName,Source);
+    TWebSourceLineReader(Result).FFS:=Self.FS;
+    end
+  else
+    Result:=Nil;
+end;
+
+function TPas2jsWebFile.Load(RaiseOnError: boolean; Binary: boolean): boolean;
+begin
+  Result:=False;
+  {$IFDEF VERBOSEWEBCACHE}
+  Writeln(ClassName,': Loading for ',FileName);
+  {$ENDIF}
+  With (FS as TPas2jsWebFS).FCache do
+    if HasFile(FileName) then
+      begin
+      SetSource(GetFileContent(FileName));
+      Result:=True;
+      end;
+  if Not Result then
+    if RaiseOnError then
+      Raise EFileNotFoundError.Create('File not loaded '+FileName)
+{$IFDEF VERBOSEWEBCACHE}
+    else Writeln('File not loaded '+FileName);
+{$ENDIF}
+end;
+
+{ TWebFilesCache }
+
+function TWebFilesCache.FindFile(aFileName: String): TWebFileContent;
+
+Var
+  N : THTCustomNode;
+
+begin
+{$IFDEF VERBOSEWEBCACHE}
+  Writeln(ClassName,': Looking for file : ',aFileName);
+{$ENDIF}
+  N:=FFiles.Find(aFileName);
+  if N=Nil then
+    result:=Nil
+  else
+    Result:=TWebFileContent(THTObjectNode(N).Data);
+{$IFDEF VERBOSEWEBCACHE}
+  Writeln(ClassName,': Looking for file : ',aFileName, ': ',Assigned(Result));
+{$ENDIF}
+end;
+
+constructor TWebFilesCache.Create;
+begin
+  FFiles:=TFPObjectHashTable.Create(True);
+end;
+
+destructor TWebFilesCache.Destroy;
+begin
+  FreeAndNil(FFiles);
+  inherited Destroy;
+end;
+
+function TWebFilesCache.HasFile(aFileName: String): Boolean;
+begin
+  Result:=FindFile(aFileName)<>Nil;
+{$IFDEF VERBOSEWEBCACHE}
+  Writeln(ClassName,': HasFile(',aFileName,') : ',Result);
+{$ENDIF}
+end;
+
+function TWebFilesCache.GetFileContent(const aFileName: String): String;
+
+Var
+  W : TWebFileContent;
+
+begin
+  {$IFDEF VERBOSEWEBCACHE}
+  Writeln(ClassName,': GetFileContent(',aFileName,')');
+  {$ENDIF}
+  W:=FindFile(aFileName);
+  if Assigned(W) then
+    Result:=W.Contents
+  else
+    Raise EFileNotFoundError.Create('No such file '+AFileName);
+end;
+
+function TWebFilesCache.SetFileContent(const aFileName, aContent: String) : Boolean;
+
+Var
+  W : TWebFileContent;
+
+begin
+  {$IFDEF VERBOSEWEBCACHE}
+  Writeln(ClassName,': SetFileContent(',aFileName,')');
+  {$ENDIF}
+  W:=FindFile(aFileName);
+  Result:=Assigned(W);
+  if Result then
+    W.Contents:=aContent
+  else
+    FFiles.Add(aFileName,TWebFileContent.Create(aFileName,aContent));
+end;
+
+{ TWebFileContent }
+
+procedure TWebFileContent.SetContents(AValue: string);
+begin
+  if FContents=AValue then Exit;
+  FContents:=AValue;
+  FModified:=True;
+end;
+
+constructor TWebFileContent.Create(const aFileName, aContents: String);
+begin
+  FContents:=aContents;
+  FFileName:=aFileName;
+end;
+
+
+{ TPas2jsWebFS }
+
+function TPas2jsWebFS.FileExists(const aFileName: String): Boolean;
+begin
+  {$IFDEF VERBOSEWEBCACHE}
+  Writeln(ClassName,': FileExists(',aFileName,')');
+  {$ENDIF}
+  Result:=FCache.HasFile(NormalizeFileName(aFileName));
+  {$IFDEF VERBOSEWEBCACHE}
+  Writeln(ClassName,': FileExists(',aFileName,') : ',Result);
+  {$ENDIF}
+end;
+
+function TPas2jsWebFS.FindCustomJSFileName(const aFilename: string): String;
+begin
+{$IFDEF VERBOSEWEBCACHE}
+  Writeln(ClassName,': FindCustomJSFileName(',aFileName,')');
+{$ENDIF}
+  Result:=NormalizeFileName(aFileName);
+  If not FCache.HasFile(Result) then
+    Result:='';
+{$IFDEF VERBOSEWEBCACHE}
+  Writeln(ClassName,': FindCustomJSFileName(',aFileName,'): ',Result);
+{$ENDIF}
+end;
+
+function TPas2jsWebFS.FindIncludeFileName(const aFilename: string): String;
+begin
+{$IFDEF VERBOSEWEBCACHE}
+  Writeln(ClassName,': FindIncludeFileName(',aFileName,')');
+{$ENDIF}
+  Result:=NormalizeFileName(aFileName);
+  If not FCache.HasFile(Result) then
+    Result:='';
+{$IFDEF VERBOSEWEBCACHE}
+  Writeln(ClassName,': FindIncludeFileName(',aFileName,') : ',Result);
+{$ENDIF}
+end;
+
+class function TPas2jsWebFS.NormalizeFileName(const aFileName: String): String;
+begin
+  Result:=LowerCase(ExtractFileName(aFileName));
+end;
+
+function TPas2jsWebFS.FindSourceFileName(const aFilename: string): String;
+begin
+{$IFDEF VERBOSEWEBCACHE}
+  Writeln(ClassName,': FindSourceFileName(',aFileName,')');
+{$ENDIF}
+  Result:=NormalizeFileName(aFileName);
+  If not FCache.HasFile(Result) then
+    Result:='';
+{$IFDEF VERBOSEWEBCACHE}
+  Writeln(ClassName,': FindSourceFileName(',aFileName,') : ',Result);
+{$ENDIF}
+end;
+
+constructor TPas2jsWebFS.Create;
+begin
+  inherited Create;
+  FCache:=TWebFilesCache.Create;
+end;
+
+function TPas2jsWebFS.CreateResolver: TPas2jsFSResolver;
+begin
+  Result:=TPas2jsWebResolver.Create(Self);
+end;
+
+function TPas2jsWebFS.FindUnitFileName(const aUnitname, InFilename: string; out IsForeign: boolean): String;
+begin
+{$IFDEF VERBOSEWEBCACHE}
+  Writeln(ClassName,': FindUnitFileName(',aUnitName,')');
+{$ENDIF}
+  Result:=NormalizeFileName(aUnitName+'.pas');
+  isForeign:=False;
+{$IFDEF VERBOSEWEBCACHE}
+  Writeln(ClassName,': FindUnitFileName(',aUnitName,') : ',Result);
+{$ENDIF}
+end;
+
+function TPas2jsWebFS.FindUnitJSFileName(const aUnitFilename: string): String;
+begin
+{$IFDEF VERBOSEWEBCACHE}
+  Writeln(ClassName,': FindUnitJSFileName(',aUnitFileName,')');
+{$ENDIF}
+  Result:=NormalizeFileName(aUnitFileName);
+{$IFDEF VERBOSEWEBCACHE}
+  Writeln(ClassName,': FindUnitJSFileName(',aUnitFileName,') : ',Result);
+{$ENDIF}
+end;
+
+function TPas2jsWebFS.LoadFile(Filename: string; Binary: boolean): TPas2jsFile;
+
+begin
+  Result:=TPas2jsWebFile.Create(Self,FileName);
+  Result.Load(True,False);
+end;
+
+(*
+  // Check if we should not be using this instead, as the compiler outputs UTF8 ?
+  // Found on
+  // https://weblog.rogueamoeba.com/2017/02/27/javascript-correctly-converting-a-byte-array-to-a-utf-8-string/
+function stringFromUTF8Array(data)
+  {
+    const extraByteMap = [ 1, 1, 1, 1, 2, 2, 3, 0 ];
+    var count = data.length;
+    var str = "";
+
+    for (var index = 0;index < count;)
+    {
+      var ch = data[index++];
+      if (ch & 0x80)
+      {
+        var extra = extraByteMap[(ch >> 3) & 0x07];
+        if (!(ch & 0x40) || !extra || ((index + extra) > count))
+          return null;
+
+        ch = ch & (0x3F >> extra);
+        for (;extra > 0;extra -= 1)
+        {
+          var chx = data[index++];
+          if ((chx & 0xC0) != 0x80)
+            return null;
+
+          ch = (ch << 6) | (chx & 0x3F);
+        }
+      }
+
+      str += String.fromCharCode(ch);
+    }
+
+    return str;
+  }
+*)
+procedure TPas2jsWebFS.SaveToFile(ms: TFPJSStream; Filename: string);
+
+Var
+  aContent : String;
+  i : Integer;
+  v : JSValue;
+
+begin
+  aContent:='';
+  for I:=0 to MS.Length-1 do
+    begin
+    v:=MS[i];
+    {AllowWriteln}
+    Writeln('Char ',i,'(',v,') : ',TJSString.fromCharCode(v));
+    {AllowWriteln-}
+    aContent:=aContent+TJSString.fromCharCode(MS[i]);
+    end;
+  SetFileContent(FileName,aContent);
+end;
+
+function TPas2jsWebFS.SetFileContent(const aFileName, aContents: String): Boolean;
+begin
+  Result:=FCache.SetFileContent(NormalizeFileName(aFileName),aContents);
+end;
+
+function TPas2jsWebFS.GetFileContent(const aFileName: String): String;
+begin
+  Result:=FCache.GetFileContent(NormalizeFileName(aFileName));
+end;
+
+function TPas2jsWebFS.LoadFile(aFileName: String; OnLoaded: TLoadFileEvent): Boolean;
+
+Var
+  FN : String;
+  aURL : String;
+  LF : TLoadFileRequest;
+
+begin
+  FN:=NormalizeFileName(aFileName);
+  Result:=Not FCache.HasFile(FN);
+  if Not result then
+    begin
+    // It is already loaded
+    if Assigned(OnLoaded) then
+      OnLoaded(Self,aFileName,'')
+    end
+  else
+    begin
+    // Not yet already loaded
+    aURL:=IncludeTrailingPathDelimiter(LoadBaseURL)+FN;
+    LF:=TLoadFileRequest.Create(Self,aFileName,OnLoaded);
+    LF.DoLoad(aURL);
+    end;
+end;
+
+Function TPas2jsWebFS.LoadFiles(aList: TStrings; OnLoaded: TLoadFileEvent): Integer;
+
+Var
+  i: Integer;
+
+begin
+  Result:=0;
+  For I:=0 to aList.Count-1 do
+    if LoadFile(aList[i],OnLoaded) then
+      Inc(Result);
+end;
+
+function TPas2jsWebFS.LoadFiles(aList: array of String; OnLoaded: TLoadFileEvent): Integer;
+
+Var
+  i: Integer;
+
+begin
+  Result:=0;
+  For I:=0 to Length(aList)-1 do
+    if LoadFile(aList[i],OnLoaded) then
+      Inc(Result);
+end;
+
+{ TPas2jsWebResolver }
+
+function TPas2jsWebResolver.GetWebFS: TPas2jsWebFS;
+begin
+  Result:=TPas2jsWebFS(FS)
+end;
+
+
+
+end.
+

Энэ ялгаанд хэт олон файл өөрчлөгдсөн тул зарим файлыг харуулаагүй болно