Skip to content

R
riscv-gcc-1
Commit e7d72fb9 by Arnaud Charlet
Options

[multiple changes] 

2009-06-22  Robert Dewar  <dewar@adacore.com>

	* sinput.adb, sinput.ads (Expr_First_Char, Expr_Last_Char): Replaced
	by Sloc_Range.

	* freeze.adb: Minor comment updates

	* s-valrea.adb (Bad_Based_Value): New procedure
	(Scan_Real): Raise exceptions with messages

2009-06-22  Matthew Gingell  <gingell@adacore.com>

	* adaint.h: Complete previous change.

2009-06-22  Thomas Quinot  <quinot@adacore.com>

	* exp_ch7.ads, exp_ch3.adb: Minor reformatting

2009-06-22  Ed Schonberg  <schonberg@adacore.com>

	* sem_ch6.adb (Check_Overriding_Indicator): When style checks are
	enabled, emit warning when a non-controlling argument of the overriding
	operation appears out of place vis-a-vis of the formal of the
	overridden operation.

From-SVN: r148782
parent 03456e44
Showing with 146 additions and 37 deletions
gcc/ada/ChangeLog
2009-06-22 Robert Dewar <dewar@adacore.com>
* sinput.adb, sinput.ads (Expr_First_Char, Expr_Last_Char): Replaced
by Sloc_Range.
* freeze.adb: Minor comment updates
* s-valrea.adb (Bad_Based_Value): New procedure
(Scan_Real): Raise exceptions with messages
2009-06-22 Matthew Gingell <gingell@adacore.com>
* adaint.h: Complete previous change.
2009-06-22 Thomas Quinot <quinot@adacore.com>
* exp_ch7.ads, exp_ch3.adb: Minor reformatting
2009-06-22 Ed Schonberg <schonberg@adacore.com>
* sem_ch6.adb (Check_Overriding_Indicator): When style checks are
enabled, emit warning when a non-controlling argument of the overriding
operation appears out of place vis-a-vis of the formal of the
overridden operation.
2009-06-22 Vincent Celier <celier@adacore.com>
* gnatcmd.adb (Check_Files): Close temporary files after all file names
......
gcc/ada/adaint.h
......@@ -58,6 +58,7 @@
#define FOPEN fopen
#define STAT stat
#define FSTAT fstat
#define LSTAT lstat
#define STRUCT_STAT struct stat
#endif
......
gcc/ada/exp_ch3.adb
......@@ -1854,7 +1854,7 @@ package body Exp_Ch3 is
-- Take a copy of Exp to ensure that later copies of this component
-- declaration in derived types see the original tree, not a node
-- rewritten during expansion of the init_proc. If the copy contains
-- itypes, the scope of the new itypes is the init.proc being built.
-- itypes, the scope of the new itypes is the init_proc being built.
Exp := New_Copy_Tree (Exp, New_Scope => Proc_Id);
......@@ -1885,7 +1885,7 @@ package body Exp_Ch3 is
end if;
-- Adjust the component if controlled except if it is an aggregate
-- that will be expanded inline
-- that will be expanded inline.
if Kind = N_Qualified_Expression then
Kind := Nkind (Expression (N));
......
gcc/ada/exp_ch7.ads
......@@ -6,7 +6,7 @@
-- --
-- S p e c --
-- --
-- Copyright (C) 1992-2008, Free Software Foundation, Inc. --
-- Copyright (C) 1992-2009, 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- --
......@@ -75,8 +75,8 @@ package Exp_Ch7 is
-- E is an entity representing a controlled object, a controlled type or a
-- scope. If Ref is not empty, it is a reference to a controlled record,
-- the closest Final list is in the controller component of the record
-- containing Ref otherwise this function returns a reference to the final
-- list attached to the closest dynamic scope (that can be E itself)
-- containing Ref, otherwise this function returns a reference to the final
-- list attached to the closest dynamic scope (which can be E itself),
-- creating this final list if necessary.
function Has_New_Controlled_Component (E : Entity_Id) return Boolean;
......
gcc/ada/freeze.adb
......@@ -2451,7 +2451,7 @@ package body Freeze is
and then Convention (E) = Convention_C
then
Error_Msg_N
("?& is a tagged type which does not "
("?& involves a tagged type which does not "
& "correspond to any C type!", Formal);
-- Check wrong convention subprogram pointer
......@@ -2600,15 +2600,30 @@ package body Freeze is
end if;
end if;
-- VM functions returning unconstrained arrays are
-- correctly handled with the .NET/JVM compilers. Don't
-- display this warning in those cases.
-- Give warning for suspicous return of a result of an
-- unconstrained array type in a foreign convention
-- function.
if Is_Array_Type (R_Type)
if Has_Foreign_Convention (E)
-- We are looking for a return of unconstrained array
and then Is_Array_Type (R_Type)
and then not Is_Constrained (R_Type)
-- Exclude imported routines, the warning does not
-- belong on the import, but on the routine definition.
and then not Is_Imported (E)
-- Exclude VM case, since both .NET and JVM can handle
-- return of unconstrained arrays without a problem.
and then VM_Target = No_VM
and then Has_Foreign_Convention (E)
-- Check that general warning is enabled, and that it
-- is not suppressed for this particular case.
and then Warn_On_Export_Import
and then not Has_Warnings_Off (E)
and then not Has_Warnings_Off (R_Type)
......@@ -5047,14 +5062,24 @@ package body Freeze is
elsif Is_Generic_Type (Etype (E)) then
null;
-- VM functions returning unconstrained arrays are
-- correctly handled with the .NET/JVM compilers. Don't
-- display this warning in those cases.
-- Display warning if returning unconstrained array
elsif Is_Array_Type (Retype)
and then not Is_Constrained (Retype)
-- Exclude cases where descriptor mechanism is set, since the
-- VMS descriptor mechanisms allow such unconstrained returns.
and then Mechanism (E) not in Descriptor_Codes
-- Check appropriate warning is enabled (should we check for
-- Warnings (Off) on specific entities here, probably so???)
and then Warn_On_Export_Import
-- Exclude the VM case, since return of unconstrained arrays
-- is properly handled in both the JVM and .NET cases.
and then VM_Target = No_VM
then
Error_Msg_N
......@@ -5084,9 +5109,9 @@ package body Freeze is
end if;
end if;
-- For VMS, descriptor mechanisms for parameters are allowed only
-- for imported/exported subprograms. Moreover, the NCA descriptor
-- is not allowed for parameters of exported subprograms.
-- For VMS, descriptor mechanisms for parameters are allowed only for
-- imported/exported subprograms. Moreover, the NCA descriptor is not
-- allowed for parameters of exported subprograms.
if OpenVMS_On_Target then
if Is_Exported (E) then
......
gcc/ada/s-valrea.adb
......@@ -89,6 +89,10 @@ package body System.Val_Real is
-- necessarily required in a case like this where the result is not
-- a machine number, but it is certainly a desirable behavior.
procedure Bad_Based_Value;
pragma No_Return (Bad_Based_Value);
-- Raise exception for bad based value
procedure Scanf;
-- Scans integer literal value starting at current character position.
-- For each digit encountered, Uval is multiplied by 10.0, and the new
......@@ -98,6 +102,16 @@ package body System.Val_Real is
-- return P points past the last character. On entry, the current
-- character is known to be a digit, so a numeral is definitely present.
---------------------
-- Bad_Based_Value --
---------------------
procedure Bad_Based_Value is
begin
raise Constraint_Error with
"invalid based literal for 'Value";
end Bad_Based_Value;
-----------
-- Scanf --
-----------
......@@ -181,7 +195,8 @@ package body System.Val_Real is
-- Any other initial character is an error
else
raise Constraint_Error;
raise Constraint_Error with
"invalid character in 'Value string";
end if;
-- Deal with based case
......@@ -219,7 +234,7 @@ package body System.Val_Real is
loop
if P > Max then
raise Constraint_Error;
Bad_Based_Value;
elsif Str (P) in Digs then
Digit := Character'Pos (Str (P)) - Character'Pos ('0');
......@@ -233,7 +248,7 @@ package body System.Val_Real is
Character'Pos (Str (P)) - (Character'Pos ('a') - 10);
else
raise Constraint_Error;
Bad_Based_Value;
end if;
-- Save up trailing zeroes after the decimal point
......@@ -267,7 +282,7 @@ package body System.Val_Real is
P := P + 1;
if P > Max then
raise Constraint_Error;
Bad_Based_Value;
elsif Str (P) = '_' then
Scan_Underscore (Str, P, Ptr, Max, True);
......@@ -282,7 +297,7 @@ package body System.Val_Real is
After_Point := 1;
if P > Max then
raise Constraint_Error;
Bad_Based_Value;
end if;
end if;
......@@ -358,7 +373,7 @@ package body System.Val_Real is
-- Here is where we check for a bad based number
if Bad_Base then
raise Constraint_Error;
Bad_Based_Value;
-- If OK, then deal with initial minus sign, note that this processing
-- is done even if Uval is zero, so that -0.0 is correctly interpreted.
......
gcc/ada/sem_ch6.adb
......@@ -4374,6 +4374,48 @@ package body Sem_Ch6 is
return;
end if;
-- The overriding operation is type conformant with the overridden one,
-- but the names of the formals are not required to match. If the names
-- appear permuted in the overriding operation this is a possible
-- source of confusion that is worth diagnosing. Controlling formals
-- often carry names that reflect the type, and it is not worthwhile
-- requiring that their names match.
if Style_Check
and then Present (Overridden_Subp)
and then Nkind (Subp) /= N_Defining_Operator_Symbol
then
declare
Form1 : Entity_Id;
Form2 : Entity_Id;
begin
Form1 := First_Formal (Subp);
Form2 := First_Formal (Overridden_Subp);
if Present (Form1) then
Form1 := Next_Formal (Form1);
Form2 := Next_Formal (Form2);
end if;
while Present (Form1) loop
if not Is_Controlling_Formal (Form1)
and then Present (Next_Formal (Form2))
and then Chars (Form1) = Chars (Next_Formal (Form2))
then
Error_Msg_Node_2 := Alias (Overridden_Subp);
Error_Msg_Sloc := Sloc (Error_Msg_Node_2);
Error_Msg_NE ("& does not match corresponding formal of&#",
Form1, Form1);
exit;
end if;
Next_Formal (Form1);
Next_Formal (Form2);
end loop;
end;
end if;
if Present (Overridden_Subp) then
if Must_Not_Override (Spec) then
Error_Msg_Sloc := Sloc (Overridden_Subp);
......
gcc/ada/sinput.ads
......@@ -471,14 +471,6 @@ package Sinput is
-- ASCII.NUL, with Name_Length indicating the length not including the
-- terminating Nul.
function Expr_First_Char (Expr : Node_Id) return Source_Ptr;
-- Given a node for a subexpression, returns the source location of the
-- first character of the expression.
function Expr_Last_Char (Expr : Node_Id) return Source_Ptr;
-- Given a node for a subexpression, returns the source location of the
-- last character of the expression.
function Get_Column_Number (P : Source_Ptr) return Column_Number;
-- The ones-origin column number of the specified Source_Ptr value is
-- determined and returned. Tab characters if present are assumed to
......@@ -571,12 +563,12 @@ package Sinput is
procedure Skip_Line_Terminators
(P : in out Source_Ptr;
Physical : out Boolean);
-- On entry, P points to a line terminator that has been encountered, which
-- is one of FF,LF,VT,CR or a wide character sequence whose value is in
-- category Separator,Line or Separator,Paragraph. P points just past the
-- character that was scanned. The purpose of this routine is to
-- distinguish physical and logical line endings. A physical line ending is
-- one of:
-- On entry, P points to a line terminator that has been encountered,
-- which is one of FF,LF,VT,CR or a wide character sequence whose value is
-- in category Separator,Line or Separator,Paragraph. P points just past
-- the character that was scanned. The purpose of this routine is to
-- distinguish physical and logical line endings. A physical line ending
-- is one of:
--
-- CR on its own (MAC System 7)
-- LF on its own (Unix and unix-like systems)
......@@ -603,6 +595,15 @@ package Sinput is
-- makes sure that the lines table for the current source file has an
-- appropriate entry for the start of the new physical line.
procedure Sloc_Range (Expr : Node_Id; Min, Max : out Source_Ptr);
-- Given a node for a subexpression, returns the minimum and maximum source
-- locations of any node in the expression subtree. This is not quite the
-- same as the locations of the first and last token in the expresion
-- because parentheses at the outer level do not have a recorded Sloc.
--
-- Note: if the tree for the expression contains no "real" Sloc values,
-- i.e. values > No_Location, then both Min and Max are set to Sloc (Expr).
function Source_Offset (S : Source_Ptr) return Nat;
-- Returns the zero-origin offset of the given source location from the
-- start of its corresponding unit. This is used for creating canonical
......
Markdown is supported
0% or
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment