|
DataMuseum.dkPresents historical artifacts from the history of: Rational R1000/400 Tapes |
This is an automatic "excavation" of a thematic subset of
See our Wiki for more about Rational R1000/400 Tapes Excavated with: AutoArchaeologist - Free & Open Source Software. |
top - downloadIndex: ┃ B T ┃
Length: 35584 (0x8b00)
Types: TextFile
Names: »B«
└─⟦a7d1ea751⟧ Bits:30000550 8mm tape, Rational 1000, !users!projects 94_04_11
└─ ⟦129cab021⟧ »DATA«
└─⟦bb25a46d4⟧
└─⟦f64eaa120⟧ Bits:30000752 8mm tape, Rational 1000, !projects 93 02 16
└─ ⟦6f12a12be⟧ »DATA«
└─⟦bb25a46d4⟧
└─⟦2f6cfab89⟧ Bits:30000547 8mm tape, Rational 1000, !projects 94-01-04
└─ ⟦d65440be7⟧ »DATA«
└─⟦bb25a46d4⟧
└─⟦this⟧
with ACTION;
with ASA_DEFINITIONS;
with CALENDAR;
with CMVC_IMPLEMENTATION_ERRORS;
with DATABASE_OPERATIONS;
with DIANA;
with DIRECTORY_OPERATIONS;
with DIRECTORY;
with ERROR_MESSAGES;
with HIERARCHY;
with JOB_SEGMENT;
with LOGGER;
with PROFILE;
with GATEWAY_OBJECT;
with RELOCATION;
with SIMPLE_STATUS;
with STRING_UTILITIES;
with SYSTEM;
with UNIX_DEFINITIONS;
package body GATEWAYS is
package ASAP renames ASA_DEFINITIONS.PROPERTIES;
package ASAS renames ASA_DEFINITIONS.SWITCHES;
package CMVCE renames CMVC_IMPLEMENTATION_ERRORS;
package CMVCI renames CMVC_IMPLEMENTATION;
package DCP renames DIRECTORY.CONTROL_POINT;
package DIR renames DIRECTORY;
package DNA renames DIRECTORY.NAMING;
package DOO renames DIRECTORY.OBJECT_OPERATIONS;
package GWO renames GATEWAY_OBJECT;
package HCHY renames HIERARCHY;
package SS renames SIMPLE_STATUS;
package SU renames STRING_UTILITIES;
package UNIX renames UNIX_DEFINITIONS;
function CREATION_MESSAGE (GATEWAY : in GWO.HANDLE) return STRING is
begin
return "Created gateway object " &
DNA.GET_FULL_NAME (GWO.DIRECTORY_OBJECT (GATEWAY)) &
" of class " &
ASA_DEFINITIONS.GATEWAY_CLASS'IMAGE (ASAP.CLASS (GATEWAY));
end CREATION_MESSAGE;
function SAME_PROPERTIES (MODULE : in HCHY.MODULE; GATEWAY : in GWO.HANDLE)
return BOOLEAN is
SAME_REQUIREMENTS : BOOLEAN := TRUE;
begin
for R in REQUIREMENTS.FUNCTIONAL_REQUIREMENT_NUMBER loop
if ASAP.ASA_REQUIREMENT (H => GATEWAY, NUMBER => R) /=
HCHY.REQUIREMENT (M => MODULE, NUMBER => R) then
SAME_REQUIREMENTS := FALSE;
exit;
end if;
end loop;
return SAME_REQUIREMENTS and then ASAP.ASA_NODE_NUMBER (GATEWAY) =
HCHY.NODE_NUMBER (MODULE) and then
ASAP.ASA_COMMENT (GATEWAY) = HCHY.COMMENT (MODULE);
end SAME_PROPERTIES;
function TREE_SIZE (ROOTED_AT : in HCHY.MODULE) return POSITIVE is
CHILDREN : HCHY.MODULE_ITERATOR := HCHY.CHILDREN_OF (ROOTED_AT);
RESULT : POSITIVE := 1;
begin
while not HCHY.DONE (CHILDREN) loop
RESULT := RESULT + TREE_SIZE (HCHY.VALUE (CHILDREN));
HCHY.NEXT (CHILDREN);
end loop;
return RESULT;
end TREE_SIZE;
-- ----------------
-- ( ) CMVC support
-- ----------------
function RELATIVE_NAME
(FULL_NAME : in STRING; RELATIVE_TO : in STRING) return STRING is
begin
pragma ASSERT (FULL_NAME'LENGTH >= RELATIVE_TO'LENGTH and then
FULL_NAME (FULL_NAME'FIRST ..
FULL_NAME'FIRST + RELATIVE_TO'LENGTH - 1) =
RELATIVE_TO);
return FULL_NAME
(FULL_NAME'FIRST + RELATIVE_TO'LENGTH + 1 -- Skip the '.'
.. FULL_NAME'LAST);
end RELATIVE_NAME;
procedure GET_CMVC_CONTROL (OBJECT : in DIR.OBJECT;
THE_STATE : in out STATE;
CONTROL : out CMVC_CONTROL_KIND) is
E : DIR.ERROR_STATUS;
N : DNA.NAME_STATUS;
S : CMVCI.ERROR_STATUS;
CONFIGURATION_OBJECT : DIR.OBJECT;
ACTION_ID : ACTION.ID renames THE_STATE.CMVC.ACTION_ID;
THE_CONFIGURATION : CMVCI.CONFIGURATION renames THE_STATE.CONFIGURATION;
THE_ELEMENT : CMVCI.ELEMENT;
THE_VERSION_SET : CMVCI.VERSION_SET;
VIEW_OBJECT : DIR.OBJECT;
use CMVCE;
begin
DCP.PARENT_WORLD (THE_OBJECT => OBJECT,
THE_WORLD => VIEW_OBJECT,
STATUS => E);
LOGGER.STATUS (E);
--
-- Make sure the configuration associated to the current view is
-- open.
--
if CMVCI.IS_NIL (THE_CONFIGURATION) then
DNA.RESOLVE (NAME => DNA.GET_FULL_NAME (VIEW_OBJECT) &
"^$$.Configurations." &
DNA.GET_SIMPLE_NAME (VIEW_OBJECT),
THE_OBJECT => CONFIGURATION_OBJECT,
STATUS => N,
ACTION_ID => ACTION_ID);
LOGGER.STATUS (N);
THE_CONFIGURATION := DATABASE_OPERATIONS.OPEN_CONFIGURATION
(FOR_CONFIG_OBJECT => CONFIGURATION_OBJECT,
S => THE_STATE.CMVC);
end if;
--
-- Look at the CMVC database to see if the object being operated
-- on is controlled.
--
CMVCI.ELEMENT_OPERATIONS.OPEN
(ELEMENT_NAME =>
RELATIVE_NAME (FULL_NAME => DNA.GET_FULL_NAME (OBJECT),
RELATIVE_TO => DNA.GET_FULL_NAME (VIEW_OBJECT)),
ELEM => THE_ELEMENT,
STATUS => S,
DB => CMVCI.CONFIGURATION_OPERATIONS.DATABASE_OF (THE_CONFIGURATION));
if S = CMVCE.NO_SUCH_ELEMENT then
CONTROL := NOT_CONTROLLED;
return;
elsif CMVCI.IS_BAD (S) then
LOGGER.STATUS (S);
end if;
CMVCI.VERSION_SET_OPERATIONS.OPEN (ELEM => THE_ELEMENT,
SET => THE_VERSION_SET,
STATUS => S,
CONFIG => THE_CONFIGURATION);
if S = CMVCE.ELEMENT_NOT_IN_CONFIGURATION then
CONTROL := NOT_CONTROLLED;
elsif CMVCI.HISTORY_OPERATIONS.IS_CHECKED_OUT (THE_VERSION_SET) then
CONTROL := CONTROLLED_CHECKED_OUT;
else
CONTROL := CONTROLLED_CHECKED_IN;
end if;
end GET_CMVC_CONTROL;
procedure MAKE_CONTROLLED (GATEWAY : in out GWO.HANDLE;
SAVE_SOURCE : in BOOLEAN;
COMMENTS : in STRING;
THE_STATE : in out STATE) is
GATEWAY_OBJECT : constant DIR.OBJECT := GWO.DIRECTORY_OBJECT (GATEWAY);
begin
DATABASE_OPERATIONS.CONTROL_PARENT (THE_OBJECT => GATEWAY_OBJECT,
SET => RELOCATION.NULL_PARAMETER,
THE_STATE => THE_STATE.CMVC);
DATABASE_OPERATIONS.CREATE_OR_ADD_ELEMENT
(THE_OBJECT => GATEWAY_OBJECT,
VERSION_SET_NAME => "<AUTO_GENERATE>",
SAVE_SOURCE => SAVE_SOURCE,
COMMENTS => COMMENTS,
COMMAND => "MAKE_CONTROLLED",
THE_STATE => THE_STATE.CMVC);
exception
when CONSTRAINT_ERROR =>
LOGGER.WARNING ("Gateway object " &
DNA.GET_FULL_NAME (GATEWAY_OBJECT) &
" could not be controlled because its parent isn't");
end MAKE_CONTROLLED;
generic
with procedure DO_UPDATE (GATEWAY : in GWO.HANDLE);
procedure UPDATER (GATEWAY : in out GWO.HANDLE;
COMMENTS : in STRING;
THE_STATE : in out STATE);
procedure UPDATER (GATEWAY : in out GWO.HANDLE;
COMMENTS : in STRING;
THE_STATE : in out STATE) is
GATEWAY_OBJECT : constant DIR.OBJECT := GWO.DIRECTORY_OBJECT (GATEWAY);
ACTION_ID : ACTION.ID renames THE_STATE.CMVC.ACTION_ID;
GATEWAY_CMVC_CONTROL : CMVC_CONTROL_KIND;
S : SS.CONDITION;
begin
GET_CMVC_CONTROL (OBJECT => GATEWAY_OBJECT,
THE_STATE => THE_STATE,
CONTROL => GATEWAY_CMVC_CONTROL);
if GATEWAY_CMVC_CONTROL = CONTROLLED_CHECKED_IN then
DATABASE_OPERATIONS.CHECK_OUT
(OBJECTS => DIRECTORY_OPERATIONS.SINGLETON
(GATEWAY_OBJECT, THE_STATE.CMVC),
EXPECTED_CHECK_IN_TIME => CALENDAR.CLOCK,
COMMENTS => COMMENTS,
ALLOW_DEMOTION => FALSE,
ALLOW_ACCEPT_CHANGES => TRUE,
THE_STATE => THE_STATE.CMVC);
end if;
if not GWO.IS_MAIN_OBJECT_OPEN_FOR_UPDATE (GATEWAY) then
GWO.CLOSE (GATEWAY, S);
LOGGER.STATUS (S);
GWO.OPEN_MAIN_OBJECT (OBJECT => GATEWAY_OBJECT,
H => GATEWAY,
UPDATE => TRUE,
ACTION_ID => ACTION_ID,
ERRORS => S);
LOGGER.STATUS (S);
end if;
DO_UPDATE (GATEWAY);
GWO.CLOSE (GATEWAY, S);
LOGGER.STATUS (S);
if GATEWAY_CMVC_CONTROL = CONTROLLED_CHECKED_IN then
DATABASE_OPERATIONS.CHECK_IN (THE_OBJECT => GATEWAY_OBJECT,
COMMENTS => COMMENTS,
THE_STATE => THE_STATE.CMVC);
end if;
end UPDATER;
-- -------------------------------
-- ( ) Individual gateway creation
-- -------------------------------
procedure CREATE_MODEL_GATEWAY (GATEWAY_NAME : in STRING;
LAST_ID : in NATURAL;
FOR_MODULE : in HCHY.MODULE;
HOST : in STRING;
MODEL : in STRING;
UPDATE_TIME : in CALENDAR.TIME;
COMMENTS : in STRING;
THE_STATE : in out STATE) is
ACTION_ID : ACTION.ID renames THE_STATE.CMVC.ACTION_ID;
S : SS.CONDITION;
GATEWAY : GWO.HANDLE;
use ASAS;
begin
GWO.CREATE (NAME => GATEWAY_NAME,
H => GATEWAY,
GATEWAY_CLASS => ASA_DEFINITIONS.GATEWAY_CLASS'IMAGE
(ASA_DEFINITIONS.ASA_MODEL),
ACTION_ID => ACTION_ID,
ERRORS => S);
LOGGER.STATUS (S);
ASAP.SET_ASA_ID (H => GATEWAY,
VALUE => 1);
ASAP.SET_ASA_LAST_ID (H => GATEWAY,
VALUE => LAST_ID);
ASAP.SET_ASA_NODE_NUMBER (H => GATEWAY,
VALUE => HCHY.NODE_NUMBER (FOR_MODULE));
ASAP.SET_ASA_COMMENT (H => GATEWAY,
VALUE => HCHY.COMMENT (FOR_MODULE));
ASAP.SET_ASA_UPDATE_TIME (H => GATEWAY,
VALUE => UPDATE_TIME);
ASAP.SET_DATA_CONTEXT (H => GATEWAY,
VALUE => UNIX.ENCLOSING_DIRECTORY (MODEL));
ASAP.SET_DATA_HOST (H => GATEWAY,
VALUE => HOST);
ASAP.SET_DATA_NAME (H => GATEWAY,
VALUE => UNIX.LOCAL_NAME (MODEL));
for R in REQUIREMENTS.FUNCTIONAL_REQUIREMENT_NUMBER loop
ASAP.SET_ASA_REQUIREMENT
(H => GATEWAY,
NUMBER => R,
VALUE => HCHY.REQUIREMENT (FOR_MODULE, NUMBER => R));
end loop;
LOGGER.POSITIVE (CREATION_MESSAGE (GATEWAY));
if ASAS.CMVC_CONTROL_LEVEL >= ASAS.CONTROL_MODEL then
MAKE_CONTROLLED (GATEWAY => GATEWAY,
SAVE_SOURCE => FALSE,
COMMENTS => COMMENTS,
THE_STATE => THE_STATE);
end if;
GWO.CLOSE (GATEWAY, S);
LOGGER.STATUS (S);
end CREATE_MODEL_GATEWAY;
procedure CREATE_MODULE_GATEWAY (GATEWAY_NAME : in STRING;
PARENT_NAME : in STRING;
ID : in POSITIVE;
FOR_MODULE : in HCHY.MODULE;
COMMENTS : in STRING;
THE_STATE : in out STATE) is
ACTION_ID : ACTION.ID renames THE_STATE.CMVC.ACTION_ID;
S : SS.CONDITION;
GATEWAY : GWO.HANDLE;
use ASAS;
begin
GWO.CREATE (NAME => GATEWAY_NAME,
H => GATEWAY,
GATEWAY_CLASS => ASA_DEFINITIONS.GATEWAY_CLASS'IMAGE
(ASA_DEFINITIONS.ASA_MODULE),
ACTION_ID => ACTION_ID,
ERRORS => S);
LOGGER.STATUS (S);
ASAP.SET_ASA_ID (H => GATEWAY,
VALUE => ID);
ASAP.SET_ASA_NODE_NUMBER (H => GATEWAY,
VALUE => HCHY.NODE_NUMBER (FOR_MODULE));
ASAP.SET_ASA_COMMENT (H => GATEWAY,
VALUE => HCHY.COMMENT (FOR_MODULE));
ASAP.SET_PARENT_NAME (H => GATEWAY,
VALUE => PARENT_NAME);
for R in REQUIREMENTS.FUNCTIONAL_REQUIREMENT_NUMBER loop
ASAP.SET_ASA_REQUIREMENT
(H => GATEWAY,
NUMBER => R,
VALUE => HCHY.REQUIREMENT (FOR_MODULE, NUMBER => R));
end loop;
LOGGER.POSITIVE (CREATION_MESSAGE (GATEWAY));
if ASAS.CMVC_CONTROL_LEVEL >= ASAS.CONTROL_MODULES then
MAKE_CONTROLLED (GATEWAY => GATEWAY,
SAVE_SOURCE => FALSE,
COMMENTS => COMMENTS,
THE_STATE => THE_STATE);
end if;
GWO.CLOSE (GATEWAY, S);
LOGGER.STATUS (S);
end CREATE_MODULE_GATEWAY;
procedure CREATE_REQUIREMENT_GATEWAY
(GATEWAY_NAME : in STRING;
PARENT_NAME : in STRING;
ID : in POSITIVE;
REQUIREMENT_KIND : in REQUIREMENTS.NON_FUNCTIONAL;
REQUIREMENT_TEXT : in STRING;
COMMENTS : in STRING;
THE_STATE : in out STATE) is
ACTION_ID : ACTION.ID renames THE_STATE.CMVC.ACTION_ID;
S : SS.CONDITION;
GATEWAY : GWO.HANDLE;
use ASAS;
begin
GWO.CREATE (NAME => GATEWAY_NAME,
H => GATEWAY,
GATEWAY_CLASS => ASA_DEFINITIONS.GATEWAY_CLASS'IMAGE
(ASA_DEFINITIONS.ASA_REQUIREMENT),
ACTION_ID => ACTION_ID,
ERRORS => S);
LOGGER.STATUS (S);
ASAP.SET_ASA_ID (H => GATEWAY,
VALUE => ID);
ASAP.SET_PARENT_NAME (H => GATEWAY,
VALUE => PARENT_NAME);
ASAP.SET_ASA_REQUIREMENT_KIND (H => GATEWAY, VALUE => REQUIREMENT_KIND);
ASAP.SET_ASA_REQUIREMENT_TEXT (H => GATEWAY, VALUE => REQUIREMENT_TEXT);
LOGGER.POSITIVE (CREATION_MESSAGE (GATEWAY));
if ASAS.CMVC_CONTROL_LEVEL >= ASAS.CONTROL_ALL then
MAKE_CONTROLLED (GATEWAY => GATEWAY,
SAVE_SOURCE => TRUE,
COMMENTS => COMMENTS,
THE_STATE => THE_STATE);
end if;
GWO.CLOSE (GATEWAY, S);
LOGGER.STATUS (S);
end CREATE_REQUIREMENT_GATEWAY;
-- --------------------
-- ( ) Module hierarchy
-- --------------------
procedure CREATE (FOR_MODULE : in HCHY.MODULE;
IN_LIBRARY : in STRING;
ROOT_ID : in POSITIVE;
COMMENTS : in STRING;
THE_STATE : in out STATE) is
ACTION_ID : ACTION.ID renames THE_STATE.CMVC.ACTION_ID;
CHILDREN : HCHY.MODULE_ITERATOR := HCHY.CHILDREN_OF (FOR_MODULE);
CHILD : HCHY.MODULE;
PARENT : constant HCHY.MODULE := HCHY.PARENT_OF (FOR_MODULE);
NB_OF_CHILDREN : constant NATURAL := HCHY.SIZE (CHILDREN);
NEXT_ID : POSITIVE := ROOT_ID + 1;
use HIERARCHY;
begin
CREATE_MODULE_GATEWAY
(GATEWAY_NAME => IN_LIBRARY & '.' & HCHY.FULL_NAME (FOR_MODULE),
PARENT_NAME => IN_LIBRARY & '.' & HCHY.FULL_NAME (PARENT),
ID => ROOT_ID,
FOR_MODULE => FOR_MODULE,
COMMENTS => COMMENTS,
THE_STATE => THE_STATE);
for C in 1 .. NB_OF_CHILDREN loop
CHILD := HCHY.VALUE (CHILDREN);
CREATE (FOR_MODULE => CHILD,
IN_LIBRARY => IN_LIBRARY,
ROOT_ID => NEXT_ID,
COMMENTS => COMMENTS,
THE_STATE => THE_STATE);
NEXT_ID := NEXT_ID + TREE_SIZE (CHILD);
HCHY.NEXT (CHILDREN);
end loop;
end CREATE;
procedure AUGMENT (FOR_MODULE : in HIERARCHY.MODULE;
IN_LIBRARY : in STRING;
COMMENTS : in STRING;
THE_STATE : in out STATE) is
GATEWAY_FULL_NAME : constant STRING :=
IN_LIBRARY & '.' & HCHY.FULL_NAME (FOR_MODULE);
ACTION_ID : ACTION.ID renames THE_STATE.CMVC.ACTION_ID;
CHILDREN : HCHY.MODULE_ITERATOR;
GATEWAY : GWO.HANDLE;
ROOT_GATEWAY : GWO.HANDLE;
ROOT_MODULE : HCHY.MODULE;
ID : POSITIVE;
S : SS.CONDITION;
procedure DO_SET_PROPERTIES (GATEWAY : in GWO.HANDLE) is
begin
ASAP.SET_ASA_NODE_NUMBER (GATEWAY,
VALUE => HCHY.NODE_NUMBER (FOR_MODULE));
ASAP.SET_ASA_COMMENT (GATEWAY, VALUE => HCHY.COMMENT (FOR_MODULE));
for R in REQUIREMENTS.FUNCTIONAL_REQUIREMENT_NUMBER loop
ASAP.SET_ASA_REQUIREMENT
(H => GATEWAY,
NUMBER => R,
VALUE => HCHY.REQUIREMENT (FOR_MODULE, NUMBER => R));
end loop;
LOGGER.POSITIVE ("Updated properties of " & IN_LIBRARY &
'.' & HCHY.FULL_NAME (FOR_MODULE));
end DO_SET_PROPERTIES;
procedure SET_PROPERTIES is new UPDATER (DO_SET_PROPERTIES);
procedure DO_SET_LAST_ID (GATEWAY : in GWO.HANDLE) is
begin
ID := ASAP.ASA_LAST_ID (GATEWAY) + 1;
ASAP.SET_ASA_LAST_ID (H => GATEWAY, VALUE => ID);
end DO_SET_LAST_ID;
procedure SET_LAST_ID is new UPDATER (DO_SET_LAST_ID);
use HCHY;
begin
GWO.OPEN_MAIN_OBJECT (OBJECT => GATEWAY_FULL_NAME,
H => GATEWAY,
UPDATE => FALSE,
ACTION_ID => ACTION_ID,
ERRORS => S);
if SS.ERROR (S) then
--
-- This is a new module. Create a gateway object to represent
-- it. Extract the id from the root and update the last id.
--
ROOT_MODULE := FOR_MODULE;
while HCHY.PARENT_OF (ROOT_MODULE) /= HCHY.NIL loop
ROOT_MODULE := HCHY.PARENT_OF (ROOT_MODULE);
end loop;
declare
ROOT_FULL_NAME : constant STRING :=
IN_LIBRARY & '.' & HCHY.FULL_NAME (ROOT_MODULE);
begin
GWO.OPEN_MAIN_OBJECT (OBJECT => ROOT_FULL_NAME,
H => ROOT_GATEWAY,
UPDATE => FALSE,
ACTION_ID => ACTION_ID,
ERRORS => S);
LOGGER.STATUS (S);
SET_LAST_ID (GATEWAY => ROOT_GATEWAY,
COMMENTS => COMMENTS,
THE_STATE => THE_STATE);
GWO.CLOSE (ROOT_GATEWAY, S);
LOGGER.STATUS (S);
CREATE (FOR_MODULE => FOR_MODULE,
IN_LIBRARY => IN_LIBRARY,
ROOT_ID => ID,
COMMENTS => COMMENTS,
THE_STATE => THE_STATE);
end;
elsif not SAME_PROPERTIES (MODULE => FOR_MODULE,
GATEWAY => GATEWAY) then
--
-- There is already a gateway object representing this module,
-- but same property has changed.
--
SET_PROPERTIES (GATEWAY => GATEWAY,
COMMENTS => COMMENTS,
THE_STATE => THE_STATE);
else
GWO.CLOSE (GATEWAY, S);
LOGGER.STATUS (S);
end if;
CHILDREN := HCHY.CHILDREN_OF (FOR_MODULE);
while not HCHY.DONE (CHILDREN) loop
AUGMENT (FOR_MODULE => HCHY.VALUE (CHILDREN),
IN_LIBRARY => IN_LIBRARY,
COMMENTS => COMMENTS,
THE_STATE => THE_STATE);
HCHY.NEXT (CHILDREN);
end loop;
end AUGMENT;
procedure DESTROY (GATEWAY_OBJECT : in DIR.OBJECT;
COMMENTS : in STRING;
THE_STATE : in out STATE) is
ACTION_ID : ACTION.ID renames THE_STATE.CMVC.ACTION_ID;
CHANGE_IMPACT : DIR.ADA.ROOTS;
E : DIR.ERROR_STATUS;
ERRORS : ERROR_MESSAGES.ERRORS;
GATEWAY_CMVC_CONTROL : CMVC_CONTROL_KIND;
MODIFIED_UNITS : DIANA.TEMP_SEQ;
begin
GET_CMVC_CONTROL (OBJECT => GATEWAY_OBJECT,
THE_STATE => THE_STATE,
CONTROL => GATEWAY_CMVC_CONTROL);
if GATEWAY_CMVC_CONTROL >= CONTROLLED_CHECKED_OUT then
DATABASE_OPERATIONS.CHECK_IN (THE_OBJECT => GATEWAY_OBJECT,
COMMENTS => COMMENTS,
THE_STATE => THE_STATE.CMVC);
end if;
if GATEWAY_CMVC_CONTROL >= CONTROLLED_CHECKED_IN then
DATABASE_OPERATIONS.MAKE_UNCONTROLLED (THE_OBJECT => GATEWAY_OBJECT,
COMMENTS => COMMENTS,
THE_STATE => THE_STATE.CMVC);
end if;
DOO.DESTROY (THE_OBJECT => GATEWAY_OBJECT,
ERRORS => ERRORS,
CHANGE_IMPACT => CHANGE_IMPACT,
MODIFIED_UNITS => MODIFIED_UNITS,
STATUS => E,
LIMIT_TYPE => DIR.ANY_OBJECT,
ACTION_ID => ACTION_ID);
LOGGER.STATUS (E);
end DESTROY;
procedure REDUCE (GATEWAY_OBJECT : in DIR.OBJECT;
CANDIDATE_MODULES : in out HIERARCHY.MODULE_ITERATOR;
COMMENTS : in STRING;
THE_STATE : in out STATE) is
ACTION_ID : ACTION.ID renames THE_STATE.CMVC.ACTION_ID;
HEAP : SYSTEM.SEGMENT renames THE_STATE.CMVC.HEAP;
E : DIR.ERROR_STATUS;
N : DNA.NAME_STATUS;
CANDIDATE_CHILDREN : HCHY.MODULE_ITERATOR;
CANDIDATE_MODULE : HCHY.MODULE;
GATEWAY_CHILD : DIR.OBJECT;
GATEWAY_CHILDREN : DNA.ITERATOR;
GATEWAY_OBJECT_FULL_NAME : constant STRING :=
DNA.GET_FULL_NAME (GATEWAY_OBJECT);
GATEWAY_OBJECT_SIMPLE_NAME : constant STRING :=
DNA.GET_SIMPLE_NAME (GATEWAY_OBJECT);
MUST_REMAIN : BOOLEAN;
use DNA;
begin
MUST_REMAIN := FALSE;
while not HCHY.DONE (CANDIDATE_MODULES) loop
CANDIDATE_MODULE := HCHY.VALUE (CANDIDATE_MODULES);
if SU.EQUAL (GATEWAY_OBJECT_SIMPLE_NAME,
HCHY.SIMPLE_NAME (CANDIDATE_MODULE)) then
MUST_REMAIN := TRUE;
exit;
end if;
HCHY.NEXT (CANDIDATE_MODULES);
end loop;
if MUST_REMAIN then
--
-- There is a module for this gateway object, so it must be
-- kept.
--
LOGGER.NOTE ("Gateway " & GATEWAY_OBJECT_FULL_NAME &
" corresponds to module " &
HCHY.FULL_NAME (CANDIDATE_MODULE));
DNA.RESOLVE (ITER => GATEWAY_CHILDREN,
SOURCE => GATEWAY_OBJECT_FULL_NAME & ".@'C(~Text)",
STATUS => N,
HEAP => HEAP,
ACTION_ID => ACTION_ID);
if N /= DNA.UNDEFINED then
LOGGER.STATUS (N);
while not DNA.DONE (GATEWAY_CHILDREN) loop
CANDIDATE_CHILDREN := HCHY.CHILDREN_OF (CANDIDATE_MODULE);
DNA.GET_OBJECT (ITER => GATEWAY_CHILDREN,
THE_OBJECT => GATEWAY_CHILD,
STATUS => E);
LOGGER.STATUS (E);
REDUCE (GATEWAY_OBJECT => GATEWAY_CHILD,
CANDIDATE_MODULES => CANDIDATE_CHILDREN,
COMMENTS => COMMENTS,
THE_STATE => THE_STATE);
DNA.NEXT (GATEWAY_CHILDREN);
end loop;
end if;
else
--
-- There is no longer a corresponding module for this gateway
-- object. We first check that the object has no
-- non-functional requirements, and then delete it.
--
DNA.RESOLVE (ITER => GATEWAY_CHILDREN,
SOURCE => GATEWAY_OBJECT_FULL_NAME & ".@'C(Text)",
STATUS => N,
HEAP => HEAP,
ACTION_ID => ACTION_ID);
if N = DNA.UNDEFINED then
DESTROY (GATEWAY_OBJECT => GATEWAY_OBJECT,
COMMENTS => COMMENTS,
THE_STATE => THE_STATE);
LOGGER.POSITIVE ("Gateway object " & GATEWAY_OBJECT_FULL_NAME &
" has been destroyed because it has no longer " &
"a corresponding module");
else
LOGGER.WARNING ("The gateway object " & GATEWAY_OBJECT_FULL_NAME &
" couldn't be destroyed because it has " &
"subobjects representing non-functional " &
"requirements. Use Asa.Move_Requirement " &
"to move these objects, and then run " &
"Asa.Accept_Changes again to complete " &
"change propagation");
end if;
end if;
end REDUCE;
-- ----------------------------------
-- ( ) Bodies of external subprograms
-- ----------------------------------
function CMVC_CONTROL (GATEWAY_NAME : in STRING) return CMVC_CONTROL_KIND is
GATEWAY_OBJECT : DIR.OBJECT;
GATEWAY_CMVC_CONTROL : CMVC_CONTROL_KIND;
N : DNA.NAME_STATUS;
THE_ACTION : ACTION.ID;
THE_STATE : STATE;
begin
THE_ACTION := ACTION.START;
INITIALIZE (THE_STATE => THE_STATE,
ACTION_ID => THE_ACTION,
WORK_ORDER => "");
DNA.RESOLVE (NAME => GATEWAY_NAME,
THE_OBJECT => GATEWAY_OBJECT,
STATUS => N,
ACTION_ID => THE_ACTION);
LOGGER.STATUS (N);
GET_CMVC_CONTROL (OBJECT => GATEWAY_OBJECT,
THE_STATE => THE_STATE,
CONTROL => GATEWAY_CMVC_CONTROL);
FINALIZE (THE_STATE);
ACTION.FINISH (THE_ACTION => THE_ACTION, DO_COMMIT => TRUE);
return GATEWAY_CMVC_CONTROL;
end CMVC_CONTROL;
procedure INITIALIZE (THE_STATE : out STATE;
ACTION_ID : in ACTION.ID;
WORK_ORDER : in STRING) is
RESULT : STATE;
THE_FILTER : PROFILE.LOG_FILTER := PROFILE.FILTER;
THE_HEAP : constant SYSTEM.SEGMENT := JOB_SEGMENT.GET;
begin
THE_FILTER (PROFILE.AUXILIARY_MSG) := FALSE;
RESULT := (CMVC => new STATE_OPERATIONS.STATE_RECORD,
CONFIGURATION => CMVCI.NIL);
pragma HEAP (THE_HEAP);
RESULT.CMVC.ACTION_ID := ACTION_ID;
RESULT.CMVC.HEAP := THE_HEAP;
RESULT.CMVC.CURRENT_PROFILE :=
PROFILE.RAISE_EXCEPTION (FILTER => THE_FILTER);
STATE_OPERATIONS.OBJECT_TO_DATABASE.INITIALIZE
(RESULT.CMVC.DATABASE_MAP, THE_HEAP);
STATE_OPERATIONS.OBJECT_TO_STRING.INITIALIZE
(RESULT.CMVC.STRING_MAP, THE_HEAP);
--[should open work-order]
THE_STATE := RESULT;
end INITIALIZE;
procedure FINALIZE (THE_STATE : in out STATE) is
begin
DATABASE_OPERATIONS.CLOSE (THE_STATE.CMVC);
end FINALIZE;
procedure AUGMENT (FOR_MODULE : in HIERARCHY.MODULE;
IN_LIBRARY : in STRING;
HOST : in STRING;
MODEL : in STRING;
UPDATE_TIME : in CALENDAR.TIME;
COMMENTS : in STRING;
THE_STATE : in out STATE) is
GATEWAY_FULL_NAME : constant STRING :=
IN_LIBRARY & '.' & HCHY.FULL_NAME (FOR_MODULE);
S : SS.CONDITION;
ACTION_ID : ACTION.ID renames THE_STATE.CMVC.ACTION_ID;
CHILDREN : HCHY.MODULE_ITERATOR;
GATEWAY : GWO.HANDLE;
procedure DO_SET_UPDATE_TIME_AND_PROPERTIES (GATEWAY : in GWO.HANDLE) is
begin
ASAP.SET_ASA_UPDATE_TIME (GATEWAY, VALUE => UPDATE_TIME);
if not SAME_PROPERTIES (MODULE => FOR_MODULE, GATEWAY => GATEWAY) then
ASAP.SET_ASA_NODE_NUMBER (GATEWAY,
VALUE => HCHY.NODE_NUMBER (FOR_MODULE));
ASAP.SET_ASA_COMMENT (GATEWAY, VALUE => HCHY.COMMENT (FOR_MODULE));
for R in REQUIREMENTS.FUNCTIONAL_REQUIREMENT_NUMBER loop
ASAP.SET_ASA_REQUIREMENT
(H => GATEWAY,
NUMBER => R,
VALUE => HCHY.REQUIREMENT (FOR_MODULE, NUMBER => R));
end loop;
LOGGER.POSITIVE ("Updated properties of " & IN_LIBRARY &
'.' & HCHY.FULL_NAME (FOR_MODULE));
end if;
end DO_SET_UPDATE_TIME_AND_PROPERTIES;
procedure SET_UPDATE_TIME_AND_PROPERTIES is
new UPDATER (DO_SET_UPDATE_TIME_AND_PROPERTIES);
use HCHY;
begin
GWO.OPEN_MAIN_OBJECT (OBJECT => GATEWAY_FULL_NAME,
H => GATEWAY,
UPDATE => FALSE,
ACTION_ID => ACTION_ID,
ERRORS => S);
if SS.ERROR (S) then
--
-- This is a new model. Create a gateway object to represent
-- it.
--
CREATE (FOR_MODULE => FOR_MODULE,
IN_LIBRARY => IN_LIBRARY,
HOST => HOST,
MODEL => MODEL,
UPDATE_TIME => UPDATE_TIME,
COMMENTS => COMMENTS,
THE_STATE => THE_STATE);
else
SET_UPDATE_TIME_AND_PROPERTIES (GATEWAY => GATEWAY,
COMMENTS => COMMENTS,
THE_STATE => THE_STATE);
GWO.CLOSE (GATEWAY, S);
LOGGER.STATUS (S);
end if;
CHILDREN := HCHY.CHILDREN_OF (FOR_MODULE);
while not HCHY.DONE (CHILDREN) loop
AUGMENT (FOR_MODULE => HCHY.VALUE (M => CHILDREN),
IN_LIBRARY => IN_LIBRARY,
COMMENTS => COMMENTS,
THE_STATE => THE_STATE);
HCHY.NEXT (CHILDREN);
end loop;
end AUGMENT;
procedure CREATE (FOR_MODULE : in HIERARCHY.MODULE;
IN_LIBRARY : in STRING;
HOST : in STRING;
MODEL : in STRING;
UPDATE_TIME : in CALENDAR.TIME;
COMMENTS : in STRING;
THE_STATE : in out STATE) is
ACTION_ID : ACTION.ID renames THE_STATE.CMVC.ACTION_ID;
CHILDREN : HCHY.MODULE_ITERATOR := HCHY.CHILDREN_OF (FOR_MODULE);
CHILD : HCHY.MODULE;
NEXT_ID : POSITIVE;
SIZE : constant POSITIVE := TREE_SIZE (FOR_MODULE);
use HIERARCHY;
begin
CREATE_MODEL_GATEWAY
(GATEWAY_NAME => IN_LIBRARY & '.' & HCHY.FULL_NAME (FOR_MODULE),
LAST_ID => SIZE,
FOR_MODULE => FOR_MODULE,
HOST => HOST,
MODEL => MODEL,
UPDATE_TIME => UPDATE_TIME,
COMMENTS => COMMENTS,
THE_STATE => THE_STATE);
NEXT_ID := 2;
for C in 1 .. HCHY.SIZE (CHILDREN) loop
CHILD := HCHY.VALUE (CHILDREN);
CREATE (FOR_MODULE => HCHY.VALUE (CHILDREN),
IN_LIBRARY => IN_LIBRARY,
ROOT_ID => NEXT_ID,
COMMENTS => COMMENTS,
THE_STATE => THE_STATE);
NEXT_ID := NEXT_ID + TREE_SIZE (CHILD);
HCHY.NEXT (CHILDREN);
end loop;
end CREATE;
procedure CREATE (IN_GATEWAY : in STRING;
REQUIREMENT_NAME : in STRING;
REQUIREMENT_KIND : in REQUIREMENTS.NON_FUNCTIONAL;
REQUIREMENT_TEXT : in STRING;
COMMENTS : in STRING;
THE_STATE : in out STATE) is
ACTION_ID : ACTION.ID renames THE_STATE.CMVC.ACTION_ID;
ID : POSITIVE;
N : DNA.NAME_STATUS;
PARENT : GWO.HANDLE;
PARENT_OBJECT : DIR.OBJECT;
S : SS.CONDITION;
procedure DO_SET_LAST_REQUIREMENT_ID (GATEWAY : in GWO.HANDLE) is
begin
ID := ASAP.ASA_LAST_REQUIREMENT_ID (GATEWAY) + 1;
ASAP.SET_ASA_LAST_REQUIREMENT_ID (H => GATEWAY, VALUE => ID);
end DO_SET_LAST_REQUIREMENT_ID;
procedure SET_LAST_REQUIREMENT_ID is
new UPDATER (DO_SET_LAST_REQUIREMENT_ID);
use ASA_DEFINITIONS;
begin
DNA.RESOLVE (NAME => IN_GATEWAY,
THE_OBJECT => PARENT_OBJECT,
STATUS => N,
ACTION_ID => ACTION_ID);
LOGGER.STATUS (N);
GWO.OPEN_MAIN_OBJECT (OBJECT => PARENT_OBJECT,
H => PARENT,
UPDATE => FALSE,
ACTION_ID => ACTION_ID,
ERRORS => S);
LOGGER.STATUS (S);
if ASAP.CLASS (PARENT) = ASA_DEFINITIONS.ASA_REQUIREMENT then
LOGGER.ERROR ("The gateway object " &
DNA.GET_FULL_NAME (PARENT_OBJECT) &
" does not represent an " &
ASA_DEFINITIONS.ASA & " module, and thus " &
"cannot host non-functional requirements");
end if;
SET_LAST_REQUIREMENT_ID (GATEWAY => PARENT,
COMMENTS => COMMENTS,
THE_STATE => THE_STATE);
GWO.CLOSE (PARENT, S);
LOGGER.STATUS (S);
declare
PARENT_FULL_NAME : constant STRING :=
DNA.GET_FULL_NAME (PARENT_OBJECT);
begin
CREATE_REQUIREMENT_GATEWAY
(GATEWAY_NAME => PARENT_FULL_NAME & '.' & REQUIREMENT_NAME,
PARENT_NAME => PARENT_FULL_NAME,
ID => ID,
REQUIREMENT_KIND => REQUIREMENT_KIND,
REQUIREMENT_TEXT => REQUIREMENT_TEXT,
COMMENTS => COMMENTS,
THE_STATE => THE_STATE);
end;
end CREATE;
procedure DESTROY (GATEWAY_NAME : in STRING;
COMMENTS : in STRING;
THE_STATE : in out STATE) is
ACTION_ID : ACTION.ID renames THE_STATE.CMVC.ACTION_ID;
N : DNA.NAME_STATUS;
GATEWAY_OBJECT : DIR.OBJECT;
begin
DNA.RESOLVE (NAME => GATEWAY_NAME,
THE_OBJECT => GATEWAY_OBJECT,
STATUS => N,
ACTION_ID => ACTION_ID);
LOGGER.STATUS (N);
DESTROY (GATEWAY_OBJECT => GATEWAY_OBJECT,
COMMENTS => COMMENTS,
THE_STATE => THE_STATE);
end DESTROY;
procedure REDUCE (GATEWAY_NAME : in STRING;
CANDIDATE_MODULES : in out HIERARCHY.MODULE_ITERATOR;
COMMENTS : in STRING;
THE_STATE : in out STATE) is
ACTION_ID : ACTION.ID renames THE_STATE.CMVC.ACTION_ID;
N : DNA.NAME_STATUS;
GATEWAY_OBJECT : DIR.OBJECT;
begin
DNA.RESOLVE (NAME => GATEWAY_NAME,
THE_OBJECT => GATEWAY_OBJECT,
STATUS => N,
ACTION_ID => ACTION_ID);
LOGGER.STATUS (N);
REDUCE (GATEWAY_OBJECT => GATEWAY_OBJECT,
CANDIDATE_MODULES => CANDIDATE_MODULES,
COMMENTS => COMMENTS,
THE_STATE => THE_STATE);
end REDUCE;
end GATEWAYS;