fixed pascal wrapper bug in including a file
All checks were successful
continuous-integration/drone/push Build is passing

This commit is contained in:
hyung-hwan 2024-02-23 00:32:17 +09:00
parent 308b39d50b
commit 14fbbd1f31
4 changed files with 54 additions and 26 deletions

View File

@ -49,7 +49,7 @@ hclgo.bin: lib/libhcl.la $(hclgo_OBJECTS)
## ---------------------------------------------------------------
CC=$(CC) \
CGO_CFLAGS="-I$(abs_srcdir)/lib -I$(abs_builddir)/lib $(CFLAGS)" \
CGO_LDFLAGS="-L$(abs_builddir)/lib -L$(abs_builddir)/lib/.libs -lhcl -ldl -lquadmath" \
CGO_LDFLAGS="-L$(abs_builddir)/lib -L$(abs_builddir)/lib/.libs -lhcl -ldl $(LIBM)" \
go build -C $(srcdir) -ldflags "-X 'main.BINDIR=$(bindir)' -X 'main.SBINDIR=$(sbindir)' -X 'main.LIBDIR=$(libdir)' -X 'main.SYSCONFDIR=$(sysconfdir)'" -x -o $(abs_builddir)/hclgo.bin -modfile $(abs_builddir)/go.mod
## ---------------------------------------------------------------
go clean -C $(srcdir) -x -modfile $(abs_builddir)/go.mod

View File

@ -939,7 +939,7 @@ clean-local:
@ENABLE_HCLGO_TRUE@ [ -f $(srcdir)/go.sum ] && cp -pf $(srcdir)/go.sum $(builddir)/go.sum >/dev/null 2>&1 || true
@ENABLE_HCLGO_TRUE@ CC=$(CC) \
@ENABLE_HCLGO_TRUE@ CGO_CFLAGS="-I$(abs_srcdir)/lib -I$(abs_builddir)/lib $(CFLAGS)" \
@ENABLE_HCLGO_TRUE@ CGO_LDFLAGS="-L$(abs_builddir)/lib -L$(abs_builddir)/lib/.libs -lhcl -ldl -lquadmath" \
@ENABLE_HCLGO_TRUE@ CGO_LDFLAGS="-L$(abs_builddir)/lib -L$(abs_builddir)/lib/.libs -lhcl -ldl $(LIBM)" \
@ENABLE_HCLGO_TRUE@ go build -C $(srcdir) -ldflags "-X 'main.BINDIR=$(bindir)' -X 'main.SBINDIR=$(sbindir)' -X 'main.LIBDIR=$(libdir)' -X 'main.SYSCONFDIR=$(sysconfdir)'" -x -o $(abs_builddir)/hclgo.bin -modfile $(abs_builddir)/go.mod
@ENABLE_HCLGO_TRUE@ go clean -C $(srcdir) -x -modfile $(abs_builddir)/go.mod

View File

@ -4,8 +4,7 @@ import (
"fmt"
"os"
"strings"
hcl "code.miflux.com/hyung-hwan/hcl/go"
"code.miflux.com/hyung-hwan/hcl/go"
)
/*

View File

@ -60,7 +60,7 @@ type
Interp = class
protected
handle: pointer;
basedir: string;
basefile: string;
public
constructor Create(x: integer);
@ -149,6 +149,14 @@ implementation
uses SysUtils, Math, Classes;
type
NamedHandle = record
handle: THandle;
name: System.RawByteString;
end;
NamedHandlePtr = ^NamedHandle;
constructor Interp.Create (x: integer);
var
h: pointer;
@ -241,44 +249,65 @@ end;
function cci_handler(handle: pointer; cmd: IoCmd; arg: CciArgPtr): integer; cdecl;
var
f: System.THandle;
nf: NamedHandlePtr;
len: System.LongInt;
err: System.Integer;
name: System.RawByteString;
basedir: System.RawByteString;
self: Interp;
begin
(* check if the main stream is requested.
* it doesn't have to be handled because the main stream must be handled via feeding *)
if arg^.includer = nil then exit(0); (* main stream - ignore it *)
case cmd of
IO_OPEN: begin
self := handle_to_self(handle);
if (arg^.includer <> nil) and (SysUtils.CompareStr(self.basedir, '') <> 0) then
name := SysUtils.ConcatPaths([self.basedir, UTF8Encode(arg^.name)])
else
name := System.UTF8Encode(arg^.name);
f := SysUtils.FileOpen(name, SysUtils.fmOpenRead);
if f = System.THandle(-1) then begin
if arg^.includer = nil then begin
(* main stream *)
name := self.basefile;
end
else begin
(* included file *)
nf := NamedHandlePtr(arg^.includer^.handle);
basedir := SysUtils.ExtractFilePath(nf^.name);
name := UTF8Encode(arg^.name);
if SysUtils.CompareStr(basedir, '') <> 0 then
name := SysUtils.ConcatPaths([basedir, name]);
end;
System.New(nf);
if nf = nil then begin
err := SysUtils.GetLastOSError();
hcl_seterrbmsg(handle, hcl_syserrstrb(handle, 0, err, nil, 0), pansichar(SysUtils.SysErrorMessage(err)));
exit(-1);
end;
arg^.handle := pointer(f);
if arg^.includer <> nil then begin
(* included file *)
nf^.handle := SysUtils.FileOpen(name, SysUtils.fmOpenRead);
if nf^.handle = System.THandle(-1) then begin
err := SysUtils.GetLastOSError();
hcl_seterrbmsg(handle, hcl_syserrstrb(handle, 0, err, nil, 0), pansichar(SysUtils.SysErrorMessage(err)));
System.Dispose(nf);
exit(-1);
end;
end
else begin
nf^.handle := THandle(-1);
end;
nf^.name := name;
arg^.handle := pointer(nf);
arg^.is_bytes := 1;
end;
IO_CLOSE: begin
f := System.THandle(arg^.handle);
SysUtils.FileClose(f);
nf := NamedHandlePtr(arg^.handle);
if nf^.handle <> System.THandle(-1) then SysUtils.FileClose(nf^.handle);
System.Dispose(nf);
end;
IO_READ_BYTES: begin
f := System.THandle(arg^.handle);
len := SysUtils.FileRead(f, arg^.buf, System.SizeOf(arg^.buf)); (* use SizeOf a widechar buffer as it needs to fill it with bytes *)
nf := NamedHandlePtr(arg^.handle);
len := SysUtils.FileRead(nf^.handle, arg^.buf, System.SizeOf(arg^.buf)); (* use SizeOf a widechar buffer as it needs to fill it with bytes *)
if len <= -1 then begin
hcl_seterrbmsg(handle, hcl_syserrstrb(handle, 0, err, nil, 0), pansichar(SysUtils.SysErrorMessage(err)));
exit(-1);
@ -322,13 +351,13 @@ begin
goto oops;
end;
self.basefile := filename;
if hcl_attachccio(self.handle, @cci_handler) <= -1 then begin
errmsg := 'failed to attach ccio handler - ' + self.FetchErrorMsg();
goto oops;
end;
attached := true;
self.basedir := SysUtils.ExtractFilePath(filename);
if hcl_beginfeed(self.handle, nil) <= -1 then begin
errmsg := 'failed to begin feeding - ' + self.FetchErrorMsg();
goto oops;
@ -358,14 +387,14 @@ begin
feed_ongoing := false;
hcl_detachccio(self.handle);
self.basedir := '';
self.basefile := '';
SysUtils.FileClose(f);
exit();
oops:
if feed_ongoing then hcl_endfeed(self.handle);
if attached then hcl_detachccio(self.handle);
self.basedir := '';
self.basefile := '';
if f >= -1 then SysUtils.FileClose(f);
raise Exception.Create(errmsg);
end;