Commit ab33559a authored by Bechir Zalila's avatar Bechir Zalila
Browse files

* (ocarina-analyzer-aadl_ba.ad?): Semantic analyzer for the behavior

        annex

        * (ocarina-analyzer.adb): Activate the semantic analyser for BA

	(By Yossra Rekik)
parent aaeb2b93
------------------------------------------------------------------------------
-- --
-- OCARINA COMPONENTS --
-- --
-- O C A R I N A . A N A L Y Z E R . A A D L _ B A --
-- --
-- B o d y --
-- --
-- Copyright (C) 2016 ESA & ISAE. --
-- --
-- Ocarina is free software; you can redistribute it and/or modify under --
-- terms of the GNU General Public License as published by the Free Soft- --
-- ware Foundation; either version 3, or (at your option) any later ver- --
-- sion. Ocarina 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. --
-- --
-- As a special exception under Section 7 of GPL version 3, you are granted --
-- additional permissions described in the GCC Runtime Library Exception, --
-- version 3.1, as published by the Free Software Foundation. --
-- --
-- You should have received a copy of the GNU General Public License and --
-- a copy of the GCC Runtime Library Exception along with this program; --
-- see the files COPYING3 and COPYING.RUNTIME respectively. If not, see --
-- <http://www.gnu.org/licenses/>. --
-- --
-- Ocarina is maintained by the TASTE project --
-- (taste-users@lists.tuxfamily.org) --
-- --
------------------------------------------------------------------------------
with Ocarina.Namet;
with Errors;
with Utils;
with Ocarina.ME_AADL;
with Ocarina.ME_AADL_BA;
with Ocarina.Analyzer.AADL.Finder;
with Ocarina.ME_AADL_BA.BA_Tree.Nodes;
with Ocarina.ME_AADL.AADL_Tree.Nodes;
with Ocarina.ME_AADL_BA.BA_Tree.Nutils;
with Ocarina.ME_AADL.AADL_Tree.Nutils;
with Ocarina.ME_AADL_BA.Tokens;
package body Ocarina.Analyzer.AADL_BA is
use Utils;
use Ocarina.Namet;
use Errors;
use Ocarina.ME_AADL;
use Ocarina.ME_AADL_BA;
use Ocarina.Analyzer.AADL.Finder;
use Ocarina.ME_AADL_BA.BA_Tree.Nodes;
use Ocarina.ME_AADL_BA.BA_Tree.Nutils;
package ATN renames Ocarina.ME_AADL.AADL_Tree.Nodes;
package ANU renames Ocarina.ME_AADL.AADL_Tree.Nutils;
package BATN renames Ocarina.ME_AADL_BA.BA_Tree.Nodes;
package BAT renames Ocarina.ME_AADL_BA.Tokens;
type Behavior_State_Kind_Array is array (Positive range <>)
of Ocarina.ME_AADL_BA.Behavior_State_Kind;
function Analyze_Behavior_Specification
(Root : Node_Id;
BA_Root : Node_Id;
Parent_Component : Node_Id)
return Boolean;
function Analyze_Behavior_Variables
(Root : Node_Id;
BA_Root : Node_Id;
Parent_Component : Node_Id)
return Boolean;
function Analyze_Behavior_States
(Root : Node_Id;
BA_Root : Node_Id;
Parent_Component : Node_Id)
return Boolean;
function Analyze_Behavior_Transitions
(Root : Node_Id;
BA_Root : Node_Id;
Parent_Component : Node_Id)
return Boolean;
function Analyze_Behavior_Transition
(Transition : Node_Id;
BA_Root : Node_Id;
Parent_Component : Node_Id)
return Boolean;
function Analyze_Dispatch_Condition
(Condition : Node_Id;
BA_Root : Node_Id;
Parent_Component : Node_Id)
return Boolean;
function Enter_Name_In_Table (Identifier : Node_Id)
return boolean;
procedure Remove_All_Identifiers_From_Table
(BA_Root : Node_Id);
function Test_With_Identifiers_In_Parent_Component
(Id : Node_Id;
Component : Node_Id)
return Boolean;
procedure Select_All_States
(BA_Root : Node_Id;
List_First_Node : in out Node_Id;
List_Last_Node : in out Node_Id);
procedure Select_States
(BA_Root : Node_Id;
Kinds : Behavior_State_Kind_Array;
List_First_Node : in out Node_Id;
List_Last_Node : in out Node_Id);
function Is_Complete
(BA_Root : Node_Id;
State : Node_Id)
return boolean;
function Is_Initial
(BA_Root : Node_Id;
State : Node_Id)
return boolean;
function Is_Final
(BA_Root : Node_Id;
State : Node_Id)
return boolean;
function Exist_In_Modes
(Component : Node_Id;
State : Node_Id)
return boolean;
function Link_Variable
(Root : Node_Id;
Node : Node_Id)
return Boolean;
function Find_State
(State_Id : Node_Id;
BA_Root : Node_Id)
return Node_Id;
function Link_Frozen_Port
(Frozen_Port : Node_Id;
Component : Node_Id)
return Node_Id;
function Link_Dispatch_Trigger_Event
(Dispatch_Trigger_Event : Node_Id;
Component : Node_Id)
return Node_Id;
function Length (L : Node_List) return Natural;
-- procedure Affiche (First_Node_List : Node_Id);
Language : constant String := "behavior_specification";
----------
-- Init --
----------
procedure Init is
begin
Ocarina.Analyzer.Register_Analyzer (Language, Analyze_Model'Access);
end Init;
-----------
-- Reset --
-----------
procedure Reset is
begin
null;
end Reset;
-------------------
-- Analyze_Model --
-------------------
function Analyze_Model (Root : Node_Id) return Boolean is
use ATN;
use BAT;
pragma Assert (ATN.Kind (Root) = ATN.K_AADL_Specification);
Success : Boolean := True;
L1 : Node_List;
L2 : Node_List;
N1 : Node_Id;
N2 : Node_Id;
BA_Root : Node_Id;
Parent_Component : Node_Id;
begin
-- chercher les noeuds racines des annexes comportementales
-- à partir de la racine AADL
L1 := Find_All_Declarations (Root,
(ATN.K_Component_Type,
ATN.K_Component_Implementation));
N1 := L1.First;
while Present (N1) loop
L2 := Find_All_Subclauses (N1, (1 => ATN.K_Annex_Subclause));
N2 := L2.First;
while Present (N2) loop
if Get_Name_String
(Utils.To_Lower
(ATN.Name (ATN.Identifier (N2)))) =
BAT.Language and then
Present (ATN.Corresponding_Annex (N2))
then
BA_Root := ATN.Corresponding_Annex (N2);
Parent_Component := Container_Component (N2);
-- pour chaque annexe trouvée,
-- on effectue l'analyse sémantique
Success := Success and then
Analyze_Behavior_Specification
(Root, BA_Root, Parent_Component);
end if;
N2 := ATN.Next_Entity (N2);
end loop;
N1 := ATN.Next_Entity (N1);
end loop;
return Success;
end Analyze_Model;
function Analyze_Behavior_Specification
(Root : Node_Id;
BA_Root : Node_Id;
Parent_Component : Node_Id)
return Boolean
is
use ATN;
pragma Assert (ATN.Kind (Root) = ATN.K_AADL_Specification);
pragma Assert (BATN.Kind (BA_Root) = BATN.K_Behavior_Annex);
pragma Assert (ATN.Kind (Parent_Component) = ATN.K_Component_Type
or else Kind (Parent_Component) =
ATN.K_Component_Implementation);
Success : Boolean := True;
List_Node : Node_Id;
Node : Node_Id;
Behavior_Variable : Node_Id;
Behavior_State : Node_Id;
Behavior_Transition : Node_Id;
begin
if not Is_Empty (Variables (BA_Root)) then
Behavior_Variable := BATN.First_Node (Variables (BA_Root));
while Present (Behavior_Variable) loop
List_Node := BATN.First_Node
(BATN.Identifiers (Behavior_Variable));
while Present (List_Node) loop
Success := Success and then Enter_Name_In_Table (List_Node);
List_Node := BATN.Next_Node (List_Node);
end loop;
Behavior_Variable := BATN.Next_Node (Behavior_Variable);
end loop;
Success := Success and then
-- analyser behavior_variables
Analyze_Behavior_Variables (Root, BA_Root, Parent_Component);
end if;
if not Is_Empty (States (BA_Root)) then
Behavior_State := BATN.First_Node (States (BA_Root));
while Present (Behavior_State) loop
List_Node := BATN.First_Node
(BATN.Identifiers (Behavior_State));
while Present (List_Node) loop
Success := Success and then Enter_Name_In_Table (List_Node);
List_Node := BATN.Next_Node (List_Node);
end loop;
Behavior_State := BATN.Next_Node (Behavior_State);
end loop;
Success := Success and then
-- analyser behavior_states
Analyze_Behavior_States (Root, BA_Root, Parent_Component);
end if;
if not Is_Empty (Transitions (BA_Root)) then
Behavior_Transition := BATN.First_Node (Transitions (BA_Root));
while Present (Behavior_Transition) loop
if Present (Behavior_Transition_Idt
(Transition (Behavior_Transition)))
then
Node := Behavior_Transition_Idt
(Transition (Behavior_Transition));
Success := Success and then Enter_Name_In_Table (Node);
end if;
Behavior_Transition := BATN.Next_Node (Behavior_Transition);
end loop;
Success := Success and then
-- analyser behavior_transitions
Analyze_Behavior_Transitions (Root, BA_Root, Parent_Component);
end if;
if Success then
Remove_All_Identifiers_From_Table (BA_Root);
end if;
return Success;
end Analyze_Behavior_Specification;
--------------------------------
-- Analyze_Behavior_Variables --
--------------------------------
function Analyze_Behavior_Variables
(Root : Node_Id;
BA_Root : Node_Id;
Parent_Component : Node_Id)
return Boolean
is
use ATN;
pragma Assert (ATN.Kind (Root) = ATN.K_AADL_Specification);
pragma Assert (BATN.Kind (BA_Root) = BATN.K_Behavior_Annex);
List_Node : Node_Id;
Behavior_Variable : Node_Id;
Success : Boolean := True;
begin
Behavior_Variable := BATN.First_Node (Variables (BA_Root));
while Present (Behavior_Variable) loop
if not Is_Empty (BATN.Identifiers (Behavior_Variable)) then
List_Node := BATN.First_Node
(BATN.Identifiers (Behavior_Variable));
while Present (List_Node) loop
Success := Success and then
-- vérifier l'unicité des identifiants des variables
-- dans le composant parent (où l'annexe
-- comportementale est définie)
Test_With_Identifiers_In_Parent_Component
(List_Node, Parent_Component);
List_Node := BATN.Next_Node (List_Node);
end loop;
end if;
if Present (BATN.Classifier_Ref (Behavior_Variable)) then
Success := Link_Variable (Root, Behavior_Variable);
if not Success then
Error_Loc (1) := BATN.Loc (BATN.First_Node
(BATN.Identifiers (Behavior_Variable)));
DE ("behavior variable(s) must be explicitly typed "
& "with a valid data component classifier.");
end if;
end if;
Behavior_Variable := BATN.Next_Node (Behavior_Variable);
end loop;
return Success;
end Analyze_Behavior_Variables;
-----------------------------
-- Analyze_Behavior_States --
-----------------------------
function Analyze_Behavior_States
(Root : Node_Id;
BA_Root : Node_Id;
Parent_Component : Node_Id)
return Boolean
is
use ATN;
pragma Assert (ATN.Kind (Root) = ATN.K_AADL_Specification);
pragma Assert (BATN.Kind (BA_Root) = BATN.K_Behavior_Annex);
pragma Assert (ATN.Kind (Parent_Component) = ATN.K_Component_Type
or else Kind (Parent_Component) =
ATN.K_Component_Implementation);
Success : Boolean := True;
Behavior_State : Node_Id;
List_Node : Node_Id;
Initial_States_List : Node_List;
Complete_States_List : Node_List;
Final_States_List : Node_List;
Execute_States_List : Node_List;
begin
Behavior_State := BATN.First_Node (States (BA_Root));
while Present (Behavior_State) loop
if not Is_Empty (BATN.Identifiers (Behavior_State)) then
List_Node := BATN.First_Node
(BATN.Identifiers (Behavior_State));
while Present (List_Node) loop
if (Is_Complete (BA_Root, List_Node) and then
not Exist_In_Modes (Parent_Component, List_Node)) or else
not Is_Complete (BA_Root, List_Node)
then
Success := Success and then
-- vérifier l'unicité des identifiants des states
-- dans le composant parent (où l'annexe
-- comportementale est définie)
Test_With_Identifiers_In_Parent_Component
(List_Node, Parent_Component);
end if;
List_Node := BATN.Next_Node (List_Node);
end loop;
end if;
Behavior_State := BATN.Next_Node (Behavior_State);
end loop;
Select_States (BA_Root, (BSK_Initial,
BSK_Initial_Complete,
BSK_Initial_Complete_Final,
BSK_Initial_Final),
Initial_States_List.First, Initial_States_List.Last);
Select_States (BA_Root, (BSK_Complete,
BSK_Initial_Complete,
BSK_Initial_Complete_Final,
BSK_Complete_Final),
Complete_States_List.First, Complete_States_List.Last);
Select_States (BA_Root, (BSK_Final,
BSK_Initial_Final,
BSK_Initial_Complete_Final,
BSK_Complete_Final),
Final_States_List.First, Final_States_List.Last);
Select_States (BA_Root, (1 => BSK_No_Kind),
Execute_States_List.First, Execute_States_List.Last);
if Component_Category'Val (Category (Parent_Component)) = CC_Subprogram
-- l'annexe comportementale pour un sous­-programme doit définir
-- un seul état (state) initial, un seul état final
-- et pas d'états complets
then
if Length (Initial_States_List) > 1 then
Success := False;
Error_Loc (1) := BATN.Loc (BATN.Next_Node
(Initial_States_List.First));
DE (Get_Name_String (ATN.Name
(ATN.Identifier (Parent_Component)))
& " ( Subprogram )"
& " can't have more than one initial state.");
else
if Length (Initial_States_List) = 0 then
Success := False;
Error_Loc (1) := BATN.Loc (Node_Id (States (BA_Root)));
DE (Get_Name_String (ATN.Name
(ATN.Identifier (Parent_Component)))
& " ( Subprogram )"
& " has no initial state.");
end if;
end if;
if Length (Complete_States_List) > 0 then
Success := False;
Error_Loc (1) := BATN.Loc (Complete_States_List.First);
DE (Get_Name_String (ATN.Name
(ATN.Identifier (Parent_Component)))
& " ( Subprogram )"
& " can't have complete state.");
end if;
if Length (Final_States_List) > 1 then
Success := False;
Error_Loc (1) := BATN.Loc (BATN.Next_Node
(Final_States_List.First));
DE (Get_Name_String (ATN.Name
(ATN.Identifier (Parent_Component)))
& " ( Subprogram )"
& " can't have more than one final state.");
else
if Length (Final_States_List) = 0 then
Success := False;
Error_Loc (1) := BATN.Loc (Node_Id (States (BA_Root)));
DE (Get_Name_String (ATN.Name
(ATN.Identifier (Parent_Component)))
& " ( Subprogram )"
& " has no final state.");
end if;
end if;
elsif Component_Category'Val (Category (Parent_Component)) = CC_Thread
-- l'annexe comportementale pour un thread doit définir
-- un seul état (state) initial, un ou plusieurs états finaux
-- et un ou plusieurs états complets
then
if Length (Initial_States_List) > 1 then
Success := False;
Error_Loc (1) := BATN.Loc (BATN.Next_Node
(Initial_States_List.First));
DE (Get_Name_String (ATN.Name
(ATN.Identifier (Parent_Component)))
& " ( Thread )"
& " can't have more than one initial state.");
else
if Length (Initial_States_List) = 0 then
Success := False;
Error_Loc (1) := BATN.Loc (Node_Id (States (BA_Root)));
DE (Get_Name_String (ATN.Name
(ATN.Identifier (Parent_Component)))
& " ( Thread )"
& " has no initial state.");
end if;
end if;
if Length (Complete_States_List) = 0 then
Success := False;
Error_Loc (1) := BATN.Loc (Node_Id (States (BA_Root)));
DE (Get_Name_String (ATN.Name
(ATN.Identifier (Parent_Component)))
& " ( Thread )"
& " must define one or more complete states.");
end if;
if Length (Final_States_List) = 0 then
Success := False;
Error_Loc (1) := BATN.Loc (Node_Id (States (BA_Root)));
DE (Get_Name_String (ATN.Name
(ATN.Identifier (Parent_Component)))
& " ( Thread )"
& " must define one or more final states.");
end if;
end if;
return Success;
end Analyze_Behavior_States;
----------------------------------
-- Analyze_Behavior_Transitions --
----------------------------------
function Analyze_Behavior_Transitions
(Root : Node_Id;
BA_Root : Node_Id;
Parent_Component : Node_Id)
return Boolean
is
use ATN;
pragma Assert (ATN.Kind (Root) = ATN.K_AADL_Specification);
pragma Assert (BATN.Kind (BA_Root) = BATN.K_Behavior_Annex);
pragma Assert (ATN.Kind (Parent_Component) = ATN.K_Component_Type
or else Kind (Parent_Component) =
ATN.K_Component_Implementation);
Success : Boolean := True;
Behavior_Transition : Node_Id;
begin
Behavior_Transition := BATN.First_Node (Transitions (BA_Root));
while Present (Behavior_Transition) loop
if Present (Behavior_Transition_Idt
(Transition (Behavior_Transition)))
then
Success := Success and then
-- vérifier l'unicité des identifiants des transitions
-- dans le composant parent (où l'annexe
-- comportementale est définie)
Test_With_Identifiers_In_Parent_Component
(Behavior_Transition_Idt
(Transition (Behavior_Transition)), Parent_Component);
end if;
Success := Success and then Analyze_Behavior_Transition
(Transition (Behavior_Transition),
BA_Root, Parent_Component);
Behavior_Transition := BATN.Next_Node (Behavior_Transition);
end loop;
return Success;
end Analyze_Behavior_Transitions;
---------------------------------
-- Analyze_Behavior_Transition --
---------------------------------
function Analyze_Behavior_Transition
(Transition : Node_Id;
BA_Root : Node_Id;
Parent_Component : Node_Id)
return Boolean
is
use ATN;
pragma Assert (BATN.Kind (BA_Root) = BATN.K_Behavior_Annex);
pragma Assert (ATN.Kind (Parent_Component) = ATN.K_Component_Type
or else Kind (Parent_Component) =
ATN.K_Component_Implementation);
Source_Transition_List : constant List_Id := Sources (Transition);
Destination_Transition : constant Node_Id
:= BATN.Destination (Transition);
Success : Boolean := True;
List_Node : Node_Id;
Pointed_State : Node_Id;
Cond_Node : Node_Id;
begin
if not Is_Empty (Source_Transition_List) then