Re: Problem with strings in record imported/exported from/to modules

22 Nov 1999

      In message <214E52CA.19991120140550.FOO-4F71.frank@g-n-u.de> Frank Heckenbach writes:
...
David James wrote:
...
I'm having problems with a string in a record that is exported 
from one module and imported into another. I *hope* I am doing 
something stupid!
The maodule (dajmod3.pas) and main program (daj3.pas) below 
should illustrate the problem.
[...]
This seems to be another innstance of a known bug with string types.
Thanks for the report and the test program which I'm adding to the
test suite.
I converted my previous test from extended Pascal modules to units.
This is unit dajunit3 and program daj3u, attached. This case works.
daj3u makes the record using new().

However what I really want to do is to put this record into shared
memory, so I moved to daj4u and dajunit4, attached. This fails.

Eventually, I tried setting the string's capacity before trying to 
assign a value to it, and, of course, then the program works.

My question is really what is the recommended way to do this: is it
to set the string's capacity, or should I be calling some other
function to initialise the record proerly after I shmat the shared
memory? I assume that new(record_pointer) is initialising string
capacities within the record, somehow. 

=====
program daj3u(output);

uses dajunit3;

begin
 new(shared_data);
 with shared_data^ do
  begin
   sanity:=4567;
   writeln('sanity is ',sanity);
   prefix:='ABCD';
   if (prefix='ABCD') then
     writeln('OK')
   else
     writeln('failed ',prefix,'|');
  end;
end.
=====
unit dajunit3;

interface

TYPE  
      astring=string(255);
      tshared_data = record
		     sanity:integer;
		     prefix:astring;
                    end;

 VAR
      shared_data : ^tshared_data;

implementation

end. {of unit implentation}
=====
program daj4u(output);

uses dajunit4;

var size:integer;
    shmflg1:integer;
    shmflg2:integer;
    base_key:integer;
    shmid:integer;
    shmaddr:pointer;
    err:integer;

begin

 base_key:=16;
 size:=sizeof(ty_shared_data);
 shmflg1:=IPC_CREAT + 8#666;
 shmflg2:=0;
 writeln('Calling shmget with key ',base_key:1,' for size ',size:1,
           ' with flags ',shmflg1:1,' and ',shmflg2:1);
 connect_shared_memory(base_key,size,shmflg1,shmflg2,shmid,shmaddr,err);
 writeln('returned from connect_shared_memory for main shared memory ',
            shmid:1,' ',integer(shmaddr):1);
 if shmid=-1 then
  begin
   writeln('Failed to get main shared memory, reason ',err:1);
   halt;
  end;

 if integer(shmaddr)=-1 then
  begin
   writeln('Failed to attach main shared memory, reason ',err:1);
   halt;
  end;

 shared_data:=shmaddr;

 with shared_data^ do
  begin
   sanity:=4567;
   writeln('sanity is ',sanity);

   (*if we set the string capacity here, everything works
     prefix.capacity:=255;
   *)

   prefix:='ABCD';
   if (prefix='ABCD') then
     writeln('OK')
   else
     writeln('failed ',prefix,'|');
  end;
end.
=====
unit dajunit4;

interface

const
    IPC_CREAT   = 8#0001000;		(* create entry if key doesn't exist *)

TYPE  
      astring=string(255);
      ty_shared_data = record
		     sanity:integer;
		     prefix:astring;
                    end;

 VAR
      shared_data : ^ty_shared_data;

procedure connect_shared_memory(key,size,shmflg1,shmflg2:integer;
				var shmid:integer;
				var shmaddr:pointer;
				var err:integer);
implementation

var errno: asmname 'errno' integer;

function shmget(key:integer; size, shmflg:integer):integer; C_language;
function shmat (shmid:integer;shmaddr:integer;
		shmflg:integer):pointer; C_language;

procedure connect_shared_memory;
var retval:pointer;
    inshmaddr:integer;
begin
 shmid:=-1;
 inshmaddr:=-1;
 shmid:=shmget(key,size,shmflg1);
 if shmid=-1 then
  begin
   err:=errno;
  end
 else
  begin
   inshmaddr:=0;
   retval:=shmat(shmid,inshmaddr,shmflg2);
   if integer(retval)=-1 then
    begin
     integer(shmaddr):=-1;
     err:=errno;
    end
   else
    begin
     shmaddr:=retval;
    end;
  end;
end;

end. {of unit implentation}
=====

-- 
David James
mailto:david@tcs01.demon.co.uk
Special Stage Rally results archive <URL:http://www.tcs01.demon.co.uk/>

david＠tcs01.demon.co.uk

tags

participants (1)