Skip to content

R
riscv-gcc-1
Commit f02b8bb8 by Robert Dewar Committed by Arnaud Charlet
Options

re PR ada/18434 (Ada: cannot build gnattools on Tru64 UNIX V5.1B) 

2005-11-14  Robert Dewar  <dewar@adacore.com>
	    Ed Schonberg  <schonberg@adacore.com>

	PR ada/18434

	* types.ads: Include All_Checks in Suppress_Array

	* checks.adb (Check_Needed): Remove kludge for a/=b rewritten as
	not(a=b), since we no longer do this rewriting, and hence it is not
	needed.
	(Elaboration_Checks_Suppressed): Add special casing to
	deal with different cases of static and dynamic elaboration checks (all
	checks does not count in the first case, but does in the second).
	(Expr_Known_Valid): Do not assume that the result of any arbitrary
	function call is valid, since this is not the case.
	(Ensure_Valid): Do not apply validity check to a real literal
	in a universal or fixed context

	* exp_ch4.adb (Expand_N_Op_Ne): Don't expand a/=b to not(a=b) for
	elementary types using the operator in standard. It is cleaner not to
	modify the programmers intent, especially in the case of floating-point.
	(Rewrite_Comparison): Fix handling of /= (this was always wrong, but
	it did not matter because we always rewrote a/=b to not(a=b).
	(Expand_Allocator_Expression): For an allocator expression whose nominal
	subtype is an unconstrained packed type, convert the expression to its
	actual constrained subtype.
	Implement warning for <= or >= where < or > not possible
	Fix to Vax_Float tests (too early in many routines, causing premature
	Vax_Float expansions.

	* sem_prag.adb (Analyze_Pragma, case Obsolescent): Allow this pragma
	to be used with packages and generic packages as well as with
	subprograms.
	(Suppress): Set All_Checks, but not Elaboration_Check, for case
	of pragma Suppress (All_Checks)
	(Analyze_Pragma, case Warnings): Implement first argument allowed to be
	a string literal for precise control over warnings.
	Avoid raise of pragma in case of unrecognized pragma and just return
	instead.

	* sem_prag.ads: Minor reformatting

	* switch-c.adb (Scan_Front_End_Switches): Replace "raise Bad_Switch;"
	with call to new procedure Bad_Switch. Call Scan_Pos with new parameter
	Switch. Do not handle any exception.
	Include -gnatwx as part of -gnatg (warn on redundant parens)
	Allow optional = after -gnatm
	(Scan_Front_End_Switches): The -gnatp switch sets All_Checks, but no
	longer sets Elaboration_Checks.
	Code to set warning mode moved to Sem_Warn
	so that it can be shared by pragma processing.

	* s-mastop-tru64.adb (Pop_Frame): Remove redundant parentheses in if
	statement.

	* s-taprop-solaris.adb: 
	Change some <= to =, to avoid new warning

	* a-exexda.adb, prj-proc.adb: 
	Fix obvious typo (Num_Tracebacks compared <= 0 instead of < 0)
	Fix obvious typo (Total_Errors_Detected <= 0 should be = 0)

From-SVN: r106950
parent 3e1fd98f
Showing with 207 additions and 104 deletions
gcc/ada/a-exexda.adb
......@@ -6,7 +6,7 @@
-- --
-- B o d y --
-- --
-- Copyright (C) 1992-2005 Free Software Foundation, Inc. --
-- Copyright (C) 1992-2005, Free Software Foundation, Inc. --
-- --
-- GNAT 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- --
......@@ -386,7 +386,7 @@ package body Exception_Data is
Ptr : in out Natural)
is
begin
if X.Num_Tracebacks <= 0 then
if X.Num_Tracebacks = 0 then
return;
end if;
......
gcc/ada/checks.adb
......@@ -6,7 +6,7 @@
-- --
-- B o d y --
-- --
-- Copyright (C) 1992-2005 Free Software Foundation, Inc. --
-- Copyright (C) 1992-2005, Free Software Foundation, Inc. --
-- --
-- GNAT 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- --
......@@ -2481,13 +2481,11 @@ package body Checks is
exit when N = Right_Opnd (P)
and then Nkind (Left_Opnd (P)) = N_Op_Eq;
-- And/And then case, left operand must be inequality test. Note that
-- at this stage, the expander will have changed a/=b to not (a=b).
-- And/And then case, left operand must be inequality test
elsif K = N_Op_And or else K = N_And_Then then
exit when N = Right_Opnd (P)
and then Nkind (Left_Opnd (P)) = N_Op_Not
and then Nkind (Right_Opnd (Left_Opnd (P))) = N_Op_Eq;
and then Nkind (Left_Opnd (P)) = N_Op_Ne;
end if;
N := P;
......@@ -3259,15 +3257,32 @@ package body Checks is
function Elaboration_Checks_Suppressed (E : Entity_Id) return Boolean is
begin
-- The complication in this routine is that if we are in the dynamic
-- model of elaboration, we also check All_Checks, since All_Checks
-- does not set Elaboration_Check explicitly.
if Present (E) then
if Kill_Elaboration_Checks (E) then
return True;
elsif Checks_May_Be_Suppressed (E) then
return Is_Check_Suppressed (E, Elaboration_Check);
if Is_Check_Suppressed (E, Elaboration_Check) then
return True;
elsif Dynamic_Elaboration_Checks then
return Is_Check_Suppressed (E, All_Checks);
else
return False;
end if;
end if;
end if;
return Scope_Suppress (Elaboration_Check);
if Scope_Suppress (Elaboration_Check) then
return True;
elsif Dynamic_Elaboration_Checks then
return Scope_Suppress (All_Checks);
else
return False;
end if;
end Elaboration_Checks_Suppressed;
---------------------------
......@@ -3690,6 +3705,15 @@ package body Checks is
then
return;
-- No check on a univeral real constant. The context will eventually
-- convert it to a machine number for some target type, or report an
-- illegality.
elsif Nkind (Expr) = N_Real_Literal
and then Etype (Expr) = Universal_Real
then
return;
-- An annoying special case. If this is an out parameter of a scalar
-- type, then the value is not going to be accessed, therefore it is
-- inappropriate to do any validity check at the call site.
......@@ -3845,11 +3869,10 @@ package body Checks is
then
return Expr_Known_Valid (Expression (Expr));
-- The result of any function call or operator is always considered
-- valid, since we assume the necessary checks are done by the call.
-- For operators on floating-point operations, we must also check
-- when the operation is the right-hand side of an assignment, or
-- is an actual in a call.
-- The result of any operator is always considered valid, since we
-- assume the necessary checks are done by the operator. For operators
-- on floating-point operations, we must also check when the operation
-- is the right-hand side of an assignment, or is an actual in a call.
elsif
Nkind (Expr) in N_Binary_Op or else Nkind (Expr) in N_Unary_Op
......@@ -3866,9 +3889,6 @@ package body Checks is
return True;
end if;
elsif Nkind (Expr) = N_Function_Call then
return True;
-- For all other cases, we do not know the expression is valid
else
......
gcc/ada/prj-proc.adb
......@@ -6,7 +6,7 @@
-- --
-- B o d y --
-- --
-- Copyright (C) 2001-2005 Free Software Foundation, Inc. --
-- Copyright (C) 2001-2005, Free Software Foundation, Inc. --
-- --
-- GNAT 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- --
......@@ -1129,7 +1129,7 @@ package body Prj.Proc is
end loop;
end if;
Success := Total_Errors_Detected <= 0;
Success := Total_Errors_Detected = 0;
end Process;
-------------------------------
......
gcc/ada/s-mastop-tru64.adb
......@@ -7,7 +7,7 @@
-- B o d y --
-- (Version for Alpha/Dec Unix) --
-- --
-- Copyright (C) 1999-2005 Ada Core Technologies, Inc. --
-- Copyright (C) 1999-2005, AdaCore --
-- --
-- GNAT 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- --
......@@ -143,7 +143,7 @@ package body System.Machine_State_Operations is
Prf : constant System.Address := exc_lookup_function (Get_Code_Loc (M));
begin
if (Prf = System.Null_Address) then
if Prf = System.Null_Address then
c_set_code_loc (M, 0);
else
exc_virtual_unwind (Prf, M);
......
gcc/ada/s-taprop-solaris.adb
......@@ -1382,7 +1382,7 @@ package body System.Task_Primitives.Operations is
begin
-- Check that caller is abort-deferred
if Self_ID.Deferral_Level <= 0 then
if Self_ID.Deferral_Level = 0 then
return False;
end if;
......@@ -1419,7 +1419,7 @@ package body System.Task_Primitives.Operations is
-- Check that caller is abort-deferred
if Self_ID.Deferral_Level <= 0 then
if Self_ID.Deferral_Level = 0 then
return False;
end if;
......@@ -1498,7 +1498,7 @@ package body System.Task_Primitives.Operations is
begin
-- Check that caller is abort-deferred
if Self_ID.Deferral_Level <= 0 then
if Self_ID.Deferral_Level = 0 then
return False;
end if;
......@@ -1617,7 +1617,7 @@ package body System.Task_Primitives.Operations is
-- Check that caller is abort-deferred
if Self_ID.Deferral_Level <= 0 then
if Self_ID.Deferral_Level = 0 then
return False;
end if;
......@@ -1646,7 +1646,7 @@ package body System.Task_Primitives.Operations is
begin
-- Check that caller is abort-deferred
if Self_ID.Deferral_Level <= 0 then
if Self_ID.Deferral_Level = 0 then
return False;
end if;
......@@ -1833,7 +1833,7 @@ package body System.Task_Primitives.Operations is
-- Check that caller is abort-deferred
if Self_ID.Deferral_Level <= 0 then
if Self_ID.Deferral_Level = 0 then
return False;
end if;
......
gcc/ada/sem_prag.ads
......@@ -6,7 +6,7 @@
-- --
-- S p e c --
-- --
-- Copyright (C) 1992-2004 Free Software Foundation, Inc. --
-- Copyright (C) 1992-2005, Free Software Foundation, Inc. --
-- --
-- GNAT 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- --
......@@ -28,62 +28,62 @@
-- (logically this processing belongs in chapter 4)
with Types; use Types;
package Sem_Prag is
procedure Analyze_Pragma (N : Node_Id);
-- Analyze procedure for pragma reference node N
function Delay_Config_Pragma_Analyze (N : Node_Id) return Boolean;
-- N is a pragma appearing in a configuration pragma file. Most
-- such pragmas are analyzed when the file is read, before parsing
-- and analyzing the main unit. However, the analysis of certain
-- pragmas results in adding information to the compiled main unit,
-- and this cannot be done till the main unit is processed. Such
-- pragmas return True from this function and in Frontend pragmas
-- where Delay_Config_Pragma_Analyze is True have their analysis
-- delayed until after the main program is parsed and analyzed.
-- N is a pragma appearing in a configuration pragma file. Most such
-- pragmas are analyzed when the file is read, before parsing and analyzing
-- the main unit. However, the analysis of certain pragmas results in
-- adding information to the compiled main unit, and this cannot be done
-- till the main unit is processed. Such pragmas return True from this
-- function and in Frontend pragmas where Delay_Config_Pragma_Analyze is
-- True have their analysis delayed until after the main program is parsed
-- and analyzed.
function Is_Non_Significant_Pragma_Reference (N : Node_Id) return Boolean;
-- The node N is a node for an entity and the issue is whether the
-- occurrence is a reference for the purposes of giving warnings
-- about unreferenced variables. This function returns True if the
-- reference is not a reference from this point of view (e.g. the
-- occurrence in a pragma Pack) and False if it is a real reference
-- (e.g. the occcurrence in a pragma Export);
-- occurrence is a reference for the purposes of giving warnings about
-- unreferenced variables. This function returns True if the reference is
-- not a reference from this point of view (e.g. the occurrence in a pragma
-- Pack) and False if it is a real reference (e.g. the occcurrence in a
-- pragma Export);
function Is_Pragma_String_Literal (Par : Node_Id) return Boolean;
-- Given an N_Pragma_Argument_Association node, Par, which has the form
-- of an operator symbol, determines whether or not it should be treated
-- as an string literal. This is called by Sem_Ch6.Analyze_Operator_Symbol.
-- If True is returned, the argument is converted to a string literal. If
-- Given an N_Pragma_Argument_Association node, Par, which has the form of
-- an operator symbol, determines whether or not it should be treated as an
-- string literal. This is called by Sem_Ch6.Analyze_Operator_Symbol. If
-- True is returned, the argument is converted to a string literal. If
-- False is returned, then the argument is treated as an entity reference
-- to the operator.
function Is_Config_Static_String (Arg : Node_Id) return Boolean;
-- This is called for a configuration pragma that requires either a
-- string literal or a concatenation of string literals. We cannot
-- use normal static string processing because it is too early in
-- the case of the pragma appearing in a configuration pragmas file.
-- If Arg is of an appropriate form, then this call obtains the string
-- (doing any necessary concatenations) and places it in Name_Buffer,
-- setting Name_Len to its length, and then returns True. If it is
-- not of the correct form, then an appropriate error message is
-- posted, and False is returned.
-- This is called for a configuration pragma that requires either string
-- literal or a concatenation of string literals. We cannot use normal
-- static string processing because it is too early in the case of the
-- pragma appearing in a configuration pragmas file. If Arg is of an
-- appropriate form, then this call obtains the string (doing any necessary
-- concatenations) and places it in Name_Buffer, setting Name_Len to its
-- length, and then returns True. If it is not of the correct form, then an
-- appropriate error message is posted, and False is returned.
procedure Process_Compilation_Unit_Pragmas (N : Node_Id);
-- Called at the start of processing compilation unit N to deal with
-- any special issues regarding pragmas. In particular, we have to
-- deal with Suppress_All at this stage, since it appears after the
-- unit instead of before.
-- Called at the start of processing compilation unit N to deal with any
-- special issues regarding pragmas. In particular, we have to deal with
-- Suppress_All at this stage, since it appears after the unit instead of
-- before.
procedure Set_Encoded_Interface_Name (E : Entity_Id; S : Node_Id);
-- This routine is used to set an encoded interface name. The node
-- S is an N_String_Literal node for the external name to be set, and
-- E is an entity whose Interface_Name field is to be set. In the
-- normal case where S contains a name that is a valid C identifier,
-- then S is simply set as the value of the Interface_Name. Otherwise
-- it is encoded. See the body for details of the encoding. This
-- encoding is only done on VMS systems, since it seems pretty silly,
-- but is needed to pass some dubious tests in the test suite.
-- This routine is used to set an encoded interface name. The node S is an
-- N_String_Literal node for the external name to be set, and E is an
-- entity whose Interface_Name field is to be set. In the normal case where
-- S contains a name that is a valid C identifier, then S is simply set as
-- the value of the Interface_Name. Otherwise it is encoded. See the body
-- for details of the encoding. This encoding is only done on VMS systems,
-- since it seems pretty silly, but is needed to pass some dubious tests in
-- the test suite.
end Sem_Prag;
gcc/ada/types.ads
......@@ -6,7 +6,7 @@
-- --
-- S p e c --
-- --
-- Copyright (C) 1992-2005 Free Software Foundation, Inc. --
-- Copyright (C) 1992-2005, Free Software Foundation, Inc. --
-- --
-- GNAT 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- --
......@@ -311,14 +311,14 @@ package Types is
-- is in practice infinite and there is no need to check the range.
Ureal_Low_Bound : constant := 500_000_000;
-- Low bound for Ureal values.
-- Low bound for Ureal values
Ureal_High_Bound : constant := 599_999_999;
-- Maximum number of Ureal values stored is 100_000_000 which is in
-- practice infinite so that no check is required.
Uint_Low_Bound : constant := 600_000_000;
-- Low bound for Uint values.
-- Low bound for Uint values
Uint_Table_Start : constant := 2_000_000_000;
-- Location where table entries for universal integers start (see
......@@ -479,7 +479,7 @@ package Types is
-- are not valid.
First_Elist_Id : constant Elist_Id := No_Elist + 1;
-- Subscript of first allocated Elist header.
-- Subscript of first allocated Elist header
-- Element Id values are used to identify individual elements of an
-- element list (see package Elists for further details).
......@@ -696,12 +696,19 @@ package Types is
Tag_Check,
All_Checks);
-- The following record contains an entry for each recognized check name
-- The following array contains an entry for each recognized check name
-- for pragma Suppress. It is used to represent current settings of scope
-- based suppress actions from pragma Suppress or command line settings.
type Suppress_Array is
array (Check_Id range Access_Check .. Tag_Check) of Boolean;
-- Note: when Suppress_Array (All_Checks) is True, then generally all other
-- specific check entries are set True, except for the Elaboration_Check
-- entry which is set only if an explicit Suppress for this check is given.
-- The reason for this non-uniformity is that we do not want All_Checks to
-- suppress elaboration checking when using the static elaboration model.
-- We recognize only an explicit suppress of Elaboration_Check as a signal
-- that the static elaboration checking should skip a compile time check.
type Suppress_Array is array (Check_Id) of Boolean;
pragma Pack (Suppress_Array);
-- To add a new check type to GNAT, the following steps are required:
......
Markdown is supported
0% or
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment