Commit 1824c168 by Arnaud Charlet

[multiple changes]

2013-01-02  Vincent Celier  <celier@adacore.com>

	* switch-m.adb (Normalize_Compiler_Switches): Record the
	complete switch -fstack-check=specific instead of its shorter
	alias -fstack-check.

2013-01-02  Ed Schonberg  <schonberg@adacore.com>

	* sem_ch3.adb (Derive_Subprogram): Enforce RM 6.3.1 (8):
	if the derived type is a tagged generic formal type with
	unknown discriminants, the inherited operation has convention
	Intrinsic. As such, the 'Access attribute cannot be applied to it.

2013-01-02  Thomas Quinot  <quinot@adacore.com>

	* sem_attr.adb: Minor reformatting.

From-SVN: r194780
parent db318f46
2013-01-02 Vincent Celier <celier@adacore.com>
* switch-m.adb (Normalize_Compiler_Switches): Record the
complete switch -fstack-check=specific instead of its shorter
alias -fstack-check.
2013-01-02 Ed Schonberg <schonberg@adacore.com>
* sem_ch3.adb (Derive_Subprogram): Enforce RM 6.3.1 (8):
if the derived type is a tagged generic formal type with
unknown discriminants, the inherited operation has convention
Intrinsic. As such, the 'Access attribute cannot be applied to it.
2013-01-02 Thomas Quinot <quinot@adacore.com>
* sem_attr.adb: Minor reformatting.
2013-01-02 Thomas Quinot <quinot@adacore.com> 2013-01-02 Thomas Quinot <quinot@adacore.com>
* par_sco.adb: Add SCO generation for S of protected types and * par_sco.adb: Add SCO generation for S of protected types and
......
...@@ -4251,9 +4251,9 @@ package body Sem_Attr is ...@@ -4251,9 +4251,9 @@ package body Sem_Attr is
Prag := N; Prag := N;
while not Nkind_In (Prag, N_Pragma, while not Nkind_In (Prag, N_Pragma,
N_Function_Specification, N_Function_Specification,
N_Procedure_Specification, N_Procedure_Specification,
N_Subprogram_Body) N_Subprogram_Body)
loop loop
Prag := Parent (Prag); Prag := Parent (Prag);
end loop; end loop;
......
...@@ -13320,8 +13320,29 @@ package body Sem_Ch3 is ...@@ -13320,8 +13320,29 @@ package body Sem_Ch3 is
-- of the parent subprogram (a requirement of AI-117). Derived -- of the parent subprogram (a requirement of AI-117). Derived
-- subprograms of untagged types simply get convention Ada by default. -- subprograms of untagged types simply get convention Ada by default.
-- If the derived type is a tagged generic formal type with unknown
-- discriminants, its convention is intrinsic (RM 6.3.1 (8)).
-- However, if the type is derived from a generic formal, the further
-- inherited subprogram has the convention of the non-generic ancestor.
-- Otherwise there would be no way to override the operation.
-- (This is subject to forthcoming ARG discussions).
if Is_Tagged_Type (Derived_Type) then if Is_Tagged_Type (Derived_Type) then
Set_Convention (New_Subp, Convention (Parent_Subp)); if Is_Generic_Type (Derived_Type)
and then Has_Unknown_Discriminants (Derived_Type)
then
Set_Convention (New_Subp, Convention_Intrinsic);
else
if Is_Generic_Type (Parent_Type)
and then Has_Unknown_Discriminants (Parent_Type)
then
Set_Convention (New_Subp, Convention (Alias (Parent_Subp)));
else
Set_Convention (New_Subp, Convention (Parent_Subp));
end if;
end if;
end if; end if;
-- Predefined controlled operations retain their name even if the parent -- Predefined controlled operations retain their name even if the parent
...@@ -13333,9 +13354,9 @@ package body Sem_Ch3 is ...@@ -13333,9 +13354,9 @@ package body Sem_Ch3 is
if Is_Controlled (Parent_Type) if Is_Controlled (Parent_Type)
and then and then
(Chars (Parent_Subp) = Name_Initialize (Chars (Parent_Subp) = Name_Initialize or else
or else Chars (Parent_Subp) = Name_Adjust Chars (Parent_Subp) = Name_Adjust or else
or else Chars (Parent_Subp) = Name_Finalize) Chars (Parent_Subp) = Name_Finalize)
and then Is_Hidden (Parent_Subp) and then Is_Hidden (Parent_Subp)
and then not Is_Visibly_Controlled (Parent_Type) and then not Is_Visibly_Controlled (Parent_Type)
then then
...@@ -13377,14 +13398,14 @@ package body Sem_Ch3 is ...@@ -13377,14 +13398,14 @@ package body Sem_Ch3 is
elsif Ada_Version >= Ada_2005 elsif Ada_Version >= Ada_2005
and then (Is_Abstract_Subprogram (Alias (New_Subp)) and then (Is_Abstract_Subprogram (Alias (New_Subp))
or else (Is_Tagged_Type (Derived_Type) or else (Is_Tagged_Type (Derived_Type)
and then Etype (New_Subp) = Derived_Type and then Etype (New_Subp) = Derived_Type
and then not Is_Null_Extension (Derived_Type)) and then not Is_Null_Extension (Derived_Type))
or else (Is_Tagged_Type (Derived_Type) or else (Is_Tagged_Type (Derived_Type)
and then Ekind (Etype (New_Subp)) = and then Ekind (Etype (New_Subp)) =
E_Anonymous_Access_Type E_Anonymous_Access_Type
and then Designated_Type (Etype (New_Subp)) = and then Designated_Type (Etype (New_Subp)) =
Derived_Type Derived_Type
and then not Is_Null_Extension (Derived_Type))) and then not Is_Null_Extension (Derived_Type)))
and then No (Actual_Subp) and then No (Actual_Subp)
then then
if not Is_Tagged_Type (Derived_Type) if not Is_Tagged_Type (Derived_Type)
...@@ -13509,9 +13530,7 @@ package body Sem_Ch3 is ...@@ -13509,9 +13530,7 @@ package body Sem_Ch3 is
-- an incomplete type whose full-view is derived type -- an incomplete type whose full-view is derived type
E := First_Entity (Scope (Derived_Type)); E := First_Entity (Scope (Derived_Type));
while Present (E) while Present (E) and then E /= Derived_Type loop
and then E /= Derived_Type
loop
if Ekind (E) = E_Incomplete_Type if Ekind (E) = E_Incomplete_Type
and then Present (Full_View (E)) and then Present (Full_View (E))
and then Full_View (E) = Derived_Type and then Full_View (E) = Derived_Type
...@@ -13648,8 +13667,7 @@ package body Sem_Ch3 is ...@@ -13648,8 +13667,7 @@ package body Sem_Ch3 is
if not Is_Tagged_Type (Derived_Type) if not Is_Tagged_Type (Derived_Type)
or else (not Has_Interfaces (Derived_Type) or else (not Has_Interfaces (Derived_Type)
and then not (Present (Generic_Actual) and then not (Present (Generic_Actual)
and then and then Has_Interfaces (Generic_Actual)))
Has_Interfaces (Generic_Actual)))
then then
Elmt := First_Elmt (Op_List); Elmt := First_Elmt (Op_List);
while Present (Elmt) loop while Present (Elmt) loop
...@@ -13673,9 +13691,10 @@ package body Sem_Ch3 is ...@@ -13673,9 +13691,10 @@ package body Sem_Ch3 is
else else
pragma Assert (No (Node (Act_Elmt)) pragma Assert (No (Node (Act_Elmt))
or else (Primitive_Names_Match (Subp, Node (Act_Elmt)) or else (Primitive_Names_Match (Subp, Node (Act_Elmt))
and then and then
Type_Conformant (Subp, Node (Act_Elmt), Type_Conformant
Skip_Controlling_Formals => True))); (Subp, Node (Act_Elmt),
Skip_Controlling_Formals => True)));
Derive_Subprogram Derive_Subprogram
(New_Subp, Subp, Derived_Type, Parent_Base, Node (Act_Elmt)); (New_Subp, Subp, Derived_Type, Parent_Base, Node (Act_Elmt));
...@@ -14722,9 +14741,7 @@ package body Sem_Ch3 is ...@@ -14722,9 +14741,7 @@ package body Sem_Ch3 is
-- Set Discard_Names if configuration pragma set, or if there is -- Set Discard_Names if configuration pragma set, or if there is
-- a parameterless pragma in the current declarative region -- a parameterless pragma in the current declarative region
if Global_Discard_Names if Global_Discard_Names or else Discard_Names (Scope (T)) then
or else Discard_Names (Scope (T))
then
Set_Discard_Names (T); Set_Discard_Names (T);
end if; end if;
......
...@@ -214,6 +214,12 @@ package body Switch.M is ...@@ -214,6 +214,12 @@ package body Switch.M is
then then
Add_Switch_Component (Switch_Chars); Add_Switch_Component (Switch_Chars);
-- Special case for -fstack-check (alias for
-- -fstack-check=specific)
elsif Switch_Chars = "-fstack-check" then
Add_Switch_Component ("-fstack-check=specific");
-- Take only into account switches that are transmitted to -- Take only into account switches that are transmitted to
-- gnat1 by the gcc driver and stored by gnat1 in the ALI file. -- gnat1 by the gcc driver and stored by gnat1 in the ALI file.
......
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