2009-11-30 Robert Dewar <dewar@adacore.com>
authorcharlet <charlet@138bc75d-0d04-0410-961f-82ee72b054a4>
Mon, 30 Nov 2009 11:15:51 +0000 (11:15 +0000)
committercharlet <charlet@138bc75d-0d04-0410-961f-82ee72b054a4>
Mon, 30 Nov 2009 11:15:51 +0000 (11:15 +0000)
* gnat_rm.texi: Add documentation for attribute Result.

2009-11-30  Arnaud Charlet  <charlet@adacore.com>

* s-osinte-hpux.ads, s-osinte-aix.ads, s-osinte-solaris-posix.ads,
s-osinte-tru64.ads, s-osinte-darwin.ads, s-osinte-freebsd.ads
(Get_Page_Size): Update comment since Get_Page_Size is now required.

2009-11-30  Jerome Lambourg  <lambourg@adacore.com>

* freeze.adb: Disable Warning on VM targets concerning C Imports, not
relevant.

2009-11-30  Bob Duff  <duff@adacore.com>

* sprint.adb (Source_Dump): Minor comment fix.
(Write_Itype): When writing a string literal subtype, use Expr_Value
instead of Intval to get the low bound.

2009-11-30  Vincent Celier  <celier@adacore.com>

* gnatlink.adb (Process_Args): Do not call Executable_Name on arguments
of switch -o.

2009-11-30  Robert Dewar  <dewar@adacore.com>

* exp_ch4.adb (Expand_N_Op_And): Implement pragma Short_Circuit_And_Or
(Expand_N_Op_Or): Implement pragma Short_Circuit_And_Or
* opt.ads (Short_Circuit_And_Or): New flag
* par-prag.adb: Add dummy entry for pragma Short_Circuit_And_Or
* sem_prag.adb: Implement pragma Short_Circuit_And_Or
* snames.ads-tmpl: Add entries for pragma Short_Circuit_And_Or

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

16 files changed:
gcc/ada/ChangeLog
gcc/ada/exp_ch4.adb
gcc/ada/freeze.adb
gcc/ada/gnat_rm.texi
gcc/ada/gnatlink.adb
gcc/ada/opt.ads
gcc/ada/par-prag.adb
gcc/ada/s-osinte-aix.ads
gcc/ada/s-osinte-darwin.ads
gcc/ada/s-osinte-freebsd.ads
gcc/ada/s-osinte-hpux.ads
gcc/ada/s-osinte-solaris-posix.ads
gcc/ada/s-osinte-tru64.ads
gcc/ada/sem_prag.adb
gcc/ada/snames.ads-tmpl
gcc/ada/sprint.adb

index 33f3219..0ff789d 100644 (file)
@@ -1,3 +1,38 @@
+2009-11-30  Robert Dewar  <dewar@adacore.com>
+
+       * gnat_rm.texi: Add documentation for attribute Result.
+
+2009-11-30  Arnaud Charlet  <charlet@adacore.com>
+
+       * s-osinte-hpux.ads, s-osinte-aix.ads, s-osinte-solaris-posix.ads,
+       s-osinte-tru64.ads, s-osinte-darwin.ads, s-osinte-freebsd.ads
+       (Get_Page_Size): Update comment since Get_Page_Size is now required.
+
+2009-11-30  Jerome Lambourg  <lambourg@adacore.com>
+
+       * freeze.adb: Disable Warning on VM targets concerning C Imports, not
+       relevant.
+
+2009-11-30  Bob Duff  <duff@adacore.com>
+
+       * sprint.adb (Source_Dump): Minor comment fix.
+       (Write_Itype): When writing a string literal subtype, use Expr_Value
+       instead of Intval to get the low bound.
+
+2009-11-30  Vincent Celier  <celier@adacore.com>
+
+       * gnatlink.adb (Process_Args): Do not call Executable_Name on arguments
+       of switch -o.
+
+2009-11-30  Robert Dewar  <dewar@adacore.com>
+
+       * exp_ch4.adb (Expand_N_Op_And): Implement pragma Short_Circuit_And_Or
+       (Expand_N_Op_Or): Implement pragma Short_Circuit_And_Or
+       * opt.ads (Short_Circuit_And_Or): New flag
+       * par-prag.adb: Add dummy entry for pragma Short_Circuit_And_Or
+       * sem_prag.adb: Implement pragma Short_Circuit_And_Or
+       * snames.ads-tmpl: Add entries for pragma Short_Circuit_And_Or
+
 2009-11-30  Arnaud Charlet  <charlet@adacore.com>
 
        * s-taprop-posix.adb: Fix casing.
index 6a7ea4f..dd74a15 100644 (file)
@@ -5025,10 +5025,26 @@ package body Exp_Ch4 is
          Expand_Boolean_Operator (N);
 
       elsif Is_Boolean_Type (Etype (N)) then
-         Adjust_Condition (Left_Opnd (N));
-         Adjust_Condition (Right_Opnd (N));
-         Set_Etype (N, Standard_Boolean);
-         Adjust_Result_Type (N, Typ);
+
+         --  Replace AND by AND THEN if Short_Circuit_And_Or active and the
+         --  type is standard Boolean (do not mess with AND that uses a non-
+         --  standard Boolean type, because something strange is going on).
+
+         if Short_Circuit_And_Or and then Typ = Standard_Boolean then
+            Rewrite (N,
+              Make_And_Then (Sloc (N),
+                Left_Opnd  => Relocate_Node (Left_Opnd (N)),
+                Right_Opnd => Relocate_Node (Right_Opnd (N))));
+            Analyze_And_Resolve (N, Typ);
+
+         --  Otherwise, adjust conditions
+
+         else
+            Adjust_Condition (Left_Opnd (N));
+            Adjust_Condition (Right_Opnd (N));
+            Set_Etype (N, Standard_Boolean);
+            Adjust_Result_Type (N, Typ);
+         end if;
       end if;
    end Expand_N_Op_And;
 
@@ -6913,10 +6929,26 @@ package body Exp_Ch4 is
          Expand_Boolean_Operator (N);
 
       elsif Is_Boolean_Type (Etype (N)) then
-         Adjust_Condition (Left_Opnd (N));
-         Adjust_Condition (Right_Opnd (N));
-         Set_Etype (N, Standard_Boolean);
-         Adjust_Result_Type (N, Typ);
+
+         --  Replace OR by OR ELSE if Short_Circuit_And_Or active and the
+         --  type is standard Boolean (do not mess with AND that uses a non-
+         --  standard Boolean type, because something strange is going on).
+
+         if Short_Circuit_And_Or and then Typ = Standard_Boolean then
+            Rewrite (N,
+              Make_Or_Else (Sloc (N),
+                Left_Opnd  => Relocate_Node (Left_Opnd (N)),
+                Right_Opnd => Relocate_Node (Right_Opnd (N))));
+            Analyze_And_Resolve (N, Typ);
+
+         --  Otherwise, adjust conditions
+
+         else
+            Adjust_Condition (Left_Opnd (N));
+            Adjust_Condition (Right_Opnd (N));
+            Set_Etype (N, Standard_Boolean);
+            Adjust_Result_Type (N, Typ);
+         end if;
       end if;
    end Expand_N_Op_Or;
 
index 9301071..e081002 100644 (file)
@@ -2554,6 +2554,7 @@ package body Freeze is
                           and then Convention (F_Type) = Convention_Ada
                           and then not Has_Warnings_Off (F_Type)
                           and then not Has_Size_Clause (F_Type)
+                          and then VM_Target = No_VM
                         then
                            Error_Msg_N
                              ("& is an 8-bit Ada Boolean?", Formal);
@@ -2682,6 +2683,7 @@ package body Freeze is
 
                         elsif Root_Type (R_Type) = Standard_Boolean
                           and then Convention (R_Type) = Convention_Ada
+                          and then VM_Target = No_VM
                           and then not Has_Warnings_Off (E)
                           and then not Has_Warnings_Off (R_Type)
                           and then not Has_Size_Clause (R_Type)
index 0a197c0..b79b87a 100644 (file)
@@ -253,6 +253,7 @@ Implementation Defined Attributes
 * Passed_By_Reference::
 * Pool_Address::
 * Range_Length::
+* Result::
 * Safe_Emax::
 * Safe_Large::
 * Small::
@@ -5423,6 +5424,7 @@ consideration, you should minimize the use of these attributes.
 * Passed_By_Reference::
 * Pool_Address::
 * Range_Length::
+* Result::
 * Safe_Emax::
 * Safe_Large::
 * Small::
@@ -6074,6 +6076,16 @@ range).  The result is static for static subtypes.  @code{Range_Length}
 applied to the index subtype of a one dimensional array always gives the
 same result as @code{Range} applied to the array itself.
 
+@node Result
+@unnumberedsec Result
+@findex Result
+@noindent
+@code{@var{function}'Result} can only be used with in a Postcondition pragma
+for a function. The prefix must be the name of the corresponding function. This
+is used to refer to the result of the function in the postcondition expression.
+For a further discussion of the use of this attribute and examples of its use,
+see the description of pragma Postcondition.
+
 @node Safe_Emax
 @unnumberedsec Safe_Emax
 @cindex Ada 83 attributes
index 3f8c540..eb19250 100644 (file)
@@ -445,8 +445,7 @@ procedure Gnatlink is
                            Exit_With_Error ("Missing argument for -o");
                         end if;
 
-                        Output_File_Name :=
-                          new String'(Executable_Name (Argument (Next_Arg)));
+                        Output_File_Name := new String'(Argument (Next_Arg));
 
                      when 'R' =>
                         Opt.Run_Path_Option := False;
index 542b1f0..16e2b10 100644 (file)
@@ -1042,6 +1042,10 @@ package Opt is
    --  for GNATBIND and to False when using the -static option. The value of
    --  this flag is set by Gnatbind.Scan_Bind_Arg.
 
+   Short_Circuit_And_Or : Boolean := False;
+   --  GNAT
+   --  Set True if a pragma Short_Circuit_And_Or applies to the current unit.
+
    Sprint_Line_Limit : Nat := 72;
    --  Limit values for chopping long lines in Sprint output, can be reset
    --  by use of NNN parameter with -gnatG or -gnatD switches.
index eb77f86..6775690 100644 (file)
@@ -1171,6 +1171,7 @@ begin
            Pragma_Share_Generic                 |
            Pragma_Shared                        |
            Pragma_Shared_Passive                |
+           Pragma_Short_Circuit_And_Or          |
            Pragma_Storage_Size                  |
            Pragma_Storage_Unit                  |
            Pragma_Static_Elaboration_Desired    |
index b1639a7..64907fb 100644 (file)
@@ -7,7 +7,7 @@
 --                                  S p e c                                 --
 --                                                                          --
 --             Copyright (C) 1991-1994, Florida State University            --
---          Copyright (C) 1995-2008, Free Software Foundation, Inc.         --
+--          Copyright (C) 1995-2009, Free Software Foundation, Inc.         --
 --                                                                          --
 -- GNARL 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- --
@@ -310,7 +310,7 @@ package System.OS_Interface is
    function Get_Page_Size return size_t;
    function Get_Page_Size return Address;
    pragma Import (C, Get_Page_Size, "getpagesize");
-   --  Returns the size of a page, or 0 if this is not relevant on this target
+   --  Returns the size of a page
 
    PROT_NONE  : constant := 0;
    PROT_READ  : constant := 1;
index 99bdc6d..ed2f931 100644 (file)
@@ -294,7 +294,7 @@ package System.OS_Interface is
    function Get_Page_Size return size_t;
    function Get_Page_Size return System.Address;
    pragma Import (C, Get_Page_Size, "getpagesize");
-   --  Returns the size of a page, or 0 if this is not relevant on this target
+   --  Returns the size of a page
 
    PROT_NONE  : constant := 0;
    PROT_READ  : constant := 1;
index c1ed40b..c837829 100644 (file)
@@ -7,7 +7,7 @@
 --                                   S p e c                                --
 --                                                                          --
 --             Copyright (C) 1991-1994, Florida State University            --
---          Copyright (C) 1995-2008, Free Software Foundation, Inc.         --
+--          Copyright (C) 1995-2009, Free Software Foundation, Inc.         --
 --                                                                          --
 -- GNARL 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- --
@@ -326,7 +326,7 @@ package System.OS_Interface is
    function Get_Page_Size return size_t;
    function Get_Page_Size return Address;
    pragma Import (C, Get_Page_Size, "getpagesize");
-   --  returns the size of a page, or 0 if this is not relevant on this target
+   --  Returns the size of a page
 
    PROT_NONE  : constant := 0;
    PROT_READ  : constant := 1;
index 5c4003d..ea31697 100644 (file)
@@ -7,7 +7,7 @@
 --                                  S p e c                                 --
 --                                                                          --
 --               Copyright (C) 1991-1994, Florida State University          --
---            Copyright (C) 1995-2008, Free Software Foundation, Inc.       --
+--            Copyright (C) 1995-2009, Free Software Foundation, Inc.       --
 --                                                                          --
 -- GNARL 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- --
@@ -300,7 +300,7 @@ package System.OS_Interface is
    function Get_Page_Size return size_t;
    function Get_Page_Size return Address;
    pragma Import (C, Get_Page_Size, "getpagesize");
-   --  Returns the size of a page, or 0 if this is not relevant on this target
+   --  Returns the size of a page
 
    PROT_NONE  : constant := 0;
    PROT_READ  : constant := 1;
index c5885e7..517ed52 100644 (file)
@@ -7,7 +7,7 @@
 --                                  S p e c                                 --
 --                                                                          --
 --             Copyright (C) 1991-1994, Florida State University            --
---          Copyright (C) 1995-2008, Free Software Foundation, Inc.         --
+--          Copyright (C) 1995-2009, Free Software Foundation, Inc.         --
 --                                                                          --
 -- GNARL 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- --
@@ -294,7 +294,7 @@ package System.OS_Interface is
    function Get_Page_Size return size_t;
    function Get_Page_Size return Address;
    pragma Import (C, Get_Page_Size, "getpagesize");
-   --  Returns the size of a page, or 0 if this is not relevant on this target
+   --  Returns the size of a page
 
    PROT_NONE  : constant := 0;
    PROT_READ  : constant := 1;
index efb739f..e893eed 100644 (file)
@@ -7,7 +7,7 @@
 --                                  S p e c                                 --
 --                                                                          --
 --             Copyright (C) 1991-1994, Florida State University            --
---          Copyright (C) 1995-2008, Free Software Foundation, Inc.         --
+--          Copyright (C) 1995-2009, Free Software Foundation, Inc.         --
 --                                                                          --
 -- GNARL 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- --
@@ -286,7 +286,7 @@ package System.OS_Interface is
    function Get_Page_Size return size_t;
    function Get_Page_Size return Address;
    pragma Import (C, Get_Page_Size, "getpagesize");
-   --  Returns the size of a page, or 0 if this is not relevant on this target
+   --  Returns the size of a page
 
    PROT_NONE  : constant := 0;
    PROT_READ  : constant := 1;
index 4d56d36..8096656 100644 (file)
@@ -10658,8 +10658,24 @@ package body Sem_Prag is
          when Pragma_Reviewable =>
             Check_Ada_83_Warning;
             Check_Arg_Count (0);
+
+            --  Call dummy debugging function rv. This is done to assist front
+            --  end debugging. By placing a Reviewable pragma in the source
+            --  program, a breakpoint on rv catches this place in the source,
+            --  allowing convenient stepping to the point of interest.
+
             rv;
 
+         --------------------------
+         -- Short_Circuit_And_Or --
+         --------------------------
+
+         when Pragma_Short_Circuit_And_Or =>
+            GNAT_Pragma;
+            Check_Arg_Count (0);
+            Check_Valid_Configuration_Pragma;
+            Short_Circuit_And_Or := True;
+
          -------------------
          -- Share_Generic --
          -------------------
@@ -12522,6 +12538,7 @@ package body Sem_Prag is
       Pragma_Restriction_Warnings          => -1,
       Pragma_Restrictions                  => -1,
       Pragma_Reviewable                    => -1,
+      Pragma_Short_Circuit_And_Or          => -1,
       Pragma_Share_Generic                 => -1,
       Pragma_Shared                        => -1,
       Pragma_Shared_Passive                => -1,
index 05c7e42..8195cdb 100644 (file)
@@ -383,6 +383,7 @@ package Snames is
    Name_Restrictions                   : constant Name_Id := N + $;
    Name_Restriction_Warnings           : constant Name_Id := N + $; -- GNAT
    Name_Reviewable                     : constant Name_Id := N + $;
+   Name_Short_Circuit_And_Or           : constant Name_Id := N + $; -- GNAT
    Name_Source_File_Name               : constant Name_Id := N + $; -- GNAT
    Name_Source_File_Name_Project       : constant Name_Id := N + $; -- GNAT
    Name_Style_Checks                   : constant Name_Id := N + $; -- GNAT
@@ -1454,6 +1455,7 @@ package Snames is
       Pragma_Restrictions,
       Pragma_Restriction_Warnings,
       Pragma_Reviewable,
+      Pragma_Short_Circuit_And_Or,
       Pragma_Source_File_Name,
       Pragma_Source_File_Name_Project,
       Pragma_Style_Checks,
index e73d204..7ad11e0 100644 (file)
@@ -35,6 +35,7 @@ with Nlists;   use Nlists;
 with Opt;      use Opt;
 with Output;   use Output;
 with Rtsfind;  use Rtsfind;
+with Sem_Eval; use Sem_Eval;
 with Sem_Util; use Sem_Util;
 with Sinfo;    use Sinfo;
 with Sinput;   use Sinput;
@@ -526,7 +527,7 @@ package body Sprint is
          Write_Eol;
       end Underline;
 
-   --  Start of processing for Tree_Dump
+   --  Start of processing for Source_Dump
 
    begin
       Dump_Generated_Only := Debug_Flag_G or
@@ -3961,7 +3962,7 @@ package body Sprint is
                   when E_String_Literal_Subtype =>
                      declare
                         LB  : constant Uint :=
-                                Intval (String_Literal_Low_Bound (Typ));
+                                Expr_Value (String_Literal_Low_Bound (Typ));
                         Len : constant Uint :=
                                 String_Literal_Length (Typ);
                      begin