+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
-- --
-- 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- --
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;
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,
BPH => Control,
NBH => Control,
Reserved_132 => Control,
- NEL => Control,
+ NEL => Control + Line_Term,
SSA => Control,
ESA => Control,
HTS => Control,
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 --
--------------
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 --
----------------
-- --
-- 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 --
-- 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 --
(Item : String) return Wide_String;
private
+ 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_Upper);
- pragma Inline (Is_Basic);
- pragma Inline (Is_Digit);
- pragma Inline (Is_Hexadecimal_Digit);
- pragma Inline (Is_Alphanumeric);
+ pragma Inline (Is_Mark);
+ pragma Inline (Is_Other_Format);
+ pragma Inline (Is_Punctuation_Connector);
+ pragma Inline (Is_Space);
pragma Inline (Is_Special);
- pragma Inline (To_Lower);
- pragma Inline (To_Upper);
+ pragma Inline (Is_Upper);
pragma Inline (To_Basic);
- pragma Inline (Is_ISO_646);
- pragma Inline (Is_Character);
pragma Inline (To_Character);
+ pragma Inline (To_Lower);
+ pragma Inline (To_Upper);
pragma Inline (To_Wide_Character);
end Ada.Characters.Handling;
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");
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
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 & ']');
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;
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)))
-- 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
projects / thirdparty / gcc.git / commitdiff
