]> git.ipfire.org Git - thirdparty/gcc.git/commitdiff
[multiple changes]
authorArnaud Charlet <charlet@gcc.gnu.org>
Mon, 30 Nov 2009 11:15:51 +0000 (12:15 +0100)
committerArnaud Charlet <charlet@gcc.gnu.org>
Mon, 30 Nov 2009 11:15:51 +0000 (12:15 +0100)
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

From-SVN: r154786

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 33f3219507c24a39e4dea65b04c3d3d053b35049..0ff789d5e1a6557d80cd01e716df0f1a8788b782 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 6a7ea4fdb1b314616eef9b404034a1946da6497c..dd74a155144929d69e0494525df6ece769854944 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 9301071b301c0569c80c4b9ff55f13df5889d2ca..e0810029314a046d9ad3e7794635460fd5a48e7b 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 0a197c011f4307ee8067bd879782f0defa15bfe4..b79b87a197e93b7bbade24aa5323ee8d73a7621e 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 3f8c540d1d5a677bf54252674330121191ee1bee..eb19250ac255f4923ae1b5c6383ed46b9b02ddc3 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 542b1f025513e04300cd514e2053d7ec0f6d4b98..16e2b109b3542394ef61485b45f0c1a12c85fb83 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 eb77f860b4fff07d21740903682efd62fb9c769f..67756900b293a6710007c7628c5451a4978184ff 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 b1639a77e3f28c444c4702d763ecefb449e468a6..64907fb3052c5820454f19965aed1078db39dc1c 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 99bdc6d8ea62a77acbd90241413f560e28833118..ed2f93124a0986c46f8db059682c257d74da5801 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 c1ed40b772019aa94375818fa366dbe6750d2d47..c8378292168e196ed3b228acbc6d1c3b840ddb5c 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 5c4003d30a30c3f0999352c78e03e85cdd08eda5..ea31697a4ed98d685536988d6081ba6bb05e4743 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 c5885e72a9ab32050aed3be096d186b155e4139d..517ed52c100e37d7754d9fa94e789179cf7b67a6 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 efb739f8f5085038952e0d1d3324d6e1ea0b87a9..e893eedb3993eff74e4de335bdcb0c92eb80af0c 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 4d56d36ee398f7f0d8cd69aff4220c774674470c..809665690dec7426c15fcdede4c92ca69d4e902f 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 05c7e4224524ba4219b8e7e10182548d808bc24c..8195cdbb5e27d9f9dc9801c9c01717592cfc10ba 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 e73d204d758633a34b001319d11e5d180b6259c0..7ad11e041e92ebc7eb4c00f0d109b2c23ce07f54 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