2013-04-24 Sergey Rybin <rybin@adacore.com frybin>
authorcharlet <charlet@138bc75d-0d04-0410-961f-82ee72b054a4>
Wed, 24 Apr 2013 14:22:24 +0000 (14:22 +0000)
committercharlet <charlet@138bc75d-0d04-0410-961f-82ee72b054a4>
Wed, 24 Apr 2013 14:22:24 +0000 (14:22 +0000)
* gnat_ugn.texi: Add description of '--help' and '--version'
options for ASIS tools: gnatelim, gnatmetric, gnatstub, gnatpp.

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

* gnat_rm.texi: Minor syntax fix.

2013-04-24  Hristian Kirtchev  <kirtchev@adacore.com>

* exp_attr.adb (Expand_Loop_Entry_Attribute): Add extra comments on
what and why is being analyzed. Remove the decoration of renamings as
this simply falls out of the general analysis mechanism.

2013-04-24  Hristian Kirtchev  <kirtchev@adacore.com>

* sem_res.adb (Explain_Redundancy): New routine.
(Resolve_Equality_Op): Place the error concerning a redundant
comparison to True at the "=". Try to explain the nature of the
redundant True.

2013-04-24  Javier Miranda  <miranda@adacore.com>

* checks.adb, exp_ch6.adb (Install_Null_Excluding_Check): No
check in interface thunks since it is performed at the caller
side.
(Expand_Simple_Function_Return): No accessibility check
needed in thunks since the check is done by the target routine.

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

* xref_lib.adb (Add_Entity): Use the canonical file names
so that source file names with capital letters are found on
platforms where file names are case insensitive.

2013-04-24  Hristian Kirtchev  <kirtchev@adacore.com>

* par-ch4.adb (P_Name): Continue to parse the name extension when the
construct is attribute Loop_Entry. Do not convert the attribute
reference into an indexed component when there is at least one
expression / range following 'Loop_Entry.

2013-04-24  Hristian Kirtchev  <kirtchev@adacore.com>

* sem_ch6.adb (Contains_Enabled_Pragmas): New routine.
(Process_PPCs): Generate procedure _Postconditions
only when the context has invariants or predicates or enabled
aspects/pragmas.

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

gcc/ada/ChangeLog
gcc/ada/exp_attr.adb
gcc/ada/gnat_rm.texi
gcc/ada/gnat_ugn.texi
gcc/ada/par-ch4.adb
gcc/ada/sem_ch6.adb
gcc/ada/sem_res.adb
gcc/ada/xref_lib.adb

index 4b39d70..1efb8b9 100644 (file)
@@ -1,3 +1,54 @@
+2013-04-24  Sergey Rybin  <rybin@adacore.com frybin>
+
+       * gnat_ugn.texi: Add description of '--help' and '--version'
+       options for ASIS tools: gnatelim, gnatmetric, gnatstub, gnatpp.
+
+2013-04-24  Arnaud Charlet  <charlet@adacore.com>
+
+       * gnat_rm.texi: Minor syntax fix.
+
+2013-04-24  Hristian Kirtchev  <kirtchev@adacore.com>
+
+       * exp_attr.adb (Expand_Loop_Entry_Attribute): Add extra comments on
+       what and why is being analyzed. Remove the decoration of renamings as
+       this simply falls out of the general analysis mechanism.
+
+2013-04-24  Hristian Kirtchev  <kirtchev@adacore.com>
+
+       * sem_res.adb (Explain_Redundancy): New routine.
+       (Resolve_Equality_Op): Place the error concerning a redundant
+       comparison to True at the "=". Try to explain the nature of the
+       redundant True.
+
+2013-04-24  Javier Miranda  <miranda@adacore.com>
+
+
+       * checks.adb, exp_ch6.adb (Install_Null_Excluding_Check): No
+       check in interface thunks since it is performed at the caller
+       side.
+       (Expand_Simple_Function_Return): No accessibility check
+       needed in thunks since the check is done by the target routine.
+
+2013-04-24  Vincent Celier  <celier@adacore.com>
+
+       * xref_lib.adb (Add_Entity): Use the canonical file names
+       so that source file names with capital letters are found on
+       platforms where file names are case insensitive.
+
+2013-04-24  Hristian Kirtchev  <kirtchev@adacore.com>
+
+       * par-ch4.adb (P_Name): Continue to parse the name extension when the
+       construct is attribute Loop_Entry. Do not convert the attribute
+       reference into an indexed component when there is at least one
+       expression / range following 'Loop_Entry.
+
+2013-04-24  Hristian Kirtchev  <kirtchev@adacore.com>
+
+       * sem_ch6.adb (Contains_Enabled_Pragmas): New routine.
+       (Process_PPCs): Generate procedure _Postconditions
+       only when the context has invariants or predicates or enabled
+       aspects/pragmas.
+
 2013-04-24  Thomas Quinot  <quinot@adacore.com>
 
        * g-socket.adb (Host_Entry): Introduce intermediate copy of
index fc44324..c206218 100644 (file)
@@ -985,37 +985,32 @@ package body Exp_Attr is
 
       Rewrite (Attr, New_Reference_To (Temp_Id, Loc));
 
-      --  The analysis of the conditional block takes care of the constant
-      --  declaration.
-
       Installed := Current_Scope = Loop_Id;
 
+      --  Depending on the pracement of attribute 'Loop_Entry relative to the
+      --  associated loop, ensure the proper visibility for analysis.
+
       if not Installed then
          Push_Scope (Scope (Loop_Id));
       end if;
 
+      --  The analysis of the conditional block takes care of the constant
+      --  declaration.
+
       if Present (Result) then
          Rewrite (Loop_Stmt, Result);
          Analyze (Loop_Stmt);
+
+      --  The conditional block was analyzed when a previous 'Loop_Entry was
+      --  expanded. There is no point in reanalyzing the block, simply analyze
+      --  the declaration of the constant.
+
       else
          Analyze (Temp_Decl);
       end if;
 
       Analyze (Attr);
 
-      --  Patch up a renaming of a 'Loop_Entry attribute. This case may arise
-      --  when the attribute is used as the name in an Ada 2012 iterator loop.
-
-      if Nkind (Parent (Attr)) = N_Object_Renaming_Declaration then
-         declare
-            Mark : constant Node_Id := Subtype_Mark (Parent (Attr));
-
-         begin
-            Rewrite (Mark, New_Reference_To (Etype (Temp_Id), Sloc (Mark)));
-            Analyze (Mark);
-         end;
-      end if;
-
       if not Installed then
          Pop_Scope;
       end if;
index edad793..2d162ef 100644 (file)
@@ -5135,9 +5135,9 @@ compiles with the Rational APEX compiler, even when the code includes non-
 conforming Ada constructs.  The profile enables the following three pragmas:
 
 @itemize @bullet
-pragma Implicit_Packing;
-pragma Overriding_Renamings;
-pragma Use_VADS_Size;
+@item pragma Implicit_Packing
+@item pragma Overriding_Renamings
+@item pragma Use_VADS_Size
 @end itemize
 
 @noindent
index 31d8fd7..97aebf1 100644 (file)
@@ -10910,6 +10910,14 @@ Ada 2005 mode etc.
 
 @table @option
 @c !sort!
+@item --version
+@cindex @option{--version} @command{gnatelim}
+Display Copyright and version, then exit disregarding all other options.
+
+@item --help
+@cindex @option{--help} @command{gnatelim}
+Display usage, then exit disregarding all other options.
+
 @item ^-files^/FILES^=@var{filename}
 @cindex @option{^-files^/FILES^} (@code{gnatelim})
 Take the argument source files from the specified file. This file should be an
@@ -14207,6 +14215,14 @@ with @option{^-pipe^/STANDARD_OUTPUT^} option.
 The additional @command{gnatpp} switches are defined in this subsection.
 
 @table @option
+@item --version
+@cindex @option{--version} @command{gnatpp}
+Display Copyright and version, then exit disregarding all other options.
+
+@item --help
+@cindex @option{--help} @command{gnatpp}
+Display usage, then exit disregarding all other options.
+
 @item ^-files @var{filename}^/FILES=@var{filename}^
 @cindex @option{^-files^/FILES^} (@code{gnatpp})
 Take the argument source files from the specified file. This file should be an
@@ -15657,6 +15673,14 @@ Report control fan-in coupling
 Additional @command{gnatmetric} switches are as follows:
 
 @table @option
+@item --version
+@cindex @option{--version} @command{gnatmetric}
+Display Copyright and version, then exit disregarding all other options.
+
+@item --help
+@cindex @option{--help} @command{gnatmetric}
+Display usage, then exit disregarding all other options.
+
 @item ^-files @var{filename}^/FILES=@var{filename}^
 @cindex @option{^-files^/FILES^} (@code{gnatmetric})
 Take the argument source files from the specified file. This file should be an
@@ -18476,6 +18500,14 @@ is an optional sequence of switches as described in the next section
 @table @option
 @c !sort!
 
+@item --version
+@cindex @option{--version} @command{gnatstub}
+Display Copyright and version, then exit disregarding all other options.
+
+@item --help
+@cindex @option{--help} @command{gnatstub}
+Display usage, then exit disregarding all other options.
+
 @item ^-f^/FULL^
 @cindex @option{^-f^/FULL^} (@command{gnatstub})
 If the destination directory already contains a file with the name of the
index 8066b8c..f0cfa35 100644 (file)
@@ -509,16 +509,25 @@ package body Ch4 is
               and then not
                 Is_Parameterless_Attribute (Get_Attribute_Id (Attr_Name))
             then
-               Set_Expressions (Name_Node, New_List);
+               --  Attribute Loop_Entry has no effect on the name extension
+               --  parsing logic, as if the attribute never existed in the
+               --  source. Continue parsing the subsequent expressions or
+               --  ranges.
+
+               if Attr_Name = Name_Loop_Entry then
+                  Scan; -- past left paren
+                  goto Scan_Name_Extension_Left_Paren;
 
                --  Attribute Update contains an array or record association
                --  list which provides new values for various components or
                --  elements. The list is parsed as an aggregate.
 
-               if Attr_Name = Name_Update then
+               elsif Attr_Name = Name_Update then
+                  Set_Expressions (Name_Node, New_List);
                   Append (P_Aggregate, Expressions (Name_Node));
 
                else
+                  Set_Expressions (Name_Node, New_List);
                   Scan; -- past left paren
 
                   loop
@@ -695,10 +704,20 @@ package body Ch4 is
 
          elsif not Comma_Present then
             T_Right_Paren;
-            Prefix_Node := Name_Node;
-            Name_Node := New_Node (N_Indexed_Component, Sloc (Prefix_Node));
-            Set_Prefix (Name_Node, Prefix_Node);
-            Set_Expressions (Name_Node, Arg_List);
+
+            --  Do not convert Prefix'Loop_Entry (Expr1, ..., ExprN) into an
+            --  indexed component now. Let the analysis determine whether the
+            --  attribute is legal and perform the transformation if needed.
+
+            if Attr_Name = Name_Loop_Entry then
+               Set_Expressions (Name_Node, Arg_List);
+            else
+               Prefix_Node := Name_Node;
+               Name_Node := New_Node (N_Indexed_Component, Sloc (Prefix_Node));
+               Set_Prefix (Name_Node, Prefix_Node);
+               Set_Expressions (Name_Node, Arg_List);
+            end if;
+
             goto Scan_Name_Extension;
          end if;
 
index ce865bb..1d8ac8f 100644 (file)
@@ -11196,6 +11196,10 @@ package body Sem_Ch6 is
       --  under the same visibility conditions as for other invariant checks,
       --  the type invariant must be applied to the returned value.
 
+      function Contains_Enabled_Pragmas (L : List_Id) return Boolean;
+      --  Determine whether list L has at least one enabled pragma. The routine
+      --  ignores nother non-pragma elements.
+
       procedure Expand_Contract_Cases (CCs : Node_Id; Subp_Id : Entity_Id);
       --  Given pragma Contract_Cases CCs, create the circuitry needed to
       --  evaluate case guards and trigger consequence expressions. Subp_Id
@@ -11263,6 +11267,26 @@ package body Sem_Ch6 is
          end if;
       end Check_Access_Invariants;
 
+      ------------------------------
+      -- Contains_Enabled_Pragmas --
+      ------------------------------
+
+      function Contains_Enabled_Pragmas (L : List_Id) return Boolean is
+         Prag : Node_Id;
+
+      begin
+         Prag := First (L);
+         while Present (Prag) loop
+            if Nkind (Prag) = N_Pragma and then Is_Ignored (Prag) then
+               return False;
+            end if;
+
+            Next (Prag);
+         end loop;
+
+         return True;
+      end Contains_Enabled_Pragmas;
+
       ---------------------------
       -- Expand_Contract_Cases --
       ---------------------------
@@ -12252,8 +12276,11 @@ package body Sem_Ch6 is
       --  If we had any postconditions and expansion is enabled, or if the
       --  subprogram has invariants, then build the _Postconditions procedure.
 
-      if (Present (Plist) or else Invariants_Or_Predicates_Present)
-        and then Expander_Active
+      if Expander_Active
+        and then
+          (Invariants_Or_Predicates_Present
+             or else
+               (Present (Plist) and then Contains_Enabled_Pragmas (Plist)))
       then
          if No (Plist) then
             Plist := Empty_List;
index 6674d1f..b4a654a 100644 (file)
@@ -6821,6 +6821,11 @@ package body Sem_Res is
       --  impose an expected type (as can be the case in an equality operation)
       --  the expression must be rejected.
 
+      procedure Explain_Redundancy (N : Node_Id);
+      --  Attempt to explain the nature of a redundant comparison with True. If
+      --  the expression N is too complex, this routine issues a general error
+      --  message.
+
       function Find_Unique_Access_Type return Entity_Id;
       --  In the case of allocators and access attributes, the context must
       --  provide an indication of the specific access type to be used. If
@@ -6850,6 +6855,72 @@ package body Sem_Res is
          end if;
       end Check_If_Expression;
 
+      ------------------------
+      -- Explain_Redundancy --
+      ------------------------
+
+      procedure Explain_Redundancy (N : Node_Id) is
+         Error  : Name_Id;
+         Val    : Node_Id;
+         Val_Id : Entity_Id;
+
+      begin
+         Val := N;
+
+         --  Strip the operand down to an entity
+
+         loop
+            if Nkind (Val) = N_Selected_Component then
+               Val := Selector_Name (Val);
+            else
+               exit;
+            end if;
+         end loop;
+
+         --  The construct denotes an entity
+
+         if Is_Entity_Name (Val) and then Present (Entity (Val)) then
+            Val_Id := Entity (Val);
+
+            --  Do not generate an error message when the comparison is done
+            --  against the enumeration literal Standard.True.
+
+            if Ekind (Val_Id) /= E_Enumeration_Literal then
+
+               --  Build a customized error message
+
+               Name_Len := 0;
+               Add_Str_To_Name_Buffer ("?r?");
+
+               if Ekind (Val_Id) = E_Component then
+                  Add_Str_To_Name_Buffer ("component ");
+
+               elsif Ekind (Val_Id) = E_Constant then
+                  Add_Str_To_Name_Buffer ("constant ");
+
+               elsif Ekind (Val_Id) = E_Discriminant then
+                  Add_Str_To_Name_Buffer ("discriminant ");
+
+               elsif Is_Formal (Val_Id) then
+                  Add_Str_To_Name_Buffer ("parameter ");
+
+               elsif Ekind (Val_Id) = E_Variable then
+                  Add_Str_To_Name_Buffer ("variable ");
+               end if;
+
+               Add_Str_To_Name_Buffer ("& is always True!");
+               Error := Name_Find;
+
+               Error_Msg_NE (Get_Name_String (Error), Val, Val_Id);
+            end if;
+
+         --  The construct is too complex to disect, issue a general message
+
+         else
+            Error_Msg_N ("?r?expression is always True!", Val);
+         end if;
+      end Explain_Redundancy;
+
       -----------------------------
       -- Find_Unique_Access_Type --
       -----------------------------
@@ -6979,12 +7050,13 @@ package body Sem_Res is
 
          if Warn_On_Redundant_Constructs
            and then Comes_From_Source (N)
+           and then Comes_From_Source (R)
            and then Is_Entity_Name (R)
            and then Entity (R) = Standard_True
-           and then Comes_From_Source (R)
          then
             Error_Msg_N -- CODEFIX
-              ("?r?comparison with True is redundant!", R);
+              ("?r?comparison with True is redundant!", N);
+            Explain_Redundancy (Original_Node (R));
          end if;
 
          Check_Unset_Reference (L);
index 56a28ef..db83c94 100644 (file)
@@ -6,7 +6,7 @@
 --                                                                          --
 --                                 B o d y                                  --
 --                                                                          --
---          Copyright (C) 1998-2012, Free Software Foundation, Inc.         --
+--          Copyright (C) 1998-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- --
@@ -272,18 +272,21 @@ package body Xref_Lib is
          end if;
       end if;
 
-      File_Ref :=
-        Add_To_Xref_File
-          (Entity (File_Start .. Line_Start - 1), Visited => True);
-      Pattern.File_Ref := File_Ref;
+      declare
+         File_Name : String := Entity (File_Start .. Line_Start - 1);
+      begin
+         Osint.Canonical_Case_File_Name (File_Name);
+         File_Ref := Add_To_Xref_File (File_Name, Visited => True);
+         Pattern.File_Ref := File_Ref;
 
-      Add_Line (Pattern.File_Ref, Line_Num, Col_Num);
+         Add_Line (Pattern.File_Ref, Line_Num, Col_Num);
 
-      File_Ref :=
-        Add_To_Xref_File
-          (ALI_File_Name (Entity (File_Start .. Line_Start - 1)),
-           Visited      => False,
-           Emit_Warning => True);
+         File_Ref :=
+           Add_To_Xref_File
+             (ALI_File_Name (File_Name),
+              Visited      => False,
+              Emit_Warning => True);
+      end;
    end Add_Entity;
 
    -------------------