[multiple changes]
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
This commit is contained in:
parent
1c6b661582
commit
6a2afd139d
@ -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.
|
||||
|
@ -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;
|
||||
|
||||
|
@ -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)
|
||||
|
@ -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
|
||||
|
@ -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;
|
||||
|
@ -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.
|
||||
|
@ -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 |
|
||||
|
@ -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;
|
||||
|
@ -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;
|
||||
|
@ -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;
|
||||
|
@ -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;
|
||||
|
@ -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;
|
||||
|
@ -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;
|
||||
|
@ -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,
|
||||
|
@ -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,
|
||||
|
@ -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
|
||||
|
Loading…
x
Reference in New Issue
Block a user