OSDN Git Service

2013-04-11 Ed Schonberg <schonberg@adacore.com>
authorcharlet <charlet@138bc75d-0d04-0410-961f-82ee72b054a4>
Thu, 11 Apr 2013 12:36:44 +0000 (12:36 +0000)
committercharlet <charlet@138bc75d-0d04-0410-961f-82ee72b054a4>
Thu, 11 Apr 2013 12:36:44 +0000 (12:36 +0000)
* sem_util.ads, sem_util.adb (Get_Incomplete_View_Of_Ancestor):
New function to implement the notion introduced in RM 7.3.1
(5.2/3): in a child unit, a derived type is within the derivation
class of an ancestor declared in a parent unit, even if there
is an intermediate derivation that does not see the full view
of that ancestor.
* sem_res.adb (Valid_Conversion): if all else fails, examine if an
incomplete view of an ancestor makes a numeric conversion legal.

2013-04-11  Ed Schonberg  <schonberg@adacore.com>

* sem_ch6.adb: in Ada2012 operators can only have in
parameters.

2013-04-11  Vincent Celier  <celier@adacore.com>

* makeutl.adb (Create_Binder_Mapping_File): Do not put into
the mapping file ALI files of sources that have been replaced.

2013-04-11  Vincent Celier  <celier@adacore.com>

* projects.texi: Add subsection Duplicate Sources in Projects.

2013-04-11  Vincent Celier  <celier@adacore.com>

* gnat_ugn.texi: Add documentation for gnatmake switch -droot_dir/**

2013-04-11  Arnaud Charlet  <charlet@adacore.com>

* init.c (__gnat_install_handler): Only set up an alternate
stack when installing a signal handler for SIGSEGV.

2013-04-11  Thomas Quinot  <quinot@adacore.com>

* g-socket.adb (Connect_Socket, timeout version): Call
underlying connect operation directly, not through the 2-argument
Connect_Socket thick binding, in order to avoid raising a junk
exception for the EINPROGRESS return.

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

gcc/ada/ChangeLog
gcc/ada/g-socket.adb
gcc/ada/gnat_ugn.texi
gcc/ada/init.c
gcc/ada/makeutl.adb
gcc/ada/projects.texi
gcc/ada/sem_ch6.adb
gcc/ada/sem_res.adb
gcc/ada/sem_util.adb
gcc/ada/sem_util.ads

index 5899c52..2032950 100644 (file)
@@ -1,3 +1,44 @@
+2013-04-11  Ed Schonberg  <schonberg@adacore.com>
+
+       * sem_util.ads, sem_util.adb (Get_Incomplete_View_Of_Ancestor):
+       New function to implement the notion introduced in RM 7.3.1
+       (5.2/3): in a child unit, a derived type is within the derivation
+       class of an ancestor declared in a parent unit, even if there
+       is an intermediate derivation that does not see the full view
+       of that ancestor.
+       * sem_res.adb (Valid_Conversion): if all else fails, examine if an
+       incomplete view of an ancestor makes a numeric conversion legal.
+
+2013-04-11  Ed Schonberg  <schonberg@adacore.com>
+
+       * sem_ch6.adb: in Ada2012 operators can only have in
+       parameters.
+
+2013-04-11  Vincent Celier  <celier@adacore.com>
+
+       * makeutl.adb (Create_Binder_Mapping_File): Do not put into
+       the mapping file ALI files of sources that have been replaced.
+
+2013-04-11  Vincent Celier  <celier@adacore.com>
+
+       * projects.texi: Add subsection Duplicate Sources in Projects.
+
+2013-04-11  Vincent Celier  <celier@adacore.com>
+
+       * gnat_ugn.texi: Add documentation for gnatmake switch -droot_dir/**
+
+2013-04-11  Arnaud Charlet  <charlet@adacore.com>
+
+       * init.c (__gnat_install_handler): Only set up an alternate
+       stack when installing a signal handler for SIGSEGV.
+
+2013-04-11  Thomas Quinot  <quinot@adacore.com>
+
+       * g-socket.adb (Connect_Socket, timeout version): Call
+       underlying connect operation directly, not through the 2-argument
+       Connect_Socket thick binding, in order to avoid raising a junk
+       exception for the EINPROGRESS return.
+
 2013-04-11  Robert Dewar  <dewar@adacore.com>
 
        * a-cdlili.adb: Minor addition of pragma Warnings (Off).
index c7b7120..7f9f34d 100644 (file)
@@ -6,7 +6,7 @@
 --                                                                          --
 --                                 B o d y                                  --
 --                                                                          --
---                     Copyright (C) 2001-2012, AdaCore                     --
+--                     Copyright (C) 2001-2013, AdaCore                     --
 --                                                                          --
 -- GNAT is free software;  you can  redistribute it  and/or modify it under --
 -- terms of the  GNU General Public License as published  by the Free Soft- --
@@ -200,6 +200,12 @@ package body GNAT.Sockets is
    --  Raise Constraint_Error if Fd is less than 0 or greater than or equal to
    --  FD_SETSIZE, on platforms where fd_set is a bitmap.
 
+   function Connect_Socket
+     (Socket : Socket_Type;
+      Server : Sock_Addr_Type) return C.int;
+   pragma Inline (Connect_Socket);
+   --  Underlying implementation for the Connect_Socket procedures
+
    --  Types needed for Datagram_Socket_Stream_Type
 
    type Datagram_Socket_Stream_Type is new Root_Stream_Type with record
@@ -662,11 +668,10 @@ package body GNAT.Sockets is
    -- Connect_Socket --
    --------------------
 
-   procedure Connect_Socket
+   function Connect_Socket
      (Socket : Socket_Type;
-      Server : Sock_Addr_Type)
+      Server : Sock_Addr_Type) return C.int
    is
-      Res : C.int;
       Sin : aliased Sockaddr_In;
       Len : constant C.int := Sin'Size / 8;
 
@@ -681,17 +686,19 @@ package body GNAT.Sockets is
         (Sin'Unchecked_Access,
          Short_To_Network (C.unsigned_short (Server.Port)));
 
-      Res := C_Connect (C.int (Socket), Sin'Address, Len);
+      return C_Connect (C.int (Socket), Sin'Address, Len);
+   end Connect_Socket;
 
-      if Res = Failure then
+   procedure Connect_Socket
+     (Socket : Socket_Type;
+      Server : Sock_Addr_Type)
+   is
+   begin
+      if Connect_Socket (Socket, Server) = Failure then
          Raise_Socket_Error (Socket_Errno);
       end if;
    end Connect_Socket;
 
-   --------------------
-   -- Connect_Socket --
-   --------------------
-
    procedure Connect_Socket
      (Socket   : Socket_Type;
       Server   : Sock_Addr_Type;
@@ -719,19 +726,16 @@ package body GNAT.Sockets is
       Req := (Name => Non_Blocking_IO, Enabled => True);
       Control_Socket (Socket, Request => Req);
 
-      --  Start operation (non-blocking), will raise Socket_Error with
-      --  EINPROGRESS.
+      --  Start operation (non-blocking), will return Failure with errno set
+      --  to EINPROGRESS.
 
-      begin
-         Connect_Socket (Socket, Server);
-      exception
-         when E : Socket_Error =>
-            if Resolve_Exception (E) = Operation_Now_In_Progress then
-               null;
-            else
-               raise;
-            end if;
-      end;
+      Res := Connect_Socket (Socket, Server);
+      if Res = Failure then
+         Conn_Err := Socket_Errno;
+         if Conn_Err /= SOSC.EINPROGRESS then
+            Raise_Socket_Error (Conn_Err);
+         end if;
+      end if;
 
       --  Wait for socket to become available for writing
 
index b92b278..9ef3fe4 100644 (file)
@@ -12315,6 +12315,9 @@ specified, no switch @option{^-P^/PROJECT_FILE^} may be specified (see below).
 @cindex @option{^-d^/SOURCE_DIRS^} (@code{gnatname})
 Look for source files in directory @file{dir}. There may be zero, one or more
 spaces between @option{^-d^/SOURCE_DIRS=^} and @file{dir}.
+@file{dir} may end with @code{/**}, that is it may be of the form
+@code{root_dir/**}. In this case, the directory @code{root_dir} and all of its
+subdirectories, recursively, have to be searched for sources.
 When a switch @option{^-d^/SOURCE_DIRS^}
 is specified, the current working directory will not be searched for source
 files, unless it is explicitly specified with a @option{^-d^/SOURCE_DIRS^}
index f5c3a81..ef9087c 100644 (file)
@@ -6,7 +6,7 @@
  *                                                                          *
  *                          C Implementation File                           *
  *                                                                          *
- *          Copyright (C) 1992-2012, Free Software Foundation, Inc.         *
+ *          Copyright (C) 1992-2013, Free Software Foundation, Inc.         *
  *                                                                          *
  * GNAT is free software;  you can  redistribute it  and/or modify it under *
  * terms of the  GNU General Public License as published  by the Free Soft- *
@@ -603,14 +603,6 @@ __gnat_install_handler (void)
      handled properly, avoiding a SEGV generation from stack usage by the
      handler itself.  */
 
-#if defined (i386) || defined (__x86_64__) || defined (__powerpc__)
-  stack_t stack;
-  stack.ss_sp = __gnat_alternate_stack;
-  stack.ss_size = sizeof (__gnat_alternate_stack);
-  stack.ss_flags = 0;
-  sigaltstack (&stack, NULL);
-#endif
-
   act.sa_sigaction = __gnat_error_handler;
   act.sa_flags = SA_NODEFER | SA_RESTART | SA_SIGINFO;
   sigemptyset (&act.sa_mask);
@@ -624,11 +616,23 @@ __gnat_install_handler (void)
     sigaction (SIGILL,  &act, NULL);
   if (__gnat_get_interrupt_state (SIGBUS) != 's')
     sigaction (SIGBUS,  &act, NULL);
+  if (__gnat_get_interrupt_state (SIGSEGV) != 's')
+    {
 #if defined (i386) || defined (__x86_64__) || defined (__powerpc__)
-  act.sa_flags |= SA_ONSTACK;
+      /* Setup an alternate stack region for the handler execution so that
+        stack overflows can be handled properly, avoiding a SEGV generation
+        from stack usage by the handler itself.  */
+      stack_t stack;
+
+      stack.ss_sp = __gnat_alternate_stack;
+      stack.ss_size = sizeof (__gnat_alternate_stack);
+      stack.ss_flags = 0;
+      sigaltstack (&stack, NULL);
+
+      act.sa_flags |= SA_ONSTACK;
 #endif
-  if (__gnat_get_interrupt_state (SIGSEGV) != 's')
-    sigaction (SIGSEGV, &act, NULL);
+      sigaction (SIGSEGV, &act, NULL);
+    }
 
   __gnat_handler_installed = 1;
 }
index e2d6b84..dc28bfd 100644 (file)
@@ -390,7 +390,10 @@ package body Makeutl is
 
             Unit := Source.Unit;
 
-            if Unit = No_Unit_Index or else Unit.Name = No_Name then
+            if Source.Replaced_By /= No_Source
+              or else Unit = No_Unit_Index
+              or else Unit.Name = No_Name
+            then
                ALI_Name := No_File;
 
             --  If this is a body, put it in the mapping
index 53baeac..492d23a 100644 (file)
@@ -217,6 +217,7 @@ should contain the following code:
 
 @menu
 * Source Files and Directories::
+* Duplicate Sources in Projects::
 * Object and Exec Directory::
 * Main Subprograms::
 * Tools Options in Project Files::
@@ -401,21 +402,31 @@ setting @code{Source_Dirs}. The project manager automatically finds
 @file{pack.ads}, @file{pack.adb} and @file{proc.adb} as source files of the
 project.
 
-Note that it is considered an error for a project file to have no sources
-attached to it unless explicitly declared as mentioned above.
+Note that by default a warning is issued when a project has no sources attached
+to it and this is not explicitly indicated in the project file.
 
+@c ---------------------------------------------
+@node Duplicate Sources in Projects
+@subsection Duplicate Sources in Projects
+@c ---------------------------------------------
+
+@noindent
 If the order of the source directories is known statically, that is if
-@code{"**"} is not used in the string list @code{Source_Dirs}, then there may
+@code{"/**"} is not used in the string list @code{Source_Dirs}, then there may
 be several files with the same source file name sitting in different
 directories of the project. In this case, only the file in the first directory
 is considered as a source of the project and the others are hidden. If
-@code{"**"} is used in the string list @code{Source_Dirs}, it is an error
+@code{"/**"} is used in the string list @code{Source_Dirs}, it is an error
 to have several files with the same source file name in the same directory
-@code{"**"} subtree, since there would be an ambiguity as to which one should
+@code{"/**"} subtree, since there would be an ambiguity as to which one should
 be used. However, two files with the same source file name may exist in two
 single directories or directory subtrees. In this case, the one in the first
 directory or directory subtree is a source of the project.
 
+If there are two sources in different directories of the same @code{"/**"}
+subtree, one way to resolve the problem is to exclude the directory of the
+file that should not be used as a source of the project.
+
 @c ---------------------------------------------
 @node Object and Exec Directory
 @subsection Object and Exec Directory
index 02f0872..c18a3a6 100644 (file)
@@ -12633,6 +12633,13 @@ package body Sem_Ch6 is
             --  [IN] OUT parameters allowed for functions in Ada 2012
 
             if Ada_Version >= Ada_2012 then
+
+               --  Even in Ada 2012 operators can only have IN parameters
+
+               if Is_Operator_Symbol_Name (Chars (Scope (Formal_Id))) then
+                  Error_Msg_N ("operators can only have IN parameters", Spec);
+               end if;
+
                if In_Present (Spec) then
                   Set_Ekind (Formal_Id, E_In_Out_Parameter);
                else
index e60f911..36d64bb 100644 (file)
@@ -10504,8 +10504,9 @@ package body Sem_Res is
       Operand     : Node_Id;
       Report_Errs : Boolean := True) return Boolean
    is
-      Target_Type : constant Entity_Id := Base_Type (Target);
-      Opnd_Type   : Entity_Id          := Etype (Operand);
+      Target_Type  : constant Entity_Id := Base_Type (Target);
+      Opnd_Type    : Entity_Id          := Etype (Operand);
+      Inc_Ancestor : Entity_Id;
 
       function Conversion_Check
         (Valid : Boolean;
@@ -10883,6 +10884,13 @@ package body Sem_Res is
          end;
       end if;
 
+      --  If we are within a child unit, check whether the type of the
+      --  expression has an ancestor in a parent unit, in which case it
+      --  belongs to its derivation class even if the ancestor is private.
+      --  See RM 7.3.1 (5.2/3).
+
+      Inc_Ancestor := Get_Incomplete_View_Of_Ancestor (Opnd_Type);
+
       --  Numeric types
 
       if Is_Numeric_Type (Target_Type)  then
@@ -10911,7 +10919,10 @@ package body Sem_Res is
 
          else
             return Conversion_Check
-                    (Is_Numeric_Type (Opnd_Type),
+                    (Is_Numeric_Type (Opnd_Type)
+                       or else
+                         (Present (Inc_Ancestor)
+                           and then Is_Numeric_Type (Inc_Ancestor)),
                      "illegal operand for numeric conversion");
          end if;
 
index d964d0f..071bdd5 100644 (file)
@@ -5380,6 +5380,55 @@ package body Sem_Util is
       end if;
    end Get_Generic_Entity;
 
+   -------------------------------------
+   -- Get_Incomplete_View_Of_Ancestor --
+   -------------------------------------
+
+   function Get_Incomplete_View_Of_Ancestor (E : Entity_Id) return Entity_Id is
+      Cur_Unit  : constant Entity_Id := Cunit_Entity (Current_Sem_Unit);
+      Par_Scope : Entity_Id;
+      Par_Type  : Entity_Id;
+
+   begin
+      --  The incomplete view of an ancestor is only relevant for private
+      --  derived types in child units.
+
+      if not Is_Derived_Type (E)
+        or else not Is_Child_Unit (Cur_Unit)
+      then
+         return Empty;
+
+      else
+         Par_Scope := Scope (Cur_Unit);
+         if No (Par_Scope) then
+            return Empty;
+         end if;
+
+         Par_Type := Etype (Base_Type (E));
+
+         --  Traverse list of ancestor types until we find one declared in
+         --  a parent or grandparent unit (two levels seem sufficient).
+
+         while Present (Par_Type) loop
+            if Scope (Par_Type) = Par_Scope
+              or else Scope (Par_Type) = Scope (Par_Scope)
+            then
+               return Par_Type;
+
+            elsif not Is_Derived_Type (Par_Type) then
+               return Empty;
+
+            else
+               Par_Type := Etype (Base_Type (Par_Type));
+            end if;
+         end loop;
+
+         --  If none found, there is no relevant ancestor type.
+
+         return Empty;
+      end if;
+   end Get_Incomplete_View_Of_Ancestor;
+
    ----------------------
    -- Get_Index_Bounds --
    ----------------------
index 0a9ff0a..11fe654 100644 (file)
@@ -582,6 +582,12 @@ package Sem_Util is
    --  Returns the true generic entity in an instantiation. If the name in the
    --  instantiation is a renaming, the function returns the renamed generic.
 
+   function Get_Incomplete_View_Of_Ancestor (E : Entity_Id) return Entity_Id;
+   --  Implements the notion introduced ever-so briefly in RM 7.3.1 (5.2/3):
+   --  in a child unit a derived type is within the derivation class of an
+   --  ancestor declared in a parent unit, even if there is an intermediate
+   --  derivation that does not see the full view of that ancestor.
+
    procedure Get_Index_Bounds (N : Node_Id; L, H : out Node_Id);
    --  This procedure assigns to L and H respectively the values of the low and
    --  high bounds of node N, which must be a range, subtype indication, or the