mirror of
https://gitlab.com/freepascal.org/fpc/source.git
synced 2025-04-07 16:28:22 +02:00
--- 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 -
This commit is contained in:
parent
cae238ca98
commit
a67e69ae28
2
.gitattributes
vendored
2
.gitattributes
vendored
@ -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
|
||||
|
@ -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.
|
27
packages/fcl-base/examples/demoio.pp
Normal file
27
packages/fcl-base/examples/demoio.pp
Normal file
@ -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.
|
32
packages/fcl-base/examples/testappexit.pp
Normal file
32
packages/fcl-base/examples/testappexit.pp
Normal file
@ -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.
|
@ -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}
|
||||
|
@ -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;
|
||||
|
Loading…
Reference in New Issue
Block a user