diff options
author | charlet <charlet@138bc75d-0d04-0410-961f-82ee72b054a4> | 2003-10-23 11:57:52 +0000 |
---|---|---|
committer | charlet <charlet@138bc75d-0d04-0410-961f-82ee72b054a4> | 2003-10-23 11:57:52 +0000 |
commit | b743d2fec7f114a7ad9f774f53d9790ce38b30c1 (patch) | |
tree | bdb15adb9e94a854c31457fc6b697589530ef086 /gcc | |
parent | fabb7dc5d9930bb83dc7372080383b31544caf1d (diff) | |
download | gcc-b743d2fec7f114a7ad9f774f53d9790ce38b30c1.tar.gz |
PR ada/11978:
* exp_ch13.adb (Expand_N_Freeze_Entity): Do not consider inherited
External_Tag attribute definition clauses.
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.
* g-regpat.ads, g-regpat.adb: Minor reformatting
* Makefile.in: Use the file 1atags.ads with the ZFP and cert run-times.
* trans.c: (tree_transform, case N_Real_Literal): Add extra arg to
Machine call.
* urealp.h: (Machine): Update to proper definition.
git-svn-id: svn+ssh://gcc.gnu.org/svn/gcc/trunk@72843 138bc75d-0d04-0410-961f-82ee72b054a4
Diffstat (limited to 'gcc')
-rw-r--r-- | gcc/ada/ChangeLog | 32 | ||||
-rw-r--r-- | gcc/ada/Makefile.in | 3 | ||||
-rw-r--r-- | gcc/ada/exp_ch13.adb | 6 | ||||
-rw-r--r-- | gcc/ada/exp_dbug.adb | 10 | ||||
-rw-r--r-- | gcc/ada/exp_dbug.ads | 7 | ||||
-rw-r--r-- | gcc/ada/g-regpat.adb | 87 | ||||
-rw-r--r-- | gcc/ada/g-regpat.ads | 21 | ||||
-rw-r--r-- | gcc/ada/trans.c | 2 | ||||
-rw-r--r-- | gcc/ada/urealp.h | 5 |
9 files changed, 104 insertions, 69 deletions
diff --git a/gcc/ada/ChangeLog b/gcc/ada/ChangeLog index 3ddc2d31ae1..82bfc681a07 100644 --- a/gcc/ada/ChangeLog +++ b/gcc/ada/ChangeLog @@ -1,3 +1,35 @@ +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. diff --git a/gcc/ada/Makefile.in b/gcc/ada/Makefile.in index ec5cabe0e16..48fae10c0ad 100644 --- a/gcc/ada/Makefile.in +++ b/gcc/ada/Makefile.in @@ -600,6 +600,7 @@ ifeq ($(strip $(filter-out powerpc% wrs vxworks,$(targ))),) 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 \ @@ -694,6 +695,7 @@ ifeq ($(strip $(filter-out powerpc% wrs vxworksae,$(targ))),) 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 \ @@ -1969,6 +1971,7 @@ gnatlib: ../stamp-gnatlib1 ../stamp-gnatlib2 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 \ diff --git a/gcc/ada/exp_ch13.adb b/gcc/ada/exp_ch13.adb index 28d6c915076..0cde2a67035 100644 --- a/gcc/ada/exp_ch13.adb +++ b/gcc/ada/exp_ch13.adb @@ -329,7 +329,9 @@ package body Exp_Ch13 is 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 := @@ -337,7 +339,7 @@ package body Exp_Ch13 is (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; diff --git a/gcc/ada/exp_dbug.adb b/gcc/ada/exp_dbug.adb index 9e7bcc0eeab..aa47c00153b 100644 --- a/gcc/ada/exp_dbug.adb +++ b/gcc/ada/exp_dbug.adb @@ -358,6 +358,16 @@ package body Exp_Dbug is 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; diff --git a/gcc/ada/exp_dbug.ads b/gcc/ada/exp_dbug.ads index d17f14b0814..e8738b3aad5 100644 --- a/gcc/ada/exp_dbug.ads +++ b/gcc/ada/exp_dbug.ads @@ -951,7 +951,10 @@ package Exp_Dbug is -- 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. @@ -1036,7 +1039,7 @@ package Exp_Dbug is -- 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 diff --git a/gcc/ada/g-regpat.adb b/gcc/ada/g-regpat.adb index 20001bc4fc8..35df55d70bd 100644 --- a/gcc/ada/g-regpat.adb +++ b/gcc/ada/g-regpat.adb @@ -237,8 +237,7 @@ package body GNAT.Regpat is 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); @@ -268,8 +267,7 @@ package body GNAT.Regpat is 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; @@ -283,14 +281,12 @@ package body GNAT.Regpat is 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); @@ -298,8 +294,7 @@ package body GNAT.Regpat is 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 @@ -2052,8 +2047,7 @@ package body GNAT.Regpat is 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); @@ -2296,8 +2290,7 @@ package body GNAT.Regpat is function Get_From_Class (Bitmap : Character_Class; - C : Character) - return Boolean + C : Character) return Boolean is Value : constant Class_Byte := Character'Pos (C); @@ -2327,8 +2320,7 @@ package body GNAT.Regpat is function Get_Next_Offset (Program : Program_Data; - IP : Pointer) - return Pointer + IP : Pointer) return Pointer is begin return Pointer (Read_Natural (Program, IP + 1)); @@ -2432,9 +2424,8 @@ package body GNAT.Regpat is -- 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. @@ -2468,8 +2459,7 @@ package body GNAT.Regpat is (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); @@ -2484,11 +2474,7 @@ package body GNAT.Regpat is -- 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 @@ -2529,7 +2515,7 @@ package body GNAT.Regpat is -- Match -- ----------- - function Match (IP : Pointer) return Boolean is + function Match (IP : Pointer) return Boolean is Scan : Pointer := IP; Next : Pointer; Op : Opcode; @@ -2835,8 +2821,7 @@ package body GNAT.Regpat is (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; @@ -3137,9 +3122,8 @@ package body GNAT.Regpat is ------------ 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; @@ -3384,12 +3368,15 @@ package body GNAT.Regpat is 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); @@ -3402,12 +3389,11 @@ package body GNAT.Regpat is 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); @@ -3436,13 +3422,16 @@ package body GNAT.Regpat is 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 @@ -3456,13 +3445,16 @@ package body GNAT.Regpat is 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); @@ -3592,8 +3584,7 @@ package body GNAT.Regpat is function Read_Natural (Program : Program_Data; - IP : Pointer) - return Natural + IP : Pointer) return Natural is begin return Character'Pos (Program (IP)) + @@ -3618,7 +3609,6 @@ package body GNAT.Regpat is C : Character) is Value : constant Class_Byte := Character'Pos (C); - begin Bitmap (Value / 8) := Bitmap (Value / 8) or Bit_Conversion (Value mod 8); @@ -3630,8 +3620,7 @@ package body GNAT.Regpat is 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); diff --git a/gcc/ada/g-regpat.ads b/gcc/ada/g-regpat.ads index 52ab3c19e29..57bc076717a 100644 --- a/gcc/ada/g-regpat.ads +++ b/gcc/ada/g-regpat.ads @@ -301,7 +301,7 @@ pragma Preelaborate (Regpat); -- 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. @@ -380,8 +380,7 @@ pragma Preelaborate (Regpat); 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 @@ -476,8 +475,7 @@ pragma Preelaborate (Regpat); 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. -- @@ -493,8 +491,7 @@ pragma Preelaborate (Regpat); 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. @@ -516,8 +513,7 @@ pragma Preelaborate (Regpat); (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. @@ -528,14 +524,13 @@ pragma Preelaborate (Regpat); (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; @@ -555,7 +550,7 @@ pragma Preelaborate (Regpat); ----------- 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 -- diff --git a/gcc/ada/trans.c b/gcc/ada/trans.c index 3df165cc2a9..d28ded8f305 100644 --- a/gcc/ada/trans.c +++ b/gcc/ada/trans.c @@ -564,7 +564,7 @@ tree_transform (gnat_node) 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); diff --git a/gcc/ada/urealp.h b/gcc/ada/urealp.h index 1153f250e15..207e8b105e5 100644 --- a/gcc/ada/urealp.h +++ b/gcc/ada/urealp.h @@ -6,7 +6,7 @@ * * * 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- * @@ -47,4 +47,5 @@ extern Boolean UR_Is_Zero (Ureal); 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); |