[multiple changes]

2014-01-20  Robert Dewar  <dewar@adacore.com>

	* exp_ch9.adb, checks.adb, exp_intr.adb: Minor reformatting.
	* sem_res.adb (Resolve): Fix error causing infinite loop for
	integer used as address. Allow addresses as integers.

2014-01-20  Arnaud Charlet  <charlet@adacore.com>

	* s-osinte-linux.ads (struct_sigaction): Fix rep clause.

2014-01-20  Bob Duff  <duff@adacore.com>

	* par-ch8.adb (P_Use_Type_Clause): Detect syntax
	error when "use all" is not followed by "type".

From-SVN: r206829

8 files changed, 144 insertions, 107 deletions

diff --git a/gcc/ada/ChangeLog b/gcc/ada/ChangeLog
index c309e57..97defc9 100644
--- a/gcc/ada/ChangeLog
+++ b/gcc/ada/ChangeLog
@@ -1,3 +1,18 @@
+2014-01-20  Robert Dewar  <dewar@adacore.com>
+
+	* exp_ch9.adb, checks.adb, exp_intr.adb: Minor reformatting.
+	* sem_res.adb (Resolve): Fix error causing infinite loop for
+	integer used as address. Allow addresses as integers.
+
+2014-01-20  Arnaud Charlet  <charlet@adacore.com>
+
+	* s-osinte-linux.ads (struct_sigaction): Fix rep clause.
+
+2014-01-20  Bob Duff  <duff@adacore.com>
+
+	* par-ch8.adb (P_Use_Type_Clause): Detect syntax
+	error when "use all" is not followed by "type".
+
 2014-01-20  Bob Duff  <duff@adacore.com>
 
 	* exp_intr.adb (Expand_Unc_Deallocation): Remove warning on abort
diff --git a/gcc/ada/checks.adb b/gcc/ada/checks.adb
index 58b8422..1e4cff8 100644
--- a/gcc/ada/checks.adb
+++ b/gcc/ada/checks.adb
@@ -767,9 +767,11 @@ package body Checks is
            and then not Warnings_Off (E)
            and then Restriction_Active (No_Exception_Propagation)
          then
-            Error_Msg_N ("address value may be incompatible with " &
-                           "alignment of object?", N);
+            Error_Msg_N
+              ("address value may be incompatible with alignment of object?",
+               N);
          end if;
+
          return;
       end if;
 
diff --git a/gcc/ada/exp_ch9.adb b/gcc/ada/exp_ch9.adb
index c505e16..7523542 100644
--- a/gcc/ada/exp_ch9.adb
+++ b/gcc/ada/exp_ch9.adb
@@ -70,9 +70,9 @@ package body Exp_Ch9 is
    --  The following constant establishes the upper bound for the index of
    --  an entry family. It is used to limit the allocated size of protected
    --  types with defaulted discriminant of an integer type, when the bound
-   --  of some entry family depends on a discriminant. The limitation to
-   --  entry families of 128K should be reasonable in all cases, and is a
-   --  documented implementation restriction.
+   --  of some entry family depends on a discriminant. The limitation to entry
+   --  families of 128K should be reasonable in all cases, and is a documented
+   --  implementation restriction.
 
    Entry_Family_Bound : constant Int := 2**16;
 
@@ -202,8 +202,8 @@ package body Exp_Ch9 is
    --  pre/postconditions. The body gathers the PPC's and expands them in the
    --  usual way, and performs the entry call itself. This way preconditions
    --  are evaluated before the call is queued. E is the entry in question,
-   --  and Decl is the enclosing synchronized type declaration at whose
-   --  freeze point the generated body is analyzed.
+   --  and Decl is the enclosing synchronized type declaration at whose freeze
+   --  point the generated body is analyzed.
 
    function Build_Protected_Entry
      (N   : Node_Id;
@@ -238,12 +238,12 @@ package body Exp_Ch9 is
       Pid       : Node_Id;
       N_Op_Spec : Node_Id) return Node_Id;
    --  This function is used to construct the protected version of a protected
-   --  subprogram. Its statement sequence first defers abort, then locks
-   --  the associated protected object, and then enters a block that contains
-   --  a call to the unprotected version of the subprogram (for details, see
-   --  Build_Unprotected_Subprogram_Body). This block statement requires
-   --  a cleanup handler that unlocks the object in all cases.
-   --  (see Exp_Ch7.Expand_Cleanup_Actions).
+   --  subprogram. Its statement sequence first defers abort, then locks the
+   --  associated protected object, and then enters a block that contains a
+   --  call to the unprotected version of the subprogram (for details, see
+   --  Build_Unprotected_Subprogram_Body). This block statement requires a
+   --  cleanup handler that unlocks the object in all cases. For details,
+   --  see Exp_Ch7.Expand_Cleanup_Actions.
 
    function Build_Renamed_Formal_Declaration
      (New_F          : Entity_Id;
@@ -262,14 +262,13 @@ package body Exp_Ch9 is
      (Prefix      : Entity_Id;
       Selector    : Entity_Id;
       Append_Char : Character := ' ') return Name_Id;
-   --  Build a name in the form of Prefix__Selector, with an optional
-   --  character appended. This is used for internal subprograms generated
-   --  for operations of protected types, including barrier functions.
-   --  For the subprograms generated for entry bodies and entry barriers,
-   --  the generated name includes a sequence number that makes names
-   --  unique in the presence of entry overloading. This is necessary
-   --  because entry body procedures and barrier functions all have the
-   --  same signature.
+   --  Build a name in the form of Prefix__Selector, with an optional character
+   --  appended. This is used for internal subprograms generated for operations
+   --  of protected types, including barrier functions. For the subprograms
+   --  generated for entry bodies and entry barriers, the generated name
+   --  includes a sequence number that makes names unique in the presence of
+   --  entry overloading. This is necessary because entry body procedures and
+   --  barrier functions all have the same signature.
 
    procedure Build_Simple_Entry_Call
      (N       : Node_Id;
@@ -350,14 +349,14 @@ package body Exp_Ch9 is
 
    procedure Ensure_Statement_Present (Loc : Source_Ptr; Alt : Node_Id);
    --  If control flow optimizations are suppressed, and Alt is an accept,
-   --  delay, or entry call alternative with no trailing statements, insert a
-   --  null trailing statement with the given Loc (which is the sloc of the
-   --  accept, delay, or entry call statement). There might not be any
-   --  generated code for the accept, delay, or entry call itself (the
-   --  effect of these statements is part of the general processsing done
-   --  for the enclosing selective accept, timed entry call, or asynchronous
-   --  select), and the null statement is there to carry the sloc of that
-   --  statement to the back-end for trace-based coverage analysis purposes.
+   --  delay, or entry call alternative with no trailing statements, insert
+   --  a null trailing statement with the given Loc (which is the sloc of
+   --  the accept, delay, or entry call statement). There might not be any
+   --  generated code for the accept, delay, or entry call itself (the effect
+   --  of these statements is part of the general processsing done for the
+   --  enclosing selective accept, timed entry call, or asynchronous select),
+   --  and the null statement is there to carry the sloc of that statement to
+   --  the back-end for trace-based coverage analysis purposes.
 
    procedure Extract_Dispatching_Call
      (N        : Node_Id;
@@ -376,8 +375,8 @@ package body Exp_Ch9 is
       Concval : out Node_Id;
       Ename   : out Node_Id;
       Index   : out Node_Id);
-   --  Given an entry call, returns the associated concurrent object,
-   --  the entry name, and the entry family index.
+   --  Given an entry call, returns the associated concurrent object, the entry
+   --  name, and the entry family index.
 
    function Family_Offset
      (Loc  : Source_Ptr;
@@ -385,11 +384,11 @@ package body Exp_Ch9 is
       Lo   : Node_Id;
       Ttyp : Entity_Id;
       Cap  : Boolean) return Node_Id;
-   --  Compute (Hi - Lo) for two entry family indexes. Hi is the index in
-   --  an accept statement, or the upper bound in the discrete subtype of
-   --  an entry declaration. Lo is the corresponding lower bound. Ttyp is
-   --  the concurrent type of the entry. If Cap is true, the result is
-   --  capped according to Entry_Family_Bound.
+   --  Compute (Hi - Lo) for two entry family indexes. Hi is the index in an
+   --  accept statement, or the upper bound in the discrete subtype of an entry
+   --  declaration. Lo is the corresponding lower bound. Ttyp is the concurrent
+   --  type of the entry. If Cap is true, the result is capped according to
+   --  Entry_Family_Bound.
 
    function Family_Size
      (Loc  : Source_Ptr;
@@ -397,11 +396,11 @@ package body Exp_Ch9 is
       Lo   : Node_Id;
       Ttyp : Entity_Id;
       Cap  : Boolean) return Node_Id;
-   --  Compute (Hi - Lo) + 1 Max 0, to determine the number of entries in
-   --  a family, and handle properly the superflat case. This is equivalent
-   --  to the use of 'Length on the index type, but must use Family_Offset
-   --  to handle properly the case of bounds that depend on discriminants.
-   --  If Cap is true, the result is capped according to Entry_Family_Bound.
+   --  Compute (Hi - Lo) + 1 Max 0, to determine the number of entries in a
+   --  family, and handle properly the superflat case. This is equivalent to
+   --  the use of 'Length on the index type, but must use Family_Offset to
+   --  handle properly the case of bounds that depend on discriminants. If
+   --  Cap is true, the result is capped according to Entry_Family_Bound.
 
    procedure Find_Enclosing_Context
      (N             : Node_Id;
@@ -417,8 +416,8 @@ package body Exp_Ch9 is
 
    function Index_Object (Spec_Id : Entity_Id) return Entity_Id;
    --  Given a subprogram identifier, return the entity which is associated
-   --  with the protection entry index in the Protected_Body_Subprogram or the
-   --  Task_Body_Procedure of Spec_Id. The returned entity denotes formal
+   --  with the protection entry index in the Protected_Body_Subprogram or
+   --  the Task_Body_Procedure of Spec_Id. The returned entity denotes formal
    --  parameter _E.
 
    function Is_Exception_Safe (Subprogram : Node_Id) return Boolean;
@@ -436,9 +435,9 @@ package body Exp_Ch9 is
 
    function Null_Statements (Stats : List_Id) return Boolean;
    --  Used to check DO-END sequence. Checks for equivalent of DO NULL; END.
-   --  Allows labels, and pragma Warnings/Unreferenced in the sequence as
-   --  well to still count as null. Returns True for a null sequence. The
-   --  argument is the list of statements from the DO-END sequence.
+   --  Allows labels, and pragma Warnings/Unreferenced in the sequence as well
+   --  to still count as null. Returns True for a null sequence. The argument
+   --  is the list of statements from the DO-END sequence.
 
    function Parameter_Block_Pack
      (Loc     : Source_Ptr;
@@ -447,8 +446,8 @@ package body Exp_Ch9 is
       Formals : List_Id;
       Decls   : List_Id;
       Stmts   : List_Id) return Entity_Id;
-   --  Set the components of the generated parameter block with the values of
-   --  the actual parameters. Generate aliased temporaries to capture the
+   --  Set the components of the generated parameter block with the values
+   --  of the actual parameters. Generate aliased temporaries to capture the
    --  values for types that are passed by copy. Otherwise generate a reference
    --  to the actual's value. Return the address of the aggregate block.
    --  Generate:
@@ -605,8 +604,8 @@ package body Exp_Ch9 is
             S :=
               Etype (Discrete_Subtype_Definition (Declaration_Node (Prev)));
 
-            --  The need for the following full view retrieval stems from
-            --  this complex case of nested generics and tasking:
+            --  The need for the following full view retrieval stems from this
+            --  complex case of nested generics and tasking:
 
             --     generic
             --        type Formal_Index is range <>;
@@ -638,6 +637,7 @@ package body Exp_Ch9 is
             --  We are currently building the index expression for the entry
             --  call "T.E" (1). Part of the expansion must mention the range
             --  of the discrete type "Index" (2) of entry family "Fam".
+
             --  However only the private view of type "Index" is available to
             --  the inner generic (3) because there was no prior mention of
             --  the type inside "Inner". This visibility requirement is
@@ -708,9 +708,9 @@ package body Exp_Ch9 is
          Set_Etype (New_F, Etype (Formal));
          Set_Scope (New_F, Ent);
 
-         --  Now we set debug info needed on New_F even though it does not
-         --  come from source, so that the debugger will get the right
-         --  information for these generated names.
+         --  Now we set debug info needed on New_F even though it does not come
+         --  from source, so that the debugger will get the right information
+         --  for these generated names.
 
          Set_Debug_Info_Needed (New_F);
 
@@ -843,8 +843,8 @@ package body Exp_Ch9 is
          New_S := Stats;
       end if;
 
-      --  At this stage we know that the new statement sequence does not
-      --  have an exception handler part, so we supply one to call
+      --  At this stage we know that the new statement sequence does
+      --  not have an exception handler part, so we supply one to call
       --  Exceptional_Complete_Rendezvous. This handler is
 
       --    when all others =>
@@ -974,8 +974,7 @@ package body Exp_Ch9 is
 
             Prepend_To (Decls, Decl);
 
-            --  Ensure that the _chain appears in the proper scope of the
-            --  context.
+            --  Ensure that _chain appears in the proper scope of the context
 
             if Context_Id /= Current_Scope then
                Push_Scope (Context_Id);
@@ -1189,9 +1188,9 @@ package body Exp_Ch9 is
                   while Nkind (Par) /= N_Compilation_Unit loop
                      Par := Parent (Par);
 
-                     --  If we fall off the top, we are at the outer level, and
-                     --  the environment task is our effective master, so
-                     --  nothing to mark.
+                     --  If we fall off the top, we are at the outer level,
+                     --  and the environment task is our effective master,
+                     --  so nothing to mark.
 
                      if Nkind_In (Par, N_Block_Statement,
                                        N_Subprogram_Body,
diff --git a/gcc/ada/exp_intr.adb b/gcc/ada/exp_intr.adb
index 058b827..6289b1e 100644
--- a/gcc/ada/exp_intr.adb
+++ b/gcc/ada/exp_intr.adb
@@ -1018,11 +1018,12 @@ package body Exp_Intr is
       --  For a task type, call Free_Task before freeing the ATCB
 
       if Is_Task_Type (Desig_T) then
+
          --  We used to detect the case of Abort followed by a Free here,
-         --  because the Free wouldn't actually free if it happens before the
-         --  aborted task actually terminates. The warning is removed, because
-         --  Free now works properly (the task will be freed once it
-         --  terminates).
+         --  because the Free wouldn't actually free if it happens before
+         --  the aborted task actually terminates. The warning was removed,
+         --  because Free now works properly (the task will be freed once
+         --  it terminates).
 
          Append_To
            (Stmts, Cleanup_Task (N, Duplicate_Subexpr_No_Checks (Arg)));
diff --git a/gcc/ada/gnat_rm.texi b/gcc/ada/gnat_rm.texi
index 5e32e74..8b349b4 100644
--- a/gcc/ada/gnat_rm.texi
+++ b/gcc/ada/gnat_rm.texi
@@ -1239,8 +1239,9 @@ If the configuration pragma
 @code{Allow_Integer_Address} is given, then integer expressions may
 be used anywhere a value of type @code{System.Address} is required.
 The effect is to introduce an implicit unchecked conversion from the
-integer value to type @code{System.Address}. The following example
-compiles without errors:
+integer value to type @code{System.Address}. The reverse case of using
+an address where an integer type is required is handled analogously.
+The following example compiles without errors:
 
 @smallexample @c ada
 pragma Allow_Integer_Address;
@@ -1253,6 +1254,8 @@ package AddrAsInt is
    m : Address := 16#4000#;
    n : constant Address := 4000;
    p : constant Address := Address (X + Y);
+   v : Integer := y'Address;
+   w : constant Integer := Integer (Y'Address);
    type R is new integer;
    RR : R := 1000;
    Z : Integer;
diff --git a/gcc/ada/par-ch8.adb b/gcc/ada/par-ch8.adb
index 89a2bb4..b4eaf8c 100644
--- a/gcc/ada/par-ch8.adb
+++ b/gcc/ada/par-ch8.adb
@@ -113,7 +113,12 @@ package body Ch8 is
          Error_Msg_Ada_2012_Feature ("|`USE ALL TYPE`", Token_Ptr);
          All_Present := True;
          Scan; -- past ALL
-      else
+
+         if Token /= Tok_Type then
+            Error_Msg_SC ("TYPE expected");
+         end if;
+
+      else pragma Assert (Token = Tok_Type);
          All_Present := False;
       end if;
 
diff --git a/gcc/ada/s-osinte-linux.ads b/gcc/ada/s-osinte-linux.ads
index 6eb0b88..3f8df80 100644
--- a/gcc/ada/s-osinte-linux.ads
+++ b/gcc/ada/s-osinte-linux.ads
@@ -7,7 +7,7 @@
 --                                  S p e c                                 --
 --                                                                          --
 --             Copyright (C) 1991-1994, Florida State University            --
---          Copyright (C) 1995-2012, Free Software Foundation, Inc.         --
+--          Copyright (C) 1995-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- --
@@ -589,7 +589,8 @@ private
    for struct_sigaction use record
       sa_handler at Linux.sa_handler_pos range 0 .. Standard'Address_Size - 1;
       sa_mask    at Linux.sa_mask_pos    range 0 .. 1023;
-      sa_flags   at Linux.sa_flags_pos   range 0 .. Standard'Address_Size - 1;
+      sa_flags   at Linux.sa_flags_pos
+        range 0 .. Interfaces.C.unsigned_long'Size - 1;
    end record;
    --  We intentionally leave sa_restorer unspecified and let the compiler
    --  append it after the last field, so disable corresponding warning.
diff --git a/gcc/ada/sem_res.adb b/gcc/ada/sem_res.adb
index c79c788..2dc9291 100644
--- a/gcc/ada/sem_res.adb
+++ b/gcc/ada/sem_res.adb
@@ -2612,30 +2612,36 @@ package body Sem_Res is
                end;
             end if;
 
-            --  If an error message was issued already, Found got reset to
-            --  True, so if it is still False, issue standard Wrong_Type msg.
-
-            --  First check for special case of Address wanted, integer found
-            --  with the configuration pragma Allow_Integer_Address active.
-
-            if Allow_Integer_Address
-              and then Is_RTE (Typ, RE_Address)
-              and then Is_Integer_Type (Etype (N))
-            then
-               Rewrite
-                 (N, Unchecked_Convert_To (RTE (RE_Address),
-                  Relocate_Node (N)));
-               Analyze_And_Resolve (N, RTE (RE_Address));
-               return;
+            --  Looks like we have a type error, but check for special case
+            --  of Address wanted, integer found, with the configuration pragma
+            --  Allow_Integer_Address active. If we have this case, introduce
+            --  an unchecked conversion to allow the integer expression to be
+            --  treated as an Address. The reverse case of integer wanted,
+            --  Address found, is treated in an analogous manner.
+
+            if Allow_Integer_Address then
+               if (Is_RTE (Typ, RE_Address)
+                    and then Is_Integer_Type (Etype (N)))
+                 or else
+                   (Is_Integer_Type (Typ)
+                     and then Is_RTE (Etype (N), RE_Address))
+               then
+                  Rewrite (N, Unchecked_Convert_To (Typ, Relocate_Node (N)));
+                  Analyze_And_Resolve (N, Typ);
+                  return;
+               end if;
+            end if;
 
-            --  OK, not the special case go ahead and issue message
+            --  That special Allow_Integer_Address check did not appply, so we
+            --  have a real type error. If an error message was issued already,
+            --  Found got reset to True, so if it's still False, issue standard
+            --  Wrong_Type message.
 
-            elsif not Found then
-               if Is_Overloaded (N)
-                 and then Nkind (N) = N_Function_Call
-               then
+            if not Found then
+               if Is_Overloaded (N) and then Nkind (N) = N_Function_Call then
                   declare
                      Subp_Name : Node_Id;
+
                   begin
                      if Is_Entity_Name (Name (N)) then
                         Subp_Name := Name (N);
@@ -11085,6 +11091,23 @@ package body Sem_Res is
          end;
       end if;
 
+      --  Deal with conversion of integer type to address if the pragma
+      --  Allow_Integer_Address is in effect. We convert the conversion to
+      --  an unchecked conversion in this case and we are all done!
+
+      if Allow_Integer_Address
+        and then
+          ((Is_RTE (Target_Type, RE_Address)
+             and then Is_Integer_Type (Opnd_Type))
+          or else
+           (Is_RTE (Opnd_Type, RE_Address)
+             and then Is_Integer_Type (Target_Type)))
+      then
+         Rewrite (N, Unchecked_Convert_To (Target_Type, Expression (N)));
+         Analyze_And_Resolve (N, Target_Type);
+         return True;
+      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.
@@ -11094,7 +11117,7 @@ package body Sem_Res is
 
       --  Numeric types
 
-      if Is_Numeric_Type (Target_Type)  then
+      if Is_Numeric_Type (Target_Type) then
 
          --  A universal fixed expression can be converted to any numeric type
 
@@ -11120,11 +11143,11 @@ package body Sem_Res is
 
          else
             return Conversion_Check
-                    (Is_Numeric_Type (Opnd_Type)
-                      or else
-                        (Present (Inc_Ancestor)
-                          and then Is_Numeric_Type (Inc_Ancestor)),
-                     "illegal operand for numeric conversion");
+                     (Is_Numeric_Type (Opnd_Type)
+                       or else
+                         (Present (Inc_Ancestor)
+                           and then Is_Numeric_Type (Inc_Ancestor)),
+                      "illegal operand for numeric conversion");
          end if;
 
       --  Array types
@@ -11637,18 +11660,6 @@ package body Sem_Res is
             ("add ALL to }!", N, Target_Type);
          return False;
 
-      --  Deal with conversion of integer type to address if the pragma
-      --  Allow_Integer_Address is in effect.
-
-      elsif Allow_Integer_Address
-        and then Is_RTE (Etype (N), RE_Address)
-        and then Is_Integer_Type (Etype (Operand))
-      then
-         Rewrite (N,
-           Unchecked_Convert_To (RTE (RE_Address), Relocate_Node (N)));
-         Analyze_And_Resolve (N, RTE (RE_Address));
-         return True;
-
       --  Here we have a real conversion error
 
       else