summaryrefslogtreecommitdiff
diff options
context:
space:
mode:
authorcharlet <charlet@138bc75d-0d04-0410-961f-82ee72b054a4>2009-11-30 11:15:51 +0000
committercharlet <charlet@138bc75d-0d04-0410-961f-82ee72b054a4>2009-11-30 11:15:51 +0000
commitb2603bc099601ce4cb49e46ddfcd560795cf7f43 (patch)
tree8e96d9ba09117e739624fe6b6c89ef394cce59e4
parent275d1ad1060c226d1682510879fd3b9b30ef7369 (diff)
downloadgcc-b2603bc099601ce4cb49e46ddfcd560795cf7f43.tar.gz
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 git-svn-id: svn+ssh://gcc.gnu.org/svn/gcc/trunk@154786 138bc75d-0d04-0410-961f-82ee72b054a4
Diffstat
-rw-r--r--gcc/ada/ChangeLog35
-rw-r--r--gcc/ada/exp_ch4.adb48
-rw-r--r--gcc/ada/freeze.adb2
-rw-r--r--gcc/ada/gnat_rm.texi12
-rw-r--r--gcc/ada/gnatlink.adb3
-rw-r--r--gcc/ada/opt.ads4
-rw-r--r--gcc/ada/par-prag.adb1
-rw-r--r--gcc/ada/s-osinte-aix.ads4
-rw-r--r--gcc/ada/s-osinte-darwin.ads2
-rw-r--r--gcc/ada/s-osinte-freebsd.ads4
-rw-r--r--gcc/ada/s-osinte-hpux.ads4
-rw-r--r--gcc/ada/s-osinte-solaris-posix.ads4
-rw-r--r--gcc/ada/s-osinte-tru64.ads4
-rw-r--r--gcc/ada/sem_prag.adb17
-rw-r--r--gcc/ada/snames.ads-tmpl2
-rw-r--r--gcc/ada/sprint.adb5
16 files changed, 128 insertions, 23 deletions
diff --git a/gcc/ada/ChangeLog b/gcc/ada/ChangeLog
index 33f3219507c..0ff789d5e1a 100644
--- a/gcc/ada/ChangeLog
+++ b/gcc/ada/ChangeLog
@@ -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.
diff --git a/gcc/ada/exp_ch4.adb b/gcc/ada/exp_ch4.adb
index 6a7ea4fdb1b..dd74a155144 100644
--- a/gcc/ada/exp_ch4.adb
+++ b/gcc/ada/exp_ch4.adb
@@ -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;
diff --git a/gcc/ada/freeze.adb b/gcc/ada/freeze.adb
index 9301071b301..e0810029314 100644
--- a/gcc/ada/freeze.adb
+++ b/gcc/ada/freeze.adb
@@ -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)
diff --git a/gcc/ada/gnat_rm.texi b/gcc/ada/gnat_rm.texi
index 0a197c011f4..b79b87a197e 100644
--- a/gcc/ada/gnat_rm.texi
+++ b/gcc/ada/gnat_rm.texi
@@ -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
diff --git a/gcc/ada/gnatlink.adb b/gcc/ada/gnatlink.adb
index 3f8c540d1d5..eb19250ac25 100644
--- a/gcc/ada/gnatlink.adb
+++ b/gcc/ada/gnatlink.adb
@@ -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;
diff --git a/gcc/ada/opt.ads b/gcc/ada/opt.ads
index 542b1f02551..16e2b109b35 100644
--- a/gcc/ada/opt.ads
+++ b/gcc/ada/opt.ads
@@ -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.
diff --git a/gcc/ada/par-prag.adb b/gcc/ada/par-prag.adb
index eb77f860b4f..67756900b29 100644
--- a/gcc/ada/par-prag.adb
+++ b/gcc/ada/par-prag.adb
@@ -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 |
diff --git a/gcc/ada/s-osinte-aix.ads b/gcc/ada/s-osinte-aix.ads
index b1639a77e3f..64907fb3052 100644
--- a/gcc/ada/s-osinte-aix.ads
+++ b/gcc/ada/s-osinte-aix.ads
@@ -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;
diff --git a/gcc/ada/s-osinte-darwin.ads b/gcc/ada/s-osinte-darwin.ads
index 99bdc6d8ea6..ed2f93124a0 100644
--- a/gcc/ada/s-osinte-darwin.ads
+++ b/gcc/ada/s-osinte-darwin.ads
@@ -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;
diff --git a/gcc/ada/s-osinte-freebsd.ads b/gcc/ada/s-osinte-freebsd.ads
index c1ed40b7720..c8378292168 100644
--- a/gcc/ada/s-osinte-freebsd.ads
+++ b/gcc/ada/s-osinte-freebsd.ads
@@ -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;
diff --git a/gcc/ada/s-osinte-hpux.ads b/gcc/ada/s-osinte-hpux.ads
index 5c4003d30a3..ea31697a4ed 100644
--- a/gcc/ada/s-osinte-hpux.ads
+++ b/gcc/ada/s-osinte-hpux.ads
@@ -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;
diff --git a/gcc/ada/s-osinte-solaris-posix.ads b/gcc/ada/s-osinte-solaris-posix.ads
index c5885e72a9a..517ed52c100 100644
--- a/gcc/ada/s-osinte-solaris-posix.ads
+++ b/gcc/ada/s-osinte-solaris-posix.ads
@@ -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;
diff --git a/gcc/ada/s-osinte-tru64.ads b/gcc/ada/s-osinte-tru64.ads
index efb739f8f50..e893eedb399 100644
--- a/gcc/ada/s-osinte-tru64.ads
+++ b/gcc/ada/s-osinte-tru64.ads
@@ -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;
diff --git a/gcc/ada/sem_prag.adb b/gcc/ada/sem_prag.adb
index 4d56d36ee39..809665690de 100644
--- a/gcc/ada/sem_prag.adb
+++ b/gcc/ada/sem_prag.adb
@@ -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,
diff --git a/gcc/ada/snames.ads-tmpl b/gcc/ada/snames.ads-tmpl
index 05c7e422452..8195cdbb5e2 100644
--- a/gcc/ada/snames.ads-tmpl
+++ b/gcc/ada/snames.ads-tmpl
@@ -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,
diff --git a/gcc/ada/sprint.adb b/gcc/ada/sprint.adb
index e73d204d758..7ad11e041e9 100644
--- a/gcc/ada/sprint.adb
+++ b/gcc/ada/sprint.adb
@@ -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
View Lorry Controller Status