+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.
New_If : Node_Id;
New_N : Node_Id;
+ -- Start of processing for Expand_N_If_Expression
+
begin
-- Check for MINIMIZED/ELIMINATED overflow mode
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.
-- 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) :=
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
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;
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
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
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
-- 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
-- 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;
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;
-- 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;
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));
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);
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");
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 ");
-----------------------
-- 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
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);
-- 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;
-- 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
-- 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
-- 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
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;
-- 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.
-- 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