+2003-10-23 Thomas Quinot <quinot@act-europe.fr>
+
+ PR ada/11978:
+ * exp_ch13.adb (Expand_N_Freeze_Entity): Do not consider inherited
+ External_Tag attribute definition clauses.
+
+2003-10-23 Ed Schonberg <schonberg@gnat.com>
+
+ PR ada/7613:
+ * exp_dbug.adb (Debug_Renaming_Declaration): For the renaming of a
+ child unit, generate a fully qualified name to avoid spurious errors
+ when the context contains renamings of different child units with
+ the same simple name.
+
+ * exp_dbug.ads: Add documentation on name qualification for renamings
+ of child units.
+
+2003-10-23 Robert Dewar <dewar@gnat.com>
+
+ * g-regpat.ads, g-regpat.adb: Minor reformatting
+
+2003-10-23 Jose Ruiz <ruiz@act-europe.fr>
+
+ * Makefile.in: Use the file 1atags.ads with the ZFP and cert run-times.
+
+2003-10-23 Richard Kenner <kenner@vlsi1.ultra.nyu.edu>
+
+ * trans.c: (tree_transform, case N_Real_Literal): Add extra arg to
+ Machine call.
+
+ * urealp.h: (Machine): Update to proper definition.
+
2003-10-23 Arnaud Charlet <charlet@act-europe.fr>
* init.c, adaint.c: Minor reformatting.
a-taside.adb<1ataside.adb \
CERT_LEVEL_B_TARGET_PAIRS=\
+ a-tags.ads<1atags.ads \
a-tags.adb<1atags.adb \
a-except.adb<2aexcept.adb \
a-except.ads<2aexcept.ads \
a-taside.adb<1ataside.adb \
CERT_LEVEL_B_TARGET_PAIRS=\
+ a-tags.ads<1atags.ads \
a-tags.adb<1atags.adb \
a-except.adb<2aexcept.adb \
a-except.ads<2aexcept.ads \
HIE_NONE_TARGET_PAIRS=\
a-except.ads<1aexcept.ads \
a-except.adb<1aexcept.adb \
+ a-tags.ads<1atags.ads \
a-tags.adb<1atags.adb \
s-secsta.ads<1ssecsta.ads \
s-secsta.adb<1ssecsta.adb \
and then Is_First_Subtype (E)
then
-- Check for a definition of External_Tag, whose expansion must
- -- be delayed until the dispatch table is built.
+ -- be delayed until the dispatch table is built. The clause
+ -- is considered only if it applies to this specific tagged
+ -- type, as opposed to one of its ancestors.
declare
Def : constant Node_Id :=
(E, Attribute_External_Tag);
begin
- if Present (Def) then
+ if Present (Def) and then Entity (Name (Def)) = E then
Expand_External_Tag_Definition (Def);
end if;
end;
when N_Package_Renaming_Declaration =>
Add_Str_To_Name_Buffer ("___XRP");
+ -- If it is a child unit create a fully qualified name,
+ -- to disambiguate multiple child units with the same
+ -- name and different parents.
+
+ if Is_Child_Unit (Ent) then
+ Prepend_String_To_Buffer ("__");
+ Prepend_String_To_Buffer
+ (Get_Name_String (Chars (Scope (Ent))));
+ end if;
+
when others =>
return Empty;
end case;
-- x___XRP for a package renaming
-- The name is fully qualified in the usual manner, i.e. qualified in
- -- the same manner as the entity x would be.
+ -- the same manner as the entity x would be. In the case of a package
+ -- renaming where x is a child unit, the qualification includes the
+ -- name of the parent unit, to disambiguate child units with the same
+ -- simple name and (of necessity) different parents.
-- Note: subprogram renamings are not encoded at the present time.
-- type p__z___XR is
-- (p__g___XEXS1XS5XRmXL2XS3);
- -- p__q___XE--------------------outer entity is g
+ -- p__g___XE--------------------outer entity is g
-- XS1-----------------first subscript for g
-- XS5--------------second subscript for g
-- XRm-----------select field m
function Get_From_Class
(Bitmap : Character_Class;
- C : Character)
- return Boolean;
+ C : Character) return Boolean;
-- Return True if the entry is set for C in the class Bitmap.
procedure Reset_Class (Bitmap : out Character_Class);
function String_Length
(Program : Program_Data;
- P : Pointer)
- return Program_Size;
+ P : Pointer) return Program_Size;
-- Return the length of the string argument of the node at P
function String_Operand (P : Pointer) return Pointer;
function Get_Next_Offset
(Program : Program_Data;
- IP : Pointer)
- return Pointer;
+ IP : Pointer) return Pointer;
-- Get the offset field of a node. Used by Get_Next.
function Get_Next
(Program : Program_Data;
- IP : Pointer)
- return Pointer;
+ IP : Pointer) return Pointer;
-- Dig the next instruction pointer out of a node
procedure Optimize (Self : in out Pattern_Matcher);
function Read_Natural
(Program : Program_Data;
- IP : Pointer)
- return Natural;
+ IP : Pointer) return Natural;
-- Return the 2-byte natural coded at position IP.
-- All of the subprograms above are tiny and should be inlined
function Compile
(Expression : String;
- Flags : Regexp_Flags := No_Flags)
- return Pattern_Matcher
+ Flags : Regexp_Flags := No_Flags) return Pattern_Matcher
is
Size : Program_Size;
Dummy : Pattern_Matcher (0);
function Get_From_Class
(Bitmap : Character_Class;
- C : Character)
- return Boolean
+ C : Character) return Boolean
is
Value : constant Class_Byte := Character'Pos (C);
function Get_Next_Offset
(Program : Program_Data;
- IP : Pointer)
- return Pointer
+ IP : Pointer) return Pointer
is
begin
return Pointer (Read_Natural (Program, IP + 1));
-- Find character C in Data starting at Start and return position
function Repeat
- (IP : Pointer;
- Max : Natural := Natural'Last)
- return Natural;
+ (IP : Pointer;
+ Max : Natural := Natural'Last) return Natural;
-- Repeatedly match something simple, report how many
-- It only matches on things of length 1.
-- Starting from Input_Pos, it matches at most Max CURLY.
(Op : Opcode;
Scan : Pointer;
Next : Pointer;
- Greedy : Boolean)
- return Boolean;
+ Greedy : Boolean) return Boolean;
-- Return True it the simple operator (possibly non-greedy) matches
pragma Inline (Index);
-- Index --
-----------
- function Index
- (Start : Positive;
- C : Character)
- return Natural
- is
+ function Index (Start : Positive; C : Character) return Natural is
begin
for J in Start .. Last_In_Data loop
if Data (J) = C then
-- Match --
-----------
- function Match (IP : Pointer) return Boolean is
+ function Match (IP : Pointer) return Boolean is
Scan : Pointer := IP;
Next : Pointer;
Op : Opcode;
(Op : Opcode;
Scan : Pointer;
Next : Pointer;
- Greedy : Boolean)
- return Boolean
+ Greedy : Boolean) return Boolean
is
Next_Char : Character := ASCII.Nul;
Next_Char_Known : Boolean := False;
------------
function Repeat
- (IP : Pointer;
- Max : Natural := Natural'Last)
- return Natural
+ (IP : Pointer;
+ Max : Natural := Natural'Last) return Natural
is
Scan : Natural := Input_Pos;
Last : Natural;
return;
end Match;
- function Match
- (Self : Pattern_Matcher;
- Data : String;
+ -----------
+ -- Match --
+ -----------
+
+ function Match
+ (Self : Pattern_Matcher;
+ Data : String;
Data_First : Integer := -1;
- Data_Last : Positive := Positive'Last)
- return Natural
+ Data_Last : Positive := Positive'Last) return Natural
is
Matches : Match_Array (0 .. 0);
end if;
end Match;
- function Match
+ function Match
(Self : Pattern_Matcher;
Data : String;
Data_First : Integer := -1;
- Data_Last : Positive := Positive'Last)
- return Boolean
+ Data_Last : Positive := Positive'Last) return Boolean
is
Matches : Match_Array (0 .. 0);
end if;
end Match;
+ -----------
+ -- Match --
+ -----------
+
function Match
(Expression : String;
Data : String;
Size : Program_Size := 0;
Data_First : Integer := -1;
- Data_Last : Positive := Positive'Last)
- return Natural
+ Data_Last : Positive := Positive'Last) return Natural
is
PM : Pattern_Matcher (Size);
Final_Size : Program_Size; -- unused
end if;
end Match;
+ -----------
+ -- Match --
+ -----------
+
function Match
(Expression : String;
Data : String;
Size : Program_Size := 0;
Data_First : Integer := -1;
- Data_Last : Positive := Positive'Last)
- return Boolean
+ Data_Last : Positive := Positive'Last) return Boolean
is
Matches : Match_Array (0 .. 0);
PM : Pattern_Matcher (Size);
function Read_Natural
(Program : Program_Data;
- IP : Pointer)
- return Natural
+ IP : Pointer) return Natural
is
begin
return Character'Pos (Program (IP)) +
C : Character)
is
Value : constant Class_Byte := Character'Pos (C);
-
begin
Bitmap (Value / 8) := Bitmap (Value / 8)
or Bit_Conversion (Value mod 8);
function String_Length
(Program : Program_Data;
- P : Pointer)
- return Program_Size
+ P : Pointer) return Program_Size
is
begin
pragma Assert (Program (P) = EXACT or else Program (P) = EXACTF);
-- byte-compiled version of regular expressions.
Max_Program_Size : constant := 2**15 - 1;
- -- Maximum size that can be allocated for a program.
+ -- Maximum size that can be allocated for a program
Max_Curly_Repeat : constant := 32767;
-- Maximum number of repetition for the curly operator.
function Compile
(Expression : String;
- Flags : Regexp_Flags := No_Flags)
- return Pattern_Matcher;
+ Flags : Regexp_Flags := No_Flags) return Pattern_Matcher;
-- Compile a regular expression into internal code.
-- Raises Expression_Error if Expression is not a legal regular expression.
-- The appropriate size is calculated automatically, but this means that
Data : String;
Size : Program_Size := 0;
Data_First : Integer := -1;
- Data_Last : Positive := Positive'Last)
- return Natural;
+ Data_Last : Positive := Positive'Last) return Natural;
-- Return the position where Data matches, or (Data'First - 1) if
-- there is no match.
--
Data : String;
Size : Program_Size := 0;
Data_First : Integer := -1;
- Data_Last : Positive := Positive'Last)
- return Boolean;
+ Data_Last : Positive := Positive'Last) return Boolean;
-- Return True if Data matches Expression. Match raises Storage_Error
-- if Size is too small for Expression, or Expression_Error if Expression
-- is not a legal regular expression.
(Self : Pattern_Matcher;
Data : String;
Data_First : Integer := -1;
- Data_Last : Positive := Positive'Last)
- return Natural;
+ Data_Last : Positive := Positive'Last) return Natural;
-- Match Data using the given pattern matcher.
-- Return the position where Data matches, or (Data'First - 1) if there is
-- no match.
(Self : Pattern_Matcher;
Data : String;
Data_First : Integer := -1;
- Data_Last : Positive := Positive'Last)
- return Boolean;
+ Data_Last : Positive := Positive'Last) return Boolean;
-- Return True if Data matches using the given pattern matcher.
--
-- See description of Data_First and Data_Last above.
pragma Inline (Match);
- -- All except the last one below.
+ -- All except the last one below
procedure Match
(Self : Pattern_Matcher;
-----------
procedure Dump (Self : Pattern_Matcher);
- -- Dump the compiled version of the regular expression matched by Self.
+ -- Dump the compiled version of the regular expression matched by Self
--------------------------
-- Private Declarations --
if (! Is_Machine_Number (gnat_node))
ur_realval
= Machine (Base_Type (Underlying_Type (Etype (gnat_node))),
- ur_realval, Round_Even);
+ ur_realval, Round_Even, gnat_node);
gnu_result
= UI_To_gnu (Numerator (ur_realval), gnu_result_type);
* *
* C Header File *
* *
- * Copyright (C) 1992-2002 Free Software Foundation, Inc. *
+ * Copyright (C) 1992-2003 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- *
enum Rounding_Mode {Floor = 0, Ceiling = 1, Round = 2, Round_Even = 3};
#define Machine eval_fat__machine
-extern Ureal Machine (Entity_Id, Ureal, enum Rounding_Mode);
+extern Ureal Machine (Entity_Id, Ureal, enum Rounding_Mode,
+ Node_Id);
OSDN Git Service
