------------------------------------------------------------------------------ ------------------------------------------------------------------------------ -- 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; with debug; use debug; package body applicability_constraints_main_structure.extended is procedure initialize (obj : out applicability_constraint_ptr) is begin obj := new applicability_constraint; obj.all.name := empty_string; obj.all.result := False; obj.all.corresponding_function := null; end initialize; procedure initialize (obj : out applicability_constraint_case_ptr) is begin obj := new applicability_constraint_case; obj.all.name := empty_string; obj.all.feasibility_test_names := empty_string; initialize (obj.all.applicability_constraints); end initialize; procedure initialize (obj : out all_cases_structure_ptr) is begin obj := new all_cases_structure; initialize (obj.all); end initialize; 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 put_debug ("loop for evaluating all constraints iteration"); -- 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; function duplicate (obj : in applicability_constraint_ptr) return applicability_constraint_ptr is obj2 : applicability_constraint_ptr; begin initialize (obj2); obj2.all.name := obj.all.name; obj2.all.result := obj.all.result; obj2.all.corresponding_function := obj.all.corresponding_function; return obj2; end duplicate; function duplicate (obj : in applicability_constraint_case_ptr) return applicability_constraint_case_ptr is obj2 : applicability_constraint_case_ptr; begin initialize (obj2); obj2.all.name := obj.all.name; obj2.all.feasibility_test_names := obj.all.feasibility_test_names; duplicate (obj.all.applicability_constraints, obj2.all.applicability_constraints, True); return obj2; end duplicate; end applicability_constraints_main_structure.extended;