------------------------------------------------------------------------------ ------------------------------------------------------------------------------ -- 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;