File : asis-compilation_units-relations.adb
------------------------------------------------------------------------------
-- --
-- ASIS-for-GNAT IMPLEMENTATION COMPONENTS --
-- --
-- A S I S . C O M P I L A T I O N _ U N I T S . R E L A T I O N S --
-- --
-- B o d y --
-- --
-- Copyright (c) 1995-1999, Free Software Foundation, Inc. --
-- --
-- ASIS-for-GNAT is free software; you can redistribute it and/or modify it --
-- under terms of the GNU General Public License as published by the Free --
-- Software Foundation; either version 2, or (at your option) any later --
-- version. ASIS-for-GNAT is distributed in the hope that it will be use- --
-- ful, but WITHOUT ANY WARRANTY; without even the implied warranty of MER- --
-- CHANTABILITY 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 distributed with ASIS-for-GNAT; see file --
-- COPYING. If not, write to the Free Software Foundation, 59 Temple Place --
-- - Suite 330, Boston, MA 02111-1307, USA. --
-- --
-- As a special exception, if other files instantiate generics from this --
-- unit, or you link this unit with other files to produce an executable, --
-- this unit does not by itself cause the resulting executable to be --
-- covered by the GNU General Public License. This exception does not --
-- however invalidate any other reasons why the executable file might be --
-- covered by the GNU Public License. --
-- --
-- ASIS-for-GNAT was originally developed by the ASIS-for-GNAT team at the --
-- Software Engineering Laboratory of the Swiss Federal Institute of --
-- Technology (LGL-EPFL) in Lausanne, Switzerland, in cooperation with the --
-- Scientific Research Computer Center of Moscow State University (SRCC --
-- MSU), Russia, with funding partially provided by grants from the Swiss --
-- National Science Foundation and the Swiss Academy of Engineering --
-- Sciences. ASIS-for-GNAT is now maintained by Ada Core Technologies Inc --
-- (http://www.gnat.com). --
-- --
------------------------------------------------------------------------------
with Asis.Exceptions; use Asis.Exceptions;
with Asis.Extensions; use Asis.Extensions;
with Asis.Set_Get; use Asis.Set_Get;
with A4G.Vcheck; use A4G.Vcheck;
with A4G.Contt.Dp; use A4G.Contt.Dp;
package body Asis.Compilation_Units.Relations is
LT : String renames ASIS_Line_Terminator;
Package_Name : String := "Asis.Compilation_Units.Relations.";
-----------------------
-- Elaboration_Order --
-----------------------
-- NOT IMPLEMENTED --
function Elaboration_Order
(Compilation_Units : in Asis.Compilation_Unit_List;
The_Context : in Asis.Context)
return Relationship
is
begin
Check_Validity (The_Context,
Package_Name & "Semantic_Dependence_Order");
Not_Implemented_Yet (Diagnosis =>
Package_Name & "Semantic_Dependence_Order");
-- ASIS_Failed is raised, Not_Implemented_Error status is setted
return Nil_Relationship; -- to make the code syntactically correct
exception
when ASIS_Inappropriate_Context =>
raise;
when ASIS_Failed =>
Add_Call_Information (Outer_Call =>
Package_Name & "Semantic_Dependence_Order");
raise;
when others =>
Raise_ASIS_Failed (Diagnosis =>
Package_Name & "Semantic_Dependence_Order");
end Elaboration_Order;
-------------------------------
-- Semantic_Dependence_Order --
-------------------------------
-- PARTIALLY IMPLEMENTED --
function Semantic_Dependence_Order
(Compilation_Units : in Asis.Compilation_Unit_List;
Dependent_Units : in Asis.Compilation_Unit_List;
The_Context : in Asis.Context;
Relation : in Asis.Relation_Kinds)
return Relationship
is
Res_Cont_Id : Context_Id;
Arg_Kind : Asis.Unit_Kinds;
Result_List : Compilation_Unit_List_Access;
begin
Check_Validity (The_Context, Package_Name & "Semantic_Dependence_Order");
Res_Cont_Id := Get_Cont_Id (The_Context);
-- The current implementation limitation is that all the units from
-- Compilation_Units list and from Dependent_Units should be from
-- The_Context
for I in Compilation_Units'Range loop
Check_Validity (Compilation_Units (I),
Package_Name & "Semantic_Dependence_Order");
Arg_Kind := Kind (Compilation_Units (I));
if Arg_Kind = Not_A_Unit or else
Arg_Kind = A_Nonexistent_Declaration or else
Arg_Kind = A_Nonexistent_Body or else
Arg_Kind = A_Configuration_Compilation
then
Raise_ASIS_Inappropriate_Compilation_Unit (Diagnosis =>
Package_Name & "Semantic_Dependence_Order");
end if;
if Res_Cont_Id /= Encl_Cont_Id (Compilation_Units (I)) then
Not_Implemented_Yet (Diagnosis =>
Package_Name &
"Semantic_Dependence_Order (multi-context processing");
end if;
end loop;
for I in Dependent_Units'Range loop
Check_Validity (Dependent_Units (I),
Package_Name & "Semantic_Dependence_Order");
Arg_Kind := Kind (Dependent_Units (I));
if Arg_Kind = Not_A_Unit or else
Arg_Kind = A_Nonexistent_Declaration or else
Arg_Kind = A_Nonexistent_Body or else
Arg_Kind = A_Configuration_Compilation
then
Raise_ASIS_Inappropriate_Compilation_Unit (Diagnosis =>
Package_Name & "Semantic_Dependence_Order");
end if;
if Res_Cont_Id /= Encl_Cont_Id (Dependent_Units (I)) then
Not_Implemented_Yet (Diagnosis =>
Package_Name &
"Semantic_Dependence_Order (multi-context processing");
end if;
end loop;
case Relation is
when Supporters =>
Set_All_Supporters
(Compilation_Units, Dependent_Units, The_Context, Result_List);
when others =>
Not_Implemented_Yet
(Diagnosis => Package_Name & "Semantic_Dependence_Order");
end case;
declare
Result : Relationship
(Consistent_Length => Result_List'Length,
Inconsistent_Length => 0,
Missing_Length => 0,
Circular_Length => 0);
begin
Result.Consistent := Result_List.all;
Free (Result_List);
return Result;
end;
exception
when ASIS_Inappropriate_Context =>
raise;
when ASIS_Failed =>
Add_Call_Information (Outer_Call =>
Package_Name & "Semantic_Dependence_Order");
raise;
when others =>
Raise_ASIS_Failed (Diagnosis =>
Package_Name & "Semantic_Dependence_Order");
end Semantic_Dependence_Order;
end Asis.Compilation_Units.Relations