From a67e69ae28c02ffffd1f685224ddff064f6d93ea Mon Sep 17 00:00:00 2001 From: marco Date: Sun, 2 Jun 2019 10:18:01 +0000 Subject: [PATCH] --- Merging r42086 into '.': U packages/gdbint/src/gdbint.pp --- Recording mergeinfo for merge of r42086 into '.': U . --- Merging r42113 into '.': U packages/openssl/src/openssl.pas --- Recording mergeinfo for merge of r42113 into '.': G . --- Merging r42114 into '.': G packages/openssl/src/openssl.pas --- Recording mergeinfo for merge of r42114 into '.': G . --- Merging r42122 into '.': U packages/fcl-base/examples/README.txt A packages/fcl-base/examples/testappexit.pp --- Recording mergeinfo for merge of r42122 into '.': G . --- Merging r42123 into '.': G packages/fcl-base/examples/README.txt A packages/fcl-base/examples/demoio.pp --- Recording mergeinfo for merge of r42123 into '.': G . # revisions: 42086,42113,42114,42122,42123 git-svn-id: branches/fixes_3_2@42160 - --- .gitattributes | 2 + packages/fcl-base/examples/README.txt | 2 + packages/fcl-base/examples/demoio.pp | 27 +++++++++++++ packages/fcl-base/examples/testappexit.pp | 32 +++++++++++++++ packages/gdbint/src/gdbint.pp | 48 +++++++++++++++++++++++ packages/openssl/src/openssl.pas | 15 ++++++- 6 files changed, 125 insertions(+), 1 deletion(-) create mode 100644 packages/fcl-base/examples/demoio.pp create mode 100644 packages/fcl-base/examples/testappexit.pp diff --git a/.gitattributes b/.gitattributes index 18e3e5df1a..b85120e5a7 100644 --- a/.gitattributes +++ b/.gitattributes @@ -1864,6 +1864,7 @@ packages/fcl-base/examples/databom.txt svneol=native#text/plain packages/fcl-base/examples/dbugsrv.pp svneol=native#text/plain packages/fcl-base/examples/debugtest.pp svneol=native#text/plain packages/fcl-base/examples/decodeascii85.pp svneol=native#text/plain +packages/fcl-base/examples/demoio.pp svneol=native#text/plain packages/fcl-base/examples/dobserver.pp svneol=native#text/plain packages/fcl-base/examples/doecho.pp svneol=native#text/plain packages/fcl-base/examples/dparser.pp svneol=native#text/plain @@ -1913,6 +1914,7 @@ packages/fcl-base/examples/stringl.pp svneol=native#text/plain packages/fcl-base/examples/tarmakercons.pas svneol=native#text/plain packages/fcl-base/examples/tarmakerconsgzip.pas svneol=native#text/plain packages/fcl-base/examples/testapp.pp svneol=native#text/plain +packages/fcl-base/examples/testappexit.pp svneol=native#text/plain packages/fcl-base/examples/testbf.pp svneol=native#text/plain packages/fcl-base/examples/testbs.pp svneol=native#text/plain packages/fcl-base/examples/testcgi.html -text diff --git a/packages/fcl-base/examples/README.txt b/packages/fcl-base/examples/README.txt index 4a89f33250..e42bc8ee20 100644 --- a/packages/fcl-base/examples/README.txt +++ b/packages/fcl-base/examples/README.txt @@ -76,3 +76,5 @@ testtimer.pp Test for TFPTimer (MVC) testini.pp Test/Demo for inifiles, ReadSectionValues. contit.pp Test/Demo for iterators in contnr.pp csvbom.pp Test/Demo for BOM detection in CSV document. (needs databom.txt) +testappexit.pp Test/Demo for TApplication exit code handling. (ExitCode and ExceptionExitcode) +demoio.pp Demo for AssignStream from streamio unit. \ No newline at end of file diff --git a/packages/fcl-base/examples/demoio.pp b/packages/fcl-base/examples/demoio.pp new file mode 100644 index 0000000000..9270b1d61e --- /dev/null +++ b/packages/fcl-base/examples/demoio.pp @@ -0,0 +1,27 @@ +program demoio; + +{$mode objfpc} +{$h+} +uses streamio, classes; + +Var + S : TStringStream; + F : Text; + a,b,c : Integer; + +begin + a:=1; + b:=2; + c:=a+b; + S:=TStringStream.Create(''); + try + AssignStream(F,S); + Rewrite(F); + Writeln(F,'Hello World !'); + Writeln(F,a:3,b:3,c:3); + CloseFile(F); + Writeln(S.DataString); + finally + S.Free; + end; +end. \ No newline at end of file diff --git a/packages/fcl-base/examples/testappexit.pp b/packages/fcl-base/examples/testappexit.pp new file mode 100644 index 0000000000..6ae9594761 --- /dev/null +++ b/packages/fcl-base/examples/testappexit.pp @@ -0,0 +1,32 @@ +program testappexit; + +uses sysutils,custapp; + +type + TApplication = Class(TCustomApplication) + Procedure DoRun; override; + end; + +Procedure TApplication.DoRun; + +begin + ExceptionExitCode:=9; + If ParamStr(1)='-h' then + Terminate(10) + else if Paramstr(1)='-e' then + Raise Exception.Create('Stopping with exception') + else + Writeln('Normal stop'); + Terminate; +end; + +begin + With TApplication.Create(Nil) do + try + StopOnException:=True; + Initialize; + Run; + finally + Free; + end; +end. \ No newline at end of file diff --git a/packages/gdbint/src/gdbint.pp b/packages/gdbint/src/gdbint.pp index cd25a289f5..90c9615b19 100644 --- a/packages/gdbint/src/gdbint.pp +++ b/packages/gdbint/src/gdbint.pp @@ -70,6 +70,9 @@ interface {$info using gdb 7.12.x} {$define GDB_VERSION_RECOGNIZED} {$define GDB_VER_GE_712} + {$define GDB_NO_INSTREAM_VAR} + {$define GDB_CURRENT_UIOUT_MACRO} + {$define GDB_NEW_UI} {$endif} {$ifdef GDB_VER_GE_712} @@ -81,6 +84,7 @@ interface {$info using gdb 7.11.x} {$define GDB_VERSION_RECOGNIZED} {$define GDB_VER_GE_711} + {$define GDB_HAS_SAVED_COMMAND_LINE_SIZE} {$endif} {$ifdef GDB_VER_GE_711} @@ -1009,6 +1013,32 @@ function inferior_pid : longint; {$ifdef GDB_V6} type ui_out = pointer; +{$ifdef GDB_CURRENT_UIOUT_MACRO} +type + pui_out = ^ui_out; +function current_ui_current_uiout_ptr : ui_out;cdecl;external; +var + cli_uiout : ui_out; + current_uiout : ui_out; + { out local copy for catch_exceptions call } + our_uiout : ui_out; + +type + pui = ^ui; + ui = record + { ui record } + next : pui; + num : longint; + end; + +{$ifdef GDB_NEW_UI} +var + local_ui : pui; + +function new_ui (instream, outstream,errstream: pui_file) : pui; cdecl;external; +{$endif GDB_NEW_UI} + +{$else not GDB_CURRENT_UIOUT_MACRO} {$ifndef GDB_NO_UIOUT} var uiout : ui_out;cvar;external; @@ -1019,6 +1049,7 @@ var { out local copy for catch_exceptions call } our_uiout : ui_out; {$endif GDB_NO_UIOUT} +{$endif not GDB_CURRENT_UIOUT_MACRO} function cli_out_new (stream : pui_file):ui_out;cdecl;external; {$endif GDB_V6} @@ -1838,16 +1869,23 @@ var {$endif GDB_HAS_DB_COMMANDS} {$ifdef GDB_NEEDS_SET_INSTREAM} +{$ifndef GDB_NO_INSTREAM_VAR} var instream : P_C_FILE;cvar;external; +{$endif not GDB_NO_INSTREAM_VAR} + function gdb_fopen (filename : pchar; mode : pchar) : pui_file;cdecl;external; {$ifdef LIBGDB_HAS_GET_STDIN} { this function is generated by the gen-libgdb-inc.sh script in a object called gdb_get_stdin.o added to the libgdb.a archive } function gdb_get_stdin : P_C_FILE; cdecl; external; +{$ifdef GDB_HAS_SAVED_COMMAND_LINE_SIZE} + { In some GDB versions, saved_command_line needs to + be explicitly allocated at startup } var saved_command_line : pchar;cvar;external; { defined in top.c source } saved_command_line_size : longint;cvar;external; {defined in top.c source } +{$endif def GDB_HAS_SAVED_COMMAND_LINE_SIZE} {$endif} {$endif GDB_NEEDS_SET_INSTREAM} var @@ -3514,8 +3552,12 @@ begin gdb_stdin:=mem_fileopen; save_gdb_stdin:=gdb_stdin; {$ifdef LIBGDB_HAS_GET_STDIN} +{$ifndef GDB_NO_INSTREAM_VAR} instream:=gdb_get_stdin; +{$endif ndef GDB_NO_INSTREAM_VAR} +{$ifdef GDB_HAS_SAVED_COMMAND_LINE_SIZE} saved_command_line:=xmalloc(saved_command_line_size); +{$endif def GDB_HAS_SAVED_COMMAND_LINE_SIZE} {$else} dummy_file :=gdb_fopen('dummy.$$$','a'); {in captured_main code, this is simply @@ -3558,6 +3600,9 @@ begin uiout := cli_out_new (gdb_stdout); {$endif not GDB_NO_UIOUT} {$endif GDB_V6} +{$ifdef GDB_NEW_UI} + local_ui := new_ui (gdb_stdin,gdb_stdout,gdb_stderr); +{$endif not GDB_NEW_UI} {$ifdef GDB_INIT_HAS_ARGV0} getmem(argv0,length(paramstr(0))+1); strpcopy(argv0,paramstr(0)); @@ -3591,6 +3636,9 @@ begin current_uiout:=cli_uiout; our_uiout:=cli_uiout; {$endif GDB_NO_UIOUT} +{$ifdef GDB_NEW_UI} + local_ui := new_ui (gdb_stdin,gdb_stdout,gdb_stderr); +{$endif not GDB_NEW_UI} {$endif GDB_NEEDS_INTERPRETER_SETUP} {$ifdef supportexceptions} {$ifdef unix} diff --git a/packages/openssl/src/openssl.pas b/packages/openssl/src/openssl.pas index 0b05add65c..c3abc53ea9 100644 --- a/packages/openssl/src/openssl.pas +++ b/packages/openssl/src/openssl.pas @@ -1024,6 +1024,7 @@ var SSLUtilFile: string = ''; // libssl.dll + function OpenSSLGetVersion(t: cint):String; function SslGetError(s: PSSL; ret_code: cInt):cInt; function SslLibraryInit:cInt; procedure SslLoadErrorStrings; @@ -1510,6 +1511,7 @@ end; type // libssl.dll + TOpenSSLversion = function (arg : cint) : pchar; cdecl; TSslGetError = function(s: PSSL; ret_code: cInt):cInt; cdecl; TSslLibraryInit = function:cInt; cdecl; TSslLoadErrorStrings = procedure; cdecl; @@ -1740,6 +1742,7 @@ type var // libssl.dll + _OpenSSLVersion : TOpenSSLversion = Nil; _SslGetError: TSslGetError = nil; _SslLibraryInit: TSslLibraryInit = nil; _SslLoadErrorStrings: TSslLoadErrorStrings = nil; @@ -2411,6 +2414,14 @@ begin Result := 0; end; +function OpenSSLGetVersion(t: cint):String; +begin + if InitSSLInterface and Assigned(_OpenSSLVersion) then + Result := _OpenSSLVersion(t) + else + Result := ''; +end; + //function SslGetVersion(ssl: PSSL):PChar; function SslGetVersion(ssl: PSSL):String; begin @@ -4672,6 +4683,7 @@ end; Procedure LoadSSLEntryPoints; begin + _OpenSSLVersion := GetProcAddr(SSLLibHandle, 'OpenSSL_version'); _SslGetError := GetProcAddr(SSLLibHandle, 'SSL_get_error'); _SslLibraryInit := GetProcAddr(SSLLibHandle, 'SSL_library_init'); _SslLoadErrorStrings := GetProcAddr(SSLLibHandle, 'SSL_load_error_strings'); @@ -5013,7 +5025,8 @@ end; Procedure ClearSSLEntryPoints; begin - _SslGetError := nil; + _OpenSSLVersion := Nil; + _SslGetError := nil; _SslLibraryInit := nil; _SslLoadErrorStrings := nil; _SslCtxSetCipherList := nil;