OpenE2K
/
gcc
2
0
Fork 0
Code Issues Pull Requests Projects Releases Wiki Activity

[multiple changes] 

2013-10-10  Thomas Quinot  <quinot@adacore.com>

	* exp_ch4.adb (Process_Transient_Object): For any context other
	than a simple return statement, insert the finalization action
	after the context, not as an action on the context (which will
	get evaluated before it).

2013-10-10  Hristian Kirtchev  <kirtchev@adacore.com>

	* einfo.adb (Write_Field19_Name): Correct the
	string name of attribute Default_Aspect_Value.

2013-10-10  Ed Schonberg  <schonberg@adacore.com>

	* sem_type.adb (Interface_Present_In_Ancestor): The progenitor
	in a type declaration may be an interface subtype.

2013-10-10  Robert Dewar  <dewar@adacore.com>

	* sinfo.ads (Do_Range_Check): Add special note on handling of
	range checks for Succ and Pred.

2013-10-10  Robert Dewar  <dewar@adacore.com>

	* erroutc.adb (Output_Msg_Text): Remove VMS special handling.

2013-10-10  Robert Dewar  <dewar@adacore.com>

	* a-chahan.ads, a-chahan.adb (Is_Line_Terminator): New function
	(Is_Mark): New function.
	(Is_Other_Format): New function.
	(Is_Punctuation_Connector): New function.
	(Is_Space): New function.

From-SVN: r203370
This commit is contained in:
Arnaud Charlet 2013-10-10 14:52:31 +02:00
parent 82893775d2
commit 815839a384
8 changed files with 137 additions and 303 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

34
gcc/ada/ChangeLog
View File

@ -1,3 +1,37 @@
2013-10-10 Thomas Quinot <quinot@adacore.com>
* exp_ch4.adb (Process_Transient_Object): For any context other
than a simple return statement, insert the finalization action
after the context, not as an action on the context (which will
get evaluated before it).
2013-10-10 Hristian Kirtchev <kirtchev@adacore.com>
* einfo.adb (Write_Field19_Name): Correct the
string name of attribute Default_Aspect_Value.
2013-10-10 Ed Schonberg <schonberg@adacore.com>
* sem_type.adb (Interface_Present_In_Ancestor): The progenitor
in a type declaration may be an interface subtype.
2013-10-10 Robert Dewar <dewar@adacore.com>
* sinfo.ads (Do_Range_Check): Add special note on handling of
range checks for Succ and Pred.
2013-10-10 Robert Dewar <dewar@adacore.com>
* erroutc.adb (Output_Msg_Text): Remove VMS special handling.
2013-10-10 Robert Dewar <dewar@adacore.com>
* a-chahan.ads, a-chahan.adb (Is_Line_Terminator): New function
(Is_Mark): New function.
(Is_Other_Format): New function.
(Is_Punctuation_Connector): New function.
(Is_Space): New function.
2013-10-10 Robert Dewar <dewar@adacore.com>
* sem_aggr.adb (Resolve_Array_Aggregate): Redo duplicate/missing

59
gcc/ada/a-chahan.adb
View File

@ -6,7 +6,7 @@
-- --
-- B o d y --
-- --
-- Copyright (C) 1992-2012, Free Software Foundation, Inc. --
-- Copyright (C) 1992-2013, 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- --
@ -49,6 +49,7 @@ package body Ada.Characters.Handling is
Hex_Digit : constant Character_Flags := 16;
Digit : constant Character_Flags := 32;
Special : constant Character_Flags := 64;
Line_Term : constant Character_Flags := 128;
Letter : constant Character_Flags := Lower or Upper;
Alphanum : constant Character_Flags := Letter or Digit;
@ -66,10 +67,10 @@ package body Ada.Characters.Handling is
BEL => Control,
BS => Control,
HT => Control,
LF => Control,
VT => Control,
FF => Control,
CR => Control,
LF => Control + Line_Term,
VT => Control + Line_Term,
FF => Control + Line_Term,
CR => Control + Line_Term,
SO => Control,
SI => Control,
@ -141,7 +142,7 @@ package body Ada.Characters.Handling is
BPH => Control,
NBH => Control,
Reserved_132 => Control,
NEL => Control,
NEL => Control + Line_Term,
SSA => Control,
ESA => Control,
HTS => Control,
@ -370,6 +371,15 @@ package body Ada.Characters.Handling is
return (Char_Map (Item) and Letter) /= 0;
end Is_Letter;
------------------------
-- Is_Line_Terminator --
------------------------
function Is_Line_Terminator (Item : Character) return Boolean is
begin
return (Char_Map (Item) and Line_Term) /= 0;
end Is_Line_Terminator;
--------------
-- Is_Lower --
--------------
@ -379,6 +389,43 @@ package body Ada.Characters.Handling is
return (Char_Map (Item) and Lower) /= 0;
end Is_Lower;
-------------
-- Is_Mark --
-------------
function Is_Mark (Item : Character) return Boolean is
pragma Unreferenced (Item);
begin
return False;
end Is_Mark;
---------------------
-- Is_Other_Format --
---------------------
function Is_Other_Format (Item : Character) return Boolean is
begin
return Item = Soft_Hyphen;
end Is_Other_Format;
------------------------------
-- Is_Punctuation_Connector --
------------------------------
function Is_Punctuation_Connector (Item : Character) return Boolean is
begin
return Item = '_';
end Is_Punctuation_Connector;
--------------
-- Is_Space --
--------------
function Is_Space (Item : Character) return Boolean is
begin
return Item = ' ' or else Item = No_Break_Space;
end Is_Space;
----------------
-- Is_Special --
----------------

58
gcc/ada/a-chahan.ads
View File

@ -6,7 +6,7 @@
-- --
-- S p e c --
-- --
-- Copyright (C) 1992-2010, Free Software Foundation, Inc. --
-- Copyright (C) 1992-2013, 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 --
@ -42,18 +42,23 @@ package Ada.Characters.Handling is
-- Character Classification Functions --
----------------------------------------
function Is_Control (Item : Character) return Boolean;
function Is_Graphic (Item : Character) return Boolean;
function Is_Letter (Item : Character) return Boolean;
function Is_Lower (Item : Character) return Boolean;
function Is_Upper (Item : Character) return Boolean;
function Is_Basic (Item : Character) return Boolean;
function Is_Digit (Item : Character) return Boolean;
function Is_Decimal_Digit (Item : Character) return Boolean
function Is_Control (Item : Character) return Boolean;
function Is_Graphic (Item : Character) return Boolean;
function Is_Letter (Item : Character) return Boolean;
function Is_Lower (Item : Character) return Boolean;
function Is_Upper (Item : Character) return Boolean;
function Is_Basic (Item : Character) return Boolean;
function Is_Digit (Item : Character) return Boolean;
function Is_Decimal_Digit (Item : Character) return Boolean
renames Is_Digit;
function Is_Hexadecimal_Digit (Item : Character) return Boolean;
function Is_Alphanumeric (Item : Character) return Boolean;
function Is_Special (Item : Character) return Boolean;
function Is_Hexadecimal_Digit (Item : Character) return Boolean;
function Is_Alphanumeric (Item : Character) return Boolean;
function Is_Special (Item : Character) return Boolean;
function Is_Line_Terminator (Item : Character) return Boolean;
function Is_Mark (Item : Character) return Boolean;
function Is_Other_Format (Item : Character) return Boolean;
function Is_Punctuation_Connector (Item : Character) return Boolean;
function Is_Space (Item : Character) return Boolean;
---------------------------------------------------
-- Conversion Functions for Character and String --
@ -129,22 +134,27 @@ package Ada.Characters.Handling is
(Item : String) return Wide_String;
private
pragma Inline (Is_Control);
pragma Inline (Is_Graphic);
pragma Inline (Is_Letter);
pragma Inline (Is_Lower);
pragma Inline (Is_Upper);
pragma Inline (Is_Basic);
pragma Inline (Is_Digit);
pragma Inline (Is_Hexadecimal_Digit);
pragma Inline (Is_Alphanumeric);
pragma Inline (Is_Basic);
pragma Inline (Is_Character);
pragma Inline (Is_Control);
pragma Inline (Is_Digit);
pragma Inline (Is_Graphic);
pragma Inline (Is_Hexadecimal_Digit);
pragma Inline (Is_ISO_646);
pragma Inline (Is_Letter);
pragma Inline (Is_Line_Terminator);
pragma Inline (Is_Lower);
pragma Inline (Is_Mark);
pragma Inline (Is_Other_Format);
pragma Inline (Is_Punctuation_Connector);
pragma Inline (Is_Space);
pragma Inline (Is_Special);
pragma Inline (Is_Upper);
pragma Inline (To_Basic);
pragma Inline (To_Character);
pragma Inline (To_Lower);
pragma Inline (To_Upper);
pragma Inline (To_Basic);
pragma Inline (Is_ISO_646);
pragma Inline (Is_Character);
pragma Inline (To_Character);
pragma Inline (To_Wide_Character);
end Ada.Characters.Handling;

2
gcc/ada/einfo.adb
View File

@ -8741,7 +8741,7 @@ package body Einfo is
Write_Str ("Corresponding_Discriminant");
when Scalar_Kind =>
Write_Str ("Default_Value");
Write_Str ("Default_Aspect_Value");
when E_Array_Type =>
Write_Str ("Default_Component_Value");

262
gcc/ada/erroutc.adb
View File

@ -451,257 +451,6 @@ package body Erroutc is
Split : Natural;
Start : Natural;
function Get_VMS_Warn_String (W : Character) return String;
-- On VMS, given a warning character W, returns VMS command string
-- that corresponds to that warning character
-------------------------
-- Get_VMS_Warn_String --
-------------------------
function Get_VMS_Warn_String (W : Character) return String is
S, E : Natural;
-- Start and end of VMS_QUALIFIER below
P : Natural;
-- Scans through string
-- The following is a copy of the S_GCC_Warn string from the package
-- VMS_Data. If we made that package part of the compiler sources
-- we could just with it and avoid the duplication ???
V : constant String := "/WARNINGS=" &
"DEFAULT " &
"!-gnatws,!-gnatwe " &
"ALL " &
"-gnatwa " &
"EVERY " &
"-gnatw.e " &
"OPTIONAL " &
"-gnatwa " &
"NOOPTIONAL " &
"-gnatwA " &
"NOALL " &
"-gnatwA " &
"ALL_GCC " &
"-Wall " &
"FAILING_ASSERTIONS " &
"-gnatw.a " &
"NO_FAILING_ASSERTIONS " &
"-gnatw.A " &
"BAD_FIXED_VALUES " &
"-gnatwb " &
"NO_BAD_FIXED_VALUES " &
"-gnatwB " &
"BIASED_REPRESENTATION " &
"-gnatw.b " &
"NO_BIASED_REPRESENTATION " &
"-gnatw.B " &
"CONDITIONALS " &
"-gnatwc " &
"NOCONDITIONALS " &
"-gnatwC " &
"MISSING_COMPONENT_CLAUSES " &
"-gnatw.c " &
"NOMISSING_COMPONENT_CLAUSES " &
"-gnatw.C " &
"IMPLICIT_DEREFERENCE " &
"-gnatwd " &
"NO_IMPLICIT_DEREFERENCE " &
"-gnatwD " &
"TAG_WARNINGS " &
"-gnatw.d " &
"NOTAG_WARNINGS " &
"-gnatw.D " &
"ERRORS " &
"-gnatwe " &
"UNREFERENCED_FORMALS " &
"-gnatwf " &
"NOUNREFERENCED_FORMALS " &
"-gnatwF " &
"UNRECOGNIZED_PRAGMAS " &
"-gnatwg " &
"NOUNRECOGNIZED_PRAGMAS " &
"-gnatwG " &
"HIDING " &
"-gnatwh " &
"NOHIDING " &
"-gnatwH " &
"AVOIDGAPS " &
"-gnatw.h " &
"NOAVOIDGAPS " &
"-gnatw.H " &
"IMPLEMENTATION " &
"-gnatwi " &
"NOIMPLEMENTATION " &
"-gnatwI " &
"OBSOLESCENT " &
"-gnatwj " &
"NOOBSOLESCENT " &
"-gnatwJ " &
"CONSTANT_VARIABLES " &
"-gnatwk " &
"NOCONSTANT_VARIABLES " &
"-gnatwK " &
"STANDARD_REDEFINITION " &
"-gnatw.k " &
"NOSTANDARD_REDEFINITION " &
"-gnatw.K " &
"ELABORATION " &
"-gnatwl " &
"NOELABORATION " &
"-gnatwL " &
"MODIFIED_UNREF " &
"-gnatwm " &
"NOMODIFIED_UNREF " &
"-gnatwM " &
"SUSPICIOUS_MODULUS " &
"-gnatw.m " &
"NOSUSPICIOUS_MODULUS " &
"-gnatw.M " &
"NORMAL " &
"-gnatwn " &
"OVERLAYS " &
"-gnatwo " &
"NOOVERLAYS " &
"-gnatwO " &
"OUT_PARAM_UNREF " &
"-gnatw.o " &
"NOOUT_PARAM_UNREF " &
"-gnatw.O " &
"INEFFECTIVE_INLINE " &
"-gnatwp " &
"NOINEFFECTIVE_INLINE " &
"-gnatwP " &
"MISSING_PARENS " &
"-gnatwq " &
"PARAMETER_ORDER " &
"-gnatw.p " &
"NOPARAMETER_ORDER " &
"-gnatw.P " &
"NOMISSING_PARENS " &
"-gnatwQ " &
"REDUNDANT " &
"-gnatwr " &
"NOREDUNDANT " &
"-gnatwR " &
"OBJECT_RENAMES " &
"-gnatw.r " &
"NOOBJECT_RENAMES " &
"-gnatw.R " &
"SUPPRESS " &
"-gnatws " &
"OVERRIDING_SIZE " &
"-gnatw.s " &
"NOOVERRIDING_SIZE " &
"-gnatw.S " &
"DELETED_CODE " &
"-gnatwt " &
"NODELETED_CODE " &
"-gnatwT " &
"UNINITIALIZED " &
"-Wuninitialized " &
"UNUSED " &
"-gnatwu " &
"NOUNUSED " &
"-gnatwU " &
"UNORDERED_ENUMERATIONS " &
"-gnatw.u " &
"NOUNORDERED_ENUMERATIONS " &
"-gnatw.U " &
"VARIABLES_UNINITIALIZED " &
"-gnatwv " &
"NOVARIABLES_UNINITIALIZED " &
"-gnatwV " &
"REVERSE_BIT_ORDER " &
"-gnatw.v " &
"NOREVERSE_BIT_ORDER " &
"-gnatw.V " &
"LOWBOUND_ASSUMED " &
"-gnatww " &
"NOLOWBOUND_ASSUMED " &
"-gnatwW " &
"WARNINGS_OFF_PRAGMAS " &
"-gnatw.w " &
"NO_WARNINGS_OFF_PRAGMAS " &
"-gnatw.W " &
"IMPORT_EXPORT_PRAGMAS " &
"-gnatwx " &
"NOIMPORT_EXPORT_PRAGMAS " &
"-gnatwX " &
"LOCAL_RAISE_HANDLING " &
"-gnatw.x " &
"NOLOCAL_RAISE_HANDLING " &
"-gnatw.X " &
"ADA_2005_COMPATIBILITY " &
"-gnatwy " &
"NOADA_2005_COMPATIBILITY " &
"-gnatwY " &
"UNCHECKED_CONVERSIONS " &
"-gnatwz " &
"NOUNCHECKED_CONVERSIONS " &
"-gnatwZ";
-- Start of processing for Get_VMS_Warn_String
begin
-- This function works by inspecting the string S_GCC_Warn in the
-- package VMS_Data. We are looking for
-- space VMS_QUALIFIER space -gnatwq
-- where q is the lower case letter W if W is lower case, and the
-- two character string .W if W is upper case. If we find a match
-- we return VMS_QUALIFIER, otherwise we return empty (this should
-- be an error, but no point in bombing over something so trivial).
P := 1;
-- Loop through entries in S_GCC_Warn
loop
-- Scan to next blank
loop
if P >= V'Last - 1 then
return "";
end if;
exit when V (P) = ' ' and then V (P + 1) in 'A' .. 'Z';
P := P + 1;
end loop;
P := P + 1;
S := P;
-- Scan to blank at end of VMS_QUALIFIER
loop
if P >= V'Last then
return "";
end if;
exit when V (P) = ' ';
P := P + 1;
end loop;
E := P - 1;
-- See if this entry matches, and if so, return it
if V (P + 1 .. P + 6) = "-gnatw"
and then
((W in 'a' .. 'z' and then V (P + 7) = W)
or else
(V (P + 7) = '.' and then Fold_Upper (V (P + 8)) = W))
then
return V (S .. E);
end if;
end loop;
end Get_VMS_Warn_String;
-- Start of processing for Output_Msg_Text
begin
-- Add warning doc tag if needed
@ -709,17 +458,6 @@ package body Erroutc is
if Warn_Chr = '?' then
Warn_Tag := new String'(" [enabled by default]");
elsif OpenVMS_On_Target then
declare
Qual : constant String := Get_VMS_Warn_String (Warn_Chr);
begin
if Qual = "" then
Warn_Tag := new String'(Qual);
else
Warn_Tag := new String'(" [" & Qual & ']');
end if;
end;
elsif Warn_Chr in 'a' .. 'z' then
Warn_Tag := new String'(" [-gnatw" & Warn_Chr & ']');

10
gcc/ada/exp_ch4.adb
View File

@ -12402,15 +12402,7 @@ package body Exp_Ch4 is
Name => New_Reference_To (Temp_Id, Loc),
Expression => Make_Null (Loc))));
-- Use the Actions list of logical operators when inserting the
-- finalization call. This ensures that all transient controlled
-- objects are finalized after the operators are evaluated.
if Nkind_In (Context, N_And_Then, N_Or_Else) then
Insert_Action (Context, Fin_Call);
else
Insert_Action_After (Context, Fin_Call);
end if;
Insert_Action_After (Context, Fin_Call);
end if;
end Process_Transient_Object;

7
gcc/ada/sem_type.adb
View File

@ -2611,8 +2611,13 @@ package body Sem_Type is
begin
AI := First (Interface_List (Parent (Target_Typ)));
-- The progenitor itself may be a subtype of an interface type.
while Present (AI) loop
if Etype (AI) = Iface_Typ then
if Etype (AI) = Iface_Typ
or else Base_Type (Etype (AI)) = Iface_Typ
then
return True;
elsif Present (Interfaces (Etype (AI)))

8
gcc/ada/sinfo.ads
View File

@ -934,6 +934,14 @@ package Sinfo is
-- listed above (e.g. in a return statement), an additional type
-- conversion node is introduced to represent the required check.
-- A special case arises for the arguments of the Pred/Succ attributes.
-- Here the range check needed is against First + 1 .. Last (Pred) or
-- First .. Last - 1 (Succ). Essentially these checks are what would be
-- performed within the implicit body of the functions that correspond
-- to these attributes. In these cases, the Do_Range check flag is set
-- on the argument to the attribute function, and the back end must
-- special case the appropriate range to check against.
-- Do_Storage_Check (Flag17-Sem)
-- This flag is set in an N_Allocator node to indicate that a storage
-- check is required for the allocation, or in an N_Subprogram_Body node