2012-12-05 Ed Schonberg <schonberg@adacore.com>
authorcharlet <charlet@138bc75d-0d04-0410-961f-82ee72b054a4>
Wed, 5 Dec 2012 10:59:09 +0000 (10:59 +0000)
committercharlet <charlet@138bc75d-0d04-0410-961f-82ee72b054a4>
Wed, 5 Dec 2012 10:59:09 +0000 (10:59 +0000)
* 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.

git-svn-id: svn+ssh://gcc.gnu.org/svn/gcc/trunk@194204 138bc75d-0d04-0410-961f-82ee72b054a4

14 files changed:
gcc/ada/ChangeLog
gcc/ada/exp_ch4.adb
gcc/ada/exp_ch5.adb
gcc/ada/gnatlink.adb
gcc/ada/make.adb
gcc/ada/par-ch4.adb
gcc/ada/scans.ads
gcc/ada/sem_ch3.adb
gcc/ada/sem_ch3.ads
gcc/ada/sem_ch4.adb
gcc/ada/sem_ch8.adb
gcc/ada/sprint.adb
gcc/ada/style.adb
gcc/ada/styleg.adb

index 6550c58..8f486e4 100644 (file)
@@ -1,3 +1,47 @@
+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.
index b3701bc..07e7ab8 100644 (file)
@@ -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
 
index 80aabc5..74acb34 100644 (file)
@@ -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.
 
index 9562b3b..f83a03e 100644 (file)
@@ -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
index c54debf..97d4278 100644 (file)
@@ -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;
index 3cb6579..019d5fb 100644 (file)
@@ -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
index eb062af..c0e589d 100644 (file)
@@ -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
index ae175e3..ea4e4e9 100644 (file)
@@ -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;
 
index 4824501..98a8dbc 100644 (file)
@@ -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;
index 5505141..12d25c9 100644 (file)
@@ -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));
index fb5c3c8..ae12e46 100644 (file)
@@ -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);
index 0eee5d5..e80708e 100644 (file)
@@ -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 ");
index b603702..fd86659 100644 (file)
@@ -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
index c674394..b24c1c0 100644 (file)
@@ -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