From 6a2afd139d8a7719f2ce49028f23a781a25d9093 Mon Sep 17 00:00:00 2001 From: Arnaud Charlet Date: Mon, 30 Nov 2009 12:15:51 +0100 Subject: [PATCH] [multiple changes] 2009-11-30 Robert Dewar * gnat_rm.texi: Add documentation for attribute Result. 2009-11-30 Arnaud Charlet * 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 * freeze.adb: Disable Warning on VM targets concerning C Imports, not relevant. 2009-11-30 Bob Duff * 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 * gnatlink.adb (Process_Args): Do not call Executable_Name on arguments of switch -o. 2009-11-30 Robert Dewar * 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 --- gcc/ada/ChangeLog | 35 ++++++++++++++++++++++ gcc/ada/exp_ch4.adb | 48 +++++++++++++++++++++++++----- gcc/ada/freeze.adb | 2 ++ gcc/ada/gnat_rm.texi | 12 ++++++++ gcc/ada/gnatlink.adb | 3 +- gcc/ada/opt.ads | 4 +++ gcc/ada/par-prag.adb | 1 + gcc/ada/s-osinte-aix.ads | 4 +-- gcc/ada/s-osinte-darwin.ads | 2 +- gcc/ada/s-osinte-freebsd.ads | 4 +-- gcc/ada/s-osinte-hpux.ads | 4 +-- gcc/ada/s-osinte-solaris-posix.ads | 4 +-- gcc/ada/s-osinte-tru64.ads | 4 +-- gcc/ada/sem_prag.adb | 17 +++++++++++ gcc/ada/snames.ads-tmpl | 2 ++ gcc/ada/sprint.adb | 5 ++-- 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 + + * gnat_rm.texi: Add documentation for attribute Result. + +2009-11-30 Arnaud Charlet + + * 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 + + * freeze.adb: Disable Warning on VM targets concerning C Imports, not + relevant. + +2009-11-30 Bob Duff + + * 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 + + * gnatlink.adb (Process_Args): Do not call Executable_Name on arguments + of switch -o. + +2009-11-30 Robert Dewar + + * 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 * 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