------------------------------------------------------------------------------ ------------------------------------------------------------------------------ -- 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-2014 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; package body cfg_edges is -- --------= CFG_Edge =-------- procedure initialize (obj : in out cfg_edge) is begin initialize (named_object (obj)); obj.node := empty_string; obj.next_node := empty_string; obj.object_type := cfg_edge_object_type; end initialize; function copy (obj : in cfg_edge) return cfg_edge_ptr is new_cfg_edge : cfg_edge_ptr; begin new_cfg_edge := new cfg_edge'(obj); return (new_cfg_edge); end copy; function copy (obj : in cfg_edge_ptr) return cfg_edge_ptr is begin return copy (obj.all); end copy; procedure put (obj : in cfg_edge) is begin put (named_object (obj)); Put ("node: "); Put (obj.node); Put ("; "); Put ("next_node: "); Put (obj.next_node); Put ("; "); end put; procedure put (obj : in cfg_edge_ptr) is begin put (obj.all); end put; procedure put_name (obj : in cfg_edge_ptr) is begin Put (To_String (obj.name)); end put_name; function get_name (obj : in cfg_edge) return Unbounded_String is begin return obj.name; end get_name; function get_name (obj : in cfg_edge_ptr) return Unbounded_String is begin return obj.name; end get_name; function type_of (obj : in cfg_edge) return unbounded_string_list is list : unbounded_string_list; s : unbounded_string_ptr; begin initialize (list); s := new Unbounded_String; s.all := To_Unbounded_String ("OBJECTS.GENERIC_OBJECT"); add (list, s); s := new Unbounded_String; s.all := To_Unbounded_String ("OBJECTS.NAMED_OBJECT"); add (list, s); s := new Unbounded_String; s.all := To_Unbounded_String ("CFG_EDGES.CFG_EDGE"); add (list, s); return list; end type_of; function type_of (obj : in cfg_edge_ptr) return unbounded_string_list is begin return type_of (obj.all); end type_of; procedure build_attributes_xml_string (obj : in cfg_edge; result : in out Unbounded_String) is begin build_attributes_xml_string (named_object (obj), result); if (xml_string (obj.node) /= empty_string) then result := result & To_Unbounded_String ("") & xml_string (obj.node) & To_Unbounded_String (""); end if; if (xml_string (obj.next_node) /= empty_string) then result := result & To_Unbounded_String ("") & xml_string (obj.next_node) & To_Unbounded_String (""); end if; end build_attributes_xml_string; function xml_string (obj : in cfg_edge) 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 cfg_edge_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 cfg_edge) return Unbounded_String is result : Unbounded_String; begin result := To_Unbounded_String (""); return (result); end xml_ref_string; function xml_ref_string (obj : in cfg_edge_ptr) return Unbounded_String is begin return xml_ref_string (obj.all); end xml_ref_string; end cfg_edges;