Skip to content

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

sem_res.adb (Resolve_Unary_Op): Add warning for use of unary minus with multiplying operator. 

2006-10-31  Robert Dewar  <dewar@adacore.com>
	    Bob Duff  <duff@adacore.com>
	    Ed Schonberg  <schonberg@adacore.com>

        * sem_res.adb (Resolve_Unary_Op): Add warning for use of unary minus
	with multiplying operator.
	(Expected_Type_Is_Any_Real): New function to determine from the Parent
	pointer whether the context expects "any real type".
	(Resolve_Arithmetic_Op): Do not give an error on calls to the
	universal_fixed "*" and "/" operators when they are used in a context
	that expects any real type. Also set the type of the node to
	Universal_Real in this case, because downstream processing requires it
	(mainly static expression evaluation).
	Reword some continuation messages
	Add some \\ sequences to continuation messages
	(Resolve_Call): Refine infinite recursion case. The test has been
	sharpened to eliminate some false positives.
	Check for Current_Task usage now includes entry barrier, and is now a
	warning, not an error.
	(Resolve): If the call is ambiguous, indicate whether an interpretation
	is an inherited operation.
	(Check_Aggr): When resolving aggregates, skip associations with a box,
	which are priori correct, and will be replaced by an actual default
	expression in the course of expansion.
	(Resolve_Type_Conversion): Add missing support for conversion from
	a class-wide interface to a tagged type. Minor code cleanup.
	(Valid_Tagged_Converion): Add support for abstact interface type
	conversions.
	(Resolve_Selected_Component): Call Generate_Reference here rather than
	during analysis, and use May_Be_Lvalue to distinguish read/write.
	(Valid_Array_Conversion): New procedure, abstracted from
	Valid_Conversion, to incorporate accessibility checks for arrays of
	anonymous access types.
	(Valid_Conversion): For a conversion to a numeric type occurring in an
	instance or inlined body, no need to check that the operand type is
	numeric, since this has been checked during analysis of the template.
	Remove legacy test for scope name Unchecked_Conversion.

	* sem_res.ads: Minor reformatting

	* a-except.adb, a-except-2005.adb: Turn off subprogram ordering
	(PE_Current_Task_In_Entry_Body): New exception code
	(SE_Restriction_Violation): Removed, not used

	* a-except.ads:  Update comments.

	* types.h, types.ads: Add definition for Validity_Check
	(PE_Current_Task_In_Entry_Body): New exception code
	(SE_Restriction_Violation): Removed, not used

From-SVN: r118232
parent 524c02d7
Showing with 108 additions and 98 deletions
gcc/ada/a-except-2005.adb
......@@ -41,6 +41,9 @@
-- The base version of this unit Ada.Exceptions omits the Wide version of
-- Exception_Name and is used to build the compiler and other basic tools.
pragma Style_Checks (All_Checks);
-- No subprogram ordering check, due to logical grouping
pragma Polling (Off);
-- We must turn polling off for this unit, because otherwise we get
-- elaboration circularities with System.Exception_Tables.
......@@ -555,23 +558,24 @@ package body Ada.Exceptions is
Rmsg_14 : constant String := "access before elaboration" & NUL;
Rmsg_15 : constant String := "accessibility check failed" & NUL;
Rmsg_16 : constant String := "all guards closed" & NUL;
Rmsg_17 : constant String := "duplicated entry address" & NUL;
Rmsg_18 : constant String := "explicit raise" & NUL;
Rmsg_19 : constant String := "finalize/adjust raised exception" & NUL;
Rmsg_20 : constant String := "implicit return with No_Return" & NUL;
Rmsg_21 : constant String := "misaligned address value" & NUL;
Rmsg_22 : constant String := "missing return" & NUL;
Rmsg_23 : constant String := "overlaid controlled object" & NUL;
Rmsg_24 : constant String := "potentially blocking operation" & NUL;
Rmsg_25 : constant String := "stubbed subprogram called" & NUL;
Rmsg_26 : constant String := "unchecked union restriction" & NUL;
Rmsg_27 : constant String := "illegal use of remote access-to-" &
Rmsg_17 : constant String := "Current_Task referenced in entry" &
" body" & NUL;
Rmsg_18 : constant String := "duplicated entry address" & NUL;
Rmsg_19 : constant String := "explicit raise" & NUL;
Rmsg_20 : constant String := "finalize/adjust raised exception" & NUL;
Rmsg_21 : constant String := "implicit return with No_Return" & NUL;
Rmsg_22 : constant String := "misaligned address value" & NUL;
Rmsg_23 : constant String := "missing return" & NUL;
Rmsg_24 : constant String := "overlaid controlled object" & NUL;
Rmsg_25 : constant String := "potentially blocking operation" & NUL;
Rmsg_26 : constant String := "stubbed subprogram called" & NUL;
Rmsg_27 : constant String := "unchecked union restriction" & NUL;
Rmsg_28 : constant String := "illegal use of remote access-to-" &
"class-wide type, see RM E.4(18)" & NUL;
Rmsg_28 : constant String := "empty storage pool" & NUL;
Rmsg_29 : constant String := "explicit raise" & NUL;
Rmsg_30 : constant String := "infinite recursion" & NUL;
Rmsg_31 : constant String := "object too large" & NUL;
Rmsg_32 : constant String := "restriction violation" & NUL;
Rmsg_29 : constant String := "empty storage pool" & NUL;
Rmsg_30 : constant String := "explicit raise" & NUL;
Rmsg_31 : constant String := "infinite recursion" & NUL;
Rmsg_32 : constant String := "object too large" & NUL;
-----------------------
-- Polling Interface --
......@@ -1106,7 +1110,7 @@ package body Ada.Exceptions is
procedure Rcheck_28 (File : System.Address; Line : Integer) is
begin
Raise_Storage_Error_Msg (File, Line, Rmsg_28'Address);
Raise_Program_Error_Msg (File, Line, Rmsg_28'Address);
end Rcheck_28;
procedure Rcheck_29 (File : System.Address; Line : Integer) is
......
gcc/ada/a-except.adb
......@@ -31,8 +31,10 @@
-- --
------------------------------------------------------------------------------
-- This version of Ada.Exceptions is a full Ada 95 version, but lacks the
-- additional definitions of Exception_Name returning Wide_[Wide_]String.
-- This version of Ada.Exceptions is a full Ada 95 version, and Ada 2005
-- features such as the additional definitions of Exception_Name returning
-- Wide_[Wide_]String.
-- It is used for building the compiler and the basic tools, since these
-- builds may be done with bootstrap compilers that cannot handle these
-- additions. The full version of Ada.Exceptions can be found in the files
......@@ -40,6 +42,9 @@
-- 2005 functionality is required. in particular, it is used for building
-- run times on all targets.
pragma Style_Checks (All_Checks);
-- No subprogram ordering check, due to logical grouping
pragma Polling (Off);
-- We must turn polling off for this unit, because otherwise we get
-- elaboration circularities with System.Exception_Tables.
......@@ -206,7 +211,7 @@ package body Ada.Exceptions is
(Excep : EOA;
Current : EOA;
Reraised : Boolean := False);
-- Dummy routine used to share a-exexda.adb, do nothing.
-- Dummy routine used to share a-exexda.adb, do nothing
end Exception_Propagation;
......@@ -504,23 +509,24 @@ package body Ada.Exceptions is
Rmsg_14 : constant String := "access before elaboration" & NUL;
Rmsg_15 : constant String := "accessibility check failed" & NUL;
Rmsg_16 : constant String := "all guards closed" & NUL;
Rmsg_17 : constant String := "duplicated entry address" & NUL;
Rmsg_18 : constant String := "explicit raise" & NUL;
Rmsg_19 : constant String := "finalize/adjust raised exception" & NUL;
Rmsg_20 : constant String := "implicit return with No_Return" & NUL;
Rmsg_21 : constant String := "misaligned address value" & NUL;
Rmsg_22 : constant String := "missing return" & NUL;
Rmsg_23 : constant String := "overlaid controlled object" & NUL;
Rmsg_24 : constant String := "potentially blocking operation" & NUL;
Rmsg_25 : constant String := "stubbed subprogram called" & NUL;
Rmsg_26 : constant String := "unchecked union restriction" & NUL;
Rmsg_27 : constant String := "illegal use of remote access-to-" &
Rmsg_17 : constant String := "Current_Task referenced in entry" &
" body" & NUL;
Rmsg_18 : constant String := "duplicated entry address" & NUL;
Rmsg_19 : constant String := "explicit raise" & NUL;
Rmsg_20 : constant String := "finalize/adjust raised exception" & NUL;
Rmsg_21 : constant String := "implicit return with No_Return" & NUL;
Rmsg_22 : constant String := "misaligned address value" & NUL;
Rmsg_23 : constant String := "missing return" & NUL;
Rmsg_24 : constant String := "overlaid controlled object" & NUL;
Rmsg_25 : constant String := "potentially blocking operation" & NUL;
Rmsg_26 : constant String := "stubbed subprogram called" & NUL;
Rmsg_27 : constant String := "unchecked union restriction" & NUL;
Rmsg_28 : constant String := "illegal use of remote access-to-" &
"class-wide type, see RM E.4(18)" & NUL;
Rmsg_28 : constant String := "empty storage pool" & NUL;
Rmsg_29 : constant String := "explicit raise" & NUL;
Rmsg_30 : constant String := "infinite recursion" & NUL;
Rmsg_31 : constant String := "object too large" & NUL;
Rmsg_32 : constant String := "restriction violation" & NUL;
Rmsg_29 : constant String := "empty storage pool" & NUL;
Rmsg_30 : constant String := "explicit raise" & NUL;
Rmsg_31 : constant String := "infinite recursion" & NUL;
Rmsg_32 : constant String := "object too large" & NUL;
-----------------------
-- Polling Interface --
......@@ -802,11 +808,7 @@ package body Ada.Exceptions is
Raise_Current_Excep (E);
end if;
-- Note: if E is null, then we simply return, which is correct Ada 95
-- semantics. If we are operating in Ada 2005 mode, then the expander
-- generates a raise Constraint_Error immediately following the call
-- to provide the required Ada 2005 semantics (see AI-329). We do it
-- this way to avoid having run time dependencies on the Ada version.
-- Note: if E is null then just return (Ada 95 semantics)
return;
end Raise_Exception;
......@@ -1072,7 +1074,7 @@ package body Ada.Exceptions is
procedure Rcheck_28 (File : System.Address; Line : Integer) is
begin
Raise_Storage_Error_Msg (File, Line, Rmsg_28'Address);
Raise_Program_Error_Msg (File, Line, Rmsg_28'Address);
end Rcheck_28;
procedure Rcheck_29 (File : System.Address; Line : Integer) is
......
gcc/ada/a-except.ads
......@@ -6,7 +6,7 @@
-- --
-- S p e c --
-- --
-- Copyright (C) 1992-2005, Free Software Foundation, Inc. --
-- Copyright (C) 1992-2006, Free Software Foundation, Inc. --
-- --
-- This specification is derived from the Ada Reference Manual for use with --
-- GNAT. The copyright notice above, and the license provisions that follow --
......@@ -35,8 +35,7 @@
-- --
------------------------------------------------------------------------------
-- This version of Ada.Exceptions is a full Ada 95 version, but lacks the
-- additional definitions of Exception_Name returning Wide_[Wide_]String.
-- This version of Ada.Exceptions is a full Ada 95 version.
-- It is used for building the compiler and the basic tools, since these
-- builds may be done with bootstrap compilers that cannot handle these
-- additions. The full version of Ada.Exceptions can be found in the files
......@@ -57,14 +56,17 @@ package Ada.Exceptions is
pragma Warnings (Off);
pragma Preelaborate_05;
pragma Warnings (On);
-- In accordance with Ada 2005 AI-362. The warnings pragmas are so that we
-- can compile this using older compiler versions, which will ignore the
-- pragma, which is fine for the bootstrap.
-- We make this preelaborable in Ada 2005 mode. If we did not do this, then
-- run time units used by the compiler (e.g. s-soflin.ads) would run
-- into trouble. Conformance is not an issue, since this version is used
-- only by the compiler.
type Exception_Id is private;
Null_Id : constant Exception_Id;
type Exception_Occurrence is limited private;
type Exception_Occurrence_Access is access all Exception_Occurrence;
Null_Occurrence : constant Exception_Occurrence;
......@@ -76,11 +78,11 @@ package Ada.Exceptions is
procedure Raise_Exception (E : Exception_Id; Message : String := "");
-- Note: it would be really nice to give a pragma No_Return for this
-- procedure, but it would be wrong, since Raise_Exception does return
-- if given the null exception. However we do special case the name in
-- the test in the compiler for issuing a warning for a missing return
-- after this call. Program_Error seems reasonable enough in such a case.
-- See also the routine Raise_Exception_Always in the private part.
-- procedure, but it would be wrong, since Raise_Exception does return if
-- given the null exception in Ada 95 mode. However we do special case the
-- name in the test in the compiler for issuing a warning for a missing
-- return after this call. Program_Error seems reasonable enough in such a
-- case. See also the routine Raise_Exception_Always in the private part.
function Exception_Message (X : Exception_Occurrence) return String;
......
gcc/ada/sem_res.ads
......@@ -6,7 +6,7 @@
-- --
-- S p e c --
-- --
-- Copyright (C) 1992-2005, Free Software Foundation, Inc. --
-- Copyright (C) 1992-2006, 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- --
......@@ -114,8 +114,7 @@ package Sem_Res is
-- read the spec of Sem.
procedure Pre_Analyze_And_Resolve (N : Node_Id);
-- Same, but use type of node because context does not impose a single
-- type.
-- Same, but use type of node because context does not impose a single type
private
procedure Resolve_Implicit_Type (N : Node_Id) renames Resolve;
......
gcc/ada/types.ads
......@@ -106,10 +106,11 @@ package Types is
subtype Line_Terminator is Character range ASCII.LF .. ASCII.CR;
-- Line terminator characters (LF, VT, FF, CR)
--
-- This definition is dubious now that we have two more wide character
-- sequences that constitute a line terminator. Every reference to
-- this subtype needs checking to make sure the wide character case
-- is handled appropriately.
-- is handled appropriately. ???
subtype Upper_Half_Character is
Character range Character'Val (16#80#) .. Character'Val (16#FF#);
......@@ -206,7 +207,7 @@ package Types is
No_Location : constant Source_Ptr := -1;
-- Value used to indicate no source position set in a node. A test for
-- a Source_Ptr value being >= No_Location is the apporoved way to test
-- a Source_Ptr value being > No_Location is the approved way to test
-- for a standard value that does not include No_Location or any of the
-- following special definitions.
......@@ -683,9 +684,10 @@ package Types is
-- Types used for Pragma Suppress Management --
-----------------------------------------------
type Check_Id is (
Access_Check,
type Check_Id is
(Access_Check,
Accessibility_Check,
Alignment_Check,
Discriminant_Check,
Division_Check,
Elaboration_Check,
......@@ -695,6 +697,7 @@ package Types is
Range_Check,
Storage_Check,
Tag_Check,
Validity_Check,
All_Checks);
-- The following array contains an entry for each recognized check name
......@@ -804,23 +807,23 @@ package Types is
PE_Access_Before_Elaboration, -- 14
PE_Accessibility_Check_Failed, -- 15
PE_All_Guards_Closed, -- 16
PE_Duplicated_Entry_Address, -- 17
PE_Explicit_Raise, -- 18
PE_Finalize_Raised_Exception, -- 19
PE_Implicit_Return, -- 20
PE_Misaligned_Address_Value, -- 21
PE_Missing_Return, -- 22
PE_Overlaid_Controlled_Object, -- 23
PE_Potentially_Blocking_Operation, -- 24
PE_Stubbed_Subprogram_Called, -- 25
PE_Unchecked_Union_Restriction, -- 26
PE_Illegal_RACW_E_4_18, -- 27
SE_Empty_Storage_Pool, -- 28
SE_Explicit_Raise, -- 29
SE_Infinite_Recursion, -- 30
SE_Object_Too_Large, -- 31
SE_Restriction_Violation); -- 32
PE_Current_Task_In_Entry_Body, -- 17
PE_Duplicated_Entry_Address, -- 18
PE_Explicit_Raise, -- 19
PE_Finalize_Raised_Exception, -- 20
PE_Implicit_Return, -- 21
PE_Misaligned_Address_Value, -- 22
PE_Missing_Return, -- 23
PE_Overlaid_Controlled_Object, -- 24
PE_Potentially_Blocking_Operation, -- 25
PE_Stubbed_Subprogram_Called, -- 26
PE_Unchecked_Union_Restriction, -- 27
PE_Illegal_RACW_E_4_18, -- 28
SE_Empty_Storage_Pool, -- 29
SE_Explicit_Raise, -- 30
SE_Infinite_Recursion, -- 31
SE_Object_Too_Large); -- 32
subtype RT_CE_Exceptions is RT_Exception_Code range
CE_Access_Check_Failed ..
......@@ -832,6 +835,6 @@ package Types is
subtype RT_SE_Exceptions is RT_Exception_Code range
SE_Empty_Storage_Pool ..
SE_Restriction_Violation;
SE_Object_Too_Large;
end Types;
gcc/ada/types.h
......@@ -6,7 +6,7 @@
* *
* C Header File *
* *
* Copyright (C) 1992-2005, Free Software Foundation, Inc. *
* Copyright (C) 1992-2006, 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- *
......@@ -348,22 +348,22 @@ typedef Int Mechanism_Type;
#define PE_Access_Before_Elaboration 14
#define PE_Accessibility_Check_Failed 15
#define PE_All_Guards_Closed 16
#define PE_Duplicated_Entry_Address 17
#define PE_Explicit_Raise 18
#define PE_Finalize_Raised_Exception 19
#define PE_Implicit_Return 20
#define PE_Misaligned_Address_Value 21
#define PE_Missing_Return 22
#define PE_Overlaid_Controlled_Object 23
#define PE_Potentially_Blocking_Operation 24
#define PE_Stubbed_Subprogram_Called 25
#define PE_Unchecked_Union_Restriction 26
#define PE_Illegal_RACW_E_4_18 27
#define SE_Empty_Storage_Pool 28
#define SE_Explicit_Raise 29
#define SE_Infinite_Recursion 30
#define SE_Object_Too_Large 31
#define SE_Restriction_Violation 32
#define LAST_REASON_CODE 31
#define PE_Current_Task_In_Entry_Body 17
#define PE_Duplicated_Entry_Address 18
#define PE_Explicit_Raise 19
#define PE_Finalize_Raised_Exception 20
#define PE_Implicit_Return 21
#define PE_Misaligned_Address_Value 22
#define PE_Missing_Return 23
#define PE_Overlaid_Controlled_Object 24
#define PE_Potentially_Blocking_Operation 25
#define PE_Stubbed_Subprogram_Called 26
#define PE_Unchecked_Union_Restriction 27
#define PE_Illegal_RACW_E_4_18 28
#define SE_Empty_Storage_Pool 29
#define SE_Explicit_Raise 30
#define SE_Infinite_Recursion 31
#define SE_Object_Too_Large 32
#define LAST_REASON_CODE 32
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