+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.
@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.
("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
-- 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
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.
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",
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 --
-----------------------------
-- 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.
-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
-- 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)
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,
projects / thirdparty / gcc.git / commitdiff
