2014-07-29 Robert Dewar <dewar@adacore.com>
authorcharlet <charlet@138bc75d-0d04-0410-961f-82ee72b054a4>
Tue, 29 Jul 2014 13:34:35 +0000 (13:34 +0000)
committercharlet <charlet@138bc75d-0d04-0410-961f-82ee72b054a4>
Tue, 29 Jul 2014 13:34:35 +0000 (13:34 +0000)
* exp_dbug.adb, g-expect.adb, sem_elab.adb: Minor typo fix.

2014-07-29  Ed Schonberg  <schonberg@adacore.com>

* sem_ch6.adb (Analyze_Return_Type): Reject a return type that
is a limited view when the context is a package body, because
there is no subsequent place at which the non-limited view may
become visible.
(Process_Formals): Ditto.
* sinfo.ads, par-ch3.adb: Minor reformatting.

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

gcc/ada/ChangeLog
gcc/ada/exp_dbug.adb
gcc/ada/g-expect.adb
gcc/ada/par-ch3.adb
gcc/ada/sem_ch6.adb
gcc/ada/sem_elab.adb
gcc/ada/sinfo.ads

index 08877c3..5e5a38c 100644 (file)
@@ -1,3 +1,16 @@
+2014-07-29  Robert Dewar  <dewar@adacore.com>
+
+       * exp_dbug.adb, g-expect.adb, sem_elab.adb: Minor typo fix.
+
+2014-07-29  Ed Schonberg  <schonberg@adacore.com>
+
+       * sem_ch6.adb (Analyze_Return_Type): Reject a return type that
+       is a limited view when the context is a package body, because
+       there is no subsequent place at which the non-limited view may
+       become visible.
+       (Process_Formals): Ditto.
+       * sinfo.ads, par-ch3.adb: Minor reformatting.
+
 2014-07-29  Jerome Lambourg  <lambourg@adacore.com>
 
        * expect.c (__gnat_expect_poll): New parameter dead_process
index 5e0d614..d1439ab 100644 (file)
@@ -332,11 +332,8 @@ package body Exp_Dbug is
          T : constant Entity_Id := Etype (N);
       begin
          Enable :=
-           (Enable
-               or else
-            (Ekind (T) in Array_Kind
-               and then
-             Present (Packed_Array_Impl_Type (T))));
+           Enable or else (Ekind (T) in Array_Kind
+                            and then Present (Packed_Array_Impl_Type (T)));
       end Enable_If_Packed_Array;
 
       ----------------------
@@ -397,8 +394,7 @@ package body Exp_Dbug is
                exit;
 
             when N_Selected_Component =>
-               Enable :=
-                 Enable or else Is_Packed (Etype (Prefix (Ren)));
+               Enable := Enable or else Is_Packed (Etype (Prefix (Ren)));
                Prepend_String_To_Buffer
                  (Get_Name_String (Chars (Selector_Name (Ren))));
                Prepend_String_To_Buffer ("XR");
@@ -406,10 +402,12 @@ package body Exp_Dbug is
 
             when N_Indexed_Component =>
                declare
-                  X : Node_Id := Last (Expressions (Ren));
+                  X : Node_Id;
 
                begin
                   Enable_If_Packed_Array (Prefix (Ren));
+
+                  X := Last (Expressions (Ren));
                   while Present (X) loop
                      if not Output_Subscript (X, "XS") then
                         Set_Materialize_Entity (Ent);
@@ -423,7 +421,6 @@ package body Exp_Dbug is
                Ren := Prefix (Ren);
 
             when N_Slice =>
-
                Enable_If_Packed_Array (Prefix (Ren));
                Typ := Etype (First_Index (Etype (Nam)));
 
@@ -451,7 +448,7 @@ package body Exp_Dbug is
          end case;
       end loop;
 
-      --  If we found no reason here to emit an encoding, stop now.
+      --  If we found no reason here to emit an encoding, stop now
 
       if not Enable then
          Set_Materialize_Entity (Ent);
index 94f80e9..af2f0dc 100644 (file)
@@ -110,10 +110,9 @@ package body GNAT.Expect is
       Dead_Process : access Integer;
       Is_Set       : System.Address) return Integer;
    pragma Import (C, Poll, "__gnat_expect_poll");
-   --  Check whether there is any data waiting on the file descriptors
-   --  Fds, and wait if there is none, at most Timeout milliseconds
-   --  Returns -1 in case of error, 0 if the timeout expired before
-   --  data became available.
+   --  Check whether there is any data waiting on the file descriptors Fds, and
+   --  wait if there is none, at most Timeout milliseconds Returns -1 in case
+   --  of error, 0 if the timeout expired before data became available.
    --
    --  Is_Set is an array of the same size as FDs and elements are set to 1 if
    --  data is available for the corresponding File Descriptor, 0 otherwise.
index acf35a5..a5f5c80 100644 (file)
@@ -3967,10 +3967,12 @@ package body Ch3 is
       if not Header_Already_Parsed then
 
          --  NOT NULL ACCESS .. is a common form of access definition.
-         --  ACCESS NON NULL ..  is certainly rare, but syntactically legal.
+         --  ACCESS NOT NULL ..  is certainly rare, but syntactically legal.
          --  NOT NULL ACCESS NOT NULL .. is rarer yet, and also legal.
          --  The last two cases are only meaningful if the following subtype
-         --  indication denotes an access type (semantic check).
+         --  indication denotes an access type (semantic check). The flag
+         --  Not_Null_Subtype indicates that this second null exclusion is
+         --  present in the access type definition.
 
          Not_Null_Present := P_Null_Exclusion;     --  Ada 2005 (AI-231)
          Scan; -- past ACCESS
index cc1cc7b..4d84a6d 100644 (file)
@@ -1951,9 +1951,17 @@ package body Sem_Ch6 is
             then
                --  AI05-0151: Tagged incomplete types are allowed in all formal
                --  parts. Untagged incomplete types are not allowed in bodies.
+               --  As a consequence, limited views cannot appear in a basic
+               --  declaration that is itself within a body, because there is
+               --  no point at which the non-limited view will become visible.
 
                if Ada_Version >= Ada_2012 then
-                  if Is_Tagged_Type (Typ) then
+                  if From_Limited_With (Typ) and then In_Package_Body then
+                     Error_Msg_NE
+                       ("invalid use of incomplete type&",
+                          Result_Definition (N), Typ);
+
+                  elsif Is_Tagged_Type (Typ) then
                      null;
 
                   elsif Nkind (Parent (N)) = N_Subprogram_Body
@@ -11328,10 +11336,10 @@ package body Sem_Ch6 is
                --  dependents of the type.
 
                if Is_Tagged_Type (Formal_Type)
-                 or else Ada_Version >= Ada_2012
+                 or else (Ada_Version >= Ada_2012
+                           and then not From_Limited_With (Formal_Type))
                then
                   if Ekind (Scope (Current_Scope)) = E_Package
-                    and then not From_Limited_With (Formal_Type)
                     and then not Is_Generic_Type (Formal_Type)
                     and then not Is_Class_Wide_Type (Formal_Type)
                   then
@@ -11363,13 +11371,19 @@ package body Sem_Ch6 is
                then
                   --  AI05-0151: Tagged incomplete types are allowed in all
                   --  formal parts. Untagged incomplete types are not allowed
-                  --  in bodies.
+                  --  in bodies. Limited views of either kind are not allowed
+                  --  if there is no place at which the non-limited view can
+                  --  become available.
 
                   if Ada_Version >= Ada_2012 then
-                     if Is_Tagged_Type (Formal_Type) then
+                     if Is_Tagged_Type (Formal_Type)
+                       and then (not From_Limited_With (Formal_Type)
+                                  or else not In_Package_Body)
+                     then
                         null;
 
                      elsif Nkind_In (Parent (Parent (T)), N_Accept_Statement,
+                                                          N_Accept_Alternative,
                                                           N_Entry_Body,
                                                           N_Subprogram_Body)
                      then
index adf5fd1..01c644e 100644 (file)
@@ -271,7 +271,7 @@ package body Sem_Elab is
    --  are all continuation messages. The argument is the call node at which
    --  the messages are to be placed. When Check_Elab_Flag is set, calls are
    --  enumerated only when flag Elab_Warning is set for the dynamic case or
-   --  when flag Elab_Info_Messages is set for the statis case.
+   --  when flag Elab_Info_Messages is set for the static case.
 
    function Same_Elaboration_Scope (Scop1, Scop2 : Entity_Id) return Boolean;
    --  Given two scopes, determine whether they are the same scope from an
index 2533f5b..13d1d59 100644 (file)
@@ -1851,7 +1851,9 @@ package Sinfo is
    --    to assist in detecting this illegal use of Unrestricted_Access.
 
    --  Null_Excluding_Subtype (Flag16)
-   --    ??? needs documentation ???
+   --   Present in N_Access_To_Object_Definition. Indicates that the subtype
+   --   indication carries a null-exclusion indicator, which is distinct from
+   --   the null-exclusion indicator that may precede the access keyword.
 
    --  Original_Discriminant (Node2-Sem)
    --    Present in identifiers. Used in references to discriminants that