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