Commit 8880426d by Arnaud Charlet

[multiple changes]

2014-02-20  Hristian Kirtchev  <kirtchev@adacore.com>

	* sem_prag.adb (Usage_Error): Remove local
	constant Typ. Remove the specialized diagnostics for unconstrained
	or tagged items as those are not part of the explicit input set
	of the related subprogram and should not be flagged.

2014-02-20  Ed Schonberg  <schonberg@adacore.com>

	* sem_attr.adb: Add guard to preserve all errors.

2014-02-20  Vincent Celier  <celier@adacore.com>

	* switch-m.adb (Normalize_Compiler_Switches): Take into account
	switches that are recorded in ALI files: -gnateA, -gnateE,
	-gnateF, -gnateinn, -gnateu, -gnateV and -gnateY.

2014-02-20  Ed Schonberg  <schonberg@adacore.com>

	* sem_ch5.adb (Analyze_Iterator_Specification): Check legality
	of an element iterator form over a formal container with an
	Iterable aspect.
	* exp_ch5.adb (Build_Formal_Container_Iteration): Utility
	to create declaration and loop statements for both forms of
	container iterators.
	(Expand_Formal_Container_Element_Iterator): New procedure
	to handle loops of the form  "for E of C" when C is a formal
	container.
	(Expand_Formal_Container_Iterator): Code cleanup.

From-SVN: r207953
parent 46de64ca
2014-02-20 Hristian Kirtchev <kirtchev@adacore.com> 2014-02-20 Hristian Kirtchev <kirtchev@adacore.com>
* sem_prag.adb (Usage_Error): Remove local
constant Typ. Remove the specialized diagnostics for unconstrained
or tagged items as those are not part of the explicit input set
of the related subprogram and should not be flagged.
2014-02-20 Ed Schonberg <schonberg@adacore.com>
* sem_attr.adb: Add guard to preserve all errors.
2014-02-20 Vincent Celier <celier@adacore.com>
* switch-m.adb (Normalize_Compiler_Switches): Take into account
switches that are recorded in ALI files: -gnateA, -gnateE,
-gnateF, -gnateinn, -gnateu, -gnateV and -gnateY.
2014-02-20 Ed Schonberg <schonberg@adacore.com>
* sem_ch5.adb (Analyze_Iterator_Specification): Check legality
of an element iterator form over a formal container with an
Iterable aspect.
* exp_ch5.adb (Build_Formal_Container_Iteration): Utility
to create declaration and loop statements for both forms of
container iterators.
(Expand_Formal_Container_Element_Iterator): New procedure
to handle loops of the form "for E of C" when C is a formal
container.
(Expand_Formal_Container_Iterator): Code cleanup.
2014-02-20 Hristian Kirtchev <kirtchev@adacore.com>
* sem_prag.adb (Add_Item_To_Name_Buffer): New routine. * sem_prag.adb (Add_Item_To_Name_Buffer): New routine.
(Analyze_Contract_Case): Remove the use of (Analyze_Contract_Case): Remove the use of
"may". Replace "aspect Contract_Cases" to avoid categorization "may". Replace "aspect Contract_Cases" to avoid categorization
......
...@@ -6310,8 +6310,12 @@ package body Sem_Attr is ...@@ -6310,8 +6310,12 @@ package body Sem_Attr is
-- Verify that all choices in an association denote -- Verify that all choices in an association denote
-- components of the same type. -- components of the same type.
if No (Comp_Type) then if No (Etype (Comp)) then
null;
elsif No (Comp_Type) then
Comp_Type := Base_Type (Etype (Comp)); Comp_Type := Base_Type (Etype (Comp));
elsif Comp_Type /= Base_Type (Etype (Comp)) then elsif Comp_Type /= Base_Type (Etype (Comp)) then
Error_Msg_N Error_Msg_N
("components in choice list must have same type", ("components in choice list must have same type",
......
...@@ -1857,39 +1857,45 @@ package body Sem_Ch5 is ...@@ -1857,39 +1857,45 @@ package body Sem_Ch5 is
Set_Ekind (Def_Id, E_Loop_Parameter); Set_Ekind (Def_Id, E_Loop_Parameter);
if Of_Present (N) then if Of_Present (N) then
if Has_Aspect (Typ, Aspect_Iterable) then
if No (Get_Iterable_Type_Primitive (Typ, Name_Element)) then
Error_Msg_N ("Missing Element primitive for iteration", N);
end if;
-- The type of the loop variable is the Iterator_Element aspect of -- For a predefined container, The type of the loop variable is
-- the container type. -- the Iterator_Element aspect of the container type.
declare else
Element : constant Entity_Id := declare
Element : constant Entity_Id :=
Find_Value_Of_Aspect (Typ, Aspect_Iterator_Element); Find_Value_Of_Aspect (Typ, Aspect_Iterator_Element);
begin begin
if No (Element) then if No (Element) then
Error_Msg_NE ("cannot iterate over&", N, Typ); Error_Msg_NE ("cannot iterate over&", N, Typ);
return; return;
else else
Set_Etype (Def_Id, Entity (Element)); Set_Etype (Def_Id, Entity (Element));
-- If subtype indication was given, verify that it matches -- If subtype indication was given, verify that it
-- element type of container. -- matches element type of container.
if Present (Subt) if Present (Subt)
and then Bas /= Base_Type (Etype (Def_Id)) and then Bas /= Base_Type (Etype (Def_Id))
then then
Error_Msg_N Error_Msg_N
("subtype indication does not match element type", ("subtype indication does not match element type",
Subt); Subt);
end if; end if;
-- If the container has a variable indexing aspect, the -- If the container has a variable indexing aspect, the
-- element is a variable and is modifiable in the loop. -- element is a variable and is modifiable in the loop.
if Has_Aspect (Typ, Aspect_Variable_Indexing) then if Has_Aspect (Typ, Aspect_Variable_Indexing) then
Set_Ekind (Def_Id, E_Variable); Set_Ekind (Def_Id, E_Variable);
end if;
end if; end if;
end if; end;
end; end if;
else else
-- For an iteration of the form IN, the name must denote an -- For an iteration of the form IN, the name must denote an
......
...@@ -1235,64 +1235,34 @@ package body Sem_Prag is ...@@ -1235,64 +1235,34 @@ package body Sem_Prag is
----------------- -----------------
procedure Usage_Error (Item : Node_Id; Item_Id : Entity_Id) is procedure Usage_Error (Item : Node_Id; Item_Id : Entity_Id) is
Typ : constant Entity_Id := Etype (Item_Id);
Error_Msg : Name_Id; Error_Msg : Name_Id;
begin begin
Name_Len := 0;
-- Input case -- Input case
if Is_Input then if Is_Input then
Add_Item_To_Name_Buffer (Item_Id);
Add_Str_To_Name_Buffer
(" & must appear in at least one input dependence list "
& "(SPARK RM 6.1.5(8))");
Error_Msg := Name_Find;
Error_Msg_NE (Get_Name_String (Error_Msg), Item, Item_Id);
-- Refine the error message for unconstrained parameters and
-- variables by giving the reason for the illegality.
if Ekind (Item_Id) = E_Out_Parameter then
-- Unconstrained arrays must appear as inputs because their
-- bounds must be read.
if Is_Array_Type (Typ)
and then not Is_Constrained (Typ)
then
Error_Msg_NE
("\\type & is an unconstrained array", Item, Typ);
Error_Msg_N ("\\array bounds must be read", Item);
-- Unconstrained discriminated records must appear as inputs -- Unconstrained and tagged items are not part of the explicit
-- because their discriminants and constrained flag must be -- input set of the related subprogram, they do not have to be
-- read. -- present in a dependence relation and should not be flagged.
elsif Is_Record_Type (Typ) if not Is_Unconstrained_Or_Tagged_Item (Item_Id) then
and then Has_Discriminants (Typ) Name_Len := 0;
and then not Is_Constrained (Typ)
then
Error_Msg_NE
("\\type & is an unconstrained discriminated record",
Item, Typ);
Error_Msg_N
("\\discriminants and constrained flag must be read",
Item);
-- Not clear if there are other cases. Anyway, we will Add_Item_To_Name_Buffer (Item_Id);
-- simply ignore any other cases. Add_Str_To_Name_Buffer
(" & must appear in at least one input dependence list "
& "(SPARK RM 6.1.5(8))");
else Error_Msg := Name_Find;
null; Error_Msg_NE (Get_Name_String (Error_Msg), Item, Item_Id);
end if;
end if; end if;
-- Output case -- Output case
else else
Name_Len := 0;
Add_Item_To_Name_Buffer (Item_Id); Add_Item_To_Name_Buffer (Item_Id);
Add_Str_To_Name_Buffer Add_Str_To_Name_Buffer
(" & must appear in exactly one output dependence list " (" & must appear in exactly one output dependence list "
......
...@@ -6,7 +6,7 @@ ...@@ -6,7 +6,7 @@
-- -- -- --
-- B o d y -- -- B o d y --
-- -- -- --
-- Copyright (C) 2001-2012, Free Software Foundation, Inc. -- -- Copyright (C) 2001-2013, Free Software Foundation, Inc. --
-- -- -- --
-- GNAT is free software; you can redistribute it and/or modify it under -- -- 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 Soft- -- -- terms of the GNU General Public License as published by the Free Soft- --
...@@ -310,6 +310,10 @@ package body Switch.M is ...@@ -310,6 +310,10 @@ package body Switch.M is
else else
case Switch_Chars (Ptr) is case Switch_Chars (Ptr) is
when 'A' =>
Ptr := Ptr + 1;
Add_Switch_Component ("-gnateA");
when 'D' => when 'D' =>
Storing (First_Stored + 1 .. Storing (First_Stored + 1 ..
First_Stored + Max - Ptr + 1) := First_Stored + Max - Ptr + 1) :=
...@@ -319,16 +323,17 @@ package body Switch.M is ...@@ -319,16 +323,17 @@ package body Switch.M is
First_Stored + Max - Ptr + 1)); First_Stored + Max - Ptr + 1));
Ptr := Max + 1; Ptr := Max + 1;
when 'G' => when 'E' | 'F' | 'G' | 'S' | 'u' | 'V' | 'Y' =>
Ptr := Ptr + 1; Add_Switch_Component
Add_Switch_Component ("-gnateG"); ("-gnate" & Switch_Chars (Ptr));
when 'I' =>
Ptr := Ptr + 1; Ptr := Ptr + 1;
when 'i' | 'I' =>
declare declare
First : constant Positive := Ptr - 1; First : constant Positive := Ptr;
begin begin
Ptr := Ptr + 1;
if Ptr <= Max and then if Ptr <= Max and then
Switch_Chars (Ptr) = '=' Switch_Chars (Ptr) = '='
then then
...@@ -376,10 +381,6 @@ package body Switch.M is ...@@ -376,10 +381,6 @@ package body Switch.M is
return; return;
when 'S' =>
Ptr := Ptr + 1;
Add_Switch_Component ("-gnateS");
when others => when others =>
Last := 0; Last := 0;
return; return;
......
Markdown is supported
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