Commit a53c5613 by Arnaud Charlet

[multiple changes]

2012-12-05  Ed Schonberg  <schonberg@adacore.com>

	* exp_ch5.adb (Expand_N_Assignment_Statement): Handle properly
	the generation of discriminant checks when the left-hand side
	has a type with hidden discriminants.
	* sem_ch3.ads (Is_Visible_Component): Add defaulted parameter to
	specify the node on which component visibility is being checked.
	* sem_ch3.adb (Is_Visible_Component): Use new parameter to
	determine whether the reference comes from a type conversion to
	a full view of a private type with unknown discriminants.
	* sem_ch4.adb (Analyze_Selected_Component): Call
	Is_Visible_Component with added parameter.

2012-12-05  Arnaud Charlet  <charlet@adacore.com>

	* make.adb: Minor comment update.

2012-12-05  Arnaud Charlet  <charlet@adacore.com>

	* gnatlink.adb: Also use -x adascil in CodePeer mode when
	calling gcc.
	* exp_ch5.adb: Minor reformatting.

2012-12-05  Bob Duff  <duff@adacore.com>

	* exp_ch4.adb: Minor comment.

2012-12-05  Bob Duff  <duff@adacore.com>

	* par-ch4.adb: Set Paren_Count correctly for a parenthesized expression
	containing a conditional expression or quantified expression.
	* sprint.adb: Update comment.

2012-12-05  Bob Duff  <duff@adacore.com>

	* style.adb, scans.ads, styleg.adb: Update comments.

2012-12-05  Ed Schonberg  <schonberg@adacore.com>

	* sem_ch8.adb (Find_Selected_Component): Handle properly an
	expanded name whose prefix is the expanded name of an enclosing
	entry,	that is to say a construct such as T.E.X, where T is an
	enclosing concurrent type and E is an enclosing entry.

From-SVN: r194204
parent 5e29ae82
2012-12-05 Ed Schonberg <schonberg@adacore.com>
* exp_ch5.adb (Expand_N_Assignment_Statement): Handle properly
the generation of discriminant checks when the left-hand side
has a type with hidden discriminants.
* sem_ch3.ads (Is_Visible_Component): Add defaulted parameter to
specify the node on which component visibility is being checked.
* sem_ch3.adb (Is_Visible_Component): Use new parameter to
determine whether the reference comes from a type conversion to
a full view of a private type with unknown discriminants.
* sem_ch4.adb (Analyze_Selected_Component): Call
Is_Visible_Component with added parameter.
2012-12-05 Arnaud Charlet <charlet@adacore.com>
* make.adb: Minor comment update.
2012-12-05 Arnaud Charlet <charlet@adacore.com>
* gnatlink.adb: Also use -x adascil in CodePeer mode when
calling gcc.
* exp_ch5.adb: Minor reformatting.
2012-12-05 Bob Duff <duff@adacore.com>
* exp_ch4.adb: Minor comment.
2012-12-05 Bob Duff <duff@adacore.com>
* par-ch4.adb: Set Paren_Count correctly for a parenthesized expression
containing a conditional expression or quantified expression.
* sprint.adb: Update comment.
2012-12-05 Bob Duff <duff@adacore.com>
* style.adb, scans.ads, styleg.adb: Update comments.
2012-12-05 Ed Schonberg <schonberg@adacore.com>
* sem_ch8.adb (Find_Selected_Component): Handle properly an
expanded name whose prefix is the expanded name of an enclosing
entry, that is to say a construct such as T.E.X, where T is an
enclosing concurrent type and E is an enclosing entry.
2012-12-05 Robert Dewar <dewar@adacore.com> 2012-12-05 Robert Dewar <dewar@adacore.com>
* lib-writ.adb (Write_ALI): Output T lines. * lib-writ.adb (Write_ALI): Output T lines.
......
...@@ -5207,6 +5207,8 @@ package body Exp_Ch4 is ...@@ -5207,6 +5207,8 @@ package body Exp_Ch4 is
New_If : Node_Id; New_If : Node_Id;
New_N : Node_Id; New_N : Node_Id;
-- Start of processing for Expand_N_If_Expression
begin begin
-- Check for MINIMIZED/ELIMINATED overflow mode -- Check for MINIMIZED/ELIMINATED overflow mode
......
...@@ -2117,10 +2117,12 @@ package body Exp_Ch5 is ...@@ -2117,10 +2117,12 @@ package body Exp_Ch5 is
end if; end if;
-- Apply discriminant check if required. If Lhs is an access type to a -- Apply discriminant check if required. If Lhs is an access type to a
-- designated type with discriminants, we must always check. -- designated type with discriminants, we must always check. If the
-- type has unknown discriminants, more elaborate processing below.
if Has_Discriminants (Etype (Lhs)) then
if Has_Discriminants (Etype (Lhs))
and then not Has_Unknown_Discriminants (Etype (Lhs))
then
-- Skip discriminant check if change of representation. Will be -- Skip discriminant check if change of representation. Will be
-- done when the change of representation is expanded out. -- done when the change of representation is expanded out.
......
...@@ -1649,7 +1649,7 @@ begin ...@@ -1649,7 +1649,7 @@ begin
-- because bindgen uses brackets encoding for all upper -- because bindgen uses brackets encoding for all upper
-- half and wide characters in identifier names. -- half and wide characters in identifier names.
-- In addition, in CodePeer mode compile with -gnatcC -- In addition, in CodePeer mode compile with -x adascil -gnatcC
Binder_Options_From_ALI.Increment_Last; Binder_Options_From_ALI.Increment_Last;
Binder_Options_From_ALI.Table (Binder_Options_From_ALI.Last) := Binder_Options_From_ALI.Table (Binder_Options_From_ALI.Last) :=
...@@ -1664,7 +1664,13 @@ begin ...@@ -1664,7 +1664,13 @@ begin
if Opt.CodePeer_Mode then if Opt.CodePeer_Mode then
Binder_Options_From_ALI.Increment_Last; Binder_Options_From_ALI.Increment_Last;
Binder_Options_From_ALI.Table (Binder_Options_From_ALI.Last) := Binder_Options_From_ALI.Table (Binder_Options_From_ALI.Last) :=
new String'("-gnatcC"); new String'("-x");
Binder_Options_From_ALI.Increment_Last;
Binder_Options_From_ALI.Table (Binder_Options_From_ALI.Last) :=
new String'("adascil");
Binder_Options_From_ALI.Increment_Last;
Binder_Options_From_ALI.Table (Binder_Options_From_ALI.Last) :=
new String'("-gnatcC");
end if; end if;
-- Locate all the necessary programs and verify required files are present -- Locate all the necessary programs and verify required files are present
......
...@@ -7841,12 +7841,8 @@ package body Make is ...@@ -7841,12 +7841,8 @@ package body Make is
Operating_Mode := Check_Semantics; Operating_Mode := Check_Semantics;
Check_Object_Consistency := False; Check_Object_Consistency := False;
-- Except in CodePeer mode, where we do want to call bind/link -- Except in CodePeer mode (set by -gnatcC), where we do want to
-- in CodePeer mode (-P switch). -- call bind/link in CodePeer mode (-P switch).
-- This is testing for -gnatcC, what is that??? Also why do we
-- want to call bind/link in the codepeer case with -gnatc
-- specified, seems odd.
if Argv'Last >= 7 and then Argv (7) = 'C' then if Argv'Last >= 7 and then Argv (7) = 'C' then
CodePeer_Mode := True; CodePeer_Mode := True;
......
...@@ -1233,11 +1233,16 @@ package body Ch4 is ...@@ -1233,11 +1233,16 @@ package body Ch4 is
Lparen_Sloc := Token_Ptr; Lparen_Sloc := Token_Ptr;
T_Left_Paren; T_Left_Paren;
-- Note on parentheses count. For cases like an if expression, the
-- parens here really count as real parentheses for the paren count,
-- so we adjust the paren count accordingly after scanning the expr.
-- If expression -- If expression
if Token = Tok_If then if Token = Tok_If then
Expr_Node := P_If_Expression; Expr_Node := P_If_Expression;
T_Right_Paren; T_Right_Paren;
Set_Paren_Count (Expr_Node, Paren_Count (Expr_Node) + 1);
return Expr_Node; return Expr_Node;
-- Case expression -- Case expression
...@@ -1245,6 +1250,7 @@ package body Ch4 is ...@@ -1245,6 +1250,7 @@ package body Ch4 is
elsif Token = Tok_Case then elsif Token = Tok_Case then
Expr_Node := P_Case_Expression; Expr_Node := P_Case_Expression;
T_Right_Paren; T_Right_Paren;
Set_Paren_Count (Expr_Node, Paren_Count (Expr_Node) + 1);
return Expr_Node; return Expr_Node;
-- Quantified expression -- Quantified expression
...@@ -1252,6 +1258,7 @@ package body Ch4 is ...@@ -1252,6 +1258,7 @@ package body Ch4 is
elsif Token = Tok_For then elsif Token = Tok_For then
Expr_Node := P_Quantified_Expression; Expr_Node := P_Quantified_Expression;
T_Right_Paren; T_Right_Paren;
Set_Paren_Count (Expr_Node, Paren_Count (Expr_Node) + 1);
return Expr_Node; return Expr_Node;
-- Note: the mechanism used here of rescanning the initial expression -- Note: the mechanism used here of rescanning the initial expression
......
...@@ -201,7 +201,7 @@ package Scans is ...@@ -201,7 +201,7 @@ package Scans is
-- This entry is used when scanning project files (where it represents -- This entry is used when scanning project files (where it represents
-- an entire comment), and in preprocessing with the -C switch set -- an entire comment), and in preprocessing with the -C switch set
-- (where it represents just the "--" of a comment). For the project -- (where it represents just the "--" of a comment). For the project
-- file case, the text of the comment is stored in -- file case, the text of the comment is stored in Comment_Id.
Tok_End_Of_Line, Tok_End_Of_Line,
-- Represents an end of line. Not used during normal compilation scans -- Represents an end of line. Not used during normal compilation scans
......
...@@ -16316,7 +16316,10 @@ package body Sem_Ch3 is ...@@ -16316,7 +16316,10 @@ package body Sem_Ch3 is
-- Is_Visible_Component -- -- Is_Visible_Component --
-------------------------- --------------------------
function Is_Visible_Component (C : Entity_Id) return Boolean is function Is_Visible_Component
(C : Entity_Id;
N : Node_Id := Empty) return Boolean
is
Original_Comp : Entity_Id := Empty; Original_Comp : Entity_Id := Empty;
Original_Scope : Entity_Id; Original_Scope : Entity_Id;
Type_Scope : Entity_Id; Type_Scope : Entity_Id;
...@@ -16376,10 +16379,17 @@ package body Sem_Ch3 is ...@@ -16376,10 +16379,17 @@ package body Sem_Ch3 is
elsif not Comes_From_Source (Original_Comp) then elsif not Comes_From_Source (Original_Comp) then
return True; return True;
-- Discriminants are always visible -- Discriminants are visible unless the (private) type has unknown
-- discriminants. If the discriminant reference is inserted for a
-- discriminant check on a full view it is also visible.
elsif Ekind (Original_Comp) = E_Discriminant elsif Ekind (Original_Comp) = E_Discriminant
and then not Has_Unknown_Discriminants (Original_Scope) and then
(not Has_Unknown_Discriminants (Original_Scope)
or else (Present (N)
and then Nkind (N) = N_Selected_Component
and then Nkind (Prefix (N)) = N_Type_Conversion
and then not Comes_From_Source (Prefix (N))))
then then
return True; return True;
......
...@@ -185,12 +185,18 @@ package Sem_Ch3 is ...@@ -185,12 +185,18 @@ package Sem_Ch3 is
-- is a null extension, meaning that it has an extension part without any -- is a null extension, meaning that it has an extension part without any
-- components and does not have a known discriminant part. -- components and does not have a known discriminant part.
function Is_Visible_Component (C : Entity_Id) return Boolean; function Is_Visible_Component
(C : Entity_Id;
N : Node_Id := Empty) return Boolean;
-- Determines if a record component C is visible in the present context. -- Determines if a record component C is visible in the present context.
-- Note that even though component C could appear in the entity chain -- Note that even though component C could appear in the entity chain
-- of a record type, C may not be visible in the current context. For -- of a record type, C may not be visible in the current context. For
-- instance, C may be a component inherited in the full view of a private -- instance, C may be a component inherited in the full view of a private
-- extension which is not visible in the current context. -- extension which is not visible in the current context.
--
-- If present, N is the selected component of which C is the selector. If
-- the prefix of N is a type conversion inserted for a discriminant check,
-- C is automatically visible.
procedure Make_Index procedure Make_Index
(I : Node_Id; (I : Node_Id;
......
...@@ -3938,7 +3938,7 @@ package body Sem_Ch4 is ...@@ -3938,7 +3938,7 @@ package body Sem_Ch4 is
while Present (Comp) and then not Is_Prefixed_Call (N) loop while Present (Comp) and then not Is_Prefixed_Call (N) loop
if Chars (Comp) = Chars (Sel) if Chars (Comp) = Chars (Sel)
and then Is_Visible_Component (Comp) and then Is_Visible_Component (Comp, N)
then then
Set_Entity_With_Style_Check (Sel, Comp); Set_Entity_With_Style_Check (Sel, Comp);
Set_Etype (Sel, Etype (Comp)); Set_Etype (Sel, Etype (Comp));
......
...@@ -5426,11 +5426,21 @@ package body Sem_Ch8 is ...@@ -5426,11 +5426,21 @@ package body Sem_Ch8 is
and then and then
Nkind (Parent (Parent (N))) /= N_Attribute_Reference)) Nkind (Parent (Parent (N))) /= N_Attribute_Reference))
then then
-- It is an entry call after all, either to the current task (which -- If both the task type and the entry are in scope, this may still
-- will deadlock) or to an enclosing task. -- be the expanded name of an entry formal.
Analyze_Selected_Component (N); if In_Open_Scopes (Id)
return; and then Nkind (Parent (N)) = N_Selected_Component
then
null;
else
-- It is an entry call after all, either to the current task
-- (which will deadlock) or to an enclosing task.
Analyze_Selected_Component (N);
return;
end if;
end if; end if;
Change_Selected_Component_To_Expanded_Name (N); Change_Selected_Component_To_Expanded_Name (N);
......
...@@ -1162,6 +1162,10 @@ package body Sprint is ...@@ -1162,6 +1162,10 @@ package body Sprint is
Alt : Node_Id; Alt : Node_Id;
begin begin
-- The syntax for case_expression does not include parentheses,
-- but sometimes parentheses are required, so unconditionally
-- generate them here.
Write_Str_With_Col_Check_Sloc ("(case "); Write_Str_With_Col_Check_Sloc ("(case ");
Sprint_Node (Expression (Node)); Sprint_Node (Expression (Node));
Write_Str_With_Col_Check (" is"); Write_Str_With_Col_Check (" is");
...@@ -1963,6 +1967,10 @@ package body Sprint is ...@@ -1963,6 +1967,10 @@ package body Sprint is
Then_Expr : constant Node_Id := Next (Condition); Then_Expr : constant Node_Id := Next (Condition);
begin begin
-- The syntax for if_expression does not include parentheses,
-- but sometimes parentheses are required, so unconditionally
-- generate them here.
Write_Str_With_Col_Check_Sloc ("(if "); Write_Str_With_Col_Check_Sloc ("(if ");
Sprint_Node (Condition); Sprint_Node (Condition);
Write_Str_With_Col_Check (" then "); Write_Str_With_Col_Check (" then ");
......
...@@ -41,8 +41,8 @@ package body Style is ...@@ -41,8 +41,8 @@ package body Style is
----------------------- -----------------------
-- If the check specs mode (-gnatys) is set, then all subprograms must -- If the check specs mode (-gnatys) is set, then all subprograms must
-- have specs unless they are parameterless procedures that are not child -- have specs unless they are parameterless procedures at the library
-- units at the library level (i.e. they are possible main programs). -- level (i.e. they are possible main programs).
procedure Body_With_No_Spec (N : Node_Id) is procedure Body_With_No_Spec (N : Node_Id) is
begin begin
......
...@@ -81,7 +81,8 @@ package body Styleg is ...@@ -81,7 +81,8 @@ package body Styleg is
function Is_White_Space (C : Character) return Boolean; function Is_White_Space (C : Character) return Boolean;
pragma Inline (Is_White_Space); pragma Inline (Is_White_Space);
-- Returns True for space, HT, VT or FF, False otherwise -- Returns True for space or HT, False otherwise
-- What about VT and FF, should they return True ???
procedure Require_Following_Space; procedure Require_Following_Space;
pragma Inline (Require_Following_Space); pragma Inline (Require_Following_Space);
...@@ -97,12 +98,12 @@ package body Styleg is ...@@ -97,12 +98,12 @@ package body Styleg is
-- Check_Abs_Or_Not -- -- Check_Abs_Or_Not --
---------------------- ----------------------
-- In check tokens mode (-gnatyt), ABS/NOT must be followed by a space -- In check token mode (-gnatyt), ABS/NOT must be followed by a space
procedure Check_Abs_Not is procedure Check_Abs_Not is
begin begin
if Style_Check_Tokens then if Style_Check_Tokens then
if Source (Scan_Ptr) > ' ' then if Source (Scan_Ptr) > ' ' then -- ???
Error_Space_Required (Scan_Ptr); Error_Space_Required (Scan_Ptr);
end if; end if;
end if; end if;
...@@ -112,7 +113,7 @@ package body Styleg is ...@@ -112,7 +113,7 @@ package body Styleg is
-- Check_Apostrophe -- -- Check_Apostrophe --
---------------------- ----------------------
-- Do not allow space before or after apostrophe -- Do not allow space before or after apostrophe -- OR AFTER???
procedure Check_Apostrophe is procedure Check_Apostrophe is
begin begin
...@@ -546,7 +547,7 @@ package body Styleg is ...@@ -546,7 +547,7 @@ package body Styleg is
-- Check_Dot_Dot -- -- Check_Dot_Dot --
------------------- -------------------
-- In check token mode (-gnatyt), colon must be surrounded by spaces -- In check token mode (-gnatyt), ".." must be surrounded by spaces
procedure Check_Dot_Dot is procedure Check_Dot_Dot is
begin begin
...@@ -630,9 +631,9 @@ package body Styleg is ...@@ -630,9 +631,9 @@ package body Styleg is
-- Check_Left_Paren -- -- Check_Left_Paren --
---------------------- ----------------------
-- In tone check mode (-gnatyt), left paren must not be preceded by an -- In check token mode (-gnatyt), left paren must not be preceded by an
-- identifier character or digit (a separating space is required) and -- identifier character or digit (a separating space is required) and may
-- may never be followed by a space. -- never be followed by a space.
procedure Check_Left_Paren is procedure Check_Left_Paren is
begin begin
...@@ -707,9 +708,9 @@ package body Styleg is ...@@ -707,9 +708,9 @@ package body Styleg is
if Style_Check_DOS_Line_Terminator then if Style_Check_DOS_Line_Terminator then
-- Ignore EOF, since we only get called with an EOF if it is the last -- Ignore EOF, since we only get called with an EOF if it is the last
-- character in the buffer (and was therefore not in the source file), -- character in the buffer (and was therefore not in the source
-- since the terminating EOF is added to stop the scan. -- file), since the terminating EOF is added to stop the scan.
if Source (Scan_Ptr) = EOF then if Source (Scan_Ptr) = EOF then
null; null;
...@@ -846,7 +847,7 @@ package body Styleg is ...@@ -846,7 +847,7 @@ package body Styleg is
-- Check_Right_Paren -- -- Check_Right_Paren --
----------------------- -----------------------
-- In check tokens mode (-gnatyt), right paren must not be immediately -- In check token mode (-gnatyt), right paren must not be immediately
-- followed by an identifier character, and must never be preceded by -- followed by an identifier character, and must never be preceded by
-- a space unless it is the initial non-blank character on the line. -- a space unless it is the initial non-blank character on the line.
...@@ -865,7 +866,7 @@ package body Styleg is ...@@ -865,7 +866,7 @@ package body Styleg is
-- Check_Semicolon -- -- Check_Semicolon --
--------------------- ---------------------
-- In check tokens mode (-gnatyt), semicolon does not permit a preceding -- In check token mode (-gnatyt), semicolon does not permit a preceding
-- space and a following space is required. -- space and a following space is required.
procedure Check_Semicolon is procedure Check_Semicolon is
......
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