diff options
author | mattias <mattias@3ad0048d-3df7-0310-abae-a5850022a9f2> | 2021-01-09 13:57:13 +0000 |
---|---|---|
committer | mattias <mattias@3ad0048d-3df7-0310-abae-a5850022a9f2> | 2021-01-09 13:57:13 +0000 |
commit | d053d76c532b1a71b0dc7e5b2b4b5d15c424083a (patch) | |
tree | ef89182e3a079a202b46b958a663d7ad3aadac90 /packages/pastojs | |
parent | bd6e523142cc3830eb1c517468ad08f943ac2849 (diff) | |
download | fpc-d053d76c532b1a71b0dc7e5b2b4b5d15c424083a.tar.gz |
pastojs: started library
git-svn-id: https://svn.freepascal.org/svn/fpc/trunk@48119 3ad0048d-3df7-0310-abae-a5850022a9f2
Diffstat (limited to 'packages/pastojs')
-rw-r--r-- | packages/pastojs/src/fppas2js.pp | 238 | ||||
-rw-r--r-- | packages/pastojs/tests/tcmodules.pas | 89 |
2 files changed, 237 insertions, 90 deletions
diff --git a/packages/pastojs/src/fppas2js.pp b/packages/pastojs/src/fppas2js.pp index 7d5d6756a7..fa6f7901b2 100644 --- a/packages/pastojs/src/fppas2js.pp +++ b/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:=''; diff --git a/packages/pastojs/tests/tcmodules.pas b/packages/pastojs/tests/tcmodules.pas index 1ab920c33a..84165e2168 100644 --- a/packages/pastojs/tests/tcmodules.pas +++ b/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. |