------------------------------------------------------------------------------ ------------------------------------------------------------------------------ -- This source file was automatically generated by Platypus -- see http://dossen.univ-brest.fr/apl -- -- 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 LAB-STICC 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 Text_IO; use Text_IO; with unbounded_strings; use unbounded_strings; with primitive_xml_strings; use primitive_xml_strings; with systems; use systems; package body applicability_constraints_main_structure is -- --------= Applicability_Constraint =-------- procedure initialize (obj : out applicability_constraint) is begin obj.name := empty_string; obj.result := False; end initialize; procedure put (obj : in applicability_constraint) is begin Put ("Name: "); Put (obj.name); Put ("; "); Put ("Result: "); standards_io.boolean_io.Put (obj.result); Put ("; "); end put; procedure put (obj : in applicability_constraint_ptr) is begin put (obj.all); end put; procedure build_attributes_xml_string (obj : in applicability_constraint; result : in out Unbounded_String) is begin if (xml_string (obj.name) /= empty_string) then result := result & To_Unbounded_String ("") & xml_string (obj.name) & To_Unbounded_String (""); end if; if (xml_string (obj.result) /= empty_string) then result := result & To_Unbounded_String ("") & xml_string (obj.result) & To_Unbounded_String (""); end if; end build_attributes_xml_string; function xml_string (obj : in applicability_constraint) return Unbounded_String is result : Unbounded_String; begin result := To_Unbounded_String (""); build_attributes_xml_string (obj, result); result := result & To_Unbounded_String (""); return (result); end xml_string; function xml_string (obj : in applicability_constraint_ptr) return Unbounded_String is begin if obj /= null then return xml_string (obj.all); else return empty_string; end if; end xml_string; function xml_ref_string (obj : in applicability_constraint) return Unbounded_String is result : Unbounded_String; begin raise xml_ref_string_error; return To_Unbounded_String (""); end xml_ref_string; function copy (obj : in applicability_constraint) return applicability_constraint_ptr is new_applicability_constraint : applicability_constraint_ptr; begin new_applicability_constraint := new applicability_constraint'(obj); return (new_applicability_constraint); end copy; function copy (obj : in applicability_constraint_ptr) return applicability_constraint_ptr is begin return copy (obj.all); end copy; -- --------= Applicability_Constraint_Case =-------- procedure initialize (obj : out applicability_constraint_case) is begin obj.name := empty_string; obj.feasibility_test_names := empty_string; end initialize; procedure put (obj : in applicability_constraint_case) is begin Put ("Name: "); Put (obj.name); Put ("; "); Put ("Feasibility_Test_Names: "); Put (obj.feasibility_test_names); Put ("; "); Put ("Applicability_Constraints: "); put (obj.applicability_constraints); Put ("; "); end put; procedure put (obj : in applicability_constraint_case_ptr) is begin put (obj.all); end put; procedure build_attributes_xml_string (obj : in applicability_constraint_case; result : in out Unbounded_String) is begin if (xml_string (obj.name) /= empty_string) then result := result & To_Unbounded_String ("") & xml_string (obj.name) & To_Unbounded_String (""); end if; if (xml_string (obj.feasibility_test_names) /= empty_string) then result := result & To_Unbounded_String ("") & xml_string (obj.feasibility_test_names) & To_Unbounded_String (""); end if; if (xml_string (obj.applicability_constraints) /= empty_string) then result := result & To_Unbounded_String ("") & xml_string (obj.applicability_constraints) & To_Unbounded_String (""); end if; end build_attributes_xml_string; function xml_string (obj : in applicability_constraint_case) return Unbounded_String is result : Unbounded_String; begin result := To_Unbounded_String (""); build_attributes_xml_string (obj, result); result := result & To_Unbounded_String (""); return (result); end xml_string; function xml_string (obj : in applicability_constraint_case_ptr) return Unbounded_String is begin if obj /= null then return xml_string (obj.all); else return empty_string; end if; end xml_string; function xml_ref_string (obj : in applicability_constraint_case) return Unbounded_String is result : Unbounded_String; begin raise xml_ref_string_error; return To_Unbounded_String (""); end xml_ref_string; function copy (obj : in applicability_constraint_case) return applicability_constraint_case_ptr is new_applicability_constraint_case : applicability_constraint_case_ptr; begin new_applicability_constraint_case := new applicability_constraint_case'(obj); return (new_applicability_constraint_case); end copy; function copy (obj : in applicability_constraint_case_ptr) return applicability_constraint_case_ptr is begin return copy (obj.all); end copy; -- --------= All_Cases_Structure =-------- procedure initialize (obj : out all_cases_structure) is begin null; end initialize; procedure put (obj : in all_cases_structure) is begin Put ("Cases: "); put (obj.cases); Put ("; "); end put; procedure put (obj : in all_cases_structure_ptr) is begin put (obj.all); end put; procedure build_attributes_xml_string (obj : in all_cases_structure; result : in out Unbounded_String) is begin if (xml_string (obj.cases) /= empty_string) then result := result & To_Unbounded_String ("") & xml_string (obj.cases) & To_Unbounded_String (""); end if; end build_attributes_xml_string; function xml_string (obj : in all_cases_structure) return Unbounded_String is result : Unbounded_String; begin result := To_Unbounded_String (""); build_attributes_xml_string (obj, result); result := result & To_Unbounded_String (""); return (result); end xml_string; function xml_string (obj : in all_cases_structure_ptr) return Unbounded_String is begin if obj /= null then return xml_string (obj.all); else return empty_string; end if; end xml_string; function xml_ref_string (obj : in all_cases_structure) return Unbounded_String is result : Unbounded_String; begin raise xml_ref_string_error; return To_Unbounded_String (""); end xml_ref_string; function copy (obj : in all_cases_structure) return all_cases_structure_ptr is new_all_cases_structure : all_cases_structure_ptr; begin new_all_cases_structure := new all_cases_structure'(obj); return (new_all_cases_structure); end copy; function copy (obj : in all_cases_structure_ptr) return all_cases_structure_ptr is begin return copy (obj.all); end copy; end applicability_constraints_main_structure;