Skip to content

R
riscv-gcc-1
Commit 3786bbd1 by Robert Dewar Committed by Arnaud Charlet
Options

sem_aggr.adb: Minor reformatting. 

2010-10-08  Robert Dewar  <dewar@adacore.com>

	* sem_aggr.adb: Minor reformatting.

2010-10-08  Robert Dewar  <dewar@adacore.com>

	* exp_imgv.adb (Expand_Image_Attribute): Handle special calling
	sequence for soft hyphen for Character'Image case.
	* rtsfind.ads (Image_Character_05): New entry
	* s-imgcha.adb (Image_Character_05): New procedurew
	* s-imgcha.ads (Image_Character_05): New procedure
	* s-imgwch.adb (Image_Wide_Character): Deal with Ada 2005 soft hyphen
	case.
	* s-valcha.adb (Value_Character): Recognize SOFT_HYPHEN for 16#AD#
	* sem_attr.adb (Eval_Attribute, case Width): Handle soft_hyphen name
	properly.

From-SVN: r165168
parent bcae2eaa
Showing with 103 additions and 25 deletions
gcc/ada/ChangeLog
2010-10-08 Robert Dewar <dewar@adacore.com>
* sem_aggr.adb: Minor reformatting.
2010-10-08 Robert Dewar <dewar@adacore.com>
* exp_imgv.adb (Expand_Image_Attribute): Handle special calling
sequence for soft hyphen for Character'Image case.
* rtsfind.ads (Image_Character_05): New entry
* s-imgcha.adb (Image_Character_05): New procedurew
* s-imgcha.ads (Image_Character_05): New procedure
* s-imgwch.adb (Image_Wide_Character): Deal with Ada 2005 soft hyphen
case.
* s-valcha.adb (Value_Character): Recognize SOFT_HYPHEN for 16#AD#
* sem_attr.adb (Eval_Attribute, case Width): Handle soft_hyphen name
properly.
2010-10-08 Robert Dewar <dewar@adacore.com>
* sem_attr.adb (Eval_Attribute, case Width): Avoid ludicrous long loop
for case of Wide_[Wide_]Character.
......
gcc/ada/exp_imgv.adb
......@@ -306,8 +306,16 @@ package body Exp_Imgv is
Imid := RE_Image_Boolean;
Tent := Rtyp;
-- For standard character, we have to select the version which handles
-- soft hyphen correctly, based on the version of Ada in use (ugly!)
elsif Rtyp = Standard_Character then
Imid := RE_Image_Character;
if Ada_Version < Ada_05 then
Imid := RE_Image_Character;
else
Imid := RE_Image_Character_05;
end if;
Tent := Rtyp;
elsif Rtyp = Standard_Wide_Character then
......
gcc/ada/rtsfind.ads
......@@ -800,6 +800,7 @@ package Rtsfind is
RE_Image_Boolean, -- System.Img_Bool
RE_Image_Character, -- System.Img_Char
RE_Image_Character_05, -- System.Img_Char
RE_Image_Decimal, -- System.Img_Dec
......@@ -1972,6 +1973,7 @@ package Rtsfind is
RE_Image_Boolean => System_Img_Bool,
RE_Image_Character => System_Img_Char,
RE_Image_Character_05 => System_Img_Char,
RE_Image_Decimal => System_Img_Dec,
......
gcc/ada/s-imgcha.adb
......@@ -6,7 +6,7 @@
-- --
-- B o d y --
-- --
-- Copyright (C) 1992-2009, Free Software Foundation, Inc. --
-- Copyright (C) 1992-2010, 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- --
......@@ -158,4 +158,23 @@ package body System.Img_Char is
end if;
end Image_Character;
------------------------
-- Image_Character_05 --
------------------------
procedure Image_Character_05
(V : Character;
S : in out String;
P : out Natural)
is
pragma Assert (S'First = 1);
begin
if V = Character'Val (16#00AD#) then
P := 11;
S (1 .. P) := "SOFT_HYPHEN";
else
Image_Character (V, S, P);
end if;
end Image_Character_05;
end System.Img_Char;
gcc/ada/s-imgcha.ads
......@@ -6,7 +6,7 @@
-- --
-- S p e c --
-- --
-- Copyright (C) 1992-2009, Free Software Foundation, Inc. --
-- Copyright (C) 1992-2010, 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- --
......@@ -42,4 +42,14 @@ package System.Img_Char is
-- setting the resulting value of P. The caller guarantees that S is
-- long enough to hold the result, and that S'First is 1.
procedure Image_Character_05
(V : Character;
S : in out String;
P : out Natural);
-- Computes Character'Image (V) and stores the result in S (1 .. P)
-- setting the resulting value of P. The caller guarantees that S is
-- long enough to hold the result, and that S'First is 1. This version
-- is for use in Ada 2005 and beyond, where soft hyphen is a non-graphic
-- and results in "SOFT_HYPHEN" as the output.
end System.Img_Char;
gcc/ada/s-imgwch.adb
......@@ -6,7 +6,7 @@
-- --
-- B o d y --
-- --
-- Copyright (C) 1992-2009, Free Software Foundation, Inc. --
-- Copyright (C) 1992-2010, 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- --
......@@ -61,6 +61,16 @@ package body System.Img_WChar is
P := 4;
-- Deal with annoying Ada 95 incompatibility with soft hyphen
elsif V = Wide_Character'Val (16#00AD#)
and then not Ada_2005
then
P := 3;
S (1) := ''';
S (2) := Character'Val (16#00AD#);
S (3) := ''';
-- Normal case, same as Wide_Wide_Character
else
......@@ -83,10 +93,14 @@ package body System.Img_WChar is
Val : Unsigned_32 := Wide_Wide_Character'Pos (V);
begin
-- If in range of standard Character, use Character routine
-- If in range of standard Character, use Character routine. Use the
-- Ada 2005 version, since either we are called directly in Ada 2005
-- mode for Wide_Wide_Character, or this is the Wide_Character case
-- which already took care of the Soft_Hyphen glitch.
if Val <= 16#FF# then
Image_Character (Character'Val (Wide_Wide_Character'Pos (V)), S, P);
Image_Character_05
(Character'Val (Wide_Wide_Character'Pos (V)), S, P);
-- Otherwise value returned is Hex_hhhhhhhh
......
gcc/ada/s-valcha.adb
......@@ -6,7 +6,7 @@
-- --
-- B o d y --
-- --
-- Copyright (C) 1992-2009, Free Software Foundation, Inc. --
-- Copyright (C) 1992-2010, 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- --
......@@ -65,6 +65,10 @@ package body System.Val_Char is
end if;
end loop;
if S (F .. L) = "SOFT_HYPHEN" then
return Character'Val (16#AD#);
end if;
raise Constraint_Error;
end if;
end Value_Character;
......
gcc/ada/sem_aggr.adb
......@@ -3654,10 +3654,11 @@ package body Sem_Aggr is
(Aggr : Node_Id;
Assoc_List : List_Id)
is
Aggr_Type : constant Entity_Id :=
Base_Type (Etype (Aggr));
Def_Node : constant Node_Id :=
Type_Definition (Declaration_Node (Aggr_Type));
Aggr_Type : constant Entity_Id :=
Base_Type (Etype (Aggr));
Def_Node : constant Node_Id :=
Type_Definition
(Declaration_Node (Aggr_Type));
Comp : Node_Id;
Comp_Elmt : Elmt_Id;
......@@ -3666,7 +3667,7 @@ package body Sem_Aggr is
Errors : Boolean;
procedure Process_Component (Comp : Entity_Id);
-- Add one component with a box association to the
-- Add one component with a box association to the
-- inner aggregate, and recurse if component is
-- itself composite.
......@@ -3702,7 +3703,6 @@ package body Sem_Aggr is
end Process_Component;
begin
-- The component type may be a variant type, so
-- collect the components that are ruled by the
-- known values of the discriminants.
......@@ -3734,7 +3734,6 @@ package body Sem_Aggr is
-- No variant part, iterate over all components
else
Comp := First_Component (Etype (Aggr));
while Present (Comp) loop
Process_Component (Comp);
......@@ -3753,15 +3752,16 @@ package body Sem_Aggr is
end if;
end Propagate_Discriminants;
-- Start of processing for Capture_Discriminants
-- Start of processing for Capture_Discriminants
begin
Expr := Make_Aggregate (Loc, New_List, New_List);
Set_Etype (Expr, Ctyp);
-- If the enclosing type has discriminants, they
-- have been collected in the aggregate earlier, and
-- they may appear as constraints of subcomponents.
-- If the enclosing type has discriminants, they have
-- been collected in the aggregate earlier, and they
-- may appear as constraints of subcomponents.
-- Similarly if this component has discriminants, they
-- might in turn be propagated to their components.
......@@ -3771,7 +3771,7 @@ package body Sem_Aggr is
elsif Has_Discriminants (Ctyp) then
Add_Discriminant_Values
(Expr, Component_Associations (Expr));
(Expr, Component_Associations (Expr));
Propagate_Discriminants
(Expr, Component_Associations (Expr));
......
gcc/ada/sem_attr.adb
......@@ -7413,7 +7413,6 @@ package body Sem_Attr is
-- No need to compute this more than once!
W := Int'Max (W, 12);
exit;
else
......@@ -7427,13 +7426,11 @@ package body Sem_Attr is
case C is
when Reserved_128 | Reserved_129 |
Reserved_132 | Reserved_153
=> Wt := 12;
when BS | HT | LF | VT | FF | CR |
SO | SI | EM | FS | GS | RS |
US | RI | MW | ST | PM
=> Wt := 2;
when NUL | SOH | STX | ETX | EOT |
......@@ -7445,13 +7442,20 @@ package body Sem_Attr is
SS2 | SS3 | DCS | PU1 | PU2 |
STS | CCH | SPA | EPA | SOS |
SCI | CSI | OSC | APC
=> Wt := 3;
when Space .. Tilde |
No_Break_Space .. LC_Y_Diaeresis
=> Wt := 3;
=>
-- Special case of soft hyphen in Ada 2005
if C = Character'Val (16#AD#)
and then Ada_Version >= Ada_05
then
Wt := 11;
else
Wt := 3;
end if;
end case;
W := Int'Max (W, Wt);
......
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