[multiple changes]

2011-08-04  Robert Dewar  <dewar@adacore.com>

	* sem_aggr.adb, par_sco.adb, sem_type.adb, exp_util.adb, exp_ch9.adb,
	prj-nmsc.adb, sem_ch13.adb, exp_strm.adb: Minor reformatting.

2011-08-04  Robert Dewar  <dewar@adacore.com>

	* gnat_rm.texi: Minor documentation fix for pragma Annotate.

2011-08-04  Yannick Moy  <moy@adacore.com>

	* sem_attr.adb (Analyze_Attribute): add check during pre-analysis that
	'Result only appears in postcondition of function.

2011-08-04  Thomas Quinot  <quinot@adacore.com>

	* a-tags.adb (Check_TSD): When raising PROGRAM_ERROR for a duplicated
	external tag, include the value of the external tag in the exception
	message.

From-SVN: r177344

gcc/ada/ChangeLog

+2011-08-04  Robert Dewar  <dewar@adacore.com>
+
+	* sem_aggr.adb, par_sco.adb, sem_type.adb, exp_util.adb, exp_ch9.adb,
+	prj-nmsc.adb, sem_ch13.adb, exp_strm.adb: Minor reformatting.
+
+2011-08-04  Robert Dewar  <dewar@adacore.com>
+
+	* gnat_rm.texi: Minor documentation fix for pragma Annotate.
+
+2011-08-04  Yannick Moy  <moy@adacore.com>
+
+	* sem_attr.adb (Analyze_Attribute): add check during pre-analysis that
+	'Result only appears in postcondition of function.
+
+2011-08-04  Thomas Quinot  <quinot@adacore.com>
+
+	* a-tags.adb (Check_TSD): When raising PROGRAM_ERROR for a duplicated
+	external tag, include the value of the external tag in the exception
+	message.
+
 2011-08-04  Yannick Moy  <moy@adacore.com>
 
 	* sem_attr.adb (Result): modify error message for misplaced 'Result

gcc/ada/a-tags.adb

@@ -310,6 +310,13 @@ package body Ada.Tags is
    procedure Check_TSD (TSD : Type_Specific_Data_Ptr) is
       T : Tag;
 
+      E_Tag_Len : constant Integer := Length (TSD.External_Tag);
+      E_Tag     : String (1 .. E_Tag_Len);
+      for E_Tag'Address use TSD.External_Tag.all'Address;
+      pragma Import (Ada, E_Tag);
+
+   --  Start of processing for Check_TSD
+
    begin
       --  Verify that the external tag of this TSD is not registered in the
       --  runtime hash table.
@@ -317,7 +324,7 @@ package body Ada.Tags is
       T := External_Tag_HTable.Get (To_Address (TSD.External_Tag));
 
       if T /= null then
-         raise Program_Error with "duplicated external tag";
+         raise Program_Error with "duplicated external tag " & E_Tag;
       end if;
    end Check_TSD;
 
@@ -718,6 +725,8 @@ package body Ada.Tags is
    -- Length --
    ------------
 
+   --  Should this be reimplemented using the strlen GCC builtin???
+
    function Length (Str : Cstring_Ptr) return Natural is
       Len : Integer;
 

gcc/ada/exp_ch9.adb

@@ -949,8 +949,7 @@ package body Exp_Ch9 is
 
       if Opt.Suppress_Control_Flow_Optimizations then
          Stmt := Make_Implicit_If_Statement (Cond,
-                   Condition       =>
-                     Cond,
+                   Condition       => Cond,
                    Then_Statements => New_List (
                      Make_Simple_Return_Statement (Loc,
                        New_Occurrence_Of (Standard_True, Loc))),

gcc/ada/exp_strm.adb

@@ -203,6 +203,7 @@ package body Exp_Strm is
            Make_Object_Declaration (Loc,
              Defining_Identifier => Make_Defining_Identifier (Loc, Name_V),
              Object_Definition   => New_Occurrence_Of (Typ, Loc));
+
       else
          Odecl :=
            Make_Object_Declaration (Loc,
@@ -270,10 +271,10 @@ package body Exp_Strm is
       for J in 1 .. Number_Dimensions (Typ) loop
          Append_To (Stms,
            Make_Attribute_Reference (Loc,
-             Prefix =>
+             Prefix         =>
                New_Occurrence_Of (Stream_Base_Type (Etype (Indx)), Loc),
              Attribute_Name => Name_Write,
-             Expressions => New_List (
+             Expressions    => New_List (
                Make_Identifier (Loc, Name_S),
                Make_Attribute_Reference (Loc,
                  Prefix         => Make_Identifier (Loc, Name_V),
@@ -283,10 +284,10 @@ package body Exp_Strm is
 
          Append_To (Stms,
            Make_Attribute_Reference (Loc,
-             Prefix =>
+             Prefix         =>
                New_Occurrence_Of (Stream_Base_Type (Etype (Indx)), Loc),
              Attribute_Name => Name_Write,
-             Expressions => New_List (
+             Expressions    => New_List (
                Make_Identifier (Loc, Name_S),
                Make_Attribute_Reference (Loc,
                  Prefix         => Make_Identifier (Loc, Name_V),
@@ -301,7 +302,7 @@ package body Exp_Strm is
 
       Append_To (Stms,
         Make_Attribute_Reference (Loc,
-          Prefix => New_Occurrence_Of (Typ, Loc),
+          Prefix         => New_Occurrence_Of (Typ, Loc),
           Attribute_Name => Name_Write,
           Expressions => New_List (
             Make_Identifier (Loc, Name_S),
@@ -566,6 +567,10 @@ package body Exp_Strm is
       --  then the representation is unsigned
 
       elsif not Is_Unsigned_Type (FST)
+
+        --  The following set of tests gets repeated many times, we should
+        --  have an abstraction defined ???
+
         and then
           (Is_Fixed_Point_Type (U_Type)
              or else
@@ -573,6 +578,7 @@ package body Exp_Strm is
              or else
            (Is_Signed_Integer_Type (U_Type)
               and then not Has_Biased_Representation (FST)))
+
       then
          if P_Size <= Standard_Short_Short_Integer_Size then
             Lib_RE := RE_I_SSI;

gcc/ada/exp_util.adb

@@ -3888,13 +3888,13 @@ package body Exp_Util is
                                      N_Selected_Component)
                then
                   Ren_Obj := Prefix (Ren_Obj);
-                  Change  := True;
+                  Change := True;
 
                elsif Nkind_In (Ren_Obj, N_Type_Conversion,
                                         N_Unchecked_Type_Conversion)
                then
                   Ren_Obj := Expression (Ren_Obj);
-                  Change  := True;
+                  Change := True;
                end if;
             end loop;
 
@@ -3909,8 +3909,7 @@ package body Exp_Util is
 
       begin
          --  If a previous invocation of this routine has determined that a
-         --  list has no renamings, there is no point in repeating the same
-         --  scan.
+         --  list has no renamings, then no point in repeating the same scan.
 
          if not Has_Rens then
             return False;

gcc/ada/gnat_rm.texi

@@ -1003,8 +1003,11 @@ All other kinds of arguments are analyzed as expressions, and must be
 unambiguous.
 
 The analyzed pragma is retained in the tree, but not otherwise processed
-by any part of the GNAT compiler.  This pragma is intended for use by
-external tools, including ASIS@.
+by any part of the GNAT compiler, except to generate corresponding note
+lines in the generated ALI file. For the format of these note lines, see
+the compiler source file lib-writ.ads. This pragma is intended for use by
+external tools, including ASIS@. The use of pragma Annotate does not
+affect the compilation process in any way.
 
 @node Pragma Assert
 @unnumberedsec Pragma Assert

gcc/ada/par_sco.adb

@@ -575,7 +575,7 @@ package body Par_SCO is
             when N_Case_Expression =>
                return OK; -- ???
 
-            --  Conditional expression, processed like an IF statement
+            --  Conditional expression, processed like an if statement
 
             when N_Conditional_Expression =>
                declare

gcc/ada/prj-nmsc.adb

@@ -7820,8 +7820,7 @@ package body Prj.Nmsc is
 
    begin
       Debug_Output ("Path_Name_Of file_name=", Name_Id (File_Name));
-      Debug_Output ("Path_Name_Of directory=",
-                    Name_Id (Directory));
+      Debug_Output ("Path_Name_Of directory=", Name_Id (Directory));
       Get_Name_String (File_Name);
       Result :=
         Locate_Regular_File

gcc/ada/sem_aggr.adb

@@ -997,6 +997,7 @@ package body Sem_Aggr is
                   Insert_Actions (N, Freeze_Entity (Typ, N));
                   exit;
                end if;
+
                Next (Comp);
             end loop;
          end;

gcc/ada/sem_attr.adb

@@ -3990,6 +3990,9 @@ package body Sem_Attr is
          --  source subprogram to which the postcondition applies. During
          --  pre-analysis, CS is the scope of the subprogram declaration.
 
+         Prag : Node_Id;
+         --  During pre-analysis, Prag is the enclosing pragma node if any
+
       begin
          --  Find enclosing scopes, excluding loops
 
@@ -4029,6 +4032,23 @@ package body Sem_Attr is
                Error_Attr;
             end if;
 
+            --  Check in postcondition of function
+
+            Prag := N;
+            while not Nkind_In (Prag, N_Pragma, N_Function_Specification,
+                                N_Subprogram_Body)
+            loop
+               Prag := Parent (Prag);
+            end loop;
+
+            if Nkind (Prag) /= N_Pragma
+              or else Get_Pragma_Id (Prag) /= Pragma_Postcondition
+            then
+               Error_Attr
+                 ("% attribute can only appear in postcondition of function",
+                  P);
+            end if;
+
             --  The attribute reference is a primary. If expressions follow,
             --  the attribute reference is really an indexable object, so
             --  rewrite and analyze as an indexed component.

gcc/ada/sem_ch13.adb

@@ -4228,10 +4228,10 @@ package body Sem_Ch13 is
                Arg1 := Get_Pragma_Arg (Arg1);
                Arg2 := Get_Pragma_Arg (Arg2);
 
-               --  See if this predicate pragma is for the current type
-               --  or for its full view. A predicate on a private completion
-               --  is placed on the partial view beause this is the visible
-               --  entity that is frozen..
+               --  See if this predicate pragma is for the current type or for
+               --  its full view. A predicate on a private completion is placed
+               --  on the partial view beause this is the visible entity that
+               --  is frozen.
 
                if Entity (Arg1) = Typ
                  or else Full_View (Entity (Arg1)) = Typ

gcc/ada/sem_type.adb

@@ -1208,7 +1208,7 @@ package body Sem_Type is
 
       function Operand_Type return Entity_Id;
       --  Determine type of operand for an equality operation, to apply
-      --  Ada2005 rules to equality on anonymous access types.
+      --  Ada 2005 rules to equality on anonymous access types.
 
       function Standard_Operator return Boolean;
       --  Check whether subprogram is predefined operator declared in Standard.
@@ -1287,14 +1287,15 @@ package body Sem_Type is
 
       function Operand_Type return Entity_Id is
          Opnd : Node_Id;
+
       begin
          if Nkind (N) = N_Function_Call then
             Opnd := First_Actual (N);
          else
             Opnd := Left_Opnd (N);
          end if;
-         return Etype (Opnd);
 
+         return Etype (Opnd);
       end Operand_Type;
 
       ------------------------
@@ -1927,14 +1928,14 @@ package body Sem_Type is
             --  may be an operator or a function call.
 
             elsif (Chars (Nam1) = Name_Op_Eq
-                  or else
-                Chars (Nam1) = Name_Op_Ne)
+                     or else
+                   Chars (Nam1) = Name_Op_Ne)
               and then Ada_Version >= Ada_2005
               and then Etype (User_Subp) = Standard_Boolean
               and then Ekind (Operand_Type) = E_Anonymous_Access_Type
               and then
                 In_Same_List (Parent (Designated_Type (Operand_Type)),
-                                    Unit_Declaration_Node (User_Subp))
+                              Unit_Declaration_Node (User_Subp))
             then
                if It2.Nam = Predef_Subp then
                   return It1;
@@ -2675,6 +2676,7 @@ package body Sem_Type is
             end if;
 
             Par := Etype (Full_View (BT2));
+
          else
             Par := Etype (BT2);
          end if;