From: Arnaud Charlet Date: Tue, 7 Jul 2009 13:38:45 +0000 (+0200) Subject: [multiple changes] X-Git-Url: https://git.libre-soc.org/?a=commitdiff_plain;h=c236914646f38f11fc12e1a4a1957c2378c51171;p=gcc.git [multiple changes] 2009-07-07 Gary Dismukes * exp_ch6.adb (Expand_Actuals): Call Add_Call_By_Copy_Code for in out parameters when the subtype of the actual is not known to be a subrange of the formal's subtype. (Expand_Call): Generate a range check only in the E_In_parameter case (in out parameter range checks are now handled in Expand_Actuals). * exp_ch4.adb (Expand_N_Slice): Restore code that calls Enable_Range_Check. 2009-07-07 Robert Dewar * a-stwise.adb, a-stzsea.adb, a-strsea.adb: Add comments 2009-07-07 Javier Miranda * exp_disp.adb (Expand_Interface_Conversion): Handle access type whose designated type comes from a limited views. 2009-07-07 Emmanuel Briot * prj.ads, prj-nmsc.adb (Mark_Excluded_Sources): Fix handling of locally removed files that are later made visible again in an importing project. 2009-07-07 Robert Dewar * gnat_rm.texi: Clarify documentation of Stream_Convert pragma 2009-07-07 Sergey Rybin * gnat_ugn.texi: Add an example to the description of gnatcheck 'Style_Checks' rule option. 2009-07-07 Tristan Gingold * seh_init.c: Fix inline assembly statement in seh_init.c 2009-07-07 Ed Schonberg * sem_warn.adb (Check_References): Do not emit warnings on formals of an entry body. Only the formals of the entry declaration are traced. From-SVN: r149328 --- diff --git a/gcc/ada/ChangeLog b/gcc/ada/ChangeLog index c22b4c7a01a..0253a696b25 100644 --- a/gcc/ada/ChangeLog +++ b/gcc/ada/ChangeLog @@ -1,3 +1,47 @@ +2009-07-07 Gary Dismukes + + * exp_ch6.adb (Expand_Actuals): Call Add_Call_By_Copy_Code for in out + parameters when the subtype of the actual is not known to be a subrange + of the formal's subtype. + (Expand_Call): Generate a range check only in the E_In_parameter case + (in out parameter range checks are now handled in Expand_Actuals). + + * exp_ch4.adb (Expand_N_Slice): Restore code that calls + Enable_Range_Check. + +2009-07-07 Robert Dewar + + * a-stwise.adb, a-stzsea.adb, a-strsea.adb: Add comments + +2009-07-07 Javier Miranda + + * exp_disp.adb (Expand_Interface_Conversion): Handle access type whose + designated type comes from a limited views. + +2009-07-07 Emmanuel Briot + + * prj.ads, prj-nmsc.adb (Mark_Excluded_Sources): Fix handling of + locally removed files that are later made visible again in an importing + project. + +2009-07-07 Robert Dewar + + * gnat_rm.texi: Clarify documentation of Stream_Convert pragma + +2009-07-07 Sergey Rybin + + * gnat_ugn.texi: Add an example to the description of gnatcheck + 'Style_Checks' rule option. + +2009-07-07 Tristan Gingold + + * seh_init.c: Fix inline assembly statement in seh_init.c + +2009-07-07 Ed Schonberg + + * sem_warn.adb (Check_References): Do not emit warnings on formals of + an entry body. Only the formals of the entry declaration are traced. + 2009-07-07 Robert Dewar * s-osprim-mingw.adb: Minor reformatting diff --git a/gcc/ada/a-strsea.adb b/gcc/ada/a-strsea.adb index d6898331e91..848c0630710 100644 --- a/gcc/ada/a-strsea.adb +++ b/gcc/ada/a-strsea.adb @@ -238,9 +238,14 @@ package body Ada.Strings.Search is Mapping : Maps.Character_Mapping := Maps.Identity) return Natural is PL1 : constant Integer := Pattern'Length - 1; - Ind : Integer; -- can be negative if Pattern'Length > Source'Length Cur : Natural; + Ind : Integer; + -- Index for start of match check. This can be negative if the pattern + -- length is greater than the string length, which is why this variable + -- is Integer instead of Natural. In this case, the search loops do not + -- execute at all, so this Ind value is never used. + begin if Pattern = "" then raise Pattern_Error; diff --git a/gcc/ada/a-stwise.adb b/gcc/ada/a-stwise.adb index c5fb0be9abf..0e22f64bec7 100644 --- a/gcc/ada/a-stwise.adb +++ b/gcc/ada/a-stwise.adb @@ -77,6 +77,7 @@ package body Ada.Strings.Wide_Search is Num : Natural; Ind : Natural; Cur : Natural; + begin if Pattern = "" then raise Pattern_Error; @@ -233,9 +234,14 @@ package body Ada.Strings.Wide_Search is return Natural is PL1 : constant Integer := Pattern'Length - 1; - Ind : Integer; -- can be negative if Pattern'Length > Source'Length Cur : Natural; + Ind : Integer; + -- Index for start of match check. This can be negative if the pattern + -- length is greater than the string length, which is why this variable + -- is Integer instead of Natural. In this case, the search loops do not + -- execute at all, so this Ind value is never used. + begin if Pattern = "" then raise Pattern_Error; diff --git a/gcc/ada/a-stzsea.adb b/gcc/ada/a-stzsea.adb index 4947896809c..0dc6d9bbf5c 100644 --- a/gcc/ada/a-stzsea.adb +++ b/gcc/ada/a-stzsea.adb @@ -237,9 +237,14 @@ package body Ada.Strings.Wide_Wide_Search is return Natural is PL1 : constant Integer := Pattern'Length - 1; - Ind : Integer; -- can be negative if Pattern'Length > Source'Length Cur : Natural; + Ind : Integer; + -- Index for start of match check. This can be negative if the pattern + -- length is greater than the string length, which is why this variable + -- is Integer instead of Natural. In this case, the search loops do not + -- execute at all, so this Ind value is never used. + begin if Pattern = "" then raise Pattern_Error; diff --git a/gcc/ada/exp_ch4.adb b/gcc/ada/exp_ch4.adb index 4d50e0b9ccb..b235db0adfb 100644 --- a/gcc/ada/exp_ch4.adb +++ b/gcc/ada/exp_ch4.adb @@ -7444,6 +7444,32 @@ package body Exp_Ch4 is Make_Build_In_Place_Call_In_Anonymous_Context (Pfx); end if; + -- Range checks are potentially also needed for cases involving a slice + -- indexed by a subtype indication, but Do_Range_Check can currently + -- only be set for expressions ??? + + if not Index_Checks_Suppressed (Ptp) + and then (not Is_Entity_Name (Pfx) + or else not Index_Checks_Suppressed (Entity (Pfx))) + and then Nkind (Discrete_Range (N)) /= N_Subtype_Indication + + -- Do not enable range check to nodes associated with the frontend + -- expansion of the dispatch table. We first check if Ada.Tags is + -- already loaded to avoid the addition of an undesired dependence + -- on such run-time unit. + + and then + (not Tagged_Type_Expansion + or else not + (RTU_Loaded (Ada_Tags) + and then Nkind (Prefix (N)) = N_Selected_Component + and then Present (Entity (Selector_Name (Prefix (N)))) + and then Entity (Selector_Name (Prefix (N))) = + RTE_Record_Component (RE_Prims_Ptr))) + then + Enable_Range_Check (Discrete_Range (N)); + end if; + -- The remaining case to be handled is packed slices. We can leave -- packed slices as they are in the following situations: diff --git a/gcc/ada/exp_ch6.adb b/gcc/ada/exp_ch6.adb index 55e1f15db74..785da600bf3 100644 --- a/gcc/ada/exp_ch6.adb +++ b/gcc/ada/exp_ch6.adb @@ -1592,12 +1592,17 @@ package body Exp_Ch6 is -- Add call-by-copy code for the case of scalar out parameters -- when it is not known at compile time that the subtype of the - -- formal is a subrange of the subtype of the actual, in order - -- to get return range checks on such actuals. (Maybe this case - -- should be handled earlier in the if statement???) + -- formal is a subrange of the subtype of the actual (or vice + -- versa for in out parameters), in order to get range checks + -- on such actuals. (Maybe this case should be handled earlier + -- in the if statement???) elsif Is_Scalar_Type (E_Formal) - and then not In_Subrange_Of (E_Formal, Etype (Actual)) + and then + (not In_Subrange_Of (E_Formal, Etype (Actual)) + or else + (Ekind (Formal) = E_In_Out_Parameter + and then not In_Subrange_Of (Etype (Actual), E_Formal))) then -- Perhaps the setting back to False should be done within -- Add_Call_By_Copy_Code, since it could get set on other @@ -2039,8 +2044,9 @@ package body Exp_Ch6 is -- formals as we process the regular formals and collect the -- corresponding actuals in Extra_Actuals. - -- We also generate any required range checks for actuals as we go - -- through the loop, since this is a convenient place to do this. + -- We also generate any required range checks for actuals for in formals + -- as we go through the loop, since this is a convenient place to do it. + -- (Though it seems that this would be better done in Expand_Actuals???) Formal := First_Formal (Subp); Actual := First_Actual (N); @@ -2050,7 +2056,7 @@ package body Exp_Ch6 is -- Generate range check if required if Do_Range_Check (Actual) - and then Ekind (Formal) /= E_Out_Parameter + and then Ekind (Formal) = E_In_Parameter then Set_Do_Range_Check (Actual, False); Generate_Range_Check diff --git a/gcc/ada/exp_disp.adb b/gcc/ada/exp_disp.adb index 977a90fc4a7..5c5534b7a3e 100644 --- a/gcc/ada/exp_disp.adb +++ b/gcc/ada/exp_disp.adb @@ -931,7 +931,8 @@ package body Exp_Disp is Desig_Typ := Etype (Expression (N)); if Is_Access_Type (Desig_Typ) then - Desig_Typ := Directly_Designated_Type (Desig_Typ); + Desig_Typ := + Available_View (Directly_Designated_Type (Desig_Typ)); end if; if Is_Concurrent_Type (Desig_Typ) then diff --git a/gcc/ada/gnat_rm.texi b/gcc/ada/gnat_rm.texi index 97c4d2b583d..ad63bac196e 100644 --- a/gcc/ada/gnat_rm.texi +++ b/gcc/ada/gnat_rm.texi @@ -4418,10 +4418,12 @@ function To_String (Source : Unbounded_String) @end smallexample @noindent -The effect is that if the value of an unbounded string is written to a -stream, then the representation of the item in the stream is in the same -format used for @code{Standard.String}, and this same representation is -expected when a value of this type is read from the stream. +The effect is that if the value of an unbounded string is written to a stream, +then the representation of the item in the stream is in the same format that +would be used for @code{Standard.String'Output}, and this same representation +is expected when a value of this type is read from the stream. Note that the +value written always includes the bounds, even for Unbounded_String'Write, +since Unbounded_String is not an array type. @node Pragma Style_Checks @unnumberedsec Pragma Style_Checks diff --git a/gcc/ada/gnat_ugn.texi b/gcc/ada/gnat_ugn.texi index a2093c44f7c..cb1f6df14d6 100644 --- a/gcc/ada/gnat_ugn.texi +++ b/gcc/ada/gnat_ugn.texi @@ -20685,6 +20685,11 @@ a generic instantiation a full source location is a chain from the location of this construct in the generic unit to the place where this unit is instantiated. +@cindex @option{^-log^/LOG^} (@command{gnatcheck}) +@item ^-log^/LOG^ +Duplicate all the output sent to Stderr into a log file. The log file is +named @var{gnatcheck.log} and is located in the current directory. + @cindex @option{^-m^/DIAGNOSTIC_LIMIT^} (@command{gnatcheck}) @item ^-m@i{nnn}^/DIAGNOSTIC_LIMIT=@i{nnn}^ Maximum number of diagnoses to be sent to Stdout, @i{nnn} from o@dots{}1000, @@ -20714,12 +20719,15 @@ Include the section containing diagnoses ordered by rules in the report file Include the section containing diagnoses ordered by files and then by rules in the report file +@cindex @option{^-t^/TIME^} (@command{gnatcheck}) +@item ^-t^/TIME^ +Print out execution time. + @cindex @option{^-v^/VERBOSE^} (@command{gnatcheck}) @item ^-v^/VERBOSE^ Verbose mode; @command{gnatcheck} generates version information and then a trace of sources being processed. - @cindex @option{^-o ^/OUTPUT^} (@command{gnatcheck}) @item ^-o ^/OUTPUT=^@var{report_file} Set name of report file file to @var{report_file} . @@ -20814,7 +20822,10 @@ which enables all the standard style checks that corresponds to @option{-gnatyy} GNAT style check option, or a string that has exactly the same structure and semantics as the @code{string_LITERAL} parameter of GNAT pragma @code{Style_Checks} (for further information about this pragma, -@pxref{Pragma Style_Checks,,, gnat_rm, GNAT Reference Manual}). +@pxref{Pragma Style_Checks,,, gnat_rm, GNAT Reference Manual}). For example, +@code{+RStyle_Checks:O} rule option activates and adds to @command{gnatcheck} +output the compiler style check that corresponds to @code{-gnatyO} style +check option. @item Warnings To record compiler warnings (@pxref{Warning Message Control}), use the rule @@ -21512,6 +21523,9 @@ The following declarations are checked: @item type declarations +@item +subtype declarations + @item constant declarations (but not number declarations) @@ -21583,6 +21597,15 @@ should have the @emph{suffix1} suffix except for the case when the designated type is also an access type, in this case the type name should have the @emph{suffix1 & suffix2} suffix. +@item Class_Access_Suffix=@emph{string} +Specifies the suffix for the name of an access type that points to some class-wide +type. If this parameter is set, it overrides for such access +types the suffix set by the @code{Type_Suffix} or @code{Access_Suffix} +parameter. + +@item Class_Subtype_Suffix=@emph{string} +Specifies the suffix for the name of a subtype that denotes a class-wide type. + @item Constant_Suffix=@emph{string} Specifies the suffix for a constant name. @@ -21613,6 +21636,19 @@ does not disable any other checks for this rule. If @code{Type_Suffix} is set, access type names are checked as ordinary type names. +@item Class_Access_Suffix +Removes the suffix specified for access types pointing to class-wide +type. This disables specific checks for names of access types pointing to +class-wide types but does not disable any other checks for this rule. +If @code{Type_Suffix} is set, access type names are +checked as ordinary type names. If @code{Access_Suffix} is set, these +access types are checked as any other access type name. + +@item Class_Subtype_Suffix=@emph{string} +Removes the suffix specified for subtype names. +This disables checks for subtype names but +does not disable any other checks for this rule. + @item Constant_Suffix Removes the suffix specified for constants. This disables checks for constant names but does not diff --git a/gcc/ada/prj-nmsc.adb b/gcc/ada/prj-nmsc.adb index aa5b10104c3..5977a8ae51f 100644 --- a/gcc/ada/prj-nmsc.adb +++ b/gcc/ada/prj-nmsc.adb @@ -7777,6 +7777,8 @@ package body Prj.Nmsc is OK := False; -- ??? Don't we have a hash table to map files to Source_Id? + -- ??? Why can't simply iterate over the sources of the current + -- project, as opposed to the whole tree ? Iter := For_Each_Source (In_Tree); loop @@ -7793,7 +7795,9 @@ package body Prj.Nmsc is if Current_Verbosity = High then Write_Str ("Removing file "); - Write_Line (Get_Name_String (Excluded.File)); + Write_Line + (Get_Name_String (Excluded.File) + & " " & Get_Name_String (Source.Project.Name)); end if; else @@ -7803,7 +7807,16 @@ package body Prj.Nmsc is Excluded.Location); end if; - exit; + -- We used to exit here, but in fact when a source is + -- overridden in an extended project we have only marked the + -- original source file if we stop here, not the one from + -- the extended project. + -- ??? We could exit (and thus be faster) if the loop could + -- be done only on the current project, but this isn't + -- compatible with the way gprbuild works with excluded + -- sources apparently + + -- exit; end if; Next (Iter); @@ -8272,6 +8285,16 @@ package body Prj.Nmsc is Replaced_By.Declared_In_Interfaces := Id.Declared_In_Interfaces; end if; + Id.In_Interfaces := False; + Id.Locally_Removed := True; + + -- ??? Should we remove the source from the unit ? The file is not used, + -- so probably should not be referenced from the unit. On the other hand + -- it might give useful additional info + -- if Id.Unit /= null then + -- Id.Unit.File_Names (Id.Kind) := null; + -- end if; + Source := Id.Language.First_Source; if Source = Id then diff --git a/gcc/ada/prj.ads b/gcc/ada/prj.ads index ad2a48543e6..3889e66e5ea 100644 --- a/gcc/ada/prj.ads +++ b/gcc/ada/prj.ads @@ -1237,7 +1237,6 @@ package Prj is function Empty_Project return Project_Data; -- Return the representation of an empty project. - -- In Ada-only mode, the Ada language is also partly initialized function Is_Extending (Extending : Project_Id; diff --git a/gcc/ada/seh_init.c b/gcc/ada/seh_init.c index 2bc3d2315c9..dc353d05c6b 100644 --- a/gcc/ada/seh_init.c +++ b/gcc/ada/seh_init.c @@ -211,17 +211,14 @@ __gnat_install_SEH_handler (void *ER) /* put current handler in ptr */ - asm ("mov %%fs:(0),%%ecx" : : : "%ecx"); - asm ("mov %%ecx,%0" : "=m" (ptr)); + asm ("mov %%fs:(0),%0" : "=r" (ptr)); ((int *)ER)[0] = (int)ptr; /* previous handler */ ((int *)ER)[1] = (int)__gnat_SEH_error_handler; /* new handler */ - /* ptr is the new handler, set fs:(0) with this value */ + /* ER is the new handler, set fs:(0) with this value */ - ptr = (int *)ER; - asm ("mov %0,%%ecx" : : "m" (ptr) : "%ecx"); - asm ("mov %ecx,%fs:(0)"); + asm volatile ("mov %0,%%fs:(0)": : "r" (ER)); } #else /* defined (_WIN32) && !defined (_WIN64) */ diff --git a/gcc/ada/sem_warn.adb b/gcc/ada/sem_warn.adb index 0ba87cccc4c..b6163375031 100644 --- a/gcc/ada/sem_warn.adb +++ b/gcc/ada/sem_warn.adb @@ -1107,6 +1107,15 @@ package body Sem_Warn is then null; + -- Suppress warning on formals of an entry body. All + -- references are attached to the formal in the entry + -- declaration, which are marked Is_Entry_Formal. + + elsif Ekind (Scope (E1)) = E_Entry + and then not Is_Entry_Formal (E1) + then + null; + -- OK, looks like warning for an IN OUT parameter that -- could be IN makes sense, but we delay the output of -- the warning, pending possibly finding out later on