ada-libraries
/
Ada_Drivers_Library
mirror of https://github.com/AdaCore/Ada_Drivers_Library
1
0
Fork 0
Code Issues Releases Wiki Activity

HAL.GPIO: Switch to a capability system 

Instead of returning False when a configuration is not supported, users
can call a function beforehand to know if it is supported. The
capability is also now a precondition of the setup procedures.
This commit is contained in:
Fabien Chouteau 2018-07-11 15:38:54 +02:00
parent eb8f8b4d8a
commit 4d32971732
15 changed files with 179 additions and 139 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

13
arch/ARM/Nordic/drivers/nrf51-gpio.adb
View File

@ -1,6 +1,6 @@
------------------------------------------------------------------------------
-- --
-- Copyright (C) 2016, AdaCore --
-- Copyright (C) 2016-2018, AdaCore --
-- --
-- Redistribution and use in source and binary forms, with or without --
-- modification, are permitted provided that the following conditions are --
@ -48,8 +48,8 @@ package body nRF51.GPIO is
--------------
overriding
function Set_Mode (This : in out GPIO_Point;
Mode : HAL.GPIO.GPIO_Config_Mode) return Boolean
procedure Set_Mode (This : in out GPIO_Point;
Mode : HAL.GPIO.GPIO_Config_Mode)
is
CNF : PIN_CNF_Register renames GPIO_Periph.PIN_CNF (This.Pin);
begin
@ -59,7 +59,6 @@ package body nRF51.GPIO is
CNF.INPUT := (case Mode is
when HAL.GPIO.Input => Connect,
when HAL.GPIO.Output => Disconnect);
return True;
end Set_Mode;
---------
@ -96,9 +95,8 @@ package body nRF51.GPIO is
-----------------------
overriding
function Set_Pull_Resistor (This : in out GPIO_Point;
Pull : HAL.GPIO.GPIO_Pull_Resistor)
return Boolean
procedure Set_Pull_Resistor (This : in out GPIO_Point;
Pull : HAL.GPIO.GPIO_Pull_Resistor)
is
begin
GPIO_Periph.PIN_CNF (This.Pin).PULL :=
@ -106,7 +104,6 @@ package body nRF51.GPIO is
when HAL.GPIO.Floating => Disabled,
when HAL.GPIO.Pull_Down => Pulldown,
when HAL.GPIO.Pull_Up => Pullup);
return True;
end Set_Pull_Resistor;
---------

19
arch/ARM/Nordic/drivers/nrf51-gpio.ads
View File

@ -1,6 +1,6 @@
------------------------------------------------------------------------------
-- --
-- Copyright (C) 2016, AdaCore --
-- Copyright (C) 2016-2018, AdaCore --
-- --
-- Redistribution and use in source and binary forms, with or without --
-- modification, are permitted provided that the following conditions are --
@ -67,21 +67,28 @@ package nRF51.GPIO is
Pin : GPIO_Pin_Index;
end record;
overriding
function Support (This : GPIO_Point;
Capa : HAL.GPIO.Capability)
return Boolean
is (case Capa is
when others => True);
-- nRF51 supports all GPIO capabilities
overriding
function Mode (This : GPIO_Point) return HAL.GPIO.GPIO_Mode;
overriding
function Set_Mode (This : in out GPIO_Point;
Mode : HAL.GPIO.GPIO_Config_Mode) return Boolean;
procedure Set_Mode (This : in out GPIO_Point;
Mode : HAL.GPIO.GPIO_Config_Mode);
overriding
function Pull_Resistor (This : GPIO_Point)
return HAL.GPIO.GPIO_Pull_Resistor;
overriding
function Set_Pull_Resistor (This : in out GPIO_Point;
Pull : HAL.GPIO.GPIO_Pull_Resistor)
return Boolean;
procedure Set_Pull_Resistor (This : in out GPIO_Point;
Pull : HAL.GPIO.GPIO_Pull_Resistor);
overriding
function Set (This : GPIO_Point) return Boolean with

12
arch/ARM/STM32/drivers/stm32-gpio.adb
View File

@ -1,6 +1,6 @@
------------------------------------------------------------------------------
-- --
-- Copyright (C) 2015-2017, AdaCore --
-- Copyright (C) 2015-2018, AdaCore --
-- --
-- Redistribution and use in source and binary forms, with or without --
-- modification, are permitted provided that the following conditions are --
@ -84,7 +84,7 @@ package body STM32.GPIO is
case Pin_IO_Mode (This) is
when Mode_Out => return HAL.GPIO.Output;
when Mode_In => return HAL.GPIO.Input;
when others => return HAL.GPIO.Unknown;
when others => return HAL.GPIO.Unknown_Mode;
end case;
end Mode;
@ -103,10 +103,9 @@ package body STM32.GPIO is
--------------
overriding
function Set_Mode
procedure Set_Mode
(This : in out GPIO_Point;
Mode : HAL.GPIO.GPIO_Config_Mode)
return Boolean
is
Index : constant GPIO_Pin_Index := GPIO_Pin'Pos (This.Pin);
begin
@ -116,7 +115,6 @@ package body STM32.GPIO is
when HAL.GPIO.Input =>
This.Periph.MODER.Arr (Index) := Pin_IO_Modes'Enum_Rep (Mode_In);
end case;
return True;
end Set_Mode;
-------------------
@ -144,10 +142,9 @@ package body STM32.GPIO is
-----------------------
overriding
function Set_Pull_Resistor
procedure Set_Pull_Resistor
(This : in out GPIO_Point;
Pull : HAL.GPIO.GPIO_Pull_Resistor)
return Boolean
is
Index : constant GPIO_Pin_Index := GPIO_Pin'Pos (This.Pin);
begin
@ -159,7 +156,6 @@ package body STM32.GPIO is
when HAL.GPIO.Pull_Down =>
This.Periph.PUPDR.Arr (Index) := 2;
end case;
return True;
end Set_Pull_Resistor;
---------

19
arch/ARM/STM32/drivers/stm32-gpio.ads
View File

@ -1,6 +1,6 @@
------------------------------------------------------------------------------
-- --
-- Copyright (C) 2015-2017, AdaCore --
-- Copyright (C) 2015-2018, AdaCore --
-- --
-- Redistribution and use in source and binary forms, with or without --
-- modification, are permitted provided that the following conditions are --
@ -142,21 +142,28 @@ package STM32.GPIO is
Pin : GPIO_Pin;
end record;
overriding
function Support (This : GPIO_Point;
Capa : HAL.GPIO.Capability)
return Boolean
is (case Capa is
when others => True);
-- STM32 supports all GPIO capabilities
overriding
function Mode (This : GPIO_Point) return HAL.GPIO.GPIO_Mode;
overriding
function Set_Mode (This : in out GPIO_Point;
Mode : HAL.GPIO.GPIO_Config_Mode) return Boolean;
procedure Set_Mode (This : in out GPIO_Point;
Mode : HAL.GPIO.GPIO_Config_Mode);
overriding
function Pull_Resistor (This : GPIO_Point)
return HAL.GPIO.GPIO_Pull_Resistor;
overriding
function Set_Pull_Resistor (This : in out GPIO_Point;
Pull : HAL.GPIO.GPIO_Pull_Resistor)
return Boolean;
procedure Set_Pull_Resistor (This : in out GPIO_Point;
Pull : HAL.GPIO.GPIO_Pull_Resistor);
overriding
function Set (This : GPIO_Point) return Boolean with

24
arch/RISC-V/SiFive/drivers/fe310-gpio.adb
View File

@ -1,6 +1,6 @@
------------------------------------------------------------------------------
-- --
-- Copyright (C) 2017, AdaCore --
-- Copyright (C) 2017-2018, AdaCore --
-- --
-- Redistribution and use in source and binary forms, with or without --
-- modification, are permitted provided that the following conditions are --
@ -75,7 +75,7 @@ package body FE310.GPIO is
function Mode (This : GPIO_Point) return HAL.GPIO.GPIO_Mode is
begin
if GPIO0_Periph.IO_FUNC_EN.Arr (This.Pin) then
return Unknown;
return Unknown_Mode;
elsif GPIO0_Periph.OUTPUT_EN.Arr (This.Pin) then
return Output;
else
@ -88,14 +88,14 @@ package body FE310.GPIO is
--------------
overriding
function Set_Mode (This : in out GPIO_Point;
Mode : HAL.GPIO.GPIO_Config_Mode) return Boolean is
procedure Set_Mode (This : in out GPIO_Point;
Mode : HAL.GPIO.GPIO_Config_Mode)
is
begin
-- Input mode is always on to make sure we can read IO state even in
-- output mode.
GPIO0_Periph.INPUT_EN.Arr (This.Pin) := True;
GPIO0_Periph.OUTPUT_EN.Arr (This.Pin) := Mode = Output;
return True;
end Set_Mode;
-------------------
@ -118,16 +118,12 @@ package body FE310.GPIO is
-----------------------
overriding
function Set_Pull_Resistor (This : in out GPIO_Point;
Pull : HAL.GPIO.GPIO_Pull_Resistor)
return Boolean is
procedure Set_Pull_Resistor (This : in out GPIO_Point;
Pull : HAL.GPIO.GPIO_Pull_Resistor)
is
begin
if Pull = Pull_Down then
return False;
else
GPIO0_Periph.PULLUP.Arr (This.Pin) := Pull = Pull_Up;
return True;
end if;
GPIO0_Periph.PULLUP.Arr (This.Pin) := Pull = Pull_Up;
end Set_Pull_Resistor;
---------

19
arch/RISC-V/SiFive/drivers/fe310-gpio.ads
View File

@ -1,6 +1,6 @@
------------------------------------------------------------------------------
-- --
-- Copyright (C) 2017, AdaCore --
-- Copyright (C) 2017-2018, AdaCore --
-- --
-- Redistribution and use in source and binary forms, with or without --
-- modification, are permitted provided that the following conditions are --
@ -56,21 +56,28 @@ package FE310.GPIO is
-- HAL.GPIO --
---------------
overriding
function Support (This : GPIO_Point;
Capa : HAL.GPIO.Capability)
return Boolean
is (case Capa is
when HAL.GPIO.Pull_Down => False,
when others => True);
overriding
function Mode (This : GPIO_Point) return HAL.GPIO.GPIO_Mode;
overriding
function Set_Mode (This : in out GPIO_Point;
Mode : HAL.GPIO.GPIO_Config_Mode) return Boolean;
procedure Set_Mode (This : in out GPIO_Point;
Mode : HAL.GPIO.GPIO_Config_Mode);
overriding
function Pull_Resistor (This : GPIO_Point)
return HAL.GPIO.GPIO_Pull_Resistor;
overriding
function Set_Pull_Resistor (This : in out GPIO_Point;
Pull : HAL.GPIO.GPIO_Pull_Resistor)
return Boolean;
procedure Set_Pull_Resistor (This : in out GPIO_Point;
Pull : HAL.GPIO.GPIO_Pull_Resistor);
overriding
function Set (This : GPIO_Point) return Boolean;

15
boards/HiFive1/src/hifive1-leds.adb
View File

@ -1,6 +1,6 @@
------------------------------------------------------------------------------
-- --
-- Copyright (C) 2017, AdaCore --
-- Copyright (C) 2017-2018, AdaCore --
-- --
-- Redistribution and use in source and binary forms, with or without --
-- modification, are permitted provided that the following conditions are --
@ -38,18 +38,17 @@ package body HiFive1.LEDs is
----------------
procedure Initialize is
Unref : Boolean with Unreferenced;
begin
Unref := Green_LED.Set_Mode (Output);
Unref := Green_LED.Set_Pull_Resistor (Pull_Up);
Green_LED.Set_Mode (Output);
Green_LED.Set_Pull_Resistor (Pull_Up);
Turn_Off (Green_LED);
Unref := Red_LED.Set_Mode (Output);
Unref := Red_LED.Set_Pull_Resistor (Pull_Up);
Red_LED.Set_Mode (Output);
Red_LED.Set_Pull_Resistor (Pull_Up);
Turn_Off (Red_LED);
Unref := Blue_LED.Set_Mode (Output);
Unref := Blue_LED.Set_Pull_Resistor (Pull_Up);
Blue_LED.Set_Mode (Output);
Blue_LED.Set_Pull_Resistor (Pull_Up);
Turn_Off (Blue_LED);
end Initialize;

19
components/src/io_expander/MCP23xxx/mcp23x08.adb
View File

@ -1,6 +1,6 @@
------------------------------------------------------------------------------
-- --
-- Copyright (C) 2015-2016, AdaCore --
-- Copyright (C) 2015-2018, AdaCore --
-- --
-- Redistribution and use in source and binary forms, with or without --
-- modification, are permitted provided that the following conditions are --
@ -314,13 +314,12 @@ package body MCP23x08 is
--------------
overriding
function Set_Mode (This : in out MCP23_GPIO_Point;
Mode : HAL.GPIO.GPIO_Config_Mode) return Boolean
procedure Set_Mode (This : in out MCP23_GPIO_Point;
Mode : HAL.GPIO.GPIO_Config_Mode)
is
begin
This.Device.Configure_Mode (Pin => This.Pin,
Output => (Mode = HAL.GPIO.Output));
return True;
end Set_Mode;
-------------------
@ -343,17 +342,11 @@ package body MCP23x08 is
-----------------------
overriding
function Set_Pull_Resistor (This : in out MCP23_GPIO_Point;
Pull : HAL.GPIO.GPIO_Pull_Resistor)
return Boolean
procedure Set_Pull_Resistor (This : in out MCP23_GPIO_Point;
Pull : HAL.GPIO.GPIO_Pull_Resistor)
is
begin
if Pull = HAL.GPIO.Pull_Down then
return False;
else
This.Device.Configure_Pull (This.Pin, Pull = HAL.GPIO.Pull_Up);
return True;
end if;
This.Device.Configure_Pull (This.Pin, Pull = HAL.GPIO.Pull_Up);
end Set_Pull_Resistor;
---------

20
components/src/io_expander/MCP23xxx/mcp23x08.ads
View File

@ -1,6 +1,6 @@
------------------------------------------------------------------------------
-- --
-- Copyright (C) 2015-2016, AdaCore --
-- Copyright (C) 2015-2018, AdaCore --
-- --
-- Redistribution and use in source and binary forms, with or without --
-- modification, are permitted provided that the following conditions are --
@ -120,21 +120,29 @@ private
end record;
-- Internal implementation of HAL.GPIO interface
overriding
function Support (This : MCP23_GPIO_Point;
Capa : HAL.GPIO.Capability)
return Boolean
is (case Capa is
when HAL.GPIO.Pull_Down => False,
when others => True);
overriding
function Mode (This : MCP23_GPIO_Point) return HAL.GPIO.GPIO_Mode;
overriding
function Set_Mode (This : in out MCP23_GPIO_Point;
Mode : HAL.GPIO.GPIO_Config_Mode) return Boolean;
procedure Set_Mode (This : in out MCP23_GPIO_Point;
Mode : HAL.GPIO.GPIO_Config_Mode);
overriding
function Pull_Resistor (This : MCP23_GPIO_Point)
return HAL.GPIO.GPIO_Pull_Resistor;
overriding
function Set_Pull_Resistor (This : in out MCP23_GPIO_Point;
Pull : HAL.GPIO.GPIO_Pull_Resistor)
return Boolean;
procedure Set_Pull_Resistor (This : in out MCP23_GPIO_Point;
Pull : HAL.GPIO.GPIO_Pull_Resistor);
overriding
function Set (This : MCP23_GPIO_Point) return Boolean;

26
components/src/io_expander/stmpe1600/stmpe1600.adb
View File

@ -1,6 +1,6 @@
------------------------------------------------------------------------------
-- --
-- Copyright (C) 2017, AdaCore --
-- Copyright (C) 2017-2018, AdaCore --
-- --
-- Redistribution and use in source and binary forms, with or without --
-- modification, are permitted provided that the following conditions are --
@ -338,21 +338,22 @@ package body STMPE1600 is
--------------
overriding
function Set_Mode (This : in out STMPE1600_Pin;
Mode : HAL.GPIO.GPIO_Config_Mode) return Boolean
procedure Set_Mode (This : in out STMPE1600_Pin;
Mode : HAL.GPIO.GPIO_Config_Mode)
is
begin
Set_Pin_Direction (This.Port.all, This.Pin, (case Mode is
when HAL.GPIO.Input => Input,
when HAL.GPIO.Output => Output));
return True;
Set_Pin_Direction (This.Port.all, This.Pin,
(case Mode is
when HAL.GPIO.Input => Input,
when HAL.GPIO.Output => Output));
end Set_Mode;
---------
-- Set --
---------
overriding function Set (This : STMPE1600_Pin) return Boolean
overriding
function Set (This : STMPE1600_Pin) return Boolean
is
begin
return Pin_State (This.Port.all, This.Pin);
@ -362,7 +363,8 @@ package body STMPE1600 is
-- Set --
---------
overriding procedure Set (This : in out STMPE1600_Pin)
overriding
procedure Set (This : in out STMPE1600_Pin)
is
begin
Set_Pin_State (This.Port.all, This.Pin, True);
@ -372,7 +374,8 @@ package body STMPE1600 is
-- Clear --
-----------
overriding procedure Clear (This : in out STMPE1600_Pin)
overriding
procedure Clear (This : in out STMPE1600_Pin)
is
begin
Set_Pin_State (This.Port.all, This.Pin, False);
@ -382,7 +385,8 @@ package body STMPE1600 is
-- Toggle --
------------
overriding procedure Toggle (This : in out STMPE1600_Pin)
overriding
procedure Toggle (This : in out STMPE1600_Pin)
is
begin
if This.Set then

20
components/src/io_expander/stmpe1600/stmpe1600.ads
View File

@ -1,6 +1,6 @@
------------------------------------------------------------------------------
-- --
-- Copyright (C) 2017, AdaCore --
-- Copyright (C) 2017-2018, AdaCore --
-- --
-- Redistribution and use in source and binary forms, with or without --
-- modification, are permitted provided that the following conditions are --
@ -152,13 +152,21 @@ private
type STMPE1600_Pin_Array is
array (STMPE1600_Pin_Number) of aliased STMPE1600_Pin;
overriding
function Support (This : STMPE1600_Pin;
Capa : HAL.GPIO.Capability)
return Boolean
is (case Capa is
when HAL.GPIO.Pull_Up | HAL.GPIO.Pull_Down => False,
when others => True);
-- STMPE1600 doesn't have internal pull resistors
overriding
function Mode (This : STMPE1600_Pin) return HAL.GPIO.GPIO_Mode;
overriding
function Set_Mode (This : in out STMPE1600_Pin;
Mode : HAL.GPIO.GPIO_Config_Mode) return Boolean;
procedure Set_Mode (This : in out STMPE1600_Pin;
Mode : HAL.GPIO.GPIO_Config_Mode);
overriding
function Pull_Resistor (This : STMPE1600_Pin)
@ -166,9 +174,9 @@ private
(HAL.GPIO.Floating);
overriding
function Set_Pull_Resistor (This : in out STMPE1600_Pin;
Pull : HAL.GPIO.GPIO_Pull_Resistor)
return Boolean is (Pull = HAL.GPIO.Floating);
procedure Set_Pull_Resistor (This : in out STMPE1600_Pin;
Pull : HAL.GPIO.GPIO_Pull_Resistor)
is null;
-- STMPE1600 doesn't have internal pull resistors
overriding

40
hal/src/hal-gpio.ads
View File

@ -1,6 +1,6 @@
------------------------------------------------------------------------------
-- --
-- Copyright (C) 2015-2016, AdaCore --
-- Copyright (C) 2015-2018, AdaCore --
-- --
-- Redistribution and use in source and binary forms, with or without --
-- modification, are permitted provided that the following conditions are --
@ -31,33 +31,47 @@
package HAL.GPIO is
type GPIO_Mode is (Unknown, Input, Output);
-- Possible modes for a GPIO point. Unknown means that the point is
-- configured in a mode that is not described in this interface. For
type Capability is (Unknown_Mode, Input, Output, -- Mode
Floating, Pull_Up, Pull_Down); -- Resistor
subtype GPIO_Mode is Capability range Unknown_Mode .. Output;
-- Possible modes for a GPIO point. Unknown_Mode means that the point
-- is configured in a mode that is not described in this interface. For
-- instance alternate function mode on an STM32 micro-controller.
subtype GPIO_Config_Mode is GPIO_Mode range Input .. Output;
-- Modes a GPIO point can be configured in
type GPIO_Pull_Resistor is (Floating, Pull_Up, Pull_Down);
subtype GPIO_Pull_Resistor is Capability range Floating .. Pull_Down;
type GPIO_Point is limited interface;
type Any_GPIO_Point is access all GPIO_Point'Class;
function Mode (This : GPIO_Point) return GPIO_Mode is abstract;
function Support (This : GPIO_Point;
Capa : Capability)
return Boolean
is abstract;
-- Return True if the GPIO_Point supports the given capability
function Set_Mode (This : in out GPIO_Point;
Mode : GPIO_Config_Mode) return Boolean is abstract;
-- Return False if the mode is not available
function Mode (This : GPIO_Point) return GPIO_Mode is abstract;
-- Return the current mode of the GPIO_Point
procedure Set_Mode (This : in out GPIO_Point;
Mode : GPIO_Config_Mode)
is abstract
with Pre'Class => This.Support (Mode);
-- Set the mode of the GPIO_Point, iff the mode is supported
function Pull_Resistor (This : GPIO_Point)
return GPIO_Pull_Resistor is abstract;
-- Return the current pull resistor mode
function Set_Pull_Resistor (This : in out GPIO_Point;
Pull : GPIO_Pull_Resistor)
return Boolean is abstract;
-- Return False if pull is not available for this GPIO point
procedure Set_Pull_Resistor (This : in out GPIO_Point;
Pull : GPIO_Pull_Resistor)
is abstract
with Pre'Class => This.Support (Pull);
-- Set the pull resistor of the GPIO_Point, iff the pull mode is supported
function Set (This : GPIO_Point) return Boolean is abstract;
-- Read actual state of the GPIO_Point.

42
testsuite/tests/wire_simulation/src/tc_virtual_wire.adb
View File

@ -1,6 +1,6 @@
------------------------------------------------------------------------------
-- --
-- Copyright (C) 2017, AdaCore --
-- Copyright (C) 2017-2018, AdaCore --
-- --
-- Redistribution and use in source and binary forms, with or without --
-- modification, are permitted provided that the following conditions are --
@ -63,25 +63,27 @@ begin
-- State with only inputs and a point pull resistor --
pragma Assert (No_Pull_Wire.Point (1).Set_Pull_Resistor (Pull_Up),
pragma Assert (No_Pull_Wire.Point (1).Support (Pull_Up),
"It should be possible to change the pull resitor");
No_Pull_Wire.Point (1).Set_Pull_Resistor (Pull_Up);
pragma Assert (No_Pull_Wire.Point (1).Set,
"State of wire with one pull up point should be high");
Unref := No_Pull_Wire.Point (1).Set_Pull_Resistor (Pull_Down);
No_Pull_Wire.Point (1).Set_Pull_Resistor (Pull_Down);
pragma Assert (not No_Pull_Wire.Point (1).Set,
"State of wire with one pull down point should be low");
-- State with one input one output and no pull resistor --
pragma Assert (No_Pull_Wire.Point (1).Set_Mode (Input),
pragma Assert (No_Pull_Wire.Point (1).Support (Input),
"It should be possible to change the mode");
Unref := No_Pull_Wire.Point (1).Set_Pull_Resistor (Pull_Down);
No_Pull_Wire.Point (1).Set_Mode (Input);
No_Pull_Wire.Point (1).Set_Pull_Resistor (Pull_Down);
Unref := No_Pull_Wire.Point (2).Set_Mode (Output);
Unref := No_Pull_Wire.Point (2).Set_Pull_Resistor (Floating);
No_Pull_Wire.Point (2).Set_Mode (Output);
No_Pull_Wire.Point (2).Set_Pull_Resistor (Floating);
No_Pull_Wire.Point (2).Set;
pragma Assert (No_Pull_Wire.Point (1).Set, "Should be high");
@ -90,18 +92,18 @@ begin
-- State with one input one output and point pull resistor --
Unref := No_Pull_Wire.Point (1).Set_Mode (Input);
Unref := No_Pull_Wire.Point (1).Set_Pull_Resistor (Pull_Up);
No_Pull_Wire.Point (1).Set_Mode (Input);
No_Pull_Wire.Point (1).Set_Pull_Resistor (Pull_Up);
Unref := No_Pull_Wire.Point (2).Set_Mode (Output);
Unref := No_Pull_Wire.Point (2).Set_Pull_Resistor (Floating);
No_Pull_Wire.Point (2).Set_Mode (Output);
No_Pull_Wire.Point (2).Set_Pull_Resistor (Floating);
No_Pull_Wire.Point (2).Set;
pragma Assert (No_Pull_Wire.Point (1).Set, "Should be high");
No_Pull_Wire.Point (2).Clear;
pragma Assert (not No_Pull_Wire.Point (1).Set, "Should be low");
Unref := No_Pull_Wire.Point (1).Set_Pull_Resistor (Pull_Down);
No_Pull_Wire.Point (1).Set_Pull_Resistor (Pull_Down);
No_Pull_Wire.Point (2).Set;
pragma Assert (No_Pull_Wire.Point (1).Set, "Should be high");
@ -111,7 +113,7 @@ begin
-- Opposite pull on the same wire --
declare
begin
Unref := Pull_Down_Wire.Point (1).Set_Pull_Resistor (Pull_Up);
Pull_Down_Wire.Point (1).Set_Pull_Resistor (Pull_Up);
exception
when Invalid_Configuration =>
Put_Line ("Expected exception on oppposite pull (1)");
@ -119,7 +121,7 @@ begin
declare
begin
Unref := Pull_Up_Wire.Point (1).Set_Pull_Resistor (Pull_Down);
Pull_Up_Wire.Point (1).Set_Pull_Resistor (Pull_Down);
exception
when Invalid_Configuration =>
Put_Line ("Expected exception on oppposite pull (2)");
@ -128,8 +130,8 @@ begin
-- Two output point on a wire --
declare
begin
Unref := Pull_Up_Wire.Point (1).Set_Mode (Output);
Unref := Pull_Up_Wire.Point (2).Set_Mode (Output);
Pull_Up_Wire.Point (1).Set_Mode (Output);
Pull_Up_Wire.Point (2).Set_Mode (Output);
exception
when Invalid_Configuration =>
Put_Line ("Expected exception on multiple output points");
@ -138,10 +140,10 @@ begin
-- Unknon state --
declare
begin
Unref := No_Pull_Wire.Point (1).Set_Mode (Input);
Unref := No_Pull_Wire.Point (1).Set_Pull_Resistor (Floating);
Unref := No_Pull_Wire.Point (2).Set_Mode (Input);
Unref := No_Pull_Wire.Point (2).Set_Pull_Resistor (Floating);
No_Pull_Wire.Point (1).Set_Mode (Input);
No_Pull_Wire.Point (1).Set_Pull_Resistor (Floating);
No_Pull_Wire.Point (2).Set_Mode (Input);
No_Pull_Wire.Point (2).Set_Pull_Resistor (Floating);
Unref := No_Pull_Wire.Point (2).Set;
exception
when Unknown_State =>

12
testsuite/utils/src/wire_simulation.adb
View File

@ -1,6 +1,6 @@
------------------------------------------------------------------------------
-- --
-- Copyright (C) 2017, AdaCore --
-- Copyright (C) 2017-2018, AdaCore --
-- --
-- Redistribution and use in source and binary forms, with or without --
-- modification, are permitted provided that the following conditions are --
@ -49,10 +49,9 @@ package body Wire_Simulation is
-- Set_Mode --
--------------
overriding function Set_Mode
overriding procedure Set_Mode
(This : in out Wire_Point;
Mode : GPIO_Config_Mode)
return Boolean
is
begin
This.Current_Mode := Input;
@ -61,17 +60,15 @@ package body Wire_Simulation is
end if;
This.Current_Mode := Mode;
This.Wire.Update_Wire_State;
return True;
end Set_Mode;
-----------------------
-- Set_Pull_Resistor --
-----------------------
overriding function Set_Pull_Resistor
overriding procedure Set_Pull_Resistor
(This : in out Wire_Point;
Pull : GPIO_Pull_Resistor)
return Boolean
is
begin
This.Current_Pull := Floating;
@ -93,7 +90,6 @@ package body Wire_Simulation is
else
This.Current_Pull := Pull;
This.Wire.Update_Wire_State;
return True;
end if;
end Set_Pull_Resistor;
@ -160,7 +156,7 @@ package body Wire_Simulation is
Has_Pull_Up : constant Boolean :=
This.At_Least_One_Pull_Up or This.Default_Pull = Pull_Up;
Has_Pull_Down : constant Boolean :=
This.At_Least_One_Pull_Down or This.Default_Pull = Pull_Down;
This.At_Least_One_Pull_Down or This.Default_Pull = Pull_Down;
State : Wire_State := Unknown;
begin

18
testsuite/utils/src/wire_simulation.ads
View File

@ -1,6 +1,6 @@
------------------------------------------------------------------------------
-- --
-- Copyright (C) 2017, AdaCore --
-- Copyright (C) 2017-2018, AdaCore --
-- --
-- Redistribution and use in source and binary forms, with or without --
-- modification, are permitted provided that the following conditions are --
@ -63,12 +63,19 @@ private
Wire : Any_Virtual_Wire := null;
end record;
overriding
function Support (This : Wire_Point;
Capa : HAL.GPIO.Capability)
return Boolean
is (case Capa is
when others => True);
overriding
function Mode (This : Wire_Point) return GPIO_Mode is (This.Current_Mode);
overriding
function Set_Mode (This : in out Wire_Point;
Mode : GPIO_Config_Mode) return Boolean;
procedure Set_Mode (This : in out Wire_Point;
Mode : GPIO_Config_Mode);
-- Return False if the mode is not available
overriding
@ -76,9 +83,8 @@ private
return GPIO_Pull_Resistor is (This.Current_Pull);
overriding
function Set_Pull_Resistor (This : in out Wire_Point;
Pull : GPIO_Pull_Resistor)
return Boolean;
procedure Set_Pull_Resistor (This : in out Wire_Point;
Pull : GPIO_Pull_Resistor);
overriding
function Set (This : Wire_Point) return Boolean;