AGB  ·  Datenschutz  ·  Impressum  







Anmelden
Nützliche Links
Registrieren
Zurück Delphi-PRAXiS Programmierung allgemein Algorithmen, Datenstrukturen und Klassendesign Parallel Programming Library: Übergabe Pointer Problem
Thema durchsuchen
Ansicht
Themen-Optionen

Parallel Programming Library: Übergabe Pointer Problem

Ein Thema von user69 · begonnen am 30. Okt 2020 · letzter Beitrag vom 30. Okt 2020
 
user69

Registriert seit: 10. Dez 2004
115 Beiträge
 
#1

Parallel Programming Library: Übergabe Pointer Problem

  Alt 30. Okt 2020, 09:11
Hallo,

ich versuch gerade ein paar erste Schritte mit der PPL und den TTask zu machen.
Dabei bekomme ich immer ein Problem (Exception) mit dem Code siehe unten und im Anhang.

TaskWorker(fCurrentRecordArray) bekommt einen Pointer auf ein Record übergeben, mit dem er nun arbeiten soll (hier nur mal das Setzen von Color als Beispiel).
Die Struktur TMyRecord = packed record und RecordArraySart: pMyRecord möchte ich gerne behalten (nicht durch ein Array ersetzen).
Nun führt aber scheinbar fCurrentRecordArray:= fCurrentRecordArray^.Next nach dem TTask.Create dazu, dass auch im Task der Übergabepointer nicht der zum Zeitpunkt der des Create zu sein, sondern immer der aktuell geänderte (und da der am Ende nil ist crasht das Programm).

Kann mir jemand sagen, wie ich den Pointer zu Übergabezeit für die Berechnungen im TaskWorker nutzen kann, So dass der TaskWorker im richtigen Record seinen Jot tut?


Code:
unit Unit1;

interface

uses
  Winapi.Windows, Winapi.Messages, System.SysUtils, System.Variants, System.Classes, System.Threading,
  Vcl.Graphics, Vcl.Controls, Vcl.Forms, Vcl.Dialogs, Vcl.StdCtrls;

type
  TForm1 = class(TForm)
    Button1: TButton;
    Memo1: TMemo;
    procedure Button1Click(Sender: TObject);
    procedure FormCreate(Sender: TObject);
  private
    { Private-Deklarationen }
  public
    { Public-Deklarationen }
  end;

type
  pMyRecord = ^TMyRecord;
  TMyRecord = packed record
    Color: Integer;
    AllowNewColor: Boolean;
    Next: pMyRecord;
  end;

var
  Form1: TForm1;
  RecordArraySart: pMyRecord;
  RecordArraySize: Integer;

implementation

{$R *.dfm}

procedure TForm1.FormCreate(Sender: TObject);
var i: Integer;
  fCurrentRecordArray: pMyRecord;
begin
  // create dummy structure
  RecordArraySize:= 0;
  New(RecordArraySart);
  fCurrentRecordArray:= RecordArraySart;
  fCurrentRecordArray^.Color:= -1;
  fCurrentRecordArray^.AllowNewColor:= True;
  fCurrentRecordArray^.Next:= nil;
  Inc(RecordArraySize);
  for i:= 0 to 18 do begin
    New(fCurrentRecordArray^.Next);
    fCurrentRecordArray:= fCurrentRecordArray^.Next;
    fCurrentRecordArray^.Color:= -1;
    fCurrentRecordArray^.AllowNewColor:= True;
    fCurrentRecordArray^.Next:= nil;
    Inc(RecordArraySize);
  end;
end;

procedure TaskWorker(ipMyRecord: pMyRecord);
begin
  Randomize;
  if ipMyRecord^.AllowNewColor then
    ipMyRecord^.Color:= Random(30000);
end;

procedure TForm1.Button1Click(Sender: TObject);
var i: Integer;
  fCurrentRecordArray: pMyRecord;
  fTaskNo: Integer;
  fTasks: array of ITask;
begin
  SetLength(fTasks, RecordArraySize);
  fTaskNo:= 0;
  fCurrentRecordArray:= RecordArraySart;
  for i:= 0 to RecordArraySize - 1 do begin
    fTasks[fTaskNo]:= TTask.Create(procedure()
      // new Task
      begin
        TaskWorker(fCurrentRecordArray);
      end);
    fTasks[fTaskNo].Start;
    fCurrentRecordArray:= fCurrentRecordArray^.Next;
    Inc(fTaskNo);
  end;
  TTask.WaitForAll(fTasks);
  Memo1.Lines.Clear;
  for i:= 0 to RecordArraySize - 1 do begin
    fCurrentRecordArray:= RecordArraySart;
    Memo1.Lines.Add(IntToStr(fCurrentRecordArray^.Color));
    fCurrentRecordArray:= fCurrentRecordArray^.Next;
  end;
end;

end.
Angehängte Dateien
Dateityp: zip _Threads.zip (23,7 KB, 0x aufgerufen)
  Mit Zitat antworten Zitat
 


Forumregeln

Es ist dir nicht erlaubt, neue Themen zu verfassen.
Es ist dir nicht erlaubt, auf Beiträge zu antworten.
Es ist dir nicht erlaubt, Anhänge hochzuladen.
Es ist dir nicht erlaubt, deine Beiträge zu bearbeiten.

BB-Code ist an.
Smileys sind an.
[IMG] Code ist an.
HTML-Code ist aus.
Trackbacks are an
Pingbacks are an
Refbacks are aus

Gehe zu:

Impressum · AGB · Datenschutz · Nach oben
Alle Zeitangaben in WEZ +1. Es ist jetzt 21:44 Uhr.
Powered by vBulletin® Copyright ©2000 - 2025, Jelsoft Enterprises Ltd.
LinkBacks Enabled by vBSEO © 2011, Crawlability, Inc.
Delphi-PRAXiS (c) 2002 - 2023 by Daniel R. Wolf, 2024-2025 by Thomas Breitkreuz