[multiple changes]

2017-01-06  Ed Schonberg  <schonberg@adacore.com>

	* sem_ch5.adb (Analyze_Loop_Statement): If the loop includes an
	iterator specification with a serious syntactic error, transform
	construct into an infinite loop in order to continue analysis
	and prevent a compiler abort.

2017-01-06  Tristan Gingold  <gingold@adacore.com>

	* exp_ch9.adb (Expand_N_Protected_Type_Declaration): Do not generate
	max_queue_lengths_array if unused.

2017-01-06  Bob Duff  <duff@adacore.com>

	* errout.adb (Set_Msg_Text): Protect against out-of-bounds
	array access, in case "\" is at the end of Text.
	* stylesw.adb (Set_Style_Check_Options): Don't include input
	characters in the error message template, because they could
	be control characters such as "\", which Errout will try to
	interpret.

2017-01-06  Ed Schonberg  <schonberg@adacore.com>

	* sem_ch4.adb (Find_Indexing_Operations, Inspect_Declarations):
	For a private type examine the visible declarations that follow
	the partial view, not just the private declarations that follow
	the full view.

2017-01-06  Hristian Kirtchev  <kirtchev@adacore.com>

	* exp_ch5.adb, sem_ch3.adb, checks.adb: Minor reformatting and
	code cleanup.

From-SVN: r244133
This commit is contained in:
Arnaud Charlet 2017-01-06 12:06:24 +01:00
parent 6eca51ce09
commit e11b776b63
9 changed files with 74 additions and 14 deletions

View File

@ -1,3 +1,36 @@
2017-01-06 Ed Schonberg <schonberg@adacore.com>
* sem_ch5.adb (Analyze_Loop_Statement): If the loop includes an
iterator specification with a serious syntactic error, transform
construct into an infinite loop in order to continue analysis
and prevent a compiler abort.
2017-01-06 Tristan Gingold <gingold@adacore.com>
* exp_ch9.adb (Expand_N_Protected_Type_Declaration): Do not generate
max_queue_lengths_array if unused.
2017-01-06 Bob Duff <duff@adacore.com>
* errout.adb (Set_Msg_Text): Protect against out-of-bounds
array access, in case "\" is at the end of Text.
* stylesw.adb (Set_Style_Check_Options): Don't include input
characters in the error message template, because they could
be control characters such as "\", which Errout will try to
interpret.
2017-01-06 Ed Schonberg <schonberg@adacore.com>
* sem_ch4.adb (Find_Indexing_Operations, Inspect_Declarations):
For a private type examine the visible declarations that follow
the partial view, not just the private declarations that follow
the full view.
2017-01-06 Hristian Kirtchev <kirtchev@adacore.com>
* exp_ch5.adb, sem_ch3.adb, checks.adb: Minor reformatting and
code cleanup.
2017-01-06 Ed Schonberg <schonberg@adacore.com>
* exp_ch5.adb (Get_Default_Iterator): For a derived type, the

View File

@ -2638,14 +2638,14 @@ package body Checks is
elsif Present (S) and then S = Predicate_Function (Typ) then
Error_Msg_NE
("predicate check includes a call to& that "
& "requires a predicate check??", Parent (N), Fun);
("predicate check includes a call to& that requires a "
& "predicate check??", Parent (N), Fun);
Error_Msg_N
("\this will result in infinite recursion??", Parent (N));
if Is_First_Subtype (Typ) then
Error_Msg_NE
("\use an explicit subtype of& to carry the predicate",
("\use an explicit subtype of& to carry the predicate",
Parent (N), Typ);
end if;

View File

@ -2992,7 +2992,7 @@ package body Errout is
when '\' =>
Continuation := True;
if Text (P) = '\' then
if P <= Text'Last and then Text (P) = '\' then
Continuation_New_Line := True;
P := P + 1;
end if;

View File

@ -3777,9 +3777,10 @@ package body Exp_Ch5 is
Op := Node (Prim);
if Alias (Op) = Iter
or else (Chars (Op) = Chars (Iter)
and then Present (DTC_Entity (Op))
and then DT_Position (Op) = DT_Position (Iter))
or else
(Chars (Op) = Chars (Iter)
and then Present (DTC_Entity (Op))
and then DT_Position (Op) = DT_Position (Iter))
then
return Op;
end if;

View File

@ -9767,7 +9767,10 @@ package body Exp_Ch9 is
-- type. This object is later passed to the appropriate protected object
-- initialization routine.
if Has_Entries (Prot_Typ) then
if Has_Entries (Prot_Typ)
and then Corresponding_Runtime_Package (Prot_Typ) =
System_Tasking_Protected_Objects_Entries
then
declare
Count : Int;
Item : Entity_Id;

View File

@ -11960,7 +11960,7 @@ package body Sem_Ch3 is
if (No (Item)
or else Nkind (Item) /= N_Aspect_Specification
or else Entity (Item) = Full_Base)
and then Present (First_Rep_Item (Priv))
and then Present (First_Rep_Item (Priv))
then
Set_First_Rep_Item (Full, Priv_Item);
@ -14182,7 +14182,8 @@ package body Sem_Ch3 is
Governed_By => Assoc_List,
Into => Comp_List,
Report_Errors => Errors);
pragma Assert (not Errors);
pragma Assert (not Errors
or else Serious_Errors_Detected > 0);
Create_All_Components;

View File

@ -7798,7 +7798,16 @@ package body Sem_Ch4 is
Ref := Empty;
Typ := Underlying_Type (Base_Type (Typ));
Inspect_Primitives (Typ, Ref);
Inspect_Primitives (Typ, Ref);
-- Now look for explicit declarations of an indexing operation.
-- If the type is private the operation may be declared in the
-- visible part that contains the partial view.
if Is_Private_Type (T) then
Inspect_Declarations (T, Ref);
end if;
Inspect_Declarations (Typ, Ref);
return Ref;

View File

@ -3273,6 +3273,19 @@ package body Sem_Ch5 is
Set_Has_Created_Identifier (N);
end if;
-- If the iterator specification has a syntactic error, transform
-- construct into an infinite loop to prevent a crash and perform
-- some analysis.
if Present (Iter)
and then Present (Iterator_Specification (Iter))
and then Error_Posted (Iterator_Specification (Iter))
then
Set_Iteration_Scheme (N, Empty);
Analyze (N);
return;
end if;
-- Iteration over a container in Ada 2012 involves the creation of a
-- controlled iterator object. Wrap the loop in a block to ensure the
-- timely finalization of the iterator and release of container locks.

View File

@ -6,7 +6,7 @@
-- --
-- B o d y --
-- --
-- Copyright (C) 1992-2013, Free Software Foundation, Inc. --
-- Copyright (C) 1992-2016, Free Software Foundation, Inc. --
-- --
-- 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- --
@ -471,7 +471,7 @@ package body Stylesw is
Write_Line ("unrecognized switch -gnaty" & C & " ignored");
else
Err_Col := Err_Col - 1;
Bad_Style_Switch ("invalid style switch: " & C);
Bad_Style_Switch ("invalid style switch");
return;
end if;
end case;
@ -580,7 +580,7 @@ package body Stylesw is
Write_Line ("unrecognized switch -gnaty-" & C & " ignored");
else
Err_Col := Err_Col - 1;
Bad_Style_Switch ("invalid style switch: " & C);
Bad_Style_Switch ("invalid style switch");
return;
end if;
end case;