diff options
author | michael <michael@3ad0048d-3df7-0310-abae-a5850022a9f2> | 2020-08-23 09:46:29 +0000 |
---|---|---|
committer | michael <michael@3ad0048d-3df7-0310-abae-a5850022a9f2> | 2020-08-23 09:46:29 +0000 |
commit | 64879abc095afb176b009c7b9d09e703d740dbed (patch) | |
tree | 2bd13bf675a7eb6825e4aa0601f8dfb0113c90ef /utils | |
parent | 0e6d341b3ff0e4f0912d9394f71796d9e6a443de (diff) | |
download | fpc-64879abc095afb176b009c7b9d09e703d740dbed.tar.gz |
* Merging revisions r46442 from trunk:
------------------------------------------------------------------------
r46442 | michael | 2020-08-15 09:26:44 +0200 (Sat, 15 Aug 2020) | 1 line
* unit alias possibility
------------------------------------------------------------------------
git-svn-id: https://svn.freepascal.org/svn/fpc/branches/fixes_3_2@46623 3ad0048d-3df7-0310-abae-a5850022a9f2
Diffstat (limited to 'utils')
-rw-r--r-- | utils/pas2js/libstub.pp | 9 | ||||
-rw-r--r-- | utils/pas2js/stubcreator.pp | 38 |
2 files changed, 42 insertions, 5 deletions
diff --git a/utils/pas2js/libstub.pp b/utils/pas2js/libstub.pp index f8d3a9eb1f..5235f0bd5b 100644 --- a/utils/pas2js/libstub.pp +++ b/utils/pas2js/libstub.pp @@ -147,6 +147,12 @@ begin Move(C[1],AErrorClass^,L); end; +Procedure SetStubCreatorUnitAliasCallBack(P : PStubCreator; ACallBack : TUnitAliasCallBack; CallBackData : Pointer); stdcall; +begin + TStubCreator(P).OnUnitAlias:=ACallBack; + TStubCreator(P).OnUnitAliasData:=CallBackData; +end; + exports // Stub creator GetStubCreator, @@ -160,7 +166,8 @@ exports GetStubCreatorLastError, AddStubCreatorDefine, AddStubCreatorForwardClass, - ExecuteStubCreator; + ExecuteStubCreator, + SetStubCreatorUnitAliasCallBack; end. diff --git a/utils/pas2js/stubcreator.pp b/utils/pas2js/stubcreator.pp index f4a71ca437..39e0ce4aec 100644 --- a/utils/pas2js/stubcreator.pp +++ b/utils/pas2js/stubcreator.pp @@ -36,6 +36,8 @@ type TWriteCallBack = Procedure (Data : Pointer; AFileData : PAnsiChar; AFileDataLen: Int32); stdcall; TWriteEvent = Procedure(AFileData : String) of object; + TUnitAliasCallBack = Function (Data: Pointer; AUnitName: PAnsiChar; + var AUnitNameMaxLen: Int32): boolean; {$IFDEF UseCDecl}cdecl{$ELSE}stdcall{$ENDIF}; { TStubCreator } @@ -45,6 +47,7 @@ type FHeaderStream: TStream; FIncludePaths: TStrings; FInputFile: String; + FOnUnitAliasData: Pointer; FOnWrite: TWriteEvent; FOnWriteCallBack: TWriteCallBack; FOutputFile: String; @@ -60,10 +63,12 @@ type FCallBackData : Pointer; FLastErrorClass : String; FLastError : String; + FOnUnitAlias : TUnitAliasCallBack; procedure SetDefines(AValue: TStrings); procedure SetIncludePaths(AValue: TStrings); procedure SetOnWrite(AValue: TWriteEvent); procedure SetWriteCallback(AValue: TWriteCallBack); + function CheckUnitAlias(const AUnitName: String): String; Protected procedure DoExecute;virtual; Procedure DoWriteEvent; virtual; @@ -81,9 +86,10 @@ type // OutputStream can be used combined with write callbacks. Property OutputStream : TStream Read FOutputStream Write FOutputStream; Property HeaderStream : TStream Read FHeaderStream Write FHeaderStream; + Property OnUnitAlias: TUnitAliasCallBack read FOnUnitAlias Write FOnUnitAlias; + Property OnUnitAliasData : Pointer Read FOnUnitAliasData Write FOnUnitAliasData; Property OnWriteCallBack : TWriteCallBack Read FOnWriteCallBack Write SetWriteCallback; Property CallbackData : Pointer Read FCallBackData Write FCallBackData; - Published Property Defines : TStrings Read FDefines Write SetDefines; Property ConfigFileName : String Read FConfigFile Write FConfigFile; @@ -97,6 +103,8 @@ type Implementation +uses Math; + ResourceString SErrNoDestGiven = 'No destination file specified.'; SErrNoSourceParsed = 'Parsing produced no file.'; @@ -131,6 +139,23 @@ begin FWriteStream:=TStringStream.Create(''); end; +function TStubCreator.CheckUnitAlias(const AUnitName: String): String; +const + MAX_UNIT_NAME_LENGTH = 255; + +var + UnitMaxLenthName: Integer; + +begin + Result := AUnitName; + UnitMaxLenthName := Max(MAX_UNIT_NAME_LENGTH, Result.Length); + + SetLength(Result, UnitMaxLenthName); + + if FOnUnitAlias(OnUnitAliasData, @Result[1], UnitMaxLenthName) then + Result := LeftStr(PChar(Result), UnitMaxLenthName); +end; + procedure TStubCreator.DoWriteEvent; Var @@ -279,7 +304,7 @@ end; -Function TStubCreator.GetModule : TPasModule; +function TStubCreator.GetModule: TPasModule; Var SE : TSimpleEngine; @@ -327,7 +352,8 @@ begin end; end; -function TStubCreator.MaybeGetFileStream(AStream: TStream; const AFileName: String; AfileMode : Word) : TStream; +function TStubCreator.MaybeGetFileStream(AStream: TStream; + const AFileName: String; aFileMode: Word): TStream; begin If Assigned(AStream) then Result:=AStream @@ -359,7 +385,7 @@ begin end; -procedure TStubCreator.WriteModule(M : TPAsModule); +procedure TStubCreator.WriteModule(M: TPasModule); Var F,H : TStream; @@ -386,6 +412,10 @@ begin W:=TPasWriter.Create(F); W.Options:=FOptions; U:=FExtraUnits; + + if Assigned(FOnUnitAlias) then + W.OnUnitAlias:=@CheckUnitAlias; + if Pos(LowerCase(DTypesUnit),LowerCase(U)) = 0 then begin if (U<>'') then |