mirror/gcc
2
0
Fork 0
mirror of git://gcc.gnu.org/git/gcc.git synced 2025-04-06 05:20:26 +08:00
Code Issues Packages Projects Releases Wiki Activity

[multiple changes]

Browse Source 
2013-10-17  Ed Schonberg  <schonberg@adacore.com>

	* sem_ch12.adb (Validated_Access_Subprogram_Instance): According
	to AI05-288, actuals for access_to_subprograms must be subtype
	conformant with the generic formal.  Previous to AI05-288
	only mode conformance was required, but the AI is a binding
	interpretation that applies to previous versions of the language,

2013-10-17  Robert Dewar  <dewar@adacore.com>

	* gnat_ugn.texi: Minor text correction.
	* ug_words: Add entry for -gnateu /IGNORE_UNRECOGNIZED.
	* vms_data.ads: Add /IGNORE_UNRECOGNIZED for -gnateu.

2013-10-17  Tristan Gingold  <gingold@adacore.com>

	* impunit.adb (Non_Imp_File_Names_95): Add g-cppexc.

2013-10-17  Hristian Kirtchev  <kirtchev@adacore.com>

	* sem_prag.adb (Analyze_Constituent): Move the check
	concerning option Part_Of to routine Check_Matching_Constituent.
	(Check_Matching_Constituent): Verify that an abstract state
	that acts as a constituent has the prope Part_Op option in
	its aspect/pragma Abstract_State.  Account for the case when a
	constituent comes from a private child or private sibling.
	* sem_util.ads, sem_util.adb (Is_Child_Or_Sibling): New routine.

From-SVN: r203760
This commit is contained in:
Arnaud Charlet 2013-10-17 15:50:34 +02:00
parent c2cd3032e6
commit 7c821effc4
9 changed files with 283 additions and 60 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

28
gcc/ada/ChangeLog
View File

@ -1,3 +1,31 @@
2013-10-17 Ed Schonberg <schonberg@adacore.com>
* sem_ch12.adb (Validated_Access_Subprogram_Instance): According
to AI05-288, actuals for access_to_subprograms must be subtype
conformant with the generic formal. Previous to AI05-288
only mode conformance was required, but the AI is a binding
interpretation that applies to previous versions of the language,
2013-10-17 Robert Dewar <dewar@adacore.com>
* gnat_ugn.texi: Minor text correction.
* ug_words: Add entry for -gnateu /IGNORE_UNRECOGNIZED.
* vms_data.ads: Add /IGNORE_UNRECOGNIZED for -gnateu.
2013-10-17 Tristan Gingold <gingold@adacore.com>
* impunit.adb (Non_Imp_File_Names_95): Add g-cppexc.
2013-10-17 Hristian Kirtchev <kirtchev@adacore.com>
* sem_prag.adb (Analyze_Constituent): Move the check
concerning option Part_Of to routine Check_Matching_Constituent.
(Check_Matching_Constituent): Verify that an abstract state
that acts as a constituent has the prope Part_Op option in
its aspect/pragma Abstract_State. Account for the case when a
constituent comes from a private child or private sibling.
* sem_util.ads, sem_util.adb (Is_Child_Or_Sibling): New routine.
2013-10-17 Tristan Gingold <gingold@adacore.com>
* g-cppexc.adb, g-cppexc.ads: New files.

2
gcc/ada/gnat_ugn.texi
View File

@ -3935,7 +3935,7 @@ TF 33 I 128 128
@item -gnateu
@cindex @option{-gnateu} (@command{gcc})
Ignore unrecognized validity, warning, and style switches that
apppear after this switch is given. This may be useful when
appear after this switch is given. This may be useful when
compiling sources developed on a later version of the compiler
with an earlier version. Of course the earlier version must
support this switch.

1
gcc/ada/impunit.adb
View File

@ -253,6 +253,7 @@ package body Impunit is
("g-cgideb", F), -- GNAT.CGI.Debug
("g-comlin", F), -- GNAT.Command_Line
("g-comver", F), -- GNAT.Compiler_Version
("g-cppexc", F), -- GNAT.CPP_Exceptions
("g-crc32 ", F), -- GNAT.CRC32
("g-ctrl_c", F), -- GNAT.Ctrl_C
("g-curexc", F), -- GNAT.Current_Exception

22
gcc/ada/sem_ch12.adb
View File

@ -10529,23 +10529,13 @@ package body Sem_Ch12 is
-- only mode conformance was required.
-- This is a binding interpretation that applies to previous versions
-- of the language, but for now we retain the milder check in order
-- to preserve ACATS tests. These will be protested eventually ???
-- of the language, no need to maintain previous weaker checks.
if Ada_Version < Ada_2012 then
Check_Mode_Conformant
(Designated_Type (Act_T),
Designated_Type (A_Gen_T),
Actual,
Get_Inst => True);
else
Check_Subtype_Conformant
(Designated_Type (Act_T),
Designated_Type (A_Gen_T),
Actual,
Get_Inst => True);
end if;
Check_Subtype_Conformant
(Designated_Type (Act_T),
Designated_Type (A_Gen_T),
Actual,
Get_Inst => True);
if Ekind (Base_Type (Act_T)) = E_Access_Protected_Subprogram_Type then
if Ekind (A_Gen_T) = E_Access_Subprogram_Type then

96
gcc/ada/sem_prag.adb
View File

@ -21439,51 +21439,74 @@ package body Sem_Prag is
Error_Msg_NE
("duplicate use of constituent &", Constit, Constit_Id);
return;
end if;
-- The related package has no hidden states, nothing to match.
-- This case arises when the constituents are states coming
-- from a private child.
-- A state can act as a constituent only when it is part of
-- another state. This relation is expressed by option Part_Of
-- of pragma Abstract_State.
if No (Hidden_States) then
return;
elsif Ekind (Constit_Id) = E_Abstract_State then
if not Is_Part_Of (Constit_Id, State_Id) then
Error_Msg_Name_1 := Chars (State_Id);
Error_Msg_NE
("state & is not a valid constituent of ancestor "
& "state %", Constit, Constit_Id);
return;
-- The constituent has the proper Part_Of option, but may
-- not appear in the immediate hidden state of the related
-- package. This case arises when the constituent comes from
-- a private child or a private sibling. Recognize these
-- scenarios to avoid generating a bogus error message.
elsif Is_Child_Or_Sibling
(Pack_1 => Scope (State_Id),
Pack_2 => Scope (Constit_Id),
Private_Child => True)
then
return;
end if;
end if;
-- Inspect the hidden states of the related package looking for
-- a match.
State_Elmt := First_Elmt (Hidden_States);
while Present (State_Elmt) loop
if Present (Hidden_States) then
State_Elmt := First_Elmt (Hidden_States);
while Present (State_Elmt) loop
-- A valid hidden state or variable participates in a
-- refinement. Add the constituent to the list of processed
-- items to aid with the detection of duplicate constituent
-- use. Remove the constituent from Hidden_States to signal
-- that it has already been used.
-- A valid hidden state or variable acts as a constituent
if Node (State_Elmt) = Constit_Id then
Add_Item (Constit_Id, Constituents_Seen);
Remove_Elmt (Hidden_States, State_Elmt);
if Node (State_Elmt) = Constit_Id then
-- Collect the constituent in the list of refinement
-- items. Establish a relation between the refined state
-- and its constituent.
-- Add the constituent to the lis of processed items
-- to aid with the detection of duplicates. Remove the
-- constituent from Hidden_States to signal that it
-- has already been matched.
Append_Elmt
(Constit_Id, Refinement_Constituents (State_Id));
Set_Refined_State (Constit_Id, State_Id);
Add_Item (Constit_Id, Constituents_Seen);
Remove_Elmt (Hidden_States, State_Elmt);
-- The state has at least one legal constituent, mark the
-- start of the refinement region. The region ends when
-- the body declarations end (see Analyze_Declarations).
-- Collect the constituent in the list of refinement
-- items. Establish a relation between the refined
-- state and its constituent.
Set_Has_Visible_Refinement (State_Id);
Append_Elmt
(Constit_Id, Refinement_Constituents (State_Id));
Set_Refined_State (Constit_Id, State_Id);
return;
end if;
-- The state has at least one legal constituent, mark
-- the start of the refinement region. The region ends
-- when the body declarations end (see routine
-- Analyze_Declarations).
Next_Elmt (State_Elmt);
end loop;
Set_Has_Visible_Refinement (State_Id);
return;
end if;
Next_Elmt (State_Elmt);
end loop;
end if;
-- If we get here, we are refining a state that is not hidden
-- with respect to the related package.
@ -21548,19 +21571,6 @@ package body Sem_Prag is
if Ekind_In (Constit_Id, E_Abstract_State, E_Variable) then
Check_Matching_Constituent (Constit_Id);
-- A state can act as a constituent only when it is part
-- of another state. This relation is expressed by option
-- "Part_Of" of pragma Abstract_State.
if Ekind (Constit_Id) = E_Abstract_State
and then not Is_Part_Of (Constit_Id, State_Id)
then
Error_Msg_Name_1 := Chars (State_Id);
Error_Msg_NE
("state & is not a valid constituent of ancestor "
& "state %", Constit, Constit_Id);
end if;
else
Error_Msg_NE
("constituent & must denote a variable or state",

175
gcc/ada/sem_util.adb
View File

@ -8324,6 +8324,181 @@ package body Sem_Util is
Is_RTE (Root_Type (Under), RO_WW_Super_String));
end Is_Bounded_String;
-------------------------
-- Is_Child_Or_Sibling --
-------------------------
function Is_Child_Or_Sibling
(Pack_1 : Entity_Id;
Pack_2 : Entity_Id;
Private_Child : Boolean) return Boolean
is
function Distance_From_Standard (Pack : Entity_Id) return Nat;
-- Given an arbitrary package, return the number of "climbs" necessary
-- to reach scope Standard_Standard.
procedure Equalize_Depths
(Pack : in out Entity_Id;
Depth : in out Nat;
Depth_To_Reach : Nat);
-- Given an arbitrary package, its depth and a target depth to reach,
-- climb the scope chain until the said depth is reached. The pointer
-- to the package and its depth a modified during the climb.
function Is_Child (Pack : Entity_Id) return Boolean;
-- Given a package Pack, determine whether it is a child package that
-- satisfies the privacy requirement (if set).
----------------------------
-- Distance_From_Standard --
----------------------------
function Distance_From_Standard (Pack : Entity_Id) return Nat is
Dist : Nat;
Scop : Entity_Id;
begin
Dist := 0;
Scop := Pack;
while Present (Scop) and then Scop /= Standard_Standard loop
Dist := Dist + 1;
Scop := Scope (Scop);
end loop;
return Dist;
end Distance_From_Standard;
---------------------
-- Equalize_Depths --
---------------------
procedure Equalize_Depths
(Pack : in out Entity_Id;
Depth : in out Nat;
Depth_To_Reach : Nat)
is
begin
-- The package must be at a greater or equal depth
if Depth < Depth_To_Reach then
raise Program_Error;
end if;
-- Climb the scope chain until the desired depth is reached
while Present (Pack) and then Depth /= Depth_To_Reach loop
Pack := Scope (Pack);
Depth := Depth - 1;
end loop;
end Equalize_Depths;
--------------
-- Is_Child --
--------------
function Is_Child (Pack : Entity_Id) return Boolean is
begin
if Is_Child_Unit (Pack) then
if Private_Child then
return Is_Private_Descendant (Pack);
else
return True;
end if;
-- The package is nested, it cannot act a child or a sibling
else
return False;
end if;
end Is_Child;
-- Local variables
P_1 : Entity_Id := Pack_1;
P_1_Child : Boolean := False;
P_1_Depth : Nat := Distance_From_Standard (P_1);
P_2 : Entity_Id := Pack_2;
P_2_Child : Boolean := False;
P_2_Depth : Nat := Distance_From_Standard (P_2);
-- Start of processing for Is_Child_Or_Sibling
begin
pragma Assert
(Ekind (Pack_1) = E_Package and then Ekind (Pack_2) = E_Package);
-- Both packages denote the same entity, therefore they cannot be
-- children or siblings.
if P_1 = P_2 then
return False;
-- One of the packages is at a deeper level than the other. Note that
-- both may still come from differen hierarchies.
-- (root) P_2
-- / \ :
-- X P_2 or X
-- : :
-- P_1 P_1
elsif P_1_Depth > P_2_Depth then
Equalize_Depths (P_1, P_1_Depth, P_2_Depth);
P_1_Child := True;
-- (root) P_1
-- / \ :
-- P_1 X or X
-- : :
-- P_2 P_2
elsif P_2_Depth > P_1_Depth then
Equalize_Depths (P_2, P_2_Depth, P_1_Depth);
P_2_Child := True;
end if;
-- At this stage the package pointers have been elevated to the same
-- depth. If the related entities are the same, then one package is a
-- potential child of the other:
-- P_1
-- :
-- X became P_1 P_2 or vica versa
-- :
-- P_2
if P_1 = P_2 then
if P_1_Child then
return Is_Child (Pack_1);
else pragma Assert (P_2_Child);
return Is_Child (Pack_2);
end if;
-- The packages may come from the same package chain or from entirely
-- different hierarcies. To determine this, climb the scope stack until
-- a common root is found.
-- (root) (root 1) (root 2)
-- / \ | |
-- P_1 P_2 P_1 P_2
else
while Present (P_1) and then Present (P_2) loop
-- The two packages may be siblings
if P_1 = P_2 then
return Is_Child (Pack_1) and then Is_Child (Pack_2);
end if;
P_1 := Scope (P_1);
P_2 := Scope (P_2);
end loop;
end if;
return False;
end Is_Child_Or_Sibling;
-----------------------------
-- Is_Concurrent_Interface --
-----------------------------

10
gcc/ada/sem_util.ads
View File

@ -945,6 +945,16 @@ package Sem_Util is
-- This is the RM definition, a type is a descendent of another type if it
-- is the same type or is derived from a descendent of the other type.
function Is_Child_Or_Sibling
(Pack_1 : Entity_Id;
Pack_2 : Entity_Id;
Private_Child : Boolean) return Boolean;
-- Determine the following relations between two arbitrary packages:
-- 1) One package is the parent of a child package
-- 2) Both packages are siblings and share a common parent
-- If flag Private_Child is set, then the child in case 1) or both siblings
-- in case 2) must be private.
function Is_Concurrent_Interface (T : Entity_Id) return Boolean;
-- First determine whether type T is an interface and then check whether
-- it is of protected, synchronized or task kind.

1
gcc/ada/ug_words
View File

@ -74,6 +74,7 @@ gcc -c ^ GNAT COMPILE
-gnateS ^ /SCO_OUTPUT
-gnatet ^ /WRITE_TARGET_DEPENDENT_INFO
-gnateT ^ /READ_TARGET_DEPENDENT_INFO
-gnateu ^ /IGNORE_UNRECOGNIZED
-gnateV ^ /PARAMETER_VALIDITY_CHECK
-gnateY ^ /IGNORE_STYLE_CHECKS_PRAGMAS
-gnatE ^ /CHECKS=ELABORATION

8
gcc/ada/vms_data.ads
View File

@ -1802,6 +1802,13 @@ package VMS_Data is
-- otherwise ignored. Allows style checks to be fully controlled by
-- command line qualifiers.
S_GCC_IgnoreU : aliased constant S := "/IGNORE_UNRECOGNIZED " &
"-gnateu";
-- /IGNORE_UNRECOGNIZED
--
-- Causes unrecognized style switches, validity switches, and warning
-- switches to be ignored rather than generating an error message.
S_GCC_Immed : aliased constant S := "/IMMEDIATE_ERRORS " &
"-gnatdO";
-- /NOIMMEDIATE_ERRORS (D)
@ -3706,6 +3713,7 @@ package VMS_Data is
S_GCC_IdentX 'Access,
S_GCC_IgnoreR 'Access,
S_GCC_IgnoreS 'Access,
S_GCC_IgnoreU 'Access,
S_GCC_Immed 'Access,
S_GCC_Inline 'Access,
S_GCC_InlineX 'Access,