diff options
| -rw-r--r-- | gcc/ada/opt.ads | 18 | ||||
| -rw-r--r-- | gcc/ada/repinfo.adb | 237 | ||||
| -rw-r--r-- | gcc/ada/sem_ch13.adb | 326 | ||||
| -rw-r--r-- | gcc/ada/sem_ch13.ads | 9 | ||||
| -rw-r--r-- | gcc/ada/style.ads | 10 | ||||
| -rw-r--r-- | gcc/ada/styleg-c.adb | 25 | ||||
| -rw-r--r-- | gcc/ada/styleg-c.ads | 11 | ||||
| -rw-r--r-- | gcc/ada/stylesw.adb | 99 | ||||
| -rw-r--r-- | gcc/ada/stylesw.ads | 6 | ||||
| -rw-r--r-- | gcc/ada/usage.adb | 13 |
10 files changed, 537 insertions, 217 deletions
diff --git a/gcc/ada/opt.ads b/gcc/ada/opt.ads index 6eff9952c17..fb1fa0ed217 100644 --- a/gcc/ada/opt.ads +++ b/gcc/ada/opt.ads @@ -430,7 +430,8 @@ package Opt is Extensions_Allowed : Boolean := False; -- GNAT -- Set to True by switch -gnatX if GNAT specific language extensions - -- are allowed. For example, "limited with" is a GNAT extension. + -- are allowed. For example, the use of 'Constrained with objects of + -- generic types is a GNAT extension. type External_Casing_Type is ( As_Is, -- External names cased as they appear in the Ada source @@ -1163,12 +1164,19 @@ package Opt is -- variable that is at least partially uninitialized. Set to false to -- suppress such warnings. The default is that such warnings are enabled. + Warn_On_Non_Local_Exception : Boolean := True; + -- GNAT + -- Set to True to generate warnings for non-local exception raises and also + -- handlers that can never handle a local raise. This warning is only ever + -- generated if pragma Restrictions (No_Exception_Propagation) is set. The + -- default is to generate the warnings if the restriction is set. + Warn_On_Obsolescent_Feature : Boolean := False; -- GNAT -- Set to True to generate warnings on use of any feature in Annex or if a -- subprogram is called for which a pragma Obsolescent applies. - Warn_On_Questionable_Missing_Parens : Boolean := False; + Warn_On_Questionable_Missing_Parens : Boolean := True; -- GNAT -- Set to True to generate warnings for cases where parenthese are missing -- and the usage is questionable, because the intent is unclear. @@ -1178,6 +1186,12 @@ package Opt is -- Set to True to generate warnings for redundant constructs (e.g. useless -- assignments/conversions). The default is that this warning is disabled. + Warn_On_Reverse_Bit_Order : Boolean := True; + -- GNAT + -- Set to True to generate warning (informational) messages for component + -- clauses that are affected by non-standard bit-order. The default is + -- that this warning is enabled. + Warn_On_Unchecked_Conversion : Boolean := True; -- GNAT -- Set to True to generate warnings for unchecked conversions that may have diff --git a/gcc/ada/repinfo.adb b/gcc/ada/repinfo.adb index 974dff4cc19..f32344291ac 100644 --- a/gcc/ada/repinfo.adb +++ b/gcc/ada/repinfo.adb @@ -784,172 +784,165 @@ package body Repinfo is Max_Name_Length := 0; Max_Suni_Length := 0; - Comp := First_Entity (Ent); + Comp := First_Component_Or_Discriminant (Ent); while Present (Comp) loop - if Ekind (Comp) = E_Component - or else Ekind (Comp) = E_Discriminant - then - Get_Decoded_Name_String (Chars (Comp)); - Max_Name_Length := Natural'Max (Max_Name_Length, Name_Len); - - Cfbit := Component_Bit_Offset (Comp); + Get_Decoded_Name_String (Chars (Comp)); + Max_Name_Length := Natural'Max (Max_Name_Length, Name_Len); - if Rep_Not_Constant (Cfbit) then - UI_Image_Length := 2; + Cfbit := Component_Bit_Offset (Comp); - else - -- Complete annotation in case not done + if Rep_Not_Constant (Cfbit) then + UI_Image_Length := 2; - Set_Normalized_Position (Comp, Cfbit / SSU); - Set_Normalized_First_Bit (Comp, Cfbit mod SSU); + else + -- Complete annotation in case not done - Sunit := Cfbit / SSU; - UI_Image (Sunit); - end if; + Set_Normalized_Position (Comp, Cfbit / SSU); + Set_Normalized_First_Bit (Comp, Cfbit mod SSU); - -- If the record is not packed, then we know that all fields whose - -- position is not specified have a starting normalized bit - -- position of zero + Sunit := Cfbit / SSU; + UI_Image (Sunit); + end if; - if Unknown_Normalized_First_Bit (Comp) - and then not Is_Packed (Ent) - then - Set_Normalized_First_Bit (Comp, Uint_0); - end if; + -- If the record is not packed, then we know that all fields whose + -- position is not specified have a starting normalized bit position + -- of zero. - Max_Suni_Length := - Natural'Max (Max_Suni_Length, UI_Image_Length); + if Unknown_Normalized_First_Bit (Comp) + and then not Is_Packed (Ent) + then + Set_Normalized_First_Bit (Comp, Uint_0); end if; - Comp := Next_Entity (Comp); + Max_Suni_Length := + Natural'Max (Max_Suni_Length, UI_Image_Length); + + Next_Component_Or_Discriminant (Comp); end loop; -- Second loop does actual output based on those values - Comp := First_Entity (Ent); + Comp := First_Component_Or_Discriminant (Ent); while Present (Comp) loop - if Ekind (Comp) = E_Component - or else Ekind (Comp) = E_Discriminant - then - declare - Esiz : constant Uint := Esize (Comp); - Bofs : constant Uint := Component_Bit_Offset (Comp); - Npos : constant Uint := Normalized_Position (Comp); - Fbit : constant Uint := Normalized_First_Bit (Comp); - Lbit : Uint; + declare + Esiz : constant Uint := Esize (Comp); + Bofs : constant Uint := Component_Bit_Offset (Comp); + Npos : constant Uint := Normalized_Position (Comp); + Fbit : constant Uint := Normalized_First_Bit (Comp); + Lbit : Uint; + + begin + Write_Str (" "); + Get_Decoded_Name_String (Chars (Comp)); + Set_Casing (Unit_Casing); + Write_Str (Name_Buffer (1 .. Name_Len)); - begin - Write_Str (" "); - Get_Decoded_Name_String (Chars (Comp)); - Set_Casing (Unit_Casing); - Write_Str (Name_Buffer (1 .. Name_Len)); + for J in 1 .. Max_Name_Length - Name_Len loop + Write_Char (' '); + end loop; - for J in 1 .. Max_Name_Length - Name_Len loop - Write_Char (' '); - end loop; + Write_Str (" at "); - Write_Str (" at "); + if Known_Static_Normalized_Position (Comp) then + UI_Image (Npos); + Spaces (Max_Suni_Length - UI_Image_Length); + Write_Str (UI_Image_Buffer (1 .. UI_Image_Length)); - if Known_Static_Normalized_Position (Comp) then - UI_Image (Npos); - Spaces (Max_Suni_Length - UI_Image_Length); - Write_Str (UI_Image_Buffer (1 .. UI_Image_Length)); + elsif Known_Component_Bit_Offset (Comp) + and then List_Representation_Info = 3 + then + Spaces (Max_Suni_Length - 2); + Write_Str ("bit offset"); + Write_Val (Bofs, Paren => True); + Write_Str (" size in bits = "); + Write_Val (Esiz, Paren => True); + Write_Eol; + goto Continue; + + elsif Known_Normalized_Position (Comp) + and then List_Representation_Info = 3 + then + Spaces (Max_Suni_Length - 2); + Write_Val (Npos); - elsif Known_Component_Bit_Offset (Comp) - and then List_Representation_Info = 3 - then - Spaces (Max_Suni_Length - 2); - Write_Str ("bit offset"); - Write_Val (Bofs, Paren => True); - Write_Str (" size in bits = "); - Write_Val (Esiz, Paren => True); - Write_Eol; + else + -- For the packed case, we don't know the bit positions if we + -- don't know the starting position! + + if Is_Packed (Ent) then + Write_Line ("?? range ? .. ??;"); goto Continue; - elsif Known_Normalized_Position (Comp) - and then List_Representation_Info = 3 - then - Spaces (Max_Suni_Length - 2); - Write_Val (Npos); + -- Otherwise we can continue else - -- For the packed case, we don't know the bit positions - -- if we don't know the starting position! - - if Is_Packed (Ent) then - Write_Line ("?? range ? .. ??;"); - goto Continue; - - -- Otherwise we can continue - - else - Write_Str ("??"); - end if; + Write_Str ("??"); end if; + end if; - Write_Str (" range "); - UI_Write (Fbit); - Write_Str (" .. "); + Write_Str (" range "); + UI_Write (Fbit); + Write_Str (" .. "); - -- Allowing Uint_0 here is a kludge, really this should be a - -- fine Esize value but currently it means unknown, except that - -- we know after gigi has back annotated that a size of zero is - -- real, since otherwise gigi back annotates using No_Uint as - -- the value to indicate unknown). + -- Allowing Uint_0 here is a kludge, really this should be a + -- fine Esize value but currently it means unknown, except that + -- we know after gigi has back annotated that a size of zero is + -- real, since otherwise gigi back annotates using No_Uint as + -- the value to indicate unknown). - if (Esize (Comp) = Uint_0 or else Known_Static_Esize (Comp)) - and then Known_Static_Normalized_First_Bit (Comp) - then - Lbit := Fbit + Esiz - 1; + if (Esize (Comp) = Uint_0 or else Known_Static_Esize (Comp)) + and then Known_Static_Normalized_First_Bit (Comp) + then + Lbit := Fbit + Esiz - 1; - if Lbit < 10 then - Write_Char (' '); - end if; + if Lbit < 10 then + Write_Char (' '); + end if; - UI_Write (Lbit); + UI_Write (Lbit); - -- The test for Esize (Comp) not being Uint_0 here is a kludge. - -- Officially a value of zero for Esize means unknown, but here - -- we use the fact that we know that gigi annotates Esize with - -- No_Uint, not Uint_0. Really everyone should use No_Uint??? + -- The test for Esize (Comp) not being Uint_0 here is a kludge. + -- Officially a value of zero for Esize means unknown, but here + -- we use the fact that we know that gigi annotates Esize with + -- No_Uint, not Uint_0. Really everyone should use No_Uint??? - elsif List_Representation_Info < 3 - or else (Esize (Comp) /= Uint_0 and then Unknown_Esize (Comp)) - then - Write_Str ("??"); + elsif List_Representation_Info < 3 + or else (Esize (Comp) /= Uint_0 and then Unknown_Esize (Comp)) + then + Write_Str ("??"); - else -- List_Representation >= 3 and Known_Esize (Comp) + -- List_Representation >= 3 and Known_Esize (Comp) - Write_Val (Esiz, Paren => True); + else + Write_Val (Esiz, Paren => True); - -- If in front end layout mode, then dynamic size is stored - -- in storage units, so renormalize for output + -- If in front end layout mode, then dynamic size is stored + -- in storage units, so renormalize for output - if not Back_End_Layout then - Write_Str (" * "); - Write_Int (SSU); - end if; + if not Back_End_Layout then + Write_Str (" * "); + Write_Int (SSU); + end if; - -- Add appropriate first bit offset + -- Add appropriate first bit offset - if Fbit = 0 then - Write_Str (" - 1"); + if Fbit = 0 then + Write_Str (" - 1"); - elsif Fbit = 1 then - null; + elsif Fbit = 1 then + null; - else - Write_Str (" + "); - Write_Int (UI_To_Int (Fbit) - 1); - end if; + else + Write_Str (" + "); + Write_Int (UI_To_Int (Fbit) - 1); end if; + end if; - Write_Line (";"); - end; - end if; + Write_Line (";"); + end; <<Continue>> - Comp := Next_Entity (Comp); + Next_Component_Or_Discriminant (Comp); end loop; Write_Line ("end record;"); diff --git a/gcc/ada/sem_ch13.adb b/gcc/ada/sem_ch13.adb index 6a49bd565ca..e6925f37866 100644 --- a/gcc/ada/sem_ch13.adb +++ b/gcc/ada/sem_ch13.adb @@ -166,6 +166,265 @@ package body Sem_Ch13 is return Empty; end Address_Aliased_Entity; + ----------------------------------------- + -- Adjust_Record_For_Reverse_Bit_Order -- + ----------------------------------------- + + procedure Adjust_Record_For_Reverse_Bit_Order (R : Entity_Id) is + Max_Machine_Scalar_Size : constant Uint := + UI_From_Int + (Standard_Long_Long_Integer_Size); + -- We use this as the maximum machine scalar size in the sense of AI-133 + + Num_CC : Natural; + Comp : Entity_Id; + SSU : constant Uint := UI_From_Int (System_Storage_Unit); + + begin + -- This first loop through components does two things. First it deals + -- with the case of components with component clauses whose length is + -- greater than the maximum machine scalar size (either accepting them + -- or rejecting as needed). Second, it counts the number of components + -- with component clauses whose length does not exceed this maximum for + -- later processing. + + Num_CC := 0; + Comp := First_Component_Or_Discriminant (R); + while Present (Comp) loop + declare + CC : constant Node_Id := Component_Clause (Comp); + Fbit : constant Uint := Static_Integer (First_Bit (CC)); + + begin + if Present (CC) then + + -- Case of component with size > max machine scalar + + if Esize (Comp) > Max_Machine_Scalar_Size then + + -- Must begin on byte boundary + + if Fbit mod SSU /= 0 then + Error_Msg_N + ("illegal first bit value for reverse bit order", + First_Bit (CC)); + Error_Msg_Uint_1 := SSU; + Error_Msg_Uint_2 := Max_Machine_Scalar_Size; + + Error_Msg_N + ("\must be a multiple of ^ if size greater than ^", + First_Bit (CC)); + + -- Must end on byte boundary + + elsif Esize (Comp) mod SSU /= 0 then + Error_Msg_N + ("illegal last bit value for reverse bit order", + Last_Bit (CC)); + Error_Msg_Uint_1 := SSU; + Error_Msg_Uint_2 := Max_Machine_Scalar_Size; + + Error_Msg_N + ("\must be a multiple of ^ if size greater than ^", + Last_Bit (CC)); + + -- OK, give warning if enabled + + elsif Warn_On_Reverse_Bit_Order then + Error_Msg_N + ("multi-byte field specified with non-standard" + & " Bit_Order?", CC); + + if Bytes_Big_Endian then + Error_Msg_N + ("\bytes are not reversed " + & "(component is big-endian)?", CC); + else + Error_Msg_N + ("\bytes are not reversed " + & "(component is little-endian)?", CC); + end if; + end if; + + -- Case where size is not greater than max machine scalar. + -- For now, we just count these. + + else + Num_CC := Num_CC + 1; + end if; + end if; + end; + + Next_Component_Or_Discriminant (Comp); + end loop; + + -- We need to sort the component clauses on the basis of the Position + -- values in the clause, so we can group clauses with the same Position + -- together to determine the relevant machine scalar size. + + declare + Comps : array (0 .. Num_CC) of Entity_Id; + -- Array to collect component and discrimninant entities. The data + -- starts at index 1, the 0'th entry is for GNAT.Heap_Sort_A. + + function CP_Lt (Op1, Op2 : Natural) return Boolean; + -- Compare routine for Sort (See GNAT.Heap_Sort_A) + + procedure CP_Move (From : Natural; To : Natural); + -- Move routine for Sort (see GNAT.Heap_Sort_A) + + Start : Natural; + Stop : Natural; + -- Start and stop positions in component list of set of components + -- with the same starting position (that constitute components in + -- a single machine scalar). + + MaxL : Uint; + -- Maximum last bit value of any component in this set + + MSS : Uint; + -- Corresponding machine scalar size + + ----------- + -- CP_Lt -- + ----------- + + function CP_Lt (Op1, Op2 : Natural) return Boolean is + begin + return Position (Component_Clause (Comps (Op1))) < + Position (Component_Clause (Comps (Op2))); + end CP_Lt; + + ------------- + -- CP_Move -- + ------------- + + procedure CP_Move (From : Natural; To : Natural) is + begin + Comps (To) := Comps (From); + end CP_Move; + + begin + -- Collect the component clauses + + Num_CC := 0; + Comp := First_Component_Or_Discriminant (R); + while Present (Comp) loop + if Present (Component_Clause (Comp)) + and then Esize (Comp) <= Max_Machine_Scalar_Size + then + Num_CC := Num_CC + 1; + Comps (Num_CC) := Comp; + end if; + + Next_Component_Or_Discriminant (Comp); + end loop; + + -- Sort by ascending position number + + Sort (Num_CC, CP_Move'Unrestricted_Access, CP_Lt'Unrestricted_Access); + + -- We now have all the components whose size does not exceed the max + -- machine scalar value, sorted by starting position. In this loop + -- we gather groups of clauses starting at the same position, to + -- process them in accordance with Ada 2005 AI-133. + + Stop := 0; + while Stop < Num_CC loop + Start := Stop + 1; + Stop := Start; + MaxL := + Static_Integer (Last_Bit (Component_Clause (Comps (Start)))); + while Stop < Num_CC loop + if Static_Integer + (Position (Component_Clause (Comps (Stop + 1)))) = + Static_Integer + (Position (Component_Clause (Comps (Stop)))) + then + Stop := Stop + 1; + MaxL := + UI_Max + (MaxL, + Static_Integer + (Last_Bit (Component_Clause (Comps (Stop))))); + else + exit; + end if; + end loop; + + -- Now we have a group of component clauses from Start to Stop + -- whose positions are identical, and MaxL is the maximum last bit + -- value of any of these components. + + -- We need to determine the corresponding machine scalar size. + -- This loop assumes that machine scalar sizes are even, and that + -- each possible machine scalar has twice as many bits as the + -- next smaller one. + + MSS := Max_Machine_Scalar_Size; + while MSS mod 2 = 0 + and then (MSS / 2) >= SSU + and then (MSS / 2) > MaxL + loop + MSS := MSS / 2; + end loop; + + -- Here is where we fix up the Component_Bit_Offset value to + -- account for the reverse bit order. Some examples of what needs + -- to be done for the case of a machine scalar size of 8 are: + + -- First_Bit .. Last_Bit Component_Bit_Offset + -- old new old new + + -- 0 .. 0 7 .. 7 0 7 + -- 0 .. 1 6 .. 7 0 6 + -- 0 .. 2 5 .. 7 0 5 + -- 0 .. 7 0 .. 7 0 4 + + -- 1 .. 1 6 .. 6 1 6 + -- 1 .. 4 3 .. 6 1 3 + -- 4 .. 7 0 .. 3 4 0 + + -- The general rule is that the first bit is is obtained by + -- subtracting the old ending bit from machine scalar size - 1. + + for C in Start .. Stop loop + declare + Comp : constant Entity_Id := Comps (C); + CC : constant Node_Id := Component_Clause (Comp); + LB : constant Uint := Static_Integer (Last_Bit (CC)); + NFB : constant Uint := MSS - Uint_1 - LB; + NLB : constant Uint := NFB + Esize (Comp) - 1; + Pos : constant Uint := Static_Integer (Position (CC)); + + begin + if Warn_On_Reverse_Bit_Order then + Error_Msg_Uint_1 := MSS; + Error_Msg_N + ("?reverse bit order in machine " & + "scalar of length^", First_Bit (CC)); + Error_Msg_Uint_1 := NFB; + Error_Msg_Uint_2 := NLB; + + if Bytes_Big_Endian then + Error_Msg_NE + ("?\big-endian range for component & is ^ .. ^", + First_Bit (CC), Comp); + else + Error_Msg_NE + ("?\little-endian range for component & is ^ .. ^", + First_Bit (CC), Comp); + end if; + end if; + + Set_Component_Bit_Offset (Comp, Pos * SSU + NFB); + Set_Normalized_First_Bit (Comp, NFB mod SSU); + end; + end loop; + end loop; + end; + end Adjust_Record_For_Reverse_Bit_Order; + -------------------------------------- -- Alignment_Check_For_Esize_Change -- -------------------------------------- @@ -355,7 +614,7 @@ package body Sem_Ch13 is end if; if Present (Subp) then - if Is_Abstract (Subp) then + if Is_Abstract_Subprogram (Subp) then Error_Msg_N ("stream subprogram must not be abstract", Expr); return; end if; @@ -926,12 +1185,12 @@ package body Sem_Ch13 is Etyp := Etype (U_Ent); end if; - -- Check size, note that Gigi is in charge of checking - -- that the size of an array or record type is OK. Also - -- we do not check the size in the ordinary fixed-point - -- case, since it is too early to do so (there may be a - -- subsequent small clause that affects the size). We can - -- check the size if a small clause has already been given. + -- Check size, note that Gigi is in charge of checking that the + -- size of an array or record type is OK. Also we do not check + -- the size in the ordinary fixed-point case, since it is too + -- early to do so (there may be subsequent small clause that + -- affects the size). We can check the size if a small clause + -- has already been given. if not Is_Ordinary_Fixed_Point_Type (U_Ent) or else Has_Small_Clause (U_Ent) @@ -945,9 +1204,9 @@ package body Sem_Ch13 is if Is_Type (U_Ent) then Set_RM_Size (U_Ent, Size); - -- For scalar types, increase Object_Size to power of 2, - -- but not less than a storage unit in any case (i.e., - -- normally this means it will be byte addressable). + -- For scalar types, increase Object_Size to power of 2, but + -- not less than a storage unit in any case (i.e., normally + -- this means it will be byte addressable). if Is_Scalar_Type (U_Ent) then if Size <= System_Storage_Unit then @@ -1294,6 +1553,12 @@ package body Sem_Ch13 is then Error_Msg_N ("Value_Size already given for &", Nam); + elsif Is_Array_Type (U_Ent) + and then not Is_Constrained (U_Ent) + then + Error_Msg_N + ("Value_Size cannot be given for unconstrained array", Nam); + else if Is_Elementary_Type (U_Ent) then Check_Size (Expr, U_Ent, Size, Biased); @@ -1837,17 +2102,10 @@ package body Sem_Ch13 is -- Clear any existing component clauses for the type (this happens -- with derived types, where we are now overriding the original) - Fent := First_Entity (Rectype); - - Comp := Fent; + Comp := First_Component_Or_Discriminant (Rectype); while Present (Comp) loop - if Ekind (Comp) = E_Component - or else Ekind (Comp) = E_Discriminant - then - Set_Component_Clause (Comp, Empty); - end if; - - Next_Entity (Comp); + Set_Component_Clause (Comp, Empty); + Next_Component_Or_Discriminant (Comp); end loop; -- All done if no component clauses @@ -1862,6 +2120,8 @@ package body Sem_Ch13 is -- it at the start of the record (otherwise gigi may place it after -- other fields that have rep clauses). + Fent := First_Entity (Rectype); + if Nkind (Fent) = N_Defining_Identifier and then Chars (Fent) = Name_uTag then @@ -2284,15 +2544,10 @@ package body Sem_Ch13 is then -- Nothing to do if at least one component with no component clause - Comp := First_Entity (Rectype); + Comp := First_Component_Or_Discriminant (Rectype); while Present (Comp) loop - if Ekind (Comp) = E_Component - or else Ekind (Comp) = E_Discriminant - then - exit when No (Component_Clause (Comp)); - end if; - - Next_Entity (Comp); + exit when No (Component_Clause (Comp)); + Next_Component_Or_Discriminant (Comp); end loop; -- If we fall out of loop, all components have component clauses @@ -2306,19 +2561,14 @@ package body Sem_Ch13 is -- Check missing components if Complete_Representation pragma appeared if Present (CR_Pragma) then - Comp := First_Entity (Rectype); + Comp := First_Component_Or_Discriminant (Rectype); while Present (Comp) loop - if Ekind (Comp) = E_Component - or else - Ekind (Comp) = E_Discriminant - then - if No (Component_Clause (Comp)) then - Error_Msg_NE - ("missing component clause for &", CR_Pragma, Comp); - end if; + if No (Component_Clause (Comp)) then + Error_Msg_NE + ("missing component clause for &", CR_Pragma, Comp); end if; - Next_Entity (Comp); + Next_Component_Or_Discriminant (Comp); end loop; end if; end Analyze_Record_Representation_Clause; diff --git a/gcc/ada/sem_ch13.ads b/gcc/ada/sem_ch13.ads index 288e3007a1f..1da73e2f1c0 100644 --- a/gcc/ada/sem_ch13.ads +++ b/gcc/ada/sem_ch13.ads @@ -6,7 +6,7 @@ -- -- -- S p e c -- -- -- --- Copyright (C) 1992-2005, Free Software Foundation, Inc. -- +-- Copyright (C) 1992-2006, 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- -- @@ -35,6 +35,13 @@ package Sem_Ch13 is procedure Analyze_Record_Representation_Clause (N : Node_Id); procedure Analyze_Code_Statement (N : Node_Id); + procedure Adjust_Record_For_Reverse_Bit_Order (R : Entity_Id); + -- Called from Freeze where R is a record entity for which reverse bit + -- order is specified and there is at least one component clause. Adjusts + -- component positions according to Ada 2005 AI-133. Note that this is only + -- called in Ada 2005 mode. The Ada 95 handling for bit order is entirely + -- contained in Freeze. + procedure Initialize; -- Initialize internal tables for new compilation diff --git a/gcc/ada/style.ads b/gcc/ada/style.ads index 170857376f5..4dbc55cef63 100644 --- a/gcc/ada/style.ads +++ b/gcc/ada/style.ads @@ -65,6 +65,16 @@ package Style is renames Style_Inst.Check_Apostrophe; -- Called after scanning an apostrophe to check spacing + procedure Check_Array_Attribute_Index + (N : Node_Id; + E1 : Node_Id; + D : Int) + renames Style_C_Inst.Check_Array_Attribute_Index; + -- Called for an array attribute specifying an index number. N is the + -- node for the attribute, and E1 is the index expression (Empty if none + -- present). If E1 is present, it is known to be a static integer. D is + -- the number of dimensions of the array. + procedure Check_Arrow renames Style_Inst.Check_Arrow; -- Called after scanning out an arrow to check spacing diff --git a/gcc/ada/styleg-c.adb b/gcc/ada/styleg-c.adb index d9c1049107f..fa3690ea427 100644 --- a/gcc/ada/styleg-c.adb +++ b/gcc/ada/styleg-c.adb @@ -6,7 +6,7 @@ -- -- -- B o d y -- -- -- --- Copyright (C) 1992-2005 Free Software Foundation, Inc. -- +-- Copyright (C) 1992-2006, 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- -- @@ -67,6 +67,29 @@ package body Styleg.C is end if; end Body_With_No_Spec; + --------------------------------- + -- Check_Array_Attribute_Index -- + --------------------------------- + + procedure Check_Array_Attribute_Index + (N : Node_Id; + E1 : Node_Id; + D : Int) + is + begin + if Style_Check_Array_Attribute_Index then + if D = 1 and then Present (E1) then + Error_Msg_N + ("(style) index number not allowed for one dimensional array", + E1); + elsif D > 1 and then No (E1) then + Error_Msg_N + ("(style) index number required for multi-dimensional array", + N); + end if; + end if; + end Check_Array_Attribute_Index; + ---------------------- -- Check_Identifier -- ---------------------- diff --git a/gcc/ada/styleg-c.ads b/gcc/ada/styleg-c.ads index 1ba9826a609..23072da91b8 100644 --- a/gcc/ada/styleg-c.ads +++ b/gcc/ada/styleg-c.ads @@ -6,7 +6,7 @@ -- -- -- S p e c -- -- -- --- Copyright (C) 1992-2005 Free Software Foundation, Inc. -- +-- Copyright (C) 1992-2006, 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- -- @@ -38,6 +38,15 @@ package Styleg.C is -- Called where N is a subprogram body node for a subprogram body -- for which no spec was given, i.e. a body acting as its own spec. + procedure Check_Array_Attribute_Index + (N : Node_Id; + E1 : Node_Id; + D : Int); + -- Called for an array attribute specifying an index number. N is the + -- node for the attribute, and E1 is the index expression (Empty if none + -- present). If E1 is present, it is known to be a static integer. D is + -- the number of dimensions of the array. + procedure Check_Identifier (Ref : Node_Or_Entity_Id; Def : Node_Or_Entity_Id); diff --git a/gcc/ada/stylesw.adb b/gcc/ada/stylesw.adb index e1eda448945..b27d4e03409 100644 --- a/gcc/ada/stylesw.adb +++ b/gcc/ada/stylesw.adb @@ -35,28 +35,29 @@ package body Stylesw is procedure Reset_Style_Check_Options is begin - Style_Check_Indentation := 0; - Style_Check_Attribute_Casing := False; - Style_Check_Blanks_At_End := False; - Style_Check_Blank_Lines := False; - Style_Check_Comments := False; - Style_Check_DOS_Line_Terminator := False; - Style_Check_End_Labels := False; - Style_Check_Form_Feeds := False; - Style_Check_Horizontal_Tabs := False; - Style_Check_If_Then_Layout := False; - Style_Check_Keyword_Casing := False; - Style_Check_Layout := False; - Style_Check_Max_Line_Length := False; - Style_Check_Max_Nesting_Level := False; - Style_Check_Mode_In := False; - Style_Check_Order_Subprograms := False; - Style_Check_Pragma_Casing := False; - Style_Check_References := False; - Style_Check_Specs := False; - Style_Check_Standard := False; - Style_Check_Tokens := False; - Style_Check_Xtra_Parens := False; + Style_Check_Indentation := 0; + Style_Check_Array_Attribute_Index := False; + Style_Check_Attribute_Casing := False; + Style_Check_Blanks_At_End := False; + Style_Check_Blank_Lines := False; + Style_Check_Comments := False; + Style_Check_DOS_Line_Terminator := False; + Style_Check_End_Labels := False; + Style_Check_Form_Feeds := False; + Style_Check_Horizontal_Tabs := False; + Style_Check_If_Then_Layout := False; + Style_Check_Keyword_Casing := False; + Style_Check_Layout := False; + Style_Check_Max_Line_Length := False; + Style_Check_Max_Nesting_Level := False; + Style_Check_Mode_In := False; + Style_Check_Order_Subprograms := False; + Style_Check_Pragma_Casing := False; + Style_Check_References := False; + Style_Check_Specs := False; + Style_Check_Standard := False; + Style_Check_Tokens := False; + Style_Check_Xtra_Parens := False; end Reset_Style_Check_Options; ------------------------------ @@ -64,7 +65,7 @@ package body Stylesw is ------------------------------ procedure Save_Style_Check_Options (Options : out Style_Check_Options) is - P : Natural := 0; + P : Natural := 0; procedure Add (C : Character; S : Boolean); -- Add given character C to string if switch S is true @@ -109,6 +110,7 @@ package body Stylesw is Style_Check_Indentation /= 0); Add ('a', Style_Check_Attribute_Casing); + Add ('A', Style_Check_Array_Attribute_Index); Add ('b', Style_Check_Blanks_At_End); Add ('c', Style_Check_Comments); Add ('d', Style_Check_DOS_Line_Terminator); @@ -155,7 +157,7 @@ package body Stylesw is procedure Set_Default_Style_Check_Options is begin Reset_Style_Check_Options; - Set_Style_Check_Options ("3abcefhiklmnprst"); + Set_Style_Check_Options ("3aAbcefhiklmnprst"); end Set_Default_Style_Check_Options; ----------------------------- @@ -228,37 +230,40 @@ package body Stylesw is Character'Pos (C) - Character'Pos ('0'); when 'a' => - Style_Check_Attribute_Casing := True; + Style_Check_Attribute_Casing := True; + + when 'A' => + Style_Check_Array_Attribute_Index := True; when 'b' => - Style_Check_Blanks_At_End := True; + Style_Check_Blanks_At_End := True; when 'c' => - Style_Check_Comments := True; + Style_Check_Comments := True; when 'd' => - Style_Check_DOS_Line_Terminator := True; + Style_Check_DOS_Line_Terminator := True; when 'e' => - Style_Check_End_Labels := True; + Style_Check_End_Labels := True; when 'f' => - Style_Check_Form_Feeds := True; + Style_Check_Form_Feeds := True; when 'h' => - Style_Check_Horizontal_Tabs := True; + Style_Check_Horizontal_Tabs := True; when 'i' => - Style_Check_If_Then_Layout := True; + Style_Check_If_Then_Layout := True; when 'I' => - Style_Check_Mode_In := True; + Style_Check_Mode_In := True; when 'k' => - Style_Check_Keyword_Casing := True; + Style_Check_Keyword_Casing := True; when 'l' => - Style_Check_Layout := True; + Style_Check_Layout := True; when 'L' => Style_Max_Nesting_Level := 0; @@ -289,11 +294,11 @@ package body Stylesw is Style_Check_Max_Nesting_Level := Style_Max_Nesting_Level /= 0; when 'm' => - Style_Check_Max_Line_Length := True; - Style_Max_Line_Length := 79; + Style_Check_Max_Line_Length := True; + Style_Max_Line_Length := 79; when 'M' => - Style_Max_Line_Length := 0; + Style_Max_Line_Length := 0; if Err_Col > Options'Last or else Options (Err_Col) not in '0' .. '9' @@ -321,34 +326,34 @@ package body Stylesw is or else Options (Err_Col) not in '0' .. '9'; end loop; - Style_Check_Max_Line_Length := Style_Max_Line_Length /= 0; + Style_Check_Max_Line_Length := Style_Max_Line_Length /= 0; when 'n' => - Style_Check_Standard := True; + Style_Check_Standard := True; when 'N' => Reset_Style_Check_Options; when 'o' => - Style_Check_Order_Subprograms := True; + Style_Check_Order_Subprograms := True; when 'p' => - Style_Check_Pragma_Casing := True; + Style_Check_Pragma_Casing := True; when 'r' => - Style_Check_References := True; + Style_Check_References := True; when 's' => - Style_Check_Specs := True; + Style_Check_Specs := True; when 't' => - Style_Check_Tokens := True; + Style_Check_Tokens := True; when 'u' => - Style_Check_Blank_Lines := True; + Style_Check_Blank_Lines := True; when 'x' => - Style_Check_Xtra_Parens := True; + Style_Check_Xtra_Parens := True; when ' ' => null; diff --git a/gcc/ada/stylesw.ads b/gcc/ada/stylesw.ads index 42e1774103e..85b823051ca 100644 --- a/gcc/ada/stylesw.ads +++ b/gcc/ada/stylesw.ads @@ -47,6 +47,12 @@ package Stylesw is -- through a call to Set_Default_Style_Check_Options. They should -- not be set directly in any other manner. + Style_Check_Array_Attribute_Index : Boolean := False; + -- This can be set True by using -gnatg or -gnatyA switches. If it is True + -- then index numbers for array attributes (like Length) are required to + -- be absent for one-dimensional arrays and present for multi-dimensional + -- array attribute references. + Style_Check_Attribute_Casing : Boolean := False; -- This can be set True by using the -gnatg or -gnatya switches. If -- it is True, then attribute names (including keywords such as diff --git a/gcc/ada/usage.adb b/gcc/ada/usage.adb index f3bc06965b6..1da60acdee8 100644 --- a/gcc/ada/usage.adb +++ b/gcc/ada/usage.adb @@ -391,10 +391,10 @@ begin Write_Line (" O turn off warnings for address clause overlay"); Write_Line (" p turn on warnings for ineffective pragma Inline"); Write_Line (" P* turn off warnings for ineffective pragma Inline"); - Write_Line (" q turn on warnings for questionable " & - "missing paretheses"); - Write_Line (" Q* turn off warnings for questionable " & - "missing paretheses"); + Write_Line (" q* turn on warnings for questionable " & + "missing parentheses"); + Write_Line (" Q turn off warnings for questionable " & + "missing parentheses"); Write_Line (" r turn on warnings for redundant construct"); Write_Line (" R* turn off warnings for redundant construct"); Write_Line (" s suppress all warnings"); @@ -409,6 +409,8 @@ begin "assumption"); Write_Line (" x* turn on warnings for export/import"); Write_Line (" X turn off warnings for export/import"); + Write_Line (" .x* turn on warnings for non-local exceptions"); + Write_Line (" .X turn off warnings for non-local exceptions"); Write_Line (" y* turn on warnings for Ada 2005 incompatibility"); Write_Line (" Y turn off warnings for Ada 2005 incompatibility"); Write_Line (" z* turn on size/align warnings for " & @@ -452,6 +454,7 @@ begin Write_Line ("Enable selected style checks xx = list of parameters:"); Write_Line (" 1-9 check indentation"); Write_Line (" a check attribute casing"); + Write_Line (" A check array attribute indexes"); Write_Line (" b check no blanks at end of lines"); Write_Line (" c check comment format"); Write_Line (" d check no DOS line terminators"); @@ -472,7 +475,7 @@ begin Write_Line (" s check separate subprogram specs present"); Write_Line (" t check token separation rules"); Write_Line (" u check no unnecessary blank lines"); - Write_Line (" x check extra parens around conditionals"); + Write_Line (" x check extra parentheses around conditionals"); -- Lines for -gnatyN switch |