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
alias of the inherited op is the parent iterator, no need to
examine dispatch table positions which might not be established
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;
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;
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;
-- 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;
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);
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;
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;
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.
-- --
-- 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- --
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;
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;
projects / platform / upstream / gcc.git / commitdiff