diff options
author | charlet <charlet@138bc75d-0d04-0410-961f-82ee72b054a4> | 2004-04-19 15:20:16 +0000 |
---|---|---|
committer | charlet <charlet@138bc75d-0d04-0410-961f-82ee72b054a4> | 2004-04-19 15:20:16 +0000 |
commit | 5329ca6475e92c4a485d941efe57819159434b5e (patch) | |
tree | 978d1dfc5330e89503dce76f1c63cf981f4b9d73 /gcc/ada/sem_elim.adb | |
parent | 4f958b344b0f1c974df27213108354f0af9adb9f (diff) | |
download | gcc-5329ca6475e92c4a485d941efe57819159434b5e.tar.gz |
2004-04-19 Arnaud Charlet <charlet@act-europe.fr>
* 5isystem.ads: Removed, unused.
* gnat_rm.texi: Redo 1.13 change.
2004-04-19 Robert Dewar <dewar@gnat.com>
* s-stoele.ads: Clean up definition of Storage_Offset (the new
definition is cleaner, avoids the kludge of explicit Standard operator
references, and also is consistent with a visible System.Address with
no visible operations.
* s-geveop.adb: Add declarations to avoid assumption of visible
operations on type System.Address (since these might not be available
if Address is a non-private type for which the operations
are made abstract).
* sem_eval.adb: Minor reformatting
* s-carsi8.ads, s-carun8.ads, s-casi16.ads, s-casi32.ads,
s-casi64.ads, s-caun16.ads, s-caun32.ads, s-caun64.ads: Minor
reformatting (new function spec format).
* s-auxdec.adb, s-carsi8.adb, s-carun8.adb, s-casi16.adb,
s-casi32.adb, s-casi64.adb, s-caun16.adb, s-caun32.adb,
s-caun64.adb: Add declarations to avoid assumption of visible
operations on type System.Address (since these might not be available
if Address is a non-private type for which the operations are made
abstract).
* lib.ads, lib.adb (Synchronize_Serial_Number): New procedure.
* exp_intr.adb: Minor comment update
* exp_aggr.adb, exp_attr.adb, exp_ch13.adb: Minor reformatting.
* 5omastop.adb: Add declarations to avoid assumption of visible
operations on type System.Address (since these might not be available
if Address is a non-private type for which the operations
are made abstract).
2004-04-19 Vincent Celier <celier@gnat.com>
* switch-m.adb: (Scan_Make_Switches): Process new switch -eL
* prj-pars.ads (Parse): New Boolean parameter Process_Languages,
defaulted to Ada.
* prj-proc.adb (Process): New Boolean parameter Process_Languages,
defaulted to Ada.
Call Check with Process_Languages.
(Check): New Boolean parameter Process_Languages. Call Recursive_Check
with Process_Languages.
(Recursive_Check): New Boolean parameter Process_Languages. Call
Nmsc.Ada_Check or Nmsc.Other_Languages_Check according to
Process_Languages.
* prj-proc.ads (Process): New Boolean parameter Process_Languages,
* prj-util.ads, prj-util.adb (Executable_Of): New Boolean
parameter Ada_Main, defaulted to True.
Check for Ada specific characteristics only when Ada_Main is True.
* opt.ads: (Follow_Links): New Boolean flag for gnatmake
* prj.adb: (Project_Empty): Add new Project_Data components.
* prj.ads: New types and tables for non Ada languages.
(Project_Data): New components Languages, Impl_Suffixes,
First_Other_Source, Last_Other_Source, Imported_Directories_Switches,
Include_Path, Include_Data_Set.
* prj-env.ads, prj-env.adb: Minor reformatting
* prj-nmsc.ads, prj-nmsc.adb: (Other_Languages_Check): New procedure
Put subprograms in alphabetical order
* prj-pars.adb (Parse): New Boolean parameter Process_Languages,
defaulted to Ada; Call Prj.Proc.Process with Process_Languages and
Opt.Follow_Links.
* mlib-prj.adb: Back out modification in last version, as they are
incorrect.
(Build_Library.Check_Libs): Remove useless pragma Warnings (Off)
* make.adb: (Mains): Moved to package Makeutl
(Linker_Opts): Moved to package Makeutl
(Is_External_Assignment): Moved to package Makeutl
(Test_If_Relative_Path): Moved to package Makeutl
(Gnatmake): Move sorting of linker options to function
Makeutl.Linker_Options_Switches.
* Makefile.in: Add makeutl.o to the object files for gnatmake
* makeusg.adb: Add line for new switch -eL.
* gnatls.adb (Image): New function.
(Output_Unit): If in verbose mode, output the list of restrictions
specified by pragmas Restrictions.
* 5bml-tgt.adb, 5vml-tgt.adb (Build_Dynamic_Library): Do not use
Text_IO.
* a-calend.adb (Split): Shift the date by multiple of 56 years, if
needed, to put it in the range 1970 (included) - 2026 (excluded).
(Time_Of): Do not shift Unix_Min_Year (1970).
Shift the date by multiple of 56 years, if needed, to put it in the
range 1970 (included) - 2026 (excluded).
* adaint.h, adaint.c (__gnat_set_executable): New function.
2004-04-19 Richard Kenner <kenner@vlsi1.ultra.nyu.edu>
* trans.c (tree_transform, case N_Subprogram_Body): Temporarily push
and pop GC context.
(tree_transform, case N_Procedure_Call): Fix typo in setting TREE_TYPE.
(tree_transform, case N_Label): Don't set LABEL_STMT_FIRST_IN_EH.
(tree_transform, case N_Procedure_Call_Statement): Build a tree.
(tree_transform, case N_Code_Statement): Likewise.
(gnat_expand_stmt, case LABEL_STMT): Don't look at
LABEL_STMT_FIRST_IN_EH.
(gnat_expand_stmt, case ASM_STMT): New case.
* utils2.c (build_unary_op): Properly set TREE_READONLY of
UNCONSTRAINED_ARRAY_REF.
* utils.c (poplevel): Temporarily push/pop GC context around inline
function expansion.
* decl.c (maybe_variable): Properly set TREE_READONLY of
UNCONSTRAINED_ARRAY_REF.
(make_packable_type): Only reference TYPE_IS_PADDING_P for RECORD_TYPE.
* ada-tree.def: (ASM_STMT): New.
* ada-tree.h: (LABEL_STMT_FIRST_IN_EH): Deleted.
(ASM_STMT_TEMPLATE, ASM_STMT_OUTPUT, ASM_STMT_ORIG_OUT,
ASM_STMT_INPUT): New.
(ASM_STMT_CLOBBER): Likewise.
2004-04-19 Thomas Quinot <quinot@act-europe.fr>
* a-except.adb, s-parint.ads, s-parint.adb, types.ads, types.h: Use
general rcheck mechanism to raise Program_Error for E.4(18), instead
of a custom raiser in System.Partition_Interface.
Part of general cleanup work before PolyORB integration.
* snames.ads, snames.adb: Add new runtime library entities and names
for PolyORB DSA.
* sem_dist.ads, sem_dist.adb (Get_Subprogram_Id): Move from sem_dist to
exp_dist.
(Build_Subprogram_Id): New subprogram provided by exp_dist
Code reorganisation in preparation for PolyORB integration.
* exp_dist.ads, exp_dist.adb (Get_Subprogram_Id): Move from sem_dist to
exp_dist.
(Build_Subprogram_Id): New subprogram provided by exp_dist
* sem_ch4.adb (Analyze_One_Call): Fix error message for mismatch in
actual parameter types for call to dereference of an
access-to-subprogram type.
* rtsfind.ads: Add new runtime library entities and names for PolyORB
DSA.
* gnatlink.adb (Value): Remove. Use Interfaces.C.Strings.Value
instead, which has the same behaviour here since we never pass it a
NULL pointer.
* link.c (run_path_option, Solaris case): Use -Wl, as for other
platforms.
* Makefile.in: adjust object file lists for gnatlink and gnatmake
to account for new dependency upon Interfaces.C.Strings + link.o
For x86 FreeBSD, use 86numaux.
* make.adb, gnatcmd.adb: Linker_Library_Path_Option has been moved up
from Mlib.Tgt to Mlib.
* mlib.ads, mlib.adb (Linker_Library_Path_Option): New subprogram, now
target-independent.
* mlib-tgt.ads, mlib-tgt.adb (Linker_Library_Path_Option): Remove
target-specific versions of this subprogram, now implemented as a
target-independent function in Mlib.
* 5aml-tgt.adb, 5bml-tgt.adb, 5gml-tgt.adb, 5hml-tgt.adb, 5lml-tgt.adb,
5sml-tgt.adb, 5vml-tgt.adb, 5zml-tgt.adb, 5wml-tgt.adb
(Linker_Library_Path_Option): Remove target-specific versions of this
subprogram, now implemented as a target-independent function in Mlib.
* atree.adb: (Allocate_Initialize_Node): New subprogram.
Factors out node table slots allocation.
(Fix_Parents): New subprogram.
Encapsulate the pattern of fixing up parent pointers for syntactic
children of a rewritten node.
(New_Copy_Tree): Use New_Copy to copy non-entity nodes.
(Rewrite): Use New_Copy when creating saved copy of original node.
(Replace): Use Copy_Node to copy nodes.
2004-04-19 Javier Miranda <miranda@gnat.com>
* sprint.adb (Sprint_Node_Actual): Give support to the new
Access_To_Subprogram node available in Access_Definition nodes. In
addition, give support to the AI-231 node fields: null-exclusion,
all-present, constant-present.
* sem_util.ads, sem_util.adb: (Has_Declarations): New subprogram
* sinfo.ads, sinfo.adb:
New field Access_To_Subprogram_Definition in Access_Definition nodes
* sem_ch6.adb (Process_Formals): Move here the code that creates and
decorates internal subtype declaration corresponding to the
null-excluding formal. This code was previously in Set_Actual_Subtypes.
In addition, carry out some code cleanup on this code. In case of
access to protected subprogram call
Replace_Anonymous_Access_To_Protected_Subprogram.
(Set_Actual_Subtypes): Code cleanup.
* sem_ch8.adb (Analyze_Object_Renaming): Remove un-necessary call to
Find_Type in case of anonymous access renamings. Add warning in case of
null-excluding attribute used in anonymous access renaming.
* sem_ch3.ads (Replace_Anonymous_Access_To_Protected_Subprogram): New
subprogram
* sem_ch3.adb (Replace_Anonymous_Access_To_Protected_Subprogram): New
subprogram.
(Access_Definition): In case of anonymous access to subprograms call
the corresponding semantic routine to decorate the node.
(Access_Subprogram_Declaration): Addition of some comments indicating
some code that probably should be added here. Detected by comparison
with the access_definition subprogram.
(Analyze_Component_Declaration): In case of access to protected
subprogram call Replace_Anonymous_Access_To_Protected.
(Array_Type_Declaration): In case of access to protected subprogram call
Replace_Anonymous_Access_To_Protected_Subprogram.
(Process_Discriminants): In case of access to protected subprogram call
Replace_Anonymous_Access_To_Protected_Subprogram.
* par.adb (P_Access_Definition): New formal that indicates if the
null-exclusion part was present.
(P_Access_Type_Definition): New formal that indicates if the caller has
already parsed the null-excluding part.
* par-ch3.adb (P_Subtype_Declaration): Code cleanup.
(P_Identifier_Declarations): Code cleanup and give support to renamings
of anonymous access to subprogram types.
(P_Derived_Type_Def_Or_Private_Ext_Decl): Code cleanup.
(P_Array_Type_Definition): Give support to AI-254.
(P_Component_Items): Give support to AI-254.
(P_Access_Definition): New formal that indicates if the header was
already parsed by the caller.
(P_Access_Type_Definition): New formal that indicates if the caller has
already parsed the null-excluding part.
* par-ch6.adb (P_Formal_Part): Add the null-excluding parameter to the
call to P_Access_Definition.
2004-04-19 Geert Bosch <bosch@gnat.com>
* checks.adb (Apply_Float_Conversion_Check): New procedure to implement
the delicate semantics of floating-point to integer conversion.
(Apply_Type_Conversion_Checks): Use Apply_Float_Conversion_Check.
* eval_fat.adb (Machine_Mantissa): Moved to spec.
(Machine_Radix): New function.
* eval_fat.ads (Machine_Mantissa): Moved from body for use in
conversion checks.
(Machine_Radix): New function also for use in conversion checks.
2004-04-19 Ed Schonberg <schonberg@gnat.com>
* par-prag.adb (Source_File_Name_Project): Fix typo in error message.
* exp_ch9.adb (Expand_Access_Protected_Subprogram_Type): Call analyze
to decorate the access-to-protected subprogram and the equivalent type.
* checks.adb (Null_Exclusion_Static_Checks): Code cleanup. Give support
to anonymous access to subprogram types.
* exp_ch4.adb (Expand_N_In): Preserve Static flag before
constant-folding, for legality checks in contexts that require an RM
static expression.
* exp_ch6.adb (Expand_N_Function_Call): If call may generate large
temporary but stack checking is not enabled, increment serial number
to so that symbol generation is consistent with and without stack
checking.
* exp_util.ads, exp_util.adb (May_Generate_Large_Temp): Predicate is
independent on whether stack checking is enabled, caller must check
the corresponding flag.
* sem_ch3.adb (Constrain_Index): Index bounds given by attributes need
range checks.
(Build_Derived_Concurrent_Type): Inherit Is_Constrained flag from
parent if it has discriminants.
(Build_Derived_Private_Type): Constructed full view does
not come from source.
(Process_Discriminants): Default discriminants on a tagged type are
legal if this is the internal completion of a private untagged
derivation.
* sem_ch6.adb (Set_Actual_Subtypes): The generated declaration needs
no constraint checks, because it corresponds to an existing object.
* sem_prag.adb (Process_Convention): Pragma applies
only to subprograms in the same declarative part, i.e. the same unit,
not the same scope.
* sem_res.adb (Valid_Conversion): In an instance or inlined body,
ignore type mismatch on a numeric conversion if expression comes from
expansion.
2004-04-19 Sergey Rybin <rybin@act-europe.fr>
* sem_elim.adb (Process_Eliminate_Pragma): Remove the processing for
Homonym_Number parameter, add processing for Source_Location parameter
corresponding.
(Check_Eliminated): Remove the check for homonym numbers, add the check
for source location traces.
* sem_elim.ads (Process_Eliminate_Pragma): Replace Arg_Homonym_Number
with Arg_Source_Location corresponding to the changes in the format of
the pragma.
* sem_prag.adb: (Analyze_Pragma): Changes in the processing of
Eliminate pragma corresponding to the changes in the format of the
pragma: Homonym_Number is replaced with Source_Location, two ways of
distinguishing homonyms are mutially-exclusive.
2004-04-19 Joel Brobecker <brobecker@gnat.com>
* get_targ.ads (Get_No_Dollar_In_Label): Remove.
* exp_dbug.adb (Output_Homonym_Numbers_Suffix): Remove use of
No_Dollar_In_Label, no longer necessary, as it is always True.
(Strip_Suffixes): Likewise.
2004-04-19 Gary Dismukes <dismukes@gnat.com>
* s-stalib.ads (type Exception_Code): Use Integer'Size for exponent of
modulus for compatibility with size clause on targets with 16-bit
Integer.
* layout.adb (Discrimify): In the case of private types, set Vtyp to
full type to fix type mismatches on calls to size functions for
discriminant-dependent array components.
2004-04-19 Jerome Guitton <guitton@act-europe.fr>
* Makefile.in (gnatlib-zcx): New target, for building a ZCX run-time
lib.
2004-04-19 Pascal Obry <obry@gnat.com>
* mdll-utl.adb (Locate): New version is idempotent.
git-svn-id: svn+ssh://gcc.gnu.org/svn/gcc/trunk@80856 138bc75d-0d04-0410-961f-82ee72b054a4
Diffstat (limited to 'gcc/ada/sem_elim.adb')
-rw-r--r-- | gcc/ada/sem_elim.adb | 249 |
1 files changed, 219 insertions, 30 deletions
diff --git a/gcc/ada/sem_elim.adb b/gcc/ada/sem_elim.adb index 3f99d828fc4..31175493ee7 100644 --- a/gcc/ada/sem_elim.adb +++ b/gcc/ada/sem_elim.adb @@ -29,12 +29,12 @@ with Einfo; use Einfo; with Errout; use Errout; with Namet; use Namet; with Nlists; use Nlists; +with Sinput; use Sinput; with Sinfo; use Sinfo; with Snames; use Snames; with Stand; use Stand; with Stringt; use Stringt; with Table; -with Uintp; use Uintp; with GNAT.HTable; use GNAT.HTable; package body Sem_Elim is @@ -83,8 +83,9 @@ package body Sem_Elim is Result_Type : Name_Id; -- Result type name if Result_Types parameter present, No_Name if not - Homonym_Number : Uint; - -- Homonyn number if Homonym_Number parameter present, No_Uint if not. + Source_Location : Name_Id; + -- String describing the source location of subprogram defining name if + -- Source_Location parameter present, No_Name if not Hash_Link : Access_Elim_Data; -- Link for hash table use @@ -229,8 +230,6 @@ package body Sem_Elim is Elmt : Access_Elim_Data; Scop : Entity_Id; Form : Entity_Id; - Ctr : Nat; - Ent : Entity_Id; function Original_Chars (S : Entity_Id) return Name_Id; -- If the candidate subprogram is a protected operation of a single @@ -360,22 +359,200 @@ package body Sem_Elim is elsif Ekind (E) = E_Function or else Ekind (E) = E_Procedure then - -- If Homonym_Number present, then see if it matches + -- If Source_Location present, then see if it matches + + if Elmt.Source_Location /= No_Name then + Get_Name_String (Elmt.Source_Location); + + declare + Sloc_Trace : constant String := + Name_Buffer (1 .. Name_Len); + + Idx : Natural := Sloc_Trace'First; + -- Index in Sloc_Trace, if equals to 0, then we have + -- completely traversed Sloc_Trace + + Last : constant Natural := Sloc_Trace'Last; + + P : Source_Ptr; + Sindex : Source_File_Index; + + function File_Mame_Match return Boolean; + -- This function is supposed to be called when Idx points + -- to the beginning of the new file name, and Name_Buffer + -- is set to contain the name of the proper source file + -- from the chain corresponding to the Sloc of E. First + -- it checks that these two files have the same name. If + -- this check is successful, moves Idx to point to the + -- beginning of the column number. + + function Line_Num_Match return Boolean; + -- This function is supposed to be called when Idx points + -- to the beginning of the column number, and P is + -- set to point to the proper Sloc the chain + -- corresponding to the Sloc of E. First it checks that + -- the line number Idx points on and the line number + -- corresponding to P are the same. If this check is + -- successful, moves Idx to point to the beginning of + -- the next file name in Sloc_Trace. If there is no file + -- name any more, Idx is set to 0. + + function Different_Trace_Lengths return Boolean; + -- From Idx and P, defines if there are in both traces + -- more element(s) in the instantiation chains. Returns + -- False if one trace contains more element(s), but + -- another does not. If both traces contains more + -- elements (that is, the function returns False), moves + -- P ahead in the chain corresponding to E, recomputes + -- Sindex and sets the name of the corresponding file in + -- Name_Buffer + + function Skip_Spaces return Natural; + -- If Sloc_Trace (Idx) is not space character, returns + -- Idx. Otherwise returns the index of the nearest + -- non-space character in Sloc_Trace to the right of + -- Idx. Returns 0 if there is no such character. + + function Different_Trace_Lengths return Boolean is + begin + P := Instantiation (Sindex); + + if (P = No_Location and then Idx /= 0) + or else + (P /= No_Location and then Idx = 0) + then + return True; + else - if Elmt.Homonym_Number /= No_Uint then - Ctr := 1; + if P /= No_Location then + Sindex := Get_Source_File_Index (P); + Get_Name_String (File_Name (Sindex)); + end if; - Ent := E; - while Present (Homonym (Ent)) - and then Scope (Ent) = Scope (Homonym (Ent)) - loop - Ctr := Ctr + 1; - Ent := Homonym (Ent); - end loop; + return False; + end if; + end Different_Trace_Lengths; - if Ctr /= Elmt.Homonym_Number then - goto Continue; - end if; + function File_Mame_Match return Boolean is + Tmp_Idx : Positive; + End_Idx : Positive; + begin + + if Idx = 0 then + return False; + end if; + + for J in Idx .. Last loop + if Sloc_Trace (J) = ':' then + Tmp_Idx := J - 1; + exit; + end if; + end loop; + + for J in reverse Idx .. Tmp_Idx loop + if Sloc_Trace (J) /= ' ' then + End_Idx := J; + exit; + end if; + end loop; + + if Sloc_Trace (Idx .. End_Idx) = + Name_Buffer (1 .. Name_Len) + then + Idx := Tmp_Idx + 2; + + Idx := Skip_Spaces; + + return True; + else + return False; + end if; + + end File_Mame_Match; + + function Line_Num_Match return Boolean is + N : Int := 0; + begin + + if Idx = 0 then + return False; + end if; + + while Idx <= Last + and then + Sloc_Trace (Idx) in '0' .. '9' + loop + N := N * 10 + + (Character'Pos (Sloc_Trace (Idx)) - + Character'Pos ('0')); + + Idx := Idx + 1; + end loop; + + if Get_Physical_Line_Number (P) = + Physical_Line_Number (N) + then + + while Sloc_Trace (Idx) /= '[' + and then + Idx <= Last + loop + Idx := Idx + 1; + end loop; + + if Sloc_Trace (Idx) = '[' + and then + Idx < Last + then + Idx := Idx + 1; + Idx := Skip_Spaces; + else + Idx := 0; + end if; + + return True; + else + return False; + end if; + + end Line_Num_Match; + + function Skip_Spaces return Natural is + Res : Natural := Idx; + begin + + while Sloc_Trace (Res) = ' ' loop + Res := Res + 1; + + if Res > Last then + Res := 0; + exit; + end if; + end loop; + + return Res; + end Skip_Spaces; + + begin + P := Sloc (E); + Sindex := Get_Source_File_Index (P); + Get_Name_String (File_Name (Sindex)); + + Idx := Skip_Spaces; + + while Idx > 0 loop + + if not File_Mame_Match then + goto Continue; + elsif not Line_Num_Match then + goto Continue; + end if; + + if Different_Trace_Lengths then + goto Continue; + end if; + end loop; + end; end if; -- If we have a Result_Type, then we must have a function @@ -394,7 +571,14 @@ package body Sem_Elim is if Elmt.Parameter_Types /= null then Form := First_Formal (E); - if No (Form) and then Elmt.Parameter_Types = null then + if No (Form) + and then + Elmt.Parameter_Types'Length = 1 + and then + Elmt.Parameter_Types (1) = No_Name + then + -- Parameterless procedure matches + null; elsif Elmt.Parameter_Types = null then @@ -471,7 +655,7 @@ package body Sem_Elim is Arg_Entity : Node_Id; Arg_Parameter_Types : Node_Id; Arg_Result_Type : Node_Id; - Arg_Homonym_Number : Node_Id) + Arg_Source_Location : Node_Id) is Data : constant Access_Elim_Data := new Elim_Data; -- Build result data here @@ -593,7 +777,13 @@ package body Sem_Elim is and then Paren_Count (Arg_Parameter_Types) = 1 then String_To_Name_Buffer (Strval (Arg_Parameter_Types)); - Data.Parameter_Types := new Names'(1 => Name_Find); + + if Name_Len = 0 then + -- Parameterless procedure + Data.Parameter_Types := new Names'(1 => No_Name); + else + Data.Parameter_Types := new Names'(1 => Name_Find); + end if; -- Otherwise must be an aggregate @@ -647,25 +837,24 @@ package body Sem_Elim is Data.Result_Type := No_Name; end if; - -- Process Homonym_Number argument + -- Process Source_Location argument - if Present (Arg_Homonym_Number) then + if Present (Arg_Source_Location) then - if Nkind (Arg_Homonym_Number) /= N_Integer_Literal then + if Nkind (Arg_Source_Location) /= N_String_Literal then Error_Msg_N - ("Homonym_Number argument for pragma% must be integer literal", - Arg_Homonym_Number); + ("Source_Location argument for pragma% must be string literal", + Arg_Source_Location); return; end if; - Data.Homonym_Number := Intval (Arg_Homonym_Number); + String_To_Name_Buffer (Strval (Arg_Source_Location)); + Data.Source_Location := Name_Find; else - Data.Homonym_Number := No_Uint; + Data.Source_Location := No_Name; end if; - -- Now link this new entry into the hash table - Elmt := Elim_Hash_Table.Get (Hash_Subprograms.Get_Key (Data)); -- If we already have an entry with this same key, then link |