Commit ac2ea5c5 by Arnaud Charlet

[multiple changes]

2014-10-17  Ed Schonberg  <schonberg@adacore.com>

	* exp_ch3.adb (Build_Component_Invariant_Call): Retrieve Invariant
	subprogram from base type.
	* sem_ch7.adb (Analyze_Package_Specification): Build invariant
	subprogram for private type, not any of its subtypes.
	* sem_ch13.adb (Build_Invariant_Procedure_Declaration): Set type
	of procedure entity, because a call to it may be generated in
	a client unit before the corresponding subprogram declaration
	is analyzed.

2014-10-17  Vincent Celier  <celier@adacore.com>

	* prj-nmsc.adb (Get_Directories): Do not create directories
	when a project is abstract.

2014-10-17  Ed Schonberg  <schonberg@adacore.com>

	* sem_ch5.adb (Analyze_Iterator_Specification): If the domain
	of iteration is given by an expression that is not an array type,
	verify that its type implements an iterator iterface.

From-SVN: r216380
parent 99425ec3
2014-10-17 Ed Schonberg <schonberg@adacore.com>
* exp_ch3.adb (Build_Component_Invariant_Call): Retrieve Invariant
subprogram from base type.
* sem_ch7.adb (Analyze_Package_Specification): Build invariant
subprogram for private type, not any of its subtypes.
* sem_ch13.adb (Build_Invariant_Procedure_Declaration): Set type
of procedure entity, because a call to it may be generated in
a client unit before the corresponding subprogram declaration
is analyzed.
2014-10-17 Vincent Celier <celier@adacore.com>
* prj-nmsc.adb (Get_Directories): Do not create directories
when a project is abstract.
2014-10-17 Ed Schonberg <schonberg@adacore.com>
* sem_ch5.adb (Analyze_Iterator_Specification): If the domain
of iteration is given by an expression that is not an array type,
verify that its type implements an iterator iterface.
2014-10-17 Robert Dewar <dewar@adacore.com> 2014-10-17 Robert Dewar <dewar@adacore.com>
* sem_attr.adb (Eval_Attribute): Ensure that attribute * sem_attr.adb (Eval_Attribute): Ensure that attribute
......
...@@ -3720,10 +3720,12 @@ package body Exp_Ch3 is ...@@ -3720,10 +3720,12 @@ package body Exp_Ch3 is
end if; end if;
end if; end if;
-- The aspect is type-specific, so retrieve it from the base type.
Call := Call :=
Make_Procedure_Call_Statement (Loc, Make_Procedure_Call_Statement (Loc,
Name => Name =>
New_Occurrence_Of (Invariant_Procedure (Typ), Loc), New_Occurrence_Of (Invariant_Procedure (Base_Type (Typ)), Loc),
Parameter_Associations => New_List (Sel_Comp)); Parameter_Associations => New_List (Sel_Comp));
if Is_Access_Type (Etype (Comp)) then if Is_Access_Type (Etype (Comp)) then
......
...@@ -5498,13 +5498,15 @@ package body Prj.Nmsc is ...@@ -5498,13 +5498,15 @@ package body Prj.Nmsc is
Dir_Exists : Boolean; Dir_Exists : Boolean;
No_Sources : constant Boolean := No_Sources : constant Boolean :=
((not Source_Files.Default Project.Qualifier = Abstract_Project
or else
(((not Source_Files.Default
and then Source_Files.Values = Nil_String) and then Source_Files.Values = Nil_String)
or else (not Source_Dirs.Default or else (not Source_Dirs.Default
and then Source_Dirs.Values = Nil_String) and then Source_Dirs.Values = Nil_String)
or else (not Languages.Default or else (not Languages.Default
and then Languages.Values = Nil_String)) and then Languages.Values = Nil_String))
and then Project.Extends = No_Project; and then Project.Extends = No_Project);
-- Start of processing for Get_Directories -- Start of processing for Get_Directories
......
...@@ -3903,6 +3903,7 @@ package body Sem_Ch13 is ...@@ -3903,6 +3903,7 @@ package body Sem_Ch13 is
if Ctrl = Ent if Ctrl = Ent
or else Ctrl = Class_Wide_Type (Ent) or else Ctrl = Class_Wide_Type (Ent)
or else or else
(Ekind (Ctrl) = E_Anonymous_Access_Type (Ekind (Ctrl) = E_Anonymous_Access_Type
and then and then
...@@ -7393,6 +7394,7 @@ package body Sem_Ch13 is ...@@ -7393,6 +7394,7 @@ package body Sem_Ch13 is
Chars => New_External_Name (Chars (Typ), "Invariant")); Chars => New_External_Name (Chars (Typ), "Invariant"));
Set_Has_Invariants (Typ); Set_Has_Invariants (Typ);
Set_Ekind (SId, E_Procedure); Set_Ekind (SId, E_Procedure);
Set_Etype (SId, Standard_Void_Type);
Set_Is_Invariant_Procedure (SId); Set_Is_Invariant_Procedure (SId);
Set_Invariant_Procedure (Typ, SId); Set_Invariant_Procedure (Typ, SId);
......
...@@ -1838,6 +1838,17 @@ package body Sem_Ch5 is ...@@ -1838,6 +1838,17 @@ package body Sem_Ch5 is
else else
Typ := Etype (Iter_Name); Typ := Etype (Iter_Name);
-- Verify that the expression produces an iterator.
if not Of_Present (N) and then not Is_Iterator (Typ)
and then not Is_Array_Type (Typ)
and then No (Find_Aspect (Typ, Aspect_Iterable))
then
Error_Msg_N
("expect object that implements iterator interface",
Iter_Name);
end if;
end if; end if;
-- Protect against malformed iterator -- Protect against malformed iterator
......
...@@ -1384,7 +1384,11 @@ package body Sem_Ch7 is ...@@ -1384,7 +1384,11 @@ package body Sem_Ch7 is
end if; end if;
if Has_Invariants (E) then if Has_Invariants (E) then
Build_Invariant_Procedure (E, N); if Ekind (E) = E_Private_Subtype then
null;
else
Build_Invariant_Procedure (E, N);
end if;
end if; end if;
end if; end if;
......
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