------------------------------------------------------------------------------ ------------------------------------------------------------------------------ -- This Ada package was automatically generated by the software engineering --tool Platypus -- see http://cassoulet.univ-brest.fr/mme -- -- Any modification of this file will be lost. -- Please see the "platypus" directory instead : it contains the Cheddar's -- model and its meta-model. ------------------------------------------------------------------------------ ------------------------------------------------------------------------------ -- Cheddar is a free real time scheduling tool. -- This program provides services to automatically check temporal constraints -- of real time tasks. -- -- Copyright (C) 2002-2009 Frank Singhoff -- Cheddar is developed by the LISYC Team, University of Brest -- -- 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 -- To post to this mailing list, you must be subscribed -- (see http//beru.univ-brest.fr/~singhoff/cheddar for details) -- ------------------------------------------------------------------------------ ------------------------------------------------------------------------------ with primitive_xml_strings; use primitive_xml_strings; with Unbounded_Strings; use Unbounded_Strings; use Unbounded_Strings.Unbounded_String_List_Package; with Systems; use Systems; with Processor_Set; use Processor_Set; package body Applicability_Constraints_Main_Structure.extended is procedure duplicate_applicability_constraints_list (obj : in Applicability_Constraints_List; obj2 : out Applicability_Constraints_List) is constraints_Iterator : Applicability_Constraints_List_Iterator; current_constraint : Applicability_Constraint_Ptr; begin Reset_Head_Iterator (obj, constraints_Iterator); Current_Element (obj, current_constraint, constraints_Iterator); while not Is_Tail_Element (obj, constraints_Iterator) loop Add (obj2, Copy (current_constraint)); Next_Element (obj, constraints_Iterator); Current_Element (obj, current_constraint, constraints_Iterator); end loop; Add (obj2, Copy (current_constraint)); end duplicate_applicability_constraints_list; procedure evaluate (obj : in out All_Cases_Structure; Sys : in System) is constraints_Iterator : Applicability_Constraints_List_Iterator; cases_iterator : Applicability_Constraint_Cases_List_Iterator; current_constraint : Applicability_Constraint_Ptr; current_case : Applicability_Constraint_Case_Ptr; temp : Boolean; begin Reset_Head_Iterator (obj.Cases, cases_iterator); Current_Element (obj.Cases, current_case, cases_iterator); loop Reset_Head_Iterator (current_case.Applicability_Constraints, constraints_Iterator); Current_Element (current_case.Applicability_Constraints, current_constraint, constraints_Iterator); loop temp := current_constraint.all.Corresponding_Function (Sys); current_constraint.all.Result := current_constraint.all.Corresponding_Function (Sys); exit when Is_Tail_Element (current_case.Applicability_Constraints, constraints_Iterator); Next_Element (current_case.all.Applicability_Constraints, constraints_Iterator); Current_Element (current_case.all.Applicability_Constraints, current_constraint, constraints_Iterator); end loop; current_constraint.all.Result := current_constraint.all.Corresponding_Function (Sys); exit when (Is_Tail_Element (obj.Cases, cases_iterator)); Next_Element (obj.Cases, cases_iterator); Current_Element (obj.Cases, current_case, cases_iterator); end loop; Reset_Head_Iterator (current_case.all.Applicability_Constraints, constraints_Iterator); Current_Element (current_case.all.Applicability_Constraints, current_constraint, constraints_Iterator); end evaluate; procedure display_tests_list (obj : in All_Cases_Structure) is constraints_Iterator : Applicability_Constraints_List_Iterator; cases_iterator : Applicability_Constraint_Cases_List_Iterator; current_constraint : Applicability_Constraint_Ptr; current_case : Applicability_Constraint_Case_Ptr; res : Boolean; begin Reset_Head_Iterator (obj.Cases, cases_iterator); Current_Element (obj.Cases, current_case, cases_iterator); loop res := True; Reset_Head_Iterator (current_case.Applicability_Constraints, constraints_Iterator); Current_Element (current_case.Applicability_Constraints, current_constraint, constraints_Iterator); loop res := res and current_constraint.all.Result; exit when (Is_Tail_Element (current_case.Applicability_Constraints, constraints_Iterator)); Next_Element (current_case.all.Applicability_Constraints, constraints_Iterator); Current_Element (current_case.all.Applicability_Constraints, current_constraint, constraints_Iterator); end loop; res := res and current_constraint.all.Result; if res then Put_Line ("*************************************"); Put_Line ("*****Feasibility tests selection*****"); Put_Line (current_case.all.Feasibility_Test_Names); Put_Line ("*************************************"); end if; exit when (Is_Tail_Element (obj.Cases, cases_iterator)); Next_Element (obj.Cases, cases_iterator); Current_Element (obj.Cases, current_case, cases_iterator); end loop; end display_tests_list; function get_tests_list (obj : in All_Cases_Structure) return Unbounded_String is constraints_Iterator : Applicability_Constraints_List_Iterator; cases_iterator : Applicability_Constraint_Cases_List_Iterator; current_constraint : Applicability_Constraint_Ptr; current_case : Applicability_Constraint_Case_Ptr; res : Boolean; begin Reset_Head_Iterator (obj.Cases, cases_iterator); Current_Element (obj.Cases, current_case, cases_iterator); loop res := True; Reset_Head_Iterator (current_case.Applicability_Constraints, constraints_Iterator); Current_Element (current_case.Applicability_Constraints, current_constraint, constraints_Iterator); loop res := res and current_constraint.all.Result; exit when (Is_Tail_Element (current_case.Applicability_Constraints, constraints_Iterator)); Next_Element (current_case.all.Applicability_Constraints, constraints_Iterator); Current_Element (current_case.all.Applicability_Constraints, current_constraint, constraints_Iterator); end loop; res := res and current_constraint.all.Result; if res then return Unbounded_lf & current_case.all.Feasibility_Test_Names & Unbounded_lf & current_case.all.Name; end if; exit when (Is_Tail_Element (obj.Cases, cases_iterator)); Next_Element (obj.Cases, cases_iterator); Current_Element (obj.Cases, current_case, cases_iterator); end loop; return Unbounded_lf & To_Unbounded_String ("No feasibility tests Selected"); end get_tests_list; end Applicability_Constraints_Main_Structure.extended;