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>
* lib-writ.adb (Write_ALI): Output T lines.
......
......@@ -5207,6 +5207,8 @@ package body Exp_Ch4 is
New_If : Node_Id;
New_N : Node_Id;
-- Start of processing for Expand_N_If_Expression
begin
-- Check for MINIMIZED/ELIMINATED overflow mode
......
......@@ -2117,10 +2117,12 @@ package body Exp_Ch5 is
end if;
-- Apply discriminant check if required. If Lhs is an access type to a
-- designated type with discriminants, we must always check.
if Has_Discriminants (Etype (Lhs)) then
-- designated type with discriminants, we must always check. If the
-- type has unknown discriminants, more elaborate processing below.
if Has_Discriminants (Etype (Lhs))
and then not Has_Unknown_Discriminants (Etype (Lhs))
then
-- Skip discriminant check if change of representation. Will be
-- done when the change of representation is expanded out.
......
......@@ -1649,7 +1649,7 @@ begin
-- because bindgen uses brackets encoding for all upper
-- 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.Table (Binder_Options_From_ALI.Last) :=
......@@ -1664,7 +1664,13 @@ begin
if Opt.CodePeer_Mode then
Binder_Options_From_ALI.Increment_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;
-- Locate all the necessary programs and verify required files are present
......
......@@ -7841,12 +7841,8 @@ package body Make is
Operating_Mode := Check_Semantics;
Check_Object_Consistency := False;
-- Except in CodePeer mode, where we do want to 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.
-- Except in CodePeer mode (set by -gnatcC), where we do want to
-- call bind/link in CodePeer mode (-P switch).
if Argv'Last >= 7 and then Argv (7) = 'C' then
CodePeer_Mode := True;
......
......@@ -1233,11 +1233,16 @@ package body Ch4 is
Lparen_Sloc := Token_Ptr;
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 Token = Tok_If then
Expr_Node := P_If_Expression;
T_Right_Paren;
Set_Paren_Count (Expr_Node, Paren_Count (Expr_Node) + 1);
return Expr_Node;
-- Case expression
......@@ -1245,6 +1250,7 @@ package body Ch4 is
elsif Token = Tok_Case then
Expr_Node := P_Case_Expression;
T_Right_Paren;
Set_Paren_Count (Expr_Node, Paren_Count (Expr_Node) + 1);
return Expr_Node;
-- Quantified expression
......@@ -1252,6 +1258,7 @@ package body Ch4 is
elsif Token = Tok_For then
Expr_Node := P_Quantified_Expression;
T_Right_Paren;
Set_Paren_Count (Expr_Node, Paren_Count (Expr_Node) + 1);
return Expr_Node;
-- Note: the mechanism used here of rescanning the initial expression
......
......@@ -201,7 +201,7 @@ package Scans is
-- This entry is used when scanning project files (where it represents
-- an entire comment), and in preprocessing with the -C switch set
-- (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,
-- Represents an end of line. Not used during normal compilation scans
......
......@@ -16316,7 +16316,10 @@ package body Sem_Ch3 is
-- 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_Scope : Entity_Id;
Type_Scope : Entity_Id;
......@@ -16376,10 +16379,17 @@ package body Sem_Ch3 is
elsif not Comes_From_Source (Original_Comp) then
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
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
return True;
......
......@@ -185,12 +185,18 @@ package Sem_Ch3 is
-- is a null extension, meaning that it has an extension part without any
-- 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.
-- 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
-- instance, C may be a component inherited in the full view of a private
-- 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
(I : Node_Id;
......
......@@ -3938,7 +3938,7 @@ package body Sem_Ch4 is
while Present (Comp) and then not Is_Prefixed_Call (N) loop
if Chars (Comp) = Chars (Sel)
and then Is_Visible_Component (Comp)
and then Is_Visible_Component (Comp, N)
then
Set_Entity_With_Style_Check (Sel, Comp);
Set_Etype (Sel, Etype (Comp));
......
......@@ -5426,11 +5426,21 @@ package body Sem_Ch8 is
and then
Nkind (Parent (Parent (N))) /= N_Attribute_Reference))
then
-- It is an entry call after all, either to the current task (which
-- will deadlock) or to an enclosing task.
-- If both the task type and the entry are in scope, this may still
-- be the expanded name of an entry formal.
Analyze_Selected_Component (N);
return;
if In_Open_Scopes (Id)
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;
Change_Selected_Component_To_Expanded_Name (N);
......
......@@ -1162,6 +1162,10 @@ package body Sprint is
Alt : Node_Id;
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 ");
Sprint_Node (Expression (Node));
Write_Str_With_Col_Check (" is");
......@@ -1963,6 +1967,10 @@ package body Sprint is
Then_Expr : constant Node_Id := Next (Condition);
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 ");
Sprint_Node (Condition);
Write_Str_With_Col_Check (" then ");
......
......@@ -41,8 +41,8 @@ package body Style is
-----------------------
-- If the check specs mode (-gnatys) is set, then all subprograms must
-- have specs unless they are parameterless procedures that are not child
-- units at the library level (i.e. they are possible main programs).
-- have specs unless they are parameterless procedures at the library
-- level (i.e. they are possible main programs).
procedure Body_With_No_Spec (N : Node_Id) is
begin
......
......@@ -81,7 +81,8 @@ package body Styleg is
function Is_White_Space (C : Character) return Boolean;
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;
pragma Inline (Require_Following_Space);
......@@ -97,12 +98,12 @@ package body Styleg is
-- 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
begin
if Style_Check_Tokens then
if Source (Scan_Ptr) > ' ' then
if Source (Scan_Ptr) > ' ' then -- ???
Error_Space_Required (Scan_Ptr);
end if;
end if;
......@@ -112,7 +113,7 @@ package body Styleg is
-- Check_Apostrophe --
----------------------
-- Do not allow space before or after apostrophe
-- Do not allow space before or after apostrophe -- OR AFTER???
procedure Check_Apostrophe is
begin
......@@ -546,7 +547,7 @@ package body Styleg is
-- 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
begin
......@@ -630,9 +631,9 @@ package body Styleg is
-- Check_Left_Paren --
----------------------
-- In tone check mode (-gnatyt), left paren must not be preceded by an
-- identifier character or digit (a separating space is required) and
-- may never be followed by a space.
-- In check token mode (-gnatyt), left paren must not be preceded by an
-- identifier character or digit (a separating space is required) and may
-- never be followed by a space.
procedure Check_Left_Paren is
begin
......@@ -707,9 +708,9 @@ package body Styleg is
if Style_Check_DOS_Line_Terminator then
-- 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),
-- since the terminating EOF is added to stop the scan.
-- 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), since the terminating EOF is added to stop the scan.
if Source (Scan_Ptr) = EOF then
null;
......@@ -846,7 +847,7 @@ package body Styleg is
-- 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
-- a space unless it is the initial non-blank character on the line.
......@@ -865,7 +866,7 @@ package body Styleg is
-- 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.
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