paweld/fpc
1
0
Fork 0
mirror of https://gitlab.com/freepascal.org/fpc/source.git synced 2025-08-15 05:49:12 +02:00
Code Issues Packages Projects Releases Wiki Activity

* added some helper functions

Browse Source 
git-svn-id: trunk@14267 -
This commit is contained in:
ivost 2009-11-24 19:20:26 +00:00
parent af7974973d
commit 0ba51db53e
1 changed files with 82 additions and 1 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

83
packages/zorba/src/xqc.pas
View File

@ -28,6 +28,7 @@ unit xqc;
interface interface
uses uses
Classes,
ctypes; ctypes;
{$IFDEF UNIX} {$IFDEF UNIX}
@ -78,7 +79,7 @@ type
// external functions // external functions
external_function_init = procedure(out user_data: Pointer; global_user_data: Pointer); extdecl; external_function_init = procedure(out user_data: Pointer; global_user_data: Pointer); extdecl;
external_function_next = function(args: XQC_Sequence; argc: cint; out result: XQC_Item; external_function_next = function(args: XQC_Sequence; argc: cint; out res: XQC_Item;
user_data: Pointer; global_user_data: Pointer): XQUERY_ERROR; extdecl; user_data: Pointer; global_user_data: Pointer): XQUERY_ERROR; extdecl;
external_function_release = procedure(user_data: Pointer; global_user_data: Pointer); extdecl; external_function_release = procedure(user_data: Pointer; global_user_data: Pointer); extdecl;
@ -2047,6 +2048,86 @@ type
data: pointer; data: pointer;
end; end;
(* helper functions *)
procedure xqc_errorhandler_error(handler: XQC_ErrorHandler; error: XQUERY_ERROR; const local_name,
description, query_uri: pchar; line, column: cuint); extdecl;
const
XQC_Console_ErrorHandler_impl: XQC_ErrorHandler_s = (error:@xqc_errorhandler_error; data: nil);
XQC_Console_ErrorHandler: XQC_ErrorHandler = @XQC_Console_ErrorHandler_impl;
function XQC_InputStream_create(const Stream: TStream; const Owned: Boolean): XQC_InputStream;
function XQC_OutputStream_create(const Stream: TStream; const Owned: Boolean): XQC_OutputStream;
implementation implementation
procedure xqc_errorhandler_error(handler: XQC_ErrorHandler; error: XQUERY_ERROR; const local_name,
description, query_uri: pchar; line, column: cuint); extdecl;
begin
WriteLn(query_uri, '(', line, ',', column, ') ', local_name, ': ', description);
end;
type
PStreamData = ^TStreamData;
TStreamData = record
Stream: TStream;
Owned: Boolean;
end;
function xqc_inputstream_read(stream: XQC_InputStream; const buf: pchar; length: cuint): cint; extdecl;
begin
if Assigned(buf) and (length > 0) then
Result := PStreamData(stream^.data)^.Stream.Read(buf^, length)
else
Result := 0;
end;
procedure xqc_inputstream_free(stream: XQC_InputStream); extdecl;
begin
if PStreamData(stream^.data)^.Owned then
PStreamData(stream^.data)^.Stream.Free;
FreeMem(stream);
end;
function XQC_InputStream_create(const Stream: TStream; const Owned: Boolean): XQC_InputStream;
begin
if not Assigned(Stream) then
Exit(nil);
GetMem(Result, Sizeof(XQC_InputStream_s)+Sizeof(TStreamData));
Result^.read := @xqc_inputstream_read;
Result^.free := @xqc_inputstream_free;
Result^.data := PChar(Result) + Sizeof(XQC_InputStream_s);
PStreamData(Result^.data)^.Owned := Owned;
PStreamData(Result^.data)^.Stream := Stream;
end;
procedure xqc_outputstream_write(stream: XQC_OutputStream; const buf: pchar; length: cuint); extdecl;
begin
if Assigned(buf) and (length > 0) then
PStreamData(stream^.data)^.Stream.Write(buf^, length);
end;
procedure xqc_outputstream_free(stream: XQC_OutputStream); extdecl;
begin
if PStreamData(stream^.data)^.Owned then
PStreamData(stream^.data)^.Stream.Free;
FreeMem(stream);
end;
function XQC_OutputStream_create(const Stream: TStream; const Owned: Boolean): XQC_OutputStream;
begin
if not Assigned(Stream) then
Exit(nil);
GetMem(Result, Sizeof(XQC_OutputStream_s)+Sizeof(TStreamData));
Result^.write := @xqc_outputstream_write;
Result^.free := @xqc_outputstream_free;
Result^.data := PChar(Result) + Sizeof(XQC_OutputStream_s);
PStreamData(Result^.data)^.Owned := Owned;
PStreamData(Result^.data)^.Stream := Stream;
end;
end. end.