Commit 4184dd81 authored by Maxime Perrotin's avatar Maxime Perrotin
Browse files

Make string vectors case insensitive

so that built-in function Find becomes case insensitive
parent ba2e564e
......@@ -6,6 +6,7 @@
with Ada.Containers.Indefinite_Ordered_Maps,
Ada.Containers.Indefinite_Vectors,
Ada.Strings.Unbounded,
Ada.Strings.Equal_Case_Insensitive,
Text_IO,
GNAT.Strings,
Interfaces.C_Streams,
......@@ -75,7 +76,8 @@ package TASTE.Parser_Utils is
package Property_Maps is new Indefinite_Ordered_Maps (String,
User_Property);
use Property_Maps;
package String_Vectors is new Indefinite_Vectors (Natural, String);
package String_Vectors is new Indefinite_Vectors (Natural, String,
Ada.Strings.Equal_Case_Insensitive);
function Get_Properties_Map (D : Node_Id) return Property_Maps.Map;
-- Shortcut to read an identifier from the parser, in lowercase
......
package TASTE.Parser_Version is
Parser_Release : constant String :=
"4924bdf ; Commit Date: Fri Mar 23 17:45:15 2018 ";
"ba2e564 ; Commit Date: Fri Mar 23 17:51:07 2018 ";
Ocarina_Version : constant String :=
"Ocarina 2017.x (Working Copy from r2a52334)";
end TASTE.Parser_Version;
\ No newline at end of file
......@@ -13,13 +13,14 @@ use Ada.Strings.Unbounded,
TASTE.Parser_Utils;
package body TASTE.Semantic_Check is
use String_Vectors;
procedure Check_Model (Model : TASTE_Model) is
use Option_Partition;
Opt_Part : Option_Partition.Option;
Opt_Part : Option_Partition.Option;
begin
if Model.Configuration.Glue then
for Each of Model.Interface_View.Flat_Functions loop
Opt_Part := Model.Find_Binding (Each.Name);
Opt_Part := Model.Find_Binding (Each.Name);
-- Check that each function is placed on a partition
if not Each.Is_Type and then not Opt_Part.Has_Value then
raise Semantic_Error with
......@@ -69,15 +70,36 @@ package body TASTE.Semantic_Check is
-- GUI checks:
-- 1) interfaces must all have a parameter
-- 2) interfaces must all be sporadic
-- 2) interfaces must all be sporadic (TODO)
if Each.Language = Language_Gui and then
((for all I of Each.Provided => I.Params.Length /= 1) or else
(for all I of Each.Required => I.Params.Length = 1))
(for all I of Each.Required => I.Params.Length /= 1))
then
raise Semantic_Error with
"Function " & To_String (Each.Name) & "'s interfaces"
& " must all have exactly one parameter";
end if;
-- Check that functions including at least one (un)protected
-- interface are located on the same partition as their caller(s)
for PI of Each.Provided loop
if not Each.Is_Type and then (PI.RCM = Protected_Operation
or PI.RCM = Unprotected_Operation)
then
for Remote of PI.Remote_Interfaces loop
if Opt_Part.Unsafe_Just.Bound_Functions.Find
(To_String (Remote.Function_Name)) = String_Vectors.No_Element
then
raise Semantic_Error with "Function "
& To_String (Each.Name) & " and function "
& To_String (Remote.Function_Name) & " must be located"
& " on the same partition in the deployment view, "
& "because they share a synchronous interface";
end if;
end loop;
end if;
end loop;
end loop;
end if;
end Check_Model;
......
Supports Markdown
0% or .
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment