소스 검색

--- 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 -

marco 6 년 전
부모
커밋
a67e69ae28

+ 2 - 0
.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

+ 2 - 0
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.

+ 27 - 0
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.

+ 32 - 0
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.

+ 48 - 0
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}

+ 14 - 1
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;