------------------------------------------------------------------------------ ------------------------------------------------------------------------------ -- Cheddar is a GNU GPL real-time scheduling analysis tool. -- This program provides services to automatically check schedulability and -- other performance criteria of real-time architecture models. -- -- Copyright (C) 2002-2020, Frank Singhoff, Alain Plantec, Jerome Legrand, -- Hai Nam Tran, Stephane Rubini -- -- The Cheddar project was started in 2002 by -- Frank Singhoff, Lab-STICC UMR CNRS 6285, Universite de Bretagne Occidentale -- -- Cheddar has been published in the "Agence de Protection des Programmes/France" in 2008. -- Since 2008, Ellidiss technologies also contributes to the development of -- Cheddar and provides industrial support. -- -- The full list of contributors and sponsors can be found in AUTHORS.txt and SPONSORS.txt -- -- This program is free software; you can redistribute it and/or modify -- it under the terms of the GNU General Public License as published by -- the Free Software Foundation; either version 2 of the License, or -- (at your option) any later version. -- -- This program is distributed in the hope that it will be useful, -- but WITHOUT ANY WARRANTY; without even the implied warranty of -- MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the -- GNU General Public License for more details. -- -- You should have received a copy of the GNU General Public License -- along with this program; if not, write to the Free Software -- Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA -- -- -- Contact : cheddar@listes.univ-brest.fr -- ------------------------------------------------------------------------------ -- Last update : -- $Rev$ -- $Date$ -- $Author: singhoff $ ------------------------------------------------------------------------------ ------------------------------------------------------------------------------ with Text_IO; use Text_IO; with Ada.Exceptions; use Ada.Exceptions; with Resources; use Resources; use Resources.Resource_accesses; with Time_Unit_Events; use Time_Unit_Events; use Time_Unit_Events.Time_Unit_Package; with natural_util; use natural_util; with double_util; use double_util; with integer_util; use integer_util; with Ada.Numerics.Elementary_Functions; use Ada.Numerics.Elementary_Functions; with Objects; use Objects; with Objects.extended; use Objects.extended; with Translate; use Translate; with Task_Groups; use Task_Groups; with Tasks; use Tasks; use Tasks.Generic_Task_List_Package; with Task_Set; use Task_Set; with Task_Dependencies; use Task_Dependencies; with initialize_framework; use initialize_framework; package body Task_Group_Set is procedure Check_Task_group (My_Task_groups : in Task_groups_Set; Name : in Unbounded_String; Task_group_Type : in Task_groups_Type; Start_Time : in Integer; Period : in Integer; Deadline : in Integer; Jitter : in Integer; Priority : in Integer; Criticality : in Integer) is begin if Name = "" then Raise_Exception (Invalid_Parameter'Identity, To_String (Lb_Task_group_Name (Current_Language) & Lb_Mandatory (Current_Language))); end if; if not Is_A_Valid_Identifier (Name) then Raise_Exception (Invalid_Parameter'Identity, To_String (Lb_Task_group (Current_Language) & " " & Name & " : " & Lb_Task_Name (Current_Language) & Lb_Colon & Lb_Invalid_Identifier (Current_Language))); end if; if (Jitter < 0) then Raise_Exception (Invalid_Parameter'Identity, To_String (Lb_Task_group (Current_Language) & " " & Name & " : " & Lb_Jitter (Current_Language) & Lb_Must_Be (Current_Language) & Lb_greater_or_equal_than (Current_Language) & "0")); end if; if (Criticality < 0) then Raise_Exception (Invalid_Parameter'Identity, To_String (Lb_Task_group (Current_Language) & " " & Name & " : " & Lb_Criticality (Current_Language) & Lb_Must_Be (Current_Language) & Lb_greater_or_equal_than (Current_Language) & "0")); end if; if (Period < 0) then Raise_Exception (Invalid_Parameter'Identity, To_String (Lb_Task_group (Current_Language) & " " & Name & " : " & Lb_Period (Current_Language) & Lb_Must_Be (Current_Language) & Lb_greater_or_equal_than (Current_Language) & "0")); end if; if (Deadline < 0) then Raise_Exception (Invalid_Parameter'Identity, To_String (Lb_Task_group (Current_Language) & " " & Name & " : " & Lb_Deadline (Current_Language) & Lb_Must_Be (Current_Language) & Lb_greater_or_equal_than (Current_Language) & "0")); end if; if (Deadline < Jitter) then Raise_Exception (Invalid_Parameter'Identity, To_String (Lb_Task_group (Current_Language) & " " & Name & " : " & Lb_Deadline (Current_Language) & Lb_Must_Be (Current_Language) & Lb_greater_than (Current_Language) & Lb_Jitter (Current_Language))); end if; if (Start_Time < 0) then Raise_Exception (Invalid_Parameter'Identity, To_String (Lb_Task_group (Current_Language) & " " & Name & " : " & Lb_Start_Time (Current_Language) & Lb_Must_Be (Current_Language) & Lb_greater_or_equal_than (Current_Language) & "0")); end if; if (Priority < Integer (Priority_Range'First)) or (Priority > Integer (Priority_Range'Last)) then Raise_Exception (Invalid_Parameter'Identity, To_String (Lb_Task_group (Current_Language) & " " & Name & " : " & Lb_Invalid_Priority (Current_Language))); end if; end Check_Task_group; procedure Add_Task_Group (My_Task_Groups : in out Task_Groups_Set; Name : in Unbounded_String; Task_Group_Type : in Task_Groups_Type; Start_Time : in Integer :=0; Period : in Integer :=0; Deadline : in Integer :=0; Jitter : in Integer :=0; Priority : in Integer :=0; Criticality : in Integer :=0) is Dummy : Generic_Task_Group_Ptr; begin Add_Task_Group (My_Task_Groups, Dummy, Name, Task_Group_Type, start_time, period, deadline, jitter, priority, criticality); end Add_Task_Group; procedure Add_Task_Group (My_Task_Groups : in out Task_Groups_Set; A_Task_Group : in out Generic_Task_Group_Ptr; Name : in Unbounded_String; Task_Group_Type : in Task_Groups_Type; Start_Time : in Integer :=0; Period : in Integer :=0; Deadline : in Integer :=0; Jitter : in Integer :=0; Priority : in Integer :=0; Criticality : in Integer :=0) is New_Multiframe_Task_Group : Multiframe_Task_Group_Ptr; New_Transaction_Task_Group : Transaction_Task_Group_Ptr; My_Iterator : Task_Groups_Iterator; begin check_initialize; Check_Task_group (My_Task_groups, Name, Task_group_Type, Start_Time, Period, Deadline, Jitter, Priority, Criticality); if (get_number_of_elements (My_Task_Groups) > 0) then reset_iterator (My_Task_Groups, My_Iterator); loop current_element (My_Task_Groups, A_Task_Group, My_Iterator); if (Name = A_Task_Group.name) then Raise_Exception (Task_Set.Invalid_Parameter'Identity, To_String (Lb_Task_Group (Current_Language) & " " & Name & " : " & Lb_Task_Group_Name (Current_Language) & Lb_Already_Defined (Current_Language))); end if; exit when is_last_element (My_Task_Groups, My_Iterator); next_element (My_Task_Groups, My_Iterator); end loop; end if; case Task_Group_Type is when Multiframe_Type => New_Multiframe_Task_Group := new Multiframe_Task_Group; A_Task_Group := Generic_Task_Group_Ptr (New_Multiframe_Task_Group); when Transaction_Type => New_Transaction_Task_Group := new Transaction_Task_Group; A_Task_Group := Generic_Task_Group_Ptr (New_Transaction_Task_Group); end case; A_Task_Group.name:=name; A_Task_Group.period:=period; A_Task_Group.jitter:=jitter; A_Task_Group.deadline:=deadline; A_Task_Group.start_time:=start_time; A_Task_Group.priority:=priority_range(priority); A_Task_Group.criticality:=criticality; A_Task_Group.task_group_type := Task_Group_Type; Add_Task_Group(My_Task_Groups, A_Task_Group); exception when Generic_Task_Group_Set.full_set => Raise_Exception (Task_Set.Invalid_Parameter'Identity, To_String (Lb_Can_Not_Define_More_Task_groups (Current_Language))); end Add_Task_Group; procedure Add_Task_Group (My_Task_Groups : in out Task_Groups_Set; A_Task_Group : in Generic_Task_Group_Ptr) is begin check_initialize; add(My_Task_Groups, A_Task_Group); end Add_Task_Group; procedure Add_Task (My_Tasks : in out Tasks_Set; My_Task_Groups : in out Task_Groups_Set; Task_Group_Name : in Unbounded_String; Name : in Unbounded_String; Cpu_Name : in Unbounded_String; Address_Space_Name : in Unbounded_String; Task_Type : in Tasks_Type; Start_Time : in Integer; Capacity : in Integer; Period : in Integer; Deadline : in Integer; Jitter : in Integer; Blocking_Time : in Integer; Priority : in Integer; Criticality : in Integer; Policy : in Policies; Offset : in Offsets_Table := No_Offset; Stack_Memory_Size : in Integer := 0; Text_Memory_Size : in Integer := 0; Text_Memory_Start_Address : in Integer := -1; Param : in User_Defined_Parameters_Table := No_User_Defined_Parameter; Parametric_Rule_Name : in Unbounded_String := empty_string; Seed_Value : in Integer := 0; Predictable : in Boolean := True; context_switch_overhead : in Integer := 0) is A_Task_Group : Generic_Task_Group_Ptr; Found : Boolean := False; begin check_initialize; -- Get the task_group pointer A_Task_Group := Search_Task_Group(My_Task_Groups, Task_Group_Name); -- Task_Set.Add_Task Task_Set.Add_Task ( My_Tasks, Name => Name, Cpu_Name => Cpu_Name, Core_Name => empty_string, Address_Space_Name => Address_Space_Name, Task_Type => Task_Type, Start_Time => Start_Time, Capacity => Capacity, Period => Period, Deadline => Deadline, Jitter => Jitter, Blocking_Time => Blocking_Time, Priority => Priority, Criticality => Criticality, Policy => Policy, Offset => Offset, Stack_Memory_Size => Stack_Memory_Size, Text_Memory_Size => Text_Memory_Size, Param => Param, Parametric_Rule_Name => Parametric_Rule_Name, Seed_Value => Seed_Value, Predictable => Predictable, context_switch_overhead => context_switch_overhead ); -- Add created task to task_group Add_Task_To_Group (My_Tasks, A_Task_Group, Name); end Add_Task; procedure Add_Task_To_Group (My_Tasks : in out Tasks_Set; My_Task_Group : in out Generic_Task_Group_Ptr; Name : in Unbounded_String) is A_Task : Generic_Task_Ptr; begin -- Get task pointer according to name in task set A_Task := Search_Task(My_Tasks, Name); Add_Task_To_Group(My_Task_Group, A_Task); end Add_Task_To_Group; procedure Add_Task_To_Group (My_Task_Group : in out Generic_Task_Group_Ptr; A_Task : in out Generic_Task_Ptr) is Tail_Task : Generic_Task_Ptr; Tail_Frame_Task : Frame_Task_Ptr; A_Multiframe : Multiframe_Task_Group_Ptr; begin check_initialize; if Task_Is_Present_In_Group(My_Task_Group, A_Task.Name) then Raise_Exception (Task_Set.Invalid_Parameter'Identity, To_String (Lb_Task (Current_Language) & " " & A_Task.Name & " : " & Lb_Task_Name (Current_Language) & Lb_Already_Defined (Current_Language))); end if; -- Check if task is of correct task_type according to task_group_type -- Check_Task(My_Task_Group, A_Task); -- Modify A_Task's start time in Multiframe case -- if (not is_empty (My_Task_Group.task_list)) and (My_Task_Group.task_group_type = Multiframe_Type) then Tail_Task := get_tail(My_Task_Group.task_list); Tail_Frame_Task := Frame_Task_Ptr(Tail_Task); -- Start_Time -- A_Task.start_time := Tail_Frame_Task.start_time + Tail_Frame_Task.interarrival; end if; -- Add task to task list tail -- add_tail(My_Task_Group.task_list, A_Task); -- Update Multiframe period -- if (My_Task_Group.task_group_type = Multiframe_Type) then A_Multiframe := Multiframe_Task_Group_Ptr(My_Task_Group); Set_Multiframe_Period(A_Multiframe); end if; end Add_Task_To_Group; procedure Check_Task (A_Task_Group : in Generic_Task_Group_Ptr; A_Task : in Generic_Task_Ptr) is begin case A_Task_Group.task_group_type is when Multiframe_type => if (A_Task.Task_Type /= Frame_Task_Type) then Raise_Exception (Task_Set.Invalid_Parameter'Identity, To_String (Lb_Task (Current_Language) & " " & A_Task.Name & " : " & Lb_Task_Type (Current_Language) & Lb_Must_Be (Current_Language) & Lb_Frame (Current_Language))); end if; when Transaction_type => if (A_Task.Task_Type /= Periodic_Type) then Raise_Exception (Task_Set.Invalid_Parameter'Identity, To_String (Lb_Task (Current_Language) & " " & A_Task.Name & " : " & Lb_Task_Type (Current_Language) & Lb_Must_Be (Current_Language) & Lb_Periodic (Current_Language))); end if; when others => null; end case; end Check_Task; function Task_Is_Present_In_Group (My_Task_Group : in Generic_Task_Group_Ptr; Name : in Unbounded_String) return Boolean is My_Iterator : Generic_Task_Iterator; A_Task : Generic_Task_Ptr; begin if not is_empty (My_Task_Group.task_list) then reset_head_iterator (My_Task_Group.task_list, My_Iterator); loop current_element (My_Task_Group.task_list, A_Task, My_Iterator); if (A_Task.name = Name) then return true; end if; exit when is_tail_element (My_Task_Group.task_list, My_Iterator); next_element (My_Task_Group.task_list, My_Iterator); end loop; else return false; end if; return false; end Task_Is_Present_In_Group; function Search_Task_Group (My_Task_Groups : in Task_Groups_Set; Name : in Unbounded_String) return Generic_Task_Group_Ptr is My_Iterator : Task_Groups_Iterator; A_Task_Group : Generic_Task_Group_Ptr; result : Generic_Task_Group_Ptr; Found : Boolean := False; begin if not is_empty(my_Task_Groups) then reset_iterator (My_Task_Groups, My_Iterator); loop current_element (My_Task_Groups, A_Task_Group, My_Iterator); if (A_Task_Group.name = Name) then Found := True; Result := A_Task_group; end if; exit when is_last_element (My_Task_Groups, My_Iterator); next_element (My_Task_Groups, My_Iterator); end loop; end if; if not Found then Raise_Exception (Task_Group_Not_Found'Identity, To_String (Lb_Task_Group_Name (Current_Language) & "=" & Name)); end if; return Result; end Search_Task_Group; function Search_Task_Group_By_Id (My_Task_Groups : in Task_Groups_Set; id : in Unbounded_String) return Generic_Task_Group_Ptr is My_Iterator : Task_Groups_Iterator; A_Task_Group : Generic_Task_Group_Ptr; result : Generic_Task_Group_Ptr; Found : Boolean := False; begin if not is_empty(my_Task_Groups) then reset_iterator (My_Task_Groups, My_Iterator); loop current_element (My_Task_Groups, A_Task_Group, My_Iterator); if (A_Task_Group.cheddar_private_id = id) then Found := True; Result := A_Task_group; end if; exit when is_last_element (My_Task_Groups, My_Iterator); next_element (My_Task_Groups, My_Iterator); end loop; end if; if not Found then Raise_Exception (Task_Group_Not_Found'Identity, To_String (Lb_Task_Group_Name (Current_Language) & "=" & id)); end if; return Result; end Search_Task_Group_by_id; function Task_Group_Is_Present (My_Task_Groups : in Task_Groups_Set; Name : in Unbounded_String) return Boolean is My_Iterator : Task_Groups_Iterator; A_Task_Group : Generic_Task_Group_Ptr; begin if is_empty (My_Task_Groups) then return False; else reset_iterator (My_Task_Groups, My_Iterator); loop current_element (My_Task_Groups, A_Task_Group, My_Iterator); if (A_Task_Group.name = Name) then return true; end if; exit when is_last_element (My_Task_Groups, My_Iterator); next_element (My_Task_Groups, My_Iterator); end loop; return false; end if; end Task_Group_Is_Present; function Search_Task_Group_By_Task (My_Task_Groups : in Task_Groups_Set; Name : in Unbounded_String) return Generic_Task_Group_Ptr is My_Iterator : Task_Groups_Iterator; A_Task_Group : Generic_Task_Group_Ptr; result : Generic_Task_Group_Ptr; Found : Boolean := False; begin if not is_empty(My_Task_Groups) then reset_iterator (My_Task_Groups, My_Iterator); loop current_element (My_Task_Groups, A_Task_Group, My_Iterator); if (Task_Is_Present_In_Group(A_Task_Group, Name)) then Found := True; Result := A_Task_group; end if; exit when is_last_element (My_Task_Groups, My_Iterator); next_element (My_Task_Groups, My_Iterator); end loop; end if; if not Found then Raise_Exception (Task_Not_Found'Identity, To_String (Lb_Task_Name (Current_Language) & "=" & Name)); end if; return Result; end Search_Task_Group_By_Task; function Search_Task_Group_By_Task (My_Task_Groups : in Task_Groups_Set; My_Task : in Generic_Task_Ptr) return Generic_Task_Group_Ptr is begin return Search_Task_Group_By_Task(My_Task_Groups, My_Task.name); end Search_Task_Group_By_Task; function Get_Multiframe_Period (A_Multiframe : in Multiframe_Task_Group_Ptr) return Integer is MF_Period : Integer; My_Iterator : Generic_Task_Iterator; A_Task : Generic_Task_Ptr; A_Frame_Task : Frame_Task_Ptr; begin MF_Period := 0; if (not is_empty (A_Multiframe.task_list)) then -- Compute MF_Period by summing Frame.interarrivals reset_head_iterator (A_Multiframe.task_list, My_Iterator); loop current_element (A_Multiframe.task_list, A_Task, My_Iterator); A_Frame_Task := Frame_Task_Ptr(A_Task); MF_Period := MF_Period + A_Frame_Task.interarrival; exit when is_tail_element (A_Multiframe.task_list, My_Iterator); next_element (A_Multiframe.task_list, My_Iterator); end loop; end if; return MF_Period; end Get_Multiframe_Period; function Get_No_Deadlocks_Precedences_Number (My_Task_Groups : in Task_Groups_Set) return Integer is begin return Get_No_Deadlocks_Precedences_Number(My_Task_Groups, Integer(get_number_of_elements(My_Task_Groups))); end Get_No_Deadlocks_Precedences_Number; function Get_No_Deadlocks_Precedences_Number (My_Task_Groups : in Task_Groups_Set; Number_Groups : in Integer) return Integer is Result : Integer; A_Task_Group : Generic_Task_Group_Ptr; Next_Task_Group : Generic_Task_Group_Ptr; begin Result := 0; for i in 0 .. (Number_Groups - 2) loop get_element_number(My_Task_Groups, A_Task_Group, (Task_Groups_Range(i))); for j in (i + 1) .. (Number_Groups - 1) loop get_element_number(My_Task_Groups, Next_Task_Group, (Task_Groups_Range(j))); Result := Result + Integer(get_number_of_elements(A_Task_Group.task_list) * get_number_of_elements(Next_Task_Group.task_list)); end loop; end loop; return Result; end Get_No_Deadlocks_Precedences_Number; procedure Set_Multiframe_Period (A_Multiframe : in out Multiframe_Task_Group_Ptr) is MF_Period : Integer; My_Iterator : Generic_Task_Iterator; A_Task : Generic_Task_Ptr; A_Frame_Task : Frame_Task_Ptr; begin if (not is_empty (A_Multiframe.task_list)) then MF_Period := Get_Multiframe_Period(A_Multiframe); -- Set MF_Period for all tasks reset_head_iterator (A_Multiframe.task_list, My_Iterator); loop current_element (A_Multiframe.task_list, A_Task, My_Iterator); A_Frame_Task := Frame_Task_Ptr(A_Task); A_Frame_Task.period := MF_Period; -- TODO Set MF_Period to A_Multiframe exit when is_tail_element (A_Multiframe.task_list, My_Iterator); next_element (A_Multiframe.task_list, My_Iterator); end loop; end if; end Set_Multiframe_Period; procedure Set_Multiframe_Precedences (My_Task_Groups : in Task_Groups_Set; My_Precedences : in out Tasks_Dependencies_Ptr) is My_Iterator : Task_Groups_Iterator; A_Task_Group : Generic_Task_Group_Ptr; A_Multiframe : Multiframe_Task_Group_Ptr; begin if (not is_empty (My_Task_Groups)) then reset_iterator (My_Task_Groups, My_Iterator); loop current_element (My_Task_Groups, A_Task_Group, My_Iterator); if (A_Task_Group.task_group_type = Multiframe_Type) then A_Multiframe := Multiframe_Task_Group_Ptr(A_Task_Group); Set_Multiframe_Precedences(A_Multiframe, My_Precedences); end if; exit when is_last_element (My_Task_Groups, My_Iterator); next_element (My_Task_Groups, My_Iterator); end loop; end if; end Set_Multiframe_Precedences; procedure Set_Multiframe_Precedences (A_Multiframe : in Multiframe_Task_Group_Ptr; My_Precedences : in out Tasks_Dependencies_Ptr) is My_Iterator : Generic_Task_Iterator; My_Next_Iterator : Generic_Task_Iterator; A_Task : Generic_Task_Ptr; Next_Task : Generic_Task_Ptr; begin if (not is_empty (A_Multiframe.task_list)) then reset_head_iterator (A_Multiframe.task_list, My_Iterator); reset_head_iterator (A_Multiframe.task_list, My_Next_Iterator); loop current_element (A_Multiframe.task_list, A_Task, My_Iterator); if (not is_tail_element (A_Multiframe.task_list, My_Next_Iterator)) then next_element (A_Multiframe.task_list, My_Next_Iterator); current_element (A_Multiframe.task_list, Next_Task, My_Next_Iterator); end if; if (not is_tail_element (A_Multiframe.task_list, My_Iterator)) then Add_One_Task_Dependency_precedence(My_Precedences, A_Task, Next_Task); end if; exit when is_tail_element (A_Multiframe.task_list, My_Iterator); next_element (A_Multiframe.task_list, My_Iterator); end loop; end if; end Set_Multiframe_Precedences; procedure Set_Interarrival (A_Frame_Task : in out Frame_Task_Ptr; A_Multiframe : in out Multiframe_Task_Group_Ptr; Interarrival : in Integer) is Dummy_Task_Group : Generic_Task_Group_Ptr; begin Dummy_Task_Group := Generic_Task_Group_Ptr(A_Multiframe); if (not Task_Is_Present_In_Group(Dummy_Task_Group, A_Frame_Task.name)) then -- TODO Add better exception message Raise_Exception (Task_Not_Present_In_Group'Identity, "Task is not present in group"); end if; A_Frame_Task.interarrival := Interarrival; Set_Multiframe_Period(A_Multiframe); Set_Multiframe_Start_Times(A_Multiframe); end Set_Interarrival; procedure Set_Multiframe_Start_Times (A_Multiframe : in Multiframe_Task_Group_Ptr) is My_Iterator : Generic_Task_Iterator; My_Next_Iterator : Generic_Task_Iterator; A_Task : Generic_Task_Ptr; A_Frame_Task : Frame_Task_Ptr; Next_Task : Generic_Task_Ptr; begin if (not is_empty (A_Multiframe.task_list)) then reset_head_iterator (A_Multiframe.task_list, My_Iterator); reset_head_iterator (A_Multiframe.task_list, My_Next_Iterator); loop current_element (A_Multiframe.task_list, A_Task, My_Iterator); if (not is_tail_element (A_Multiframe.task_list, My_Next_Iterator)) then next_element (A_Multiframe.task_list, My_Next_Iterator); current_element (A_Multiframe.task_list, Next_Task, My_Next_Iterator); end if; if (not is_tail_element (A_Multiframe.task_list, My_Iterator)) then A_Frame_Task := Frame_Task_Ptr(A_Task); Next_Task.start_time := A_Frame_Task.start_time + A_Frame_Task.interarrival; end if; exit when is_tail_element (A_Multiframe.task_list, My_Iterator); next_element (A_Multiframe.task_list, My_Iterator); end loop; end if; end Set_Multiframe_Start_Times; procedure Check_entity_referencing_task (My_task_groups : in task_groups_Set; A_task : in Unbounded_String) is A_task_group : Generic_task_group_Ptr; My_Iterator : task_groups_Iterator; begin if (get_number_of_elements (My_task_groups) > 0) then reset_iterator (My_task_groups, My_Iterator); loop current_element (My_task_groups, A_task_group, My_Iterator); -- Look for the task in the task list -- declare My_Next_Iterator : Generic_Task_Iterator; A_generic_Task : Generic_Task_Ptr; begin if (not is_empty (A_task_group.task_list)) then reset_head_iterator (A_task_group.task_list, My_next_Iterator); loop current_element (A_task_group.task_list, A_generic_Task, My_next_Iterator); if (not is_tail_element (A_task_group.task_list, My_next_Iterator)) then if (A_generic_task.name = a_task) then Raise_Exception (Invalid_Parameter'Identity, To_String ( lb_task (Current_Language) & " " & a_task & " : " & lb_task_group (Current_Language) & " " & a_task_group.Name & " : " & lb_entity_referenced_elsewhere(current_language) )); end if; end if; exit when is_tail_element (A_task_group.task_list, My_next_Iterator); next_element (A_task_group.task_list, My_next_Iterator); end loop; end if; end; exit when is_last_element (My_task_groups, My_Iterator); next_element (My_task_groups, My_Iterator); end loop; end if; end Check_entity_referencing_task; procedure Transaction_Control (My_Task_groups : in Task_groups_Set) is Iterator1 : Task_groups_Iterator; Task_group1 : Generic_Task_group_Ptr; begin reset_iterator (My_Task_groups, Iterator1); loop current_element (My_Task_groups, Task_group1, Iterator1); if Task_group1.task_group_type /= transaction_type then raise transaction_Error; end if; exit when is_last_element (My_Task_groups, Iterator1); next_element (My_Task_groups, Iterator1); end loop; end Transaction_Control; end Task_Group_Set;