Commit ce09f8b3 by Arnaud Charlet

[multiple changes]

2010-10-26  Robert Dewar  <dewar@adacore.com>

	* opt.ads (Treat_Categorization_Errors_As_Warnings): New flag
	* sem_cat.adb (Check_Categorization_Dependencies):
	Use Check_Categorization_Dependencies
	* switch-c.adb: GNAT Mode sets Treat_Categorization_Errors_As_Warnings
	-gnateP sets Treat_Categorization_Errors_As_Warnings
	* usage.adb: Add line for -gnateP switch

2010-10-26  Javier Miranda  <miranda@adacore.com>

	* sem_ch3.adb (Add_Internal_Interface_Entities): Handle primitives
	inherited from the parent that cover interface primitives.
	(Derive_Progenitor_Subprograms): Handle primitives inherited from
	the parent that cover interface primitives.
	* sem_disp.adb (Find_Primitive_Covering_Interface): When searching in
	the list of primitives of the type extend the test to include inherited
	private primitives.
	* sem_ch6.ads (Is_Interface_Conformant): Add missing documentation.
	* sem_ch7.adb (Declare_Inherited_Private_Subprograms): Add missing
	barrier to the loop searching for explicit overriding primitives.
	* sem_ch4.adb (Analyze_Indexed_Component_Form): Add missing barrier
	before accessing attribute Entity.

2010-10-26  Bob Duff  <duff@adacore.com>

	* make.adb: Call Namet.Finalize, so we can get statistics.

From-SVN: r165952
parent f9673bb0
2010-10-26 Robert Dewar <dewar@adacore.com>
* opt.ads (Treat_Categorization_Errors_As_Warnings): New flag
* sem_cat.adb (Check_Categorization_Dependencies):
Use Check_Categorization_Dependencies
* switch-c.adb: GNAT Mode sets Treat_Categorization_Errors_As_Warnings
-gnateP sets Treat_Categorization_Errors_As_Warnings
* usage.adb: Add line for -gnateP switch
2010-10-26 Javier Miranda <miranda@adacore.com>
* sem_ch3.adb (Add_Internal_Interface_Entities): Handle primitives
inherited from the parent that cover interface primitives.
(Derive_Progenitor_Subprograms): Handle primitives inherited from
the parent that cover interface primitives.
* sem_disp.adb (Find_Primitive_Covering_Interface): When searching in
the list of primitives of the type extend the test to include inherited
private primitives.
* sem_ch6.ads (Is_Interface_Conformant): Add missing documentation.
* sem_ch7.adb (Declare_Inherited_Private_Subprograms): Add missing
barrier to the loop searching for explicit overriding primitives.
* sem_ch4.adb (Analyze_Indexed_Component_Form): Add missing barrier
before accessing attribute Entity.
2010-10-26 Bob Duff <duff@adacore.com>
* make.adb: Call Namet.Finalize, so we can get statistics.
2010-10-26 Geert Bosch <bosch@adacore.com> 2010-10-26 Geert Bosch <bosch@adacore.com>
* sem_ch6.adb (Analyze_Subprogram_Body_Helper): Use the subprogram_body * sem_ch6.adb (Analyze_Subprogram_Body_Helper): Use the subprogram_body
......
...@@ -6511,6 +6511,10 @@ package body Make is ...@@ -6511,6 +6511,10 @@ package body Make is
Delete_All_Temp_Files; Delete_All_Temp_Files;
-- Output Namet statistics
Namet.Finalize;
exception exception
when X : others => when X : others =>
Set_Standard_Error; Set_Standard_Error;
......
...@@ -41,10 +41,10 @@ ...@@ -41,10 +41,10 @@
with Hostparm; use Hostparm; with Hostparm; use Hostparm;
with Types; use Types; with Types; use Types;
with System.WCh_Con; use System.WCh_Con;
pragma Warnings (Off); pragma Warnings (Off);
-- This package is used also by gnatcoll
with System.Strings; use System.Strings; with System.Strings; use System.Strings;
with System.WCh_Con; use System.WCh_Con;
pragma Warnings (On); pragma Warnings (On);
package Opt is package Opt is
...@@ -1230,6 +1230,11 @@ package Opt is ...@@ -1230,6 +1230,11 @@ package Opt is
-- Tolerate time stamp and other consistency errors. If this flag is set to -- Tolerate time stamp and other consistency errors. If this flag is set to
-- True (-t), then inconsistencies result in warnings rather than errors. -- True (-t), then inconsistencies result in warnings rather than errors.
Treat_Categorization_Errors_As_Warnings : Boolean := False;
-- Normally categorization errors are true illegalities. If this switch
-- is set, then such errors result in warning messages rather than error
-- messages. Set True by -gnatg or -gnateP (P for Pure/Preelaborate).
Treat_Restrictions_As_Warnings : Boolean := False; Treat_Restrictions_As_Warnings : Boolean := False;
-- GNAT -- GNAT
-- Set True to treat pragma Restrictions as Restriction_Warnings. Set by -- Set True to treat pragma Restrictions as Restriction_Warnings. Set by
......
...@@ -226,10 +226,10 @@ package body Sem_Cat is ...@@ -226,10 +226,10 @@ package body Sem_Cat is
if Err then if Err then
-- These messages are warnings in GNAT mode, to allow it to be -- These messages are warnings in GNAT mode or if the -gnateC switch
-- judiciously turned off. Otherwise it is a real error. -- was set. Otherwise these are real errors for real illegalities.
Error_Msg_Warn := GNAT_Mode; Error_Msg_Warn := Treat_Categorization_Errors_As_Warnings;
-- Don't give error if main unit is not an internal unit, and the -- Don't give error if main unit is not an internal unit, and the
-- unit generating the message is an internal unit. This is the -- unit generating the message is an internal unit. This is the
......
...@@ -1572,6 +1572,26 @@ package body Sem_Ch3 is ...@@ -1572,6 +1572,26 @@ package body Sem_Ch3 is
pragma Assert (Present (Prim)); pragma Assert (Present (Prim));
-- Ada 2012 (AI05-0197): If the name of the covering primitive
-- differs from the name of the interface primitive then it is
-- a private primitive inherited from a parent type. In such
-- case, given that Tagged_Type covers the interface, the
-- inherited private primitive becomes visible. For such
-- purpose we add a new entity that renames the inherited
-- private primitive.
if Chars (Prim) /= Chars (Iface_Prim) then
pragma Assert (Has_Suffix (Prim, 'P'));
Derive_Subprogram
(New_Subp => New_Subp,
Parent_Subp => Iface_Prim,
Derived_Type => Tagged_Type,
Parent_Type => Iface);
Set_Alias (New_Subp, Prim);
Set_Is_Abstract_Subprogram (New_Subp,
Is_Abstract_Subprogram (Prim));
end if;
Derive_Subprogram Derive_Subprogram
(New_Subp => New_Subp, (New_Subp => New_Subp,
Parent_Subp => Iface_Prim, Parent_Subp => Iface_Prim,
...@@ -12416,6 +12436,22 @@ package body Sem_Ch3 is ...@@ -12416,6 +12436,22 @@ package body Sem_Ch3 is
Derive_Subprogram Derive_Subprogram
(New_Subp, Iface_Subp, Tagged_Type, Iface); (New_Subp, Iface_Subp, Tagged_Type, Iface);
-- Ada 2012 (AI05-0197): If the covering primitive's name
-- differs from the name of the interface primitive then it
-- is a private primitive inherited from a parent type. In
-- such case, given that Tagged_Type covers the interface,
-- the inherited private primitive becomes visible. For such
-- purpose we add a new entity that renames the inherited
-- private primitive.
elsif Chars (E) /= Chars (Iface_Subp) then
pragma Assert (Has_Suffix (E, 'P'));
Derive_Subprogram
(New_Subp, Iface_Subp, Tagged_Type, Iface);
Set_Alias (New_Subp, E);
Set_Is_Abstract_Subprogram (New_Subp,
Is_Abstract_Subprogram (E));
-- Propagate to the full view interface entities associated -- Propagate to the full view interface entities associated
-- with the partial view -- with the partial view
......
...@@ -2155,7 +2155,9 @@ package body Sem_Ch4 is ...@@ -2155,7 +2155,9 @@ package body Sem_Ch4 is
P_T := Base_Type (Etype (P)); P_T := Base_Type (Etype (P));
if Is_Entity_Name (P) then if Is_Entity_Name (P)
and then Present (Entity (P))
then
U_N := Entity (P); U_N := Entity (P);
if Is_Type (U_N) then if Is_Type (U_N) then
......
...@@ -186,9 +186,10 @@ package Sem_Ch6 is ...@@ -186,9 +186,10 @@ package Sem_Ch6 is
(Tagged_Type : Entity_Id; (Tagged_Type : Entity_Id;
Iface_Prim : Entity_Id; Iface_Prim : Entity_Id;
Prim : Entity_Id) return Boolean; Prim : Entity_Id) return Boolean;
-- Returns true if both primitives have a matching name, they are type -- Returns true if both primitives have a matching name (including support
-- conformant, and Prim is defined in the scope of Tagged_Type. Special -- for names of inherited private primitives --which have suffix 'P'), they
-- management is done for functions returning interfaces. -- are type conformant, and Prim is defined in the scope of Tagged_Type.
-- Special management is done for functions returning interfaces.
procedure List_Inherited_Pre_Post_Aspects (E : Entity_Id); procedure List_Inherited_Pre_Post_Aspects (E : Entity_Id);
-- E is the entity for a subprogram or generic subprogram spec. This call -- E is the entity for a subprogram or generic subprogram spec. This call
......
...@@ -1527,8 +1527,15 @@ package body Sem_Ch7 is ...@@ -1527,8 +1527,15 @@ package body Sem_Ch7 is
Op_Elmt_2 := Next_Elmt (Op_Elmt); Op_Elmt_2 := Next_Elmt (Op_Elmt);
while Present (Op_Elmt_2) loop while Present (Op_Elmt_2) loop
-- Skip entities with attribute Interface_Alias since
-- they are not overriding primitives (these entities
-- link an interface primitive with their covering
-- primitive)
if Chars (Node (Op_Elmt_2)) = Chars (Parent_Subp) if Chars (Node (Op_Elmt_2)) = Chars (Parent_Subp)
and then Type_Conformant (Prim_Op, Node (Op_Elmt_2)) and then Type_Conformant (Prim_Op, Node (Op_Elmt_2))
and then No (Interface_Alias (Node (Op_Elmt_2)))
then then
-- The private inherited operation has been -- The private inherited operation has been
-- overridden by an explicit subprogram: replace -- overridden by an explicit subprogram: replace
......
...@@ -1817,6 +1817,13 @@ package body Sem_Disp is ...@@ -1817,6 +1817,13 @@ package body Sem_Disp is
end if; end if;
end if; end if;
-- Check if E covers the interface primitive (includes case in
-- which E is an inherited private primitive)
if Is_Interface_Conformant (Tagged_Type, Iface_Prim, E) then
return E;
end if;
-- Use the internal entity that links the interface primitive with -- Use the internal entity that links the interface primitive with
-- the covering primitive to locate the entity -- the covering primitive to locate the entity
......
...@@ -495,6 +495,11 @@ package body Switch.C is ...@@ -495,6 +495,11 @@ package body Switch.C is
Ptr := Max + 1; Ptr := Max + 1;
-- -gnateP (Treat pragma Pure/Preelaborate errs as warnings)
when 'P' =>
Treat_Categorization_Errors_As_Warnings := True;
-- -gnatez (final delimiter of explicit switches) -- -gnatez (final delimiter of explicit switches)
-- All switches that come after -gnatez have been added by -- All switches that come after -gnatez have been added by
...@@ -562,6 +567,10 @@ package body Switch.C is ...@@ -562,6 +567,10 @@ package body Switch.C is
Set_GNAT_Mode_Warnings; Set_GNAT_Mode_Warnings;
Set_GNAT_Style_Check_Options; Set_GNAT_Style_Check_Options;
-- Other special modes set by -gnatg
Treat_Categorization_Errors_As_Warnings := True;
-- Processing for G switch -- Processing for G switch
when 'G' => when 'G' =>
......
...@@ -207,6 +207,11 @@ begin ...@@ -207,6 +207,11 @@ begin
Write_Switch_Char ("ep=?"); Write_Switch_Char ("ep=?");
Write_Line ("Specify preprocessing data file, e.g. -gnatep=prep.data"); Write_Line ("Specify preprocessing data file, e.g. -gnatep=prep.data");
-- Line for -gnateP switch
Write_Switch_Char ("eP");
Write_Line ("Pure/Prelaborate errors generate warnings rather than errors");
-- Line for -gnateS switch -- Line for -gnateS switch
Write_Switch_Char ("eS"); Write_Switch_Char ("eS");
......
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