Newsgroup: it.comp.lang.delphi
Titolo: I puntatori mi tirano scemo

qualcuno riesce a dirmi cosa c'è che non va in questo coso? la seconda
volta che arriva alla riga che ho commentato con (* BOOOM! *) solleva
un'eccezione di puntatore non valido, seguita da un malefico loop
senza uscita di eccezioni di I/O assortite.
Il file di prova contiene:
#-----*--|---*-----|*------*-|----*----|-*------*|-----*---|--*------#
il programma dovrebbe leggere a blocchi di 7 caratteri alla volta e
scrivere blocchi di 10 (un asterisco ogni 7 caratteri e una pipe ogni
10, come vedete). Anzi, DEVE. Perchè certi file vanno letti per forza
a blocchi di certe dimensioni.
Praticamente quello che fa il programma è allocare buffer e accumulare
input finchè non ci sono abbastanza dati per scrivere almeno un blocco;
dopodichè scrive il blocco, libera la memoria corrispondente al blocco
scritto e fa puntare il buffer al byte immediatamente successivo. Il
problema è che il buffer non sembra gradire il trasloco: quando cerco
di riallocarlo in modo da contenere il suo contenuto attuale più la
dimensione del prossimo blocco di input, crash.
Ecco tutto.
Per fare il debug di questa cosa ho messo come watch:
PChar(buf2)
PChar(buf)
e, a giudicare da quello che vedo, le watch danno ragione a me. A voi.
(non abbiate timore di fregarmi pezzi di codice: il coso è sotto GPL,
e in tutta franchezza non lo trovo un granchè di programma. E le
persone abbastanza disperate da rubarlo non credo ci capiranno molto)
(************************************************************)
program dddd;
{$APPTYPE CONSOLE}
uses
  SysUtils, Windows;
type
  TBlockSize   =  Integer;
  TBlockCount  =  Integer;
  TFileName    =    PChar;
  TFileHandle  = Cardinal;
  TBuffer      =           ^_TBuffer;
  _TBuffer     = array[0..0] of Char;
  TFilePointer = packed record
    case Cardinal of
      0: (LongLong: Int64);
      1: (LowLong, HighLong: TBlockSize);
  end;
  EIOException   =      class(Exception);
  EEOF           =   class(EIOException);
  EOpenError     =   class(EIOException);
  EWriteError    =   class(EIOException);
  EReadError     =   class(EIOException);
  EHandleError   =   class(EIOException);
  ESeekException =   class(EIOException);
  ECannotSeek    = class(ESeekException);
  ENegativeSeek  = class(ESeekException);
const
  defBlockSize   : TBlockSize   = 512;
  defBlockCount  : TBlockCount  =   0;
  defFileName    : TFileName    = '-';
  defBuffer      : TBuffer      = nil;
  defFilePointer : TFilePointer = (LongLong: $0000000000000000);
  nilFileName    : TFileName    = nil;
var
  ibs      :   TBlockSize;
  obs      :   TBlockSize;
  count    :  TBlockCount;
  ifName   :    TFileName;
  ofName   :    TFileName;
  skip     :  TBlockCount;
  seek     :  TBlockCount;
  ifHandle :  TFileHandle;
  ofHandle :  TFileHandle;
  buf      :      TBuffer;
  buf2     :      TBuffer;
  bufsize  :      Integer;
  read     :   TBlockSize;
  written  :   TBlockSize;
  EOF      :      Boolean;
function _path_is_std(FileName: TFileName): Boolean;
begin
  _path_is_std:=
    (FileName = nilFileName) or
    (FileName = '-') or
    (StrLen(FileName) < 1);
end;
procedure DD_SetFilePointer(
  FileHandle: TFileHandle;
  var FilePointer: TFilePointer
);
  var
    retVal: DWORD;
begin
  FilePointer.LowLong:= TBlockSize(
    SetFilePointer(
      Cardinal(FileHandle),
      Cardinal(FilePointer.LowLong),
      @Cardinal(FilePointer.HighLong),
      FILE_BEGIN
    )
  );
  if not(Cardinal(FilePointer.LowLong) = $FFFFFFFF) then begin
    retVal:= GetLastError;
    case retVal of
      ERROR_SUCCESS:
        (* do nothing *);
      ERROR_NEGATIVE_SEEK:
        raise ENegativeSeek.Create('Cannot do a negative seek');
      ERROR_SEEK_ON_DEVICE:
        raise ECannotSeek.Create('Cannot seek a character device');
      ERROR_INVALID_HANDLE:
        raise EHandleError.Create('Attempt to seek an invalid file handle');
      else
        raise ESeekException.Create('');
    end;
  end;
end;
function DD_OpenInput(FileName: TFileName): TFileHandle;
  var
    tmpHandle: Cardinal;
begin
  if _path_is_std(FileName) then
    DD_OpenInput:= GetStdHandle(STD_INPUT_HANDLE)
  else begin
    tmpHandle:= CreateFile(
      PChar(FileName),
      GENERIC_READ,
      FILE_SHARE_READ,
      nil,
      OPEN_EXISTING,
      FILE_ATTRIBUTE_NORMAL or FILE_FLAG_SEQUENTIAL_SCAN,
      0
    );
    if tmpHandle = INVALID_HANDLE_VALUE then
      raise EOpenError.CreateFmt('Failed to open "%s" for input', [FileName]);
    DD_OpenInput:= tmpHandle;
  end;
end;
function DD_OpenOutput(FileName: TFileName): TFileHandle;
  var
    tmpHandle: Cardinal;
begin
  if _path_is_std(FileName) then
    DD_OpenOutput:= GetStdHandle(STD_OUTPUT_HANDLE)
  else begin
    tmpHandle:= CreateFile(
      PChar(FileName),
      GENERIC_WRITE,
      FILE_SHARE_WRITE,
      nil,
      CREATE_ALWAYS,
      FILE_ATTRIBUTE_NORMAL or FILE_FLAG_SEQUENTIAL_SCAN,
      0
    );
    if tmpHandle = INVALID_HANDLE_VALUE then begin
      (* maybe the file is a device? *)
      tmpHandle:= CreateFile(
        PChar(FileName),
        GENERIC_WRITE,
        FILE_SHARE_WRITE,
        nil,
        OPEN_EXISTING,
        FILE_ATTRIBUTE_NORMAL or FILE_FLAG_SEQUENTIAL_SCAN,
        0
      );
      if tmpHandle = INVALID_HANDLE_VALUE then
        raise EOpenError.CreateFmt('Failed to open "%s" for output', [FileName]);
    end;
    DD_OpenOutput:= tmpHandle;
  end;
end;
procedure DD_CloseFile(FileHandle: TFileHandle);
begin
  CloseHandle(Cardinal(FileHandle));
end;
procedure DD_Malloc(var Ptr: TBuffer; Size: TBlockSize);
begin
  GetMem(Ptr, Integer(Size));
end;
procedure DD_Free(var Ptr: TBuffer; Size: TBlockSize);
begin
  FreeMem(Ptr, Integer(Size));
end;
procedure DD_Realloc(var Ptr: TBuffer; Size: TBlockSize);
begin
  ReallocMem(Ptr, Integer(Size));
end;
procedure DD_ReadInput(
  FileHandle: TFileHandle;
  BlockSize: TBlockSize;
  var Count: TBlockCount;
  const Buffer: Pointer;
  var ReadBytes: TBlockSize
);
  var
    retVal: DWORD;
begin
  if not ReadFile(
    Cardinal(FileHandle),
    Buffer^,
    DWORD(BlockSize),
    DWORD(ReadBytes),
    nil
  ) then begin
    retVal:= GetLastError;
    case retVal of
      ERROR_SUCCESS:
        (* do nothing*);
      ERROR_HANDLE_EOF:
        raise EEOF.Create('');
      ERROR_INVALID_HANDLE:
        raise EHandleError.Create('');
      else
        raise EWriteError.Create('');
    end;
  end;
end;
procedure DD_WriteOutput(
  FileHandle: TFileHandle;
  BlockSize: TBlockSize;
  const Buffer: Pointer;
  var WrittenBytes: TBlockSize
);
  var
    retVal: DWORD;
begin
  if not WriteFile(
    Cardinal(FileHandle),
    Buffer^,
    DWORD(BlockSize),
    DWORD(WrittenBytes),
    nil
  ) then begin
    retVal:= GetLastError;
    case retVal of
      ERROR_SUCCESS:
        (* do nothing*);
      ERROR_INVALID_HANDLE:
        raise EHandleError.Create('');
      else
        raise EWriteError.Create('');
    end;
  end;
end;
procedure _initialize_vars;
begin
  ibs      :=  defBlockSize;
  obs      :=  defBlockSize;
  count    := defBlockCount;
  ifName   :=   defFileName;
  ofName   :=   defFileName;
  skip     := defBlockCount;
  seek     := defBlockCount;
  buf      :=     defBuffer;
  buf2     :=     defBuffer;
  bufsize  :=             0;
  EOF      :=         False;
end;
begin
  _initialize_vars;
  ifName:= 'D:\home\Hyperion\Desktop\testfile.txt';
  obs:= 10;
  ibs:= 7;
  try
    ifHandle:= DD_OpenInput(ifName);
    ofHandle:= DD_OpenOutput(ofName);
    try
      (* allocate memory *)
      DD_Malloc(buf, 1);
      try
        while true do begin (* read-write loop *)
          try
            while bufsize < obs do begin
            (* we accumulate enough data in the input buffer *)
              DD_Realloc(buf, bufsize + ibs + 1);
              buf2:= @(buf^[bufsize]);
              bufsize:= bufsize + ibs; (* we try to be pessimistic - if
                                          DD_ReadInput() raises an unhandled
                                          exception, we're sure DD_Free
                                          deallocates all the memory we
                                          used *)
              DD_ReadInput(ifHandle, ibs, count, buf2, read);
              bufsize:= bufsize - (ibs - read);
            end;
          except
            on EEOF do Break;
          end;
          (* we write the data *)
          while bufsize >= obs do begin
            DD_WriteOutput(ofHandle, obs, buf, written);
            buf2:= @(buf^[written]); (* we save a pointer to the portion of the
                                        buffer yet to output *)
            DD_Free(buf, written); (* we free the portion of the buffer
                                      already output *)
            buf:= buf2;
            bufsize:= bufsize - written;
          end;
          if EOF then
            raise EEOF.Create('');
        end;
      finally
        (* make sure we deallocate memory - bufsize is always set to the
           maximum value available *)
        DD_Free(buf, bufsize);
      end;
    finally
      (* make sure we close the file handles *)
      DD_CloseFile(ifHandle);
      DD_CloseFile(ofHandle);
    end;
  except
    on EOpenError do WriteLn(GetLastError);
    on EWriteError do WriteLn;
    on EReadError do WriteLn;
    on EEOF do WriteLn;
 
  end;
  ReadLn;
end.
(************************************************************)

blocco di input, crash. 
aggiornamento: credo di aver capito. ReallocMem funziona solo con 
puntatori inizializzati da GetMem o ReallocMem

risolto
cancellato il contenuto dei due cicli while incriminati e riscritti in 
maniera un po' più sana
solo una cosa: ma il debugger deve starmi a ricordare gentilmente ogni 
volta che una FOTTUTA eccezione viene sollevata??? che, i blocchi except 
li ho messi per farmi quattro risate, forse?

 li ho messi per farmi quattro risate, forse?
Se non ho capito male:
Tools ==> Debugger Options ==> Language Exceptions
  "sflagghi" Stop on Delphi Exceptions.
Bye Bye.

li ho messi per farmi quattro risate, forse?
I blocchi try... except vengono /comunque/ considerati.
Il debugger ti blocca se sei tu a dirgli di farlo (ed e' il default).
Se non vuoi che questo accada, vai su:
Tools/Debugger Options/Language Exceptions/
e abilita/disabilita la voce "Stop on Delphi Exceptions"

  "sflagghi" Stop on Delphi Exceptions.
thank you! (io avrei messo una semplicissima checkbox nel menu Debug... 
chi ha scritto la struttura dei menu dell'IDE di Delphi doveva andarci 
pesante con certe sostanze)

pesante con certe sostanze)
Chi ha scritto la struttura dei menu dell'IDE di Delphi e' gente che a
me, a te e a tutti quanti ha da insegnare parecchio...

e abilita/disabilita la voce "Stop on Delphi Exceptions"
ripeto che mi sembra una fesseria seppellire in questo modo un'opzione 
così comune... ma tant'è, Delphi è troppo bello per stare a pontificare
(mi mancano le toolbar di Office, comunque)

cosě comune... ma tant'č, Delphi č troppo bello per stare a pontificare
in che senso? ti ricordo che si stoppa solo in debug time per fornire
maggiori informaioni sull'eccezione al programmatore, l'exe compilato
che usa l'utente cattura le eccezioni in modo "silenzioso" come
descritto dal try except
Ciao,
Alan Solo

così comune... ma tant'è, Delphi è troppo bello per stare a pontificare
Quell'opzione non mi sembra affatto seppellita.
Se si e' incapaci di usare l'ambiente di sviluppo, e' un altro
discorso.

a me, a te e a tutti quanti ha da insegnare parecchio...ù
certo di ergonomia a me non hanno niente da insegnare

discorso.
se non si è capaci di riconoscere un ambiente di sviluppo da una specie 
di vecchia officina messa sottosopra, allora sì che è un altro discorso. 
E' un'opzione di debug. E' un'opzione che voglio disattivare e 
riattivare *spesso*. DEVE essere in vista. O devo poterla mettere in 
vista io
VOGLIO una checkbox in un menu. Non voglio dover raggiungere un menu che 
apre una dialog in cui devo spostarmi in una tab, selezionare una 
checkbox, schiacciare OK e dimenticarmi che cosa stavo facendo prima di 
questo viaggio
Impara da Office: se all'utente gira così, può anche mettere i menu in 
verticale e le etichette dei menu in latino

verticale e le etichette dei menu in latino
Di Office si puo' fare tutto tranne che usarlo come mezzo di
insegnamento.

eccezioni per segnalare cose PULITE e' ERRATO.
tu forse usi i GoTo? io personalmente non li uso più dai tempi del BASIC 
1.0 sul Commodore 64