diff --git a/FPCTests/fpcunitproject1.lpi b/FPCTests/fpcunitproject1.lpi index 752ce22..9b72ff3 100644 --- a/FPCTests/fpcunitproject1.lpi +++ b/FPCTests/fpcunitproject1.lpi @@ -39,7 +39,7 @@ - + @@ -50,9 +50,13 @@ - + + + + + @@ -60,11 +64,11 @@ - + - + @@ -74,6 +78,9 @@ + + + diff --git a/FPCTests/fpcunitproject1.lps b/FPCTests/fpcunitproject1.lps index fe6d19e..c799b8e 100644 --- a/FPCTests/fpcunitproject1.lps +++ b/FPCTests/fpcunitproject1.lps @@ -4,37 +4,217 @@ - + - - + + - - - - - + + + + + - + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + - - - - + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + diff --git a/FPCTests/test b/FPCTests/test new file mode 100644 index 0000000..aa6f417 Binary files /dev/null and b/FPCTests/test differ diff --git a/FPCTests/testcase1.pas b/FPCTests/testcase1.pas index fddc963..89dce5a 100644 --- a/FPCTests/testcase1.pas +++ b/FPCTests/testcase1.pas @@ -5,7 +5,7 @@ unit TestCase1; interface uses - Classes, SysUtils, fpcunit, testutils, testregistry,Fasm4Delphi; + Classes, SysUtils, fpcunit, testutils, testregistry,FasmOnDelphi; type @@ -16,36 +16,35 @@ type implementation -const - CompliterMemSize=$10000; - -var - CompliterMem:PFASM_STATE; - procedure TTestCase1.TestHookUp; +var + Res:TFasmResult; begin - if fasm_AssembleFile('..\Tests\Test1.asm',CompliterMem,CompliterMemSize)<>FASM_OK then - Fail('Error in test1:'+sLineBreak+ - 'Condition: '+CompliterMem^.condition.ToString+sLineBreak+ - 'Error Code: '+CompliterMem^.error_code.ToString); - if fasm_Assemble('add eax,0',CompliterMem,CompliterMemSize)<>FASM_OK then - writeln('Error in test2:'+sLineBreak+ - 'Condition: '+CompliterMem^.condition.ToString+sLineBreak+ - 'Error Code: '+CompliterMem^.error_code.ToString); - if fasm_AssembleFile('..\FasmDll\FASM.ASH',CompliterMem,CompliterMemSize)=FASM_OK then - Fail('Error in test3:'+sLineBreak+ - 'FASM is compiling something that it is can not compile at all.'); - if fasm_Assemble('call -100',CompliterMem,CompliterMemSize)<>FASM_OK then - Fail('Error in test4:'+sLineBreak+ - 'Condition: '+CompliterMem^.condition.ToString+sLineBreak+ - 'Error Code: '+CompliterMem^.error_code.ToString); +Res:=FasmAssembleFileToFile('..\Tests\Test1.ASM','..\Tests\Test1.bin'); +if Res.Error<>FASM_OK then + Fail('Error in test1:'+sLineBreak+ + 'Condition: '+Res.OutStr+sLineBreak+ + 'Error Code: '+IntToStr(Res.Error)+sLineBreak); +Res:=FasmAssemble('add eax,0'); +if Res.Error<>FASM_OK then + Fail('Error in test2:'+sLineBreak+ + 'Condition: '+Res.OutStr+sLineBreak+ + 'Error Code: '+IntToStr(Res.Error)+sLineBreak); +Res:=FasmAssembleFile('..\Fasm4Delphi\FasmDll\FASM.ASH'); +if Res.Error=FASM_OK then + Fail('Error in test3:'+sLineBreak+ + 'FASM is compiling something that it is can not compile at all.'); +Res:=FasmAssembleToFile('add eax,0','test'); +if Res.Error<>FASM_OK then + Fail('Error in test4:'+sLineBreak+ + 'Condition: '+Res.OutStr+sLineBreak+ + 'Error Code:'+IntToStr(Res.Error)+sLineBreak); end; initialization - LoadFASM('..\FasmDll\FASM.DLL'); - GetMem(CompliterMem,CompliterMemSize); + OpenFASM('..\fasmw172\FASM.EXE'); RegisterTest(TTestCase1); end. diff --git a/Source/FasmOnDelphi.pas b/Source/FasmOnDelphi.pas index 80e0b98..3e1c173 100644 --- a/Source/FasmOnDelphi.pas +++ b/Source/FasmOnDelphi.pas @@ -1,4 +1,4 @@ -unit FasmOnDelphi platform; +unit FasmOnDelphi; {Delphi Translation&Tests:Artyom Gavrilov,Vlad Untkin. Donate:https://money.yandex.ru/to/410014959153552} @@ -20,9 +20,9 @@ interface {$ENDIF} uses - System.SysUtils, + SysUtils, {$IFDEF USEFasm4Delphi}Fasm4Delphi,{$ENDIF} - {$IFDEF USEIOUtils}System.IOUtils{$ENDIF},Windows,Math; + {$IFDEF USEIOUtils}System.IOUtils,{$ENDIF}Windows,Math; type TFasmVersion={$IFDEF USEFasm4Delphi}Fasm4Delphi.TFasmVersion; @@ -178,12 +178,51 @@ procedure SetFasmTemp(Path:string); implementation +{$IFDEF FPC} +function GetLongPathNameA(lpszShortPath: LPSTR; lpszLongPath: LPSTR; + cchBuffer: DWORD): DWORD; stdcall;external 'Kernel32.dll'; + +function Pos(const SubStr,Str:AnsiString;Offset:Integer): Integer; overload; +var + I, LIterCnt, L, J: Integer; + PSubStr, PS: PAnsiChar; +begin + L := Length(SubStr); + { Calculate the number of possible iterations. Not valid if Offset < 1. } + LIterCnt := Length(Str) - Offset - L + 1; + + { Only continue if the number of iterations is positive or zero (there is space to check) } + if (Offset > 0) and (LIterCnt >= 0) and (L > 0) then + begin + PSubStr := PAnsiChar(SubStr); + PS := PAnsiChar(Str); + Inc(PS, Offset - 1); + + for I := 0 to LIterCnt do + begin + J := 0; + while (J >= 0) and (J < L) do + begin + if PS[I + J] = PSubStr[J] then + Inc(J) + else + J := -1; + end; + if J >= L then + Exit(I + Offset); + end; + end; + + Result := 0; +end; +{$ENDIF} + var FasmLocation:string='FASM'; FasmTemp:string; IsDll:boolean=false; -function RunFasm(Command:string):string; +function RunFasm(Command:AnsiString):string; var StartupInfo:TStartupInfo; ProcessInformation:TProcessInformation; @@ -227,7 +266,7 @@ var begin {$IFDEF USEFasm4Delphi} if IsDll then - Result:=fasm_GetVersion + Result:=fasm_GetVersion() else begin {$ENDIF} @@ -273,26 +312,26 @@ begin Result.Error:=fasm_Assemble(PAnsiChar(Source),Mem,cbMemorySize,nPassesLimit); if Result.Error=FASM_OK then begin - GetMem(Result.OutData,Mem.output_length); - CopyMemory(Result.OutData,Mem.output_data,Mem.output_length); - Result.sb:=Mem.output_length; + GetMem(Result.OutData,Mem^.output_length); + CopyMemory(Result.OutData,Mem^.output_data,Mem^.output_length); + Result.sb:=Mem^.output_length; Result.OutStr:='Success.'; end else begin Result.OutData:=nil; Result.sb:=0; - Result.OutStr:='Error: '+Mem.error_code.ToString+' '+FasmErrorCodeNames[Mem.error_code]; - p:=Mem.error_line; + Result.OutStr:='Error: '+Mem^.error_code.ToString+' '+FasmErrorCodeNames[Mem^.error_code]; + p:=Mem^.error_line; nr:=0; while(NativeUInt(p)>=NativeUInt(Mem))and(NativeUInt(Mem)+NativeUInt(cbMemorySize)>=NativeUInt(p))do begin Result.OutStr:=Result.OutStr+sLineBreak+ - string(p.file_path)+'['+p.line_number.ToString+']'; + string(p^.file_path)+'['+p^.line_number.ToString+']'; inc(nr); SetLength(Result.Lines,nr); - Result.Lines[nr-1].Line:=p.line_number; - Result.Lines[nr-1].&File:=string(p.file_path); + Result.Lines[nr-1].Line:=p^.line_number; + Result.Lines[nr-1].&File:=string(p^.file_path); p:=p^.macro_calling_line; end; end; @@ -318,7 +357,7 @@ begin Result.Error:=i0; if Result.Error=FASM_OK then begin - FileHandle:=CreateFile(PWideChar(s),GENERIC_READ,0,nil,3,128,0); + FileHandle:=CreateFile(PChar(s),GENERIC_READ,0,nil,3,128,0); Result.sb:=GetFileSize(FileHandle,nil); getmem(Result.OutData,Result.sb); ReadFile(FileHandle,Result.OutData,Result.sb,nr,nil); @@ -375,24 +414,24 @@ begin Result.sb:=0; if Result.Error=FASM_OK then begin - FileHandle:=CreateFile(PWideChar(OutFile),GENERIC_READ,0,nil,3,128,0); - WriteFile(FileHandle,Mem.output_data^,Mem.output_length,nr,nil); + FileHandle:=CreateFile(PChar(OutFile),GENERIC_WRITE,0,nil,3,128,0); + WriteFile(FileHandle,Mem^.output_data^,Mem^.output_length,nr,nil); CloseHandle(FileHandle); Result.OutStr:='Success.'; end else begin - Result.OutStr:='Error: '+Mem.error_code.ToString+' '+FasmErrorCodeNames[Mem.error_code]; - p:=Mem.error_line; + Result.OutStr:='Error: '+Mem^.error_code.ToString+' '+FasmErrorCodeNames[Mem^.error_code]; + p:=Mem^.error_line; nr:=0; while(NativeUInt(p)>=NativeUInt(Mem))and(NativeUInt(Mem)+NativeUInt(cbMemorySize)>=NativeUInt(p))do begin Result.OutStr:=Result.OutStr+sLineBreak+ - string(p.file_path)+'['+p.line_number.ToString+']'; + string(p^.file_path)+'['+p^.line_number.ToString+']'; inc(nr); SetLength(Result.Lines,nr); - Result.Lines[nr-1].Line:=p.line_number; - Result.Lines[nr-1].&File:=string(p.file_path); + Result.Lines[nr-1].Line:=p^.line_number; + Result.Lines[nr-1].&File:=string(p^.file_path); p:=p^.macro_calling_line; end; end; @@ -464,26 +503,26 @@ begin Result.Error:=fasm_AssembleFile(PAnsiChar(Source),Mem,cbMemorySize,nPassesLimit); if Result.Error=FASM_OK then begin - GetMem(Result.OutData,Mem.output_length); - CopyMemory(Result.OutData,Mem.output_data,Mem.output_length); - Result.sb:=Mem.output_length; + GetMem(Result.OutData,Mem^.output_length); + CopyMemory(Result.OutData,Mem^.output_data,Mem^.output_length); + Result.sb:=Mem^.output_length; Result.OutStr:='Success.'; end else begin Result.OutData:=nil; Result.sb:=0; - Result.OutStr:='Error: '+Mem.error_code.ToString+' '+FasmErrorCodeNames[Mem.error_code]; - p:=Mem.error_line; + Result.OutStr:='Error: '+Mem^.error_code.ToString+' '+FasmErrorCodeNames[Mem^.error_code]; + p:=Mem^.error_line; nr:=0; while(NativeUInt(p)>=NativeUInt(Mem))and(NativeUInt(Mem)+NativeUInt(cbMemorySize)>=NativeUInt(p))do begin Result.OutStr:=Result.OutStr+sLineBreak+ - string(p.file_path)+'['+p.line_number.ToString+']'; + string(p^.file_path)+'['+p^.line_number.ToString+']'; inc(nr); SetLength(Result.Lines,nr); - Result.Lines[nr-1].Line:=p.line_number; - Result.Lines[nr-1].&File:=string(p.file_path); + Result.Lines[nr-1].Line:=p^.line_number; + Result.Lines[nr-1].&File:=string(p^.file_path); p:=p^.macro_calling_line; end; end; @@ -505,7 +544,7 @@ begin Result.Error:=i0; if Result.Error=FASM_OK then begin - FileHandle:=CreateFile(PWideChar(s),GENERIC_READ,0,nil,3,128,0); + FileHandle:=CreateFile(PChar(s),GENERIC_READ,0,nil,3,128,0); Result.sb:=GetFileSize(FileHandle,nil); getmem(Result.OutData,Result.sb); ReadFile(FileHandle,Result.OutData,Result.sb,nr,nil); @@ -562,8 +601,8 @@ begin Result.sb:=0; if Result.Error=FASM_OK then begin - FileHandle:=CreateFile(PWideChar(OutFile),GENERIC_READ,0,nil,3,128,0); - WriteFile(FileHandle,Mem.output_data^,Mem.output_length,nr,nil); + FileHandle:=CreateFile(PChar(OutFile),GENERIC_READ,0,nil,3,128,0); + WriteFile(FileHandle,Mem^.output_data^,Mem^.output_length,nr,nil); CloseHandle(FileHandle); Result.OutStr:='Success.'; end @@ -571,17 +610,17 @@ begin begin Result.OutData:=nil; Result.sb:=0; - Result.OutStr:='Error: '+Mem.error_code.ToString+' '+FasmErrorCodeNames[Mem.error_code]; - p:=Mem.error_line; + Result.OutStr:='Error: '+Mem^.error_code.ToString+' '+FasmErrorCodeNames[Mem^.error_code]; + p:=Mem^.error_line; nr:=0; while(NativeUInt(p)>=NativeUInt(Mem))and(NativeUInt(Mem)+NativeUInt(cbMemorySize)>=NativeUInt(p))do begin Result.OutStr:=Result.OutStr+sLineBreak+ - string(p.file_path)+'['+p.line_number.ToString+']'; + string(p^.file_path)+'['+p^.line_number.ToString+']'; inc(nr); SetLength(Result.Lines,nr); - Result.Lines[nr-1].Line:=p.line_number; - Result.Lines[nr-1].&File:=string(p.file_path); + Result.Lines[nr-1].Line:=p^.line_number; + Result.Lines[nr-1].&File:=string(p^.file_path); p:=p^.macro_calling_line; end; end; @@ -658,12 +697,12 @@ initialization {$IFDEF FPC} {$IFDEF WINDOWS} begin - SetLength(Result,MAX_PATH); + SetLength(FasmTemp,MAX_PATH); Len:=GetTempPath(MAX_PATH,PChar(FasmTemp)); if Len<>0 then begin - Len:=GetLongPathName(PChar(FasmTemp),nil,0); - GetLongPathName(PChar(FasmTemp),PChar(FasmTemp),Len); + Len:=GetLongPathNameA(PChar(FasmTemp),nil,0); + GetLongPathNameA(PChar(FasmTemp),PChar(FasmTemp),Len); SetLength(FasmTemp,Len-1); end else diff --git a/Tests/Test1..bin b/Tests/Test1.bin similarity index 100% rename from Tests/Test1..bin rename to Tests/Test1.bin diff --git a/Tests/TesterMain.pas b/Tests/TesterMain.pas index 6f5263d..a074c8d 100644 --- a/Tests/TesterMain.pas +++ b/Tests/TesterMain.pas @@ -22,12 +22,6 @@ type [Test] procedure Test4; end; - -const - CompliterMemSize=$10000; - -var - CompliterMem:PFASM_STATE; implementation @@ -45,8 +39,8 @@ var begin Res:=FasmAssembleFileToFile('..\..\Test1.ASM','..\..\Test1..bin'); if Res.Error<>FASM_OK then - raise Exception.Create('Condition: '+CompliterMem^.condition.ToString+sLineBreak+ - 'Error Code: '+CompliterMem^.error_code.ToString+sLineBreak); + raise Exception.Create('Condition: '+Res.OutStr+sLineBreak+ + 'Error Code: '+IntToStr(Res.Error)+sLineBreak); end; procedure TMyTestObject.Test2; @@ -74,12 +68,11 @@ var begin Res:=FasmAssembleToFile('add eax,0','test'); if Res.Error<>FASM_OK then - raise Exception.Create('Condition: '+Res.OutStr+sLineBreak+ - 'Error Code: '+IntToStr(Res.Error)+sLineBreak); + raise Exception.Create('Condition: '+Res.OutStr+sLineBreak+ + 'Error Code:'+IntToStr(Res.Error)+sLineBreak); end; initialization TDUnitX.RegisterTestFixture(TMyTestObject); OpenFASM('..\..\..\fasmw172\FASM.EXE'); - GetMem(CompliterMem,CompliterMemSize); end.