pastojs: started library

git-svn-id: trunk@48119 -

packages/pastojs/src/fppas2js.pp

@@ -506,6 +506,7 @@ const
   nDuplicateMessageIdXAtY = 4029;
   nDispatchRequiresX = 4030;
   nConstRefNotForXAsConst = 4031;
+  nSymbolCannotBeExportedFromALibrary = 4032;
 // resourcestring patterns of messages
 resourcestring
   sPasElementNotSupported = 'Pascal element not supported: %s';
@@ -539,6 +540,7 @@ resourcestring
   sDuplicateMessageIdXAtY = 'Duplicate message id "%s" at %s';
   sDispatchRequiresX = 'Dispatch requires %s';
   sConstRefNotForXAsConst = 'ConstRef not yet implemented for %s. Treating as Const';
+  sSymbolCannotBeExportedFromALibrary = 'The symbol cannot be exported from a library';
 
 const
   ExtClassBracketAccessor = '[]'; // external name '[]' marks the array param getter/setter
@@ -606,6 +608,7 @@ type
     pbifnValEnum,
     pbifnFreeLocalVar,
     pbifnFreeVar,
+    pbifnLibraryMain,
     pbifnOverflowCheckInt,
     pbifnProcType_Create,
     pbifnProcType_CreateSafe,
@@ -671,6 +674,7 @@ type
     pbivnImplCode,
     pbivnMessageInt,
     pbivnMessageStr,
+    pbivnLibrary, // library
     pbivnLocalModuleRef,
     pbivnLocalProcRef,
     pbivnLocalTypeRef,
@@ -682,6 +686,7 @@ type
     pbivnPtrClass,
     pbivnPtrRecord,
     pbivnProcOk,
+    pbivnProgram,  // program
     pbivnResourceStrings,
     pbivnResourceStringOrig,
     pbivnRTL,
@@ -791,6 +796,7 @@ const
     'valEnum', // pbifnValEnum  rtl.valEnum
     'freeLoc', // pbifnFreeLocalVar  rtl.freeLoc
     'free', // pbifnFreeVar  rtl.free
+    '$main', // pbifnLibraryMain
     'oc', //  pbifnOverflowCheckInt rtl.oc
     'createCallback', // pbifnProcType_Create  rtl.createCallback
     'createSafeCallback', // pbifnProcType_CreateSafe  rtl.createSafeCallback
@@ -855,6 +861,7 @@ const
     '$implcode', // pbivnImplCode
     '$msgint', // pbivnMessageInt
     '$msgstr', // pbivnMessageStr
+    'library', //  pbivnLibrary  pas.library
     '$lm', // pbivnLocalModuleRef
     '$lp', // pbivnLocalProcRef
     '$lt', // pbivnLocalTypeRef
@@ -866,6 +873,7 @@ const
     '$class', // pbivnPtrClass, ClassType
     '$record', // pbivnPtrRecord, hidden recordtype
     '$ok', // pbivnProcOk
+    'program', // pbivnProgram  pas.program
     '$resourcestrings', // pbivnResourceStrings
     'org', // pbivnResourceStringOrig
     'rtl', // pbivnRTL
@@ -1538,6 +1546,7 @@ type
       Params: TParamsExpr); override;
     procedure FinishPropertyParamAccess(Params: TParamsExpr; Prop: TPasProperty
       ); override;
+    procedure FinishExportSymbol(El: TPasExportSymbol); override;
     procedure FindCreatorArrayOfConst(Args: TFPList; ErrorEl: TPasElement);
     function FindProc_ArrLitToArrayOfConst(ErrorEl: TPasElement): TPasFunction; virtual;
     function FindSystemExternalClassType(const aClassName, JSName: string;
@@ -2071,7 +2080,7 @@ type
     Procedure CreateInitSection(El: TPasModule; Src: TJSSourceElements; AContext: TConvertContext); virtual;
     Procedure AddHeaderStatement(JS: TJSElement; PosEl: TPasElement; aContext: TConvertContext); virtual;
     Procedure AddImplHeaderStatement(JS: TJSElement; PosEl: TPasElement; aContext: TConvertContext); virtual;
-    Procedure AddDelayedInits(El: TPasProgram; Src: TJSSourceElements; AContext: TConvertContext); virtual;
+    Procedure AddDelayedInits(El: TPasModule; Src: TJSSourceElements; AContext: TConvertContext); virtual;
     Procedure AddDelaySpecializeInit(El: TPasGenericType; Src: TJSSourceElements; AContext: TConvertContext); virtual;
     // enum and sets
     Function CreateReferencedSet(El: TPasElement; SetExpr: TJSElement): TJSElement; virtual;
@@ -4880,6 +4889,41 @@ begin
   FindCreatorArrayOfConst(Args,Params);
 end;
 
+procedure TPas2JSResolver.FinishExportSymbol(El: TPasExportSymbol);
+var
+  ResolvedEl: TPasResolverResult;
+  DeclEl: TPasElement;
+  Proc: TPasProcedure;
+begin
+  if El.Parent is TLibrarySection then
+    // ok
+  else
+    // everywhere else: not supported
+    RaiseMsg(20210106224720,nNotSupportedX,sNotSupportedX,['non library export'],El.ExportIndex);
+  if El.ExportIndex<>nil then
+    RaiseMsg(20210106223403,nNotSupportedX,sNotSupportedX,['export index'],El.ExportIndex);
+
+  inherited FinishExportSymbol(El);
+
+  ComputeElement(El,ResolvedEl,[]);
+  DeclEl:=ResolvedEl.IdentEl;
+  if DeclEl=nil then
+    RaiseMsg(20210106223620,nSymbolCannotBeExportedFromALibrary,
+      sSymbolCannotBeExportedFromALibrary,[],El)
+  else if DeclEl is TPasProcedure then
+    begin
+    Proc:=TPasProcedure(DeclEl);
+    if Proc.Parent is TPasSection then
+      // ok
+    else
+      RaiseMsg(20210106224436,nSymbolCannotBeExportedFromALibrary,
+        sSymbolCannotBeExportedFromALibrary,[],El);
+    end
+  else
+    RaiseMsg(20210106223621,nSymbolCannotBeExportedFromALibrary,
+      sSymbolCannotBeExportedFromALibrary,[],El);
+end;
+
 procedure TPas2JSResolver.FindCreatorArrayOfConst(Args: TFPList;
   ErrorEl: TPasElement);
 var
@@ -8083,6 +8127,18 @@ Program:
         };
     });
 
+Library:
+ rtl.module('library',
+    [<uses1>,<uses2>, ...],
+    function(){
+      var $mod = this;
+      <librarysection>
+      this.$main=function(){
+        <initialization>
+        };
+    });
+  export1 = pas.unit1.func1;
+
 Unit without implementation:
  rtl.module('<unitname>',
     [<interface uses1>,<uses2>, ...],
@@ -8136,6 +8192,7 @@ begin
     ModScope:=nil;
   OuterSrc:=TJSSourceElements(CreateElement(TJSSourceElements, El));
   Result:=OuterSrc;
+  IntfContext:=nil;
   ok:=false;
   try
     // create 'rtl.module(...)'
@@ -8145,7 +8202,7 @@ begin
     ArgArray := RegModuleCall.Args;
     RegModuleCall.Args:=ArgArray;
 
-    // add unitname parameter: unitname
+    // add module name parameter
     ModuleName:=TransformModuleName(El,false,AContext);
     ArgArray.Elements.AddElement.Expr:=CreateLiteralString(El,ModuleName);
 
@@ -8183,95 +8240,88 @@ begin
       IntfContext:=TInterfaceSectionContext.Create(El,Src,AContext)
     else
       IntfContext:=TSectionContext.Create(El,Src,AContext);
-    try
-      // add "var $mod = this;"
-      IntfContext.ThisVar.Element:=El;
-      IntfContext.ThisVar.Kind:=cvkGlobal;
-      if El.CustomData is TPasModuleScope then
-        IntfContext.ScannerBoolSwitches:=TPasModuleScope(El.CustomData).BoolSwitches;
-      ModVarName:=GetBIName(pbivnModule);
-      IntfContext.AddLocalVar(ModVarName,El,cvkGlobal,false);
-      AddToSourceElements(Src,CreateVarStatement(ModVarName,
-        CreatePrimitiveDotExpr('this',El),El));
-
-      if (ModScope<>nil) then
-        RestoreImplJSLocals(ModScope,IntfContext);
-
-      if (El is TPasProgram) then
-        begin // program
-        Prg:=TPasProgram(El);
-        if Assigned(Prg.ProgramSection) then
-          AddToSourceElements(Src,ConvertDeclarations(Prg.ProgramSection,IntfContext));
-        AddDelayedInits(Prg,Src,IntfContext);
-        CreateInitSection(Prg,Src,IntfContext);
-        end
-      else if El is TPasLibrary then
-        begin // library
-        Lib:=TPasLibrary(El);
-        if Assigned(Lib.LibrarySection) then
-          AddToSourceElements(Src,ConvertDeclarations(Lib.LibrarySection,IntfContext));
-        // ToDo AddDelayedInits(Lib,Src,IntfContext);
-        CreateInitSection(Lib,Src,IntfContext);
-        end
-      else
-        begin // unit
-        IntfSecCtx:=TInterfaceSectionContext(IntfContext);
-        if Assigned(El.ImplementationSection) then
-          begin
-          // add var $impl = $mod.$impl
-          ImplVarSt:=CreateVarStatement(GetBIName(pbivnImplementation),
-            CreateMemberExpression([ModVarName,GetBIName(pbivnImplementation)]),El);
-          AddToSourceElements(Src,ImplVarSt);
-          // register local var $impl
-          IntfSecCtx.AddLocalVar(GetBIName(pbivnImplementation),El.ImplementationSection,cvkGlobal,false);
-          end;
-        if Assigned(El.InterfaceSection) then
-          AddToSourceElements(Src,ConvertDeclarations(El.InterfaceSection,IntfSecCtx));
-
-        ImplFunc:=CreateImplementationSection(El,IntfSecCtx);
-        // add $mod.$implcode = ImplFunc;
-        AssignSt:=TJSSimpleAssignStatement(CreateElement(TJSSimpleAssignStatement,El));
-        AssignSt.LHS:=CreateMemberExpression([ModVarName,GetBIName(pbivnImplCode)]);
-        AssignSt.Expr:=ImplFunc;
-        AddToSourceElements(Src,AssignSt);
+    // add "var $mod = this;"
+    IntfContext.ThisVar.Element:=El;
+    IntfContext.ThisVar.Kind:=cvkGlobal;
+    if El.CustomData is TPasModuleScope then
+      IntfContext.ScannerBoolSwitches:=TPasModuleScope(El.CustomData).BoolSwitches;
+    ModVarName:=GetBIName(pbivnModule);
+    IntfContext.AddLocalVar(ModVarName,El,cvkGlobal,false);
+    AddToSourceElements(Src,CreateVarStatement(ModVarName,
+      CreatePrimitiveDotExpr('this',El),El));
+
+    if (ModScope<>nil) then
+      RestoreImplJSLocals(ModScope,IntfContext);
 
-        // append initialization section
-        CreateInitSection(El,Src,IntfSecCtx);
+    if (El is TPasProgram) then
+      begin // program
+      Prg:=TPasProgram(El);
+      if Assigned(Prg.ProgramSection) then
+        AddToSourceElements(Src,ConvertDeclarations(Prg.ProgramSection,IntfContext));
+      AddDelayedInits(Prg,Src,IntfContext);
+      CreateInitSection(Prg,Src,IntfContext);
+      end
+    else if El is TPasLibrary then
+      begin // library
+      Lib:=TPasLibrary(El);
+      if Assigned(Lib.LibrarySection) then
+        AddToSourceElements(Src,ConvertDeclarations(Lib.LibrarySection,IntfContext));
+      AddDelayedInits(Lib,Src,IntfContext);
+      CreateInitSection(Lib,Src,IntfContext);
+      // ToDo: append exports
+      end
+    else
+      begin // unit
+      IntfSecCtx:=TInterfaceSectionContext(IntfContext);
+      if Assigned(El.ImplementationSection) then
+        begin
+        // add var $impl = $mod.$impl
+        ImplVarSt:=CreateVarStatement(GetBIName(pbivnImplementation),
+          CreateMemberExpression([ModVarName,GetBIName(pbivnImplementation)]),El);
+        AddToSourceElements(Src,ImplVarSt);
+        // register local var $impl
+        IntfSecCtx.AddLocalVar(GetBIName(pbivnImplementation),El.ImplementationSection,cvkGlobal,false);
+        end;
+      if Assigned(El.InterfaceSection) then
+        AddToSourceElements(Src,ConvertDeclarations(El.InterfaceSection,IntfSecCtx));
+
+      ImplFunc:=CreateImplementationSection(El,IntfSecCtx);
+      // add $mod.$implcode = ImplFunc;
+      AssignSt:=TJSSimpleAssignStatement(CreateElement(TJSSimpleAssignStatement,El));
+      AssignSt.LHS:=CreateMemberExpression([ModVarName,GetBIName(pbivnImplCode)]);
+      AssignSt.Expr:=ImplFunc;
+      AddToSourceElements(Src,AssignSt);
 
-        if TJSSourceElements(ImplFunc.AFunction.Body.A).Statements.Count=0 then
-          begin
-          // empty implementation
-
-          // remove unneeded $impl from interface
-          RemoveFromSourceElements(Src,ImplVarSt);
-          // remove unneeded $mod.$implcode = function(){}
-          RemoveFromSourceElements(Src,AssignSt);
-          HasImplUsesClause:=(El.ImplementationSection<>nil)
-                         and (length(El.ImplementationSection.UsesClause)>0);
-          end
-        else
-          begin
-          HasImplUsesClause:=true;
-          end;
+      // append initialization section
+      CreateInitSection(El,Src,IntfSecCtx);
 
-        if HasImplUsesClause then
-          // add implementation uses list: [<implementation uses1>,<uses2>, ...]
-          ArgArray.AddElement(CreateUsesList(El.ImplementationSection,AContext));
+      if TJSSourceElements(ImplFunc.AFunction.Body.A).Statements.Count=0 then
+        begin
+        // empty implementation
 
+        // remove unneeded $impl from interface
+        RemoveFromSourceElements(Src,ImplVarSt);
+        // remove unneeded $mod.$implcode = function(){}
+        RemoveFromSourceElements(Src,AssignSt);
+        HasImplUsesClause:=(El.ImplementationSection<>nil)
+                       and (length(El.ImplementationSection.UsesClause)>0);
+        end
+      else
+        begin
+        HasImplUsesClause:=true;
         end;
 
-      if (ModScope<>nil) and (coStoreImplJS in Options) then
-        StoreImplJSLocals(ModScope,IntfContext);
-    finally
-      IntfContext.Free;
-    end;
+      if HasImplUsesClause then
+        // add implementation uses list: [<implementation uses1>,<uses2>, ...]
+        ArgArray.AddElement(CreateUsesList(El.ImplementationSection,AContext));
 
-    // add implementation function
-    if ImplVarSt<>nil then
-      begin
-      end;
+      end; // end unit
+
+    if (ModScope<>nil) and (coStoreImplJS in Options) then
+      StoreImplJSLocals(ModScope,IntfContext);
     ok:=true;
   finally
+    IntfContext.Free;
     if not ok then
       FreeAndNil(Result);
   end;
@@ -15397,6 +15447,8 @@ begin
         end
       else if C=TPasAttributes then
         continue
+      else if C=TPasExportSymbol then
+        continue
       else
         RaiseNotSupported(P as TPasElement,AContext,20161024191434);
       Add(E,P);
@@ -17148,11 +17200,21 @@ begin
     Scope:=nil;
     end;
 
-  IsMain:=(El is TPasProgram);
-  if IsMain then
+  if El.ClassType=TPasProgram then
+    begin
+    IsMain:=true;
     FunName:=GetBIName(pbifnProgramMain)
+    end
+  else if El.ClassType=TPasLibrary then
+    begin
+    IsMain:=true;
+    FunName:=GetBIName(pbifnLibraryMain)
+    end
   else
+    begin
+    IsMain:=false;
     FunName:=GetBIName(pbifnUnitInit);
+    end;
   NeedRTLCheckVersion:=IsMain and (coRTLVersionCheckMain in Options);
 
   RootContext:=AContext.GetRootContext as TRootContext;
@@ -17680,7 +17742,7 @@ begin
   IntfSec.AddImplHeaderStatement(JS);
 end;
 
-procedure TPasToJSConverter.AddDelayedInits(El: TPasProgram;
+procedure TPasToJSConverter.AddDelayedInits(El: TPasModule;
   Src: TJSSourceElements; AContext: TConvertContext);
 var
   aResolver: TPas2JSResolver;
@@ -26617,8 +26679,10 @@ begin
     if Result<>'' then
       exit;
     end;
-  if El is TPasProgram then
-    Result:='program'
+  if El.ClassType=TPasProgram then
+    Result:=GetBIName(pbivnProgram)
+  else if El.ClassType=TPasLibrary then
+    Result:=GetBIName(pbivnLibrary)
   else
     begin
     Result:='';

packages/pastojs/tests/tcmodules.pas

@@ -125,6 +125,7 @@ type
     FModules: TObjectList;// list of TTestEnginePasResolver
     FParser: TTestPasParser;
     FPasProgram: TPasProgram;
+    FPasLibrary: TPasLibrary;
     FHintMsgs: TObjectList; // list of TTestHintMessage
     FHintMsgsGood: TFPList; // list of TTestHintMessage marked as expected
     FJSRegModuleCall: TJSCallExpression;
@@ -157,6 +158,7 @@ type
     procedure ParseModuleQueue; virtual;
     procedure ParseModule; virtual;
     procedure ParseProgram; virtual;
+    procedure ParseLibrary; virtual;
     procedure ParseUnit; virtual;
   protected
     function FindModuleWithFilename(aFilename: string): TTestEnginePasResolver; virtual;
@@ -166,9 +168,11 @@ type
       ImplementationSrc: string): TTestEnginePasResolver; virtual;
     procedure AddSystemUnit(Parts: TSystemUnitParts = []); virtual;
     procedure StartProgram(NeedSystemUnit: boolean; SystemUnitParts: TSystemUnitParts = []); virtual;
+    procedure StartLibrary(NeedSystemUnit: boolean; SystemUnitParts: TSystemUnitParts = []); virtual;
     procedure StartUnit(NeedSystemUnit: boolean; SystemUnitParts: TSystemUnitParts = []); virtual;
     procedure ConvertModule; virtual;
     procedure ConvertProgram; virtual;
+    procedure ConvertLibrary; virtual;
     procedure ConvertUnit; virtual;
     function ConvertJSModuleToString(El: TJSElement): string; virtual;
     procedure CheckDottedIdentifier(Msg: string; El: TJSElement; DottedName: string);
@@ -196,6 +200,7 @@ type
     function GetResolver(const Filename: string): TTestEnginePasResolver;
     function GetDefaultNamespace: string;
     property PasProgram: TPasProgram Read FPasProgram;
+    property PasLibrary: TPasLibrary Read FPasLibrary;
     property Resolvers[Index: integer]: TTestEnginePasResolver read GetResolvers;
     property ResolverCount: integer read GetResolverCount;
     property Engine: TTestEnginePasResolver read FEngine;
@@ -894,6 +899,12 @@ type
     Procedure TestAsync_Inherited;
     Procedure TestAsync_ClassInterface;
     Procedure TestAsync_ClassInterface_AsyncMissmatchFail;
+
+    // Library
+    Procedure TestLibrary_Empty;
+    Procedure TestLibrary_ExportFunc; // ToDo
+    // ToDo: test delayed specialization init
+    // ToDO: analyzer
   end;
 
 function LinesToStr(Args: array of const): string;
@@ -1587,6 +1598,22 @@ begin
       FFirstPasStatement:=TPasImplBlock(PasProgram.InitializationSection.Elements[0]);
 end;
 
+procedure TCustomTestModule.ParseLibrary;
+var
+  Init: TInitializationSection;
+begin
+  if SkipTests then exit;
+  ParseModule;
+  if SkipTests then exit;
+  AssertEquals('Has library',TPasLibrary,Module.ClassType);
+  FPasLibrary:=TPasLibrary(Module);
+  AssertNotNull('Has library section',PasLibrary.LibrarySection);
+  Init:=PasLibrary.InitializationSection;
+  if (Init<>nil) and (Init.Elements.Count>0) then
+    if TObject(Init.Elements[0]) is TPasImplBlock then
+      FFirstPasStatement:=TPasImplBlock(PasLibrary.InitializationSection.Elements[0]);
+end;
+
 procedure TCustomTestModule.ParseUnit;
 begin
   if SkipTests then exit;
@@ -1869,6 +1896,17 @@ begin
   Add('');
 end;
 
+procedure TCustomTestModule.StartLibrary(NeedSystemUnit: boolean;
+  SystemUnitParts: TSystemUnitParts);
+begin
+  if NeedSystemUnit then
+    AddSystemUnit(SystemUnitParts)
+  else
+    Parser.ImplicitUses.Clear;
+  Add('library '+ExtractFileUnitName(Filename)+';');
+  Add('');
+end;
+
 procedure TCustomTestModule.StartUnit(NeedSystemUnit: boolean;
   SystemUnitParts: TSystemUnitParts);
 begin
@@ -1974,6 +2012,8 @@ begin
   AssertEquals('module name param is string',ord(jstString),ord(ModuleNameExpr.Value.ValueType));
   if Module is TPasProgram then
     AssertEquals('module name','program',String(ModuleNameExpr.Value.AsString))
+  else if Module is TPasLibrary then
+    AssertEquals('module name','library',String(ModuleNameExpr.Value.AsString))
   else
     AssertEquals('module name',Module.Name,String(ModuleNameExpr.Value.AsString));
 
@@ -1990,7 +2030,7 @@ begin
   CheckFunctionParam('module intf-function',Arg,FJSModuleSrc);
 
   // search for $mod.$init or $mod.$main - the last statement
-  if Module is TPasProgram then
+  if (Module is TPasProgram) or (Module is TPasLibrary) then
     begin
     InitName:='$main';
     AssertEquals('$mod.'+InitName+' function 1',true,JSModuleSrc.Statements.Count>0);
@@ -2009,7 +2049,7 @@ begin
         InitFunction:=InitAssign.Expr as TJSFunctionDeclarationStatement;
         FJSInitBody:=InitFunction.AFunction.Body as TJSFunctionBody;
         end
-      else if Module is TPasProgram then
+      else if (Module is TPasProgram) or (Module is TPasLibrary) then
         CheckDottedIdentifier('init function',InitAssign.LHS,'$mod.'+InitName);
       end;
     end;
@@ -2028,6 +2068,13 @@ begin
   ConvertModule;
 end;
 
+procedure TCustomTestModule.ConvertLibrary;
+begin
+  Add('end.');
+  ParseLibrary;
+  ConvertModule;
+end;
+
 procedure TCustomTestModule.ConvertUnit;
 begin
   Add('end.');
@@ -2089,7 +2136,7 @@ begin
   // program main or unit initialization
   if (Module is TPasProgram) or (Trim(InitStatements)<>'') then
     begin
-    if Module is TPasProgram then
+    if (Module is TPasProgram) or (Module is TPasLibrary) then
       InitName:='$main'
     else
       InitName:='$init';
@@ -33110,6 +33157,42 @@ begin
   ConvertProgram;
 end;
 
+procedure TTestModule.TestLibrary_Empty;
+begin
+  StartLibrary(false);
+  Add([
+  '']);
+  ConvertLibrary;
+  CheckSource('TestLibrary_Empty',
+    LinesToStr([ // statements
+    '']),
+    LinesToStr([
+    '']));
+  CheckResolverUnexpectedHints();
+end;
+
+procedure TTestModule.TestLibrary_ExportFunc;
+begin
+  exit;
+
+  StartLibrary(false);
+  Add([
+  'procedure Run(w: word);',
+  'begin',
+  'end;',
+  'exports',
+  '  Run,',
+  '  run name ''Foo'';',
+  '']);
+  ConvertLibrary;
+  CheckSource('TestLibrary_ExportFunc',
+    LinesToStr([ // statements
+    '']),
+    LinesToStr([
+    '']));
+  CheckResolverUnexpectedHints();
+end;
+
 Initialization
   RegisterTests([TTestModule]);
 end.